ref: 05e66c8ffeea8c0b02d49acca753f44b65e4ad32
parent: 8a1512175fa175d1a725a3731eb820338aa3ea26
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Apr 8 13:38:53 EDT 2025
extend stack tracing to C builtins; include the entire stack trace, always
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -269,14 +269,12 @@
NIL NIL NIL NIL :from-end 3) identity #0# #fn("n10S;J;04AF0<51513500<:92<0=61:" #() find-if-)list-tail list-head reverse!) find-if)
fits-i8 #fn("n10Y;3<0470r\xaf0r\xb063:" #(>=) fits-i8) fn-disasm- #fn("\x871000.///W1000J60q?14z282JG07001E534715047260:@30q482<2305124051II252687>1?:5142527187>2?;514E288851b<I8<<8=L23\x8a24292:888<>2q7;53E8<<L23907150@30q4E87K~2<|48<8<<KM_48>2=8?2>523[08;8>8<<r45348:897?888<<52G5148<8<<r4M_@\x1912=8?2@523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xea12=8?2A523e08;8>8<<K5347B2C888<<G8>2DC70r3@30EM515148<8<<KM_@\xac12=8?2E523\\08;8>8<<r45347B2C7?888<<52515148<8<<r4M_@w12=8?2F523\xb808;8>8<<r88>2GC70r4@30EM5347B2C7?888<<52512H5248<8<<r4M_47B2C7?888<<52515148<8<<r4M_48>2GCY07B2H5147B2C7?888<<52512H5248<8<<r4M_@30q@\xe608?2Ic3^08;8>8<<r45347B2C7?888<<52512H5248<8<<r4M_@\xb202=8?2J523b08;8>8<<r25347B2K7L8<<7M888<<52M515248<8<<r2M_@w02=8?2N523b08;8>8<<r45347B2K7L8<<7?888<<52M515248<8<<r4M_@<08;8>8<<E53^1^1@\xd0-:" #(fn-disasm- newline void #fn(fn-code) #fn(fn-vals) #1# #fn("n10\\3F00[JA070504710qAKM63:72061:" #(newline- fn-disasm
- print) print-val)
- #fn("n370A3U0FEl23N071A72151523A0A182ML237023@4024751K~512602765:" #(princ >= 1- " >" " " hex5- ": " " ") print-inst)
- #fn(length) #fn(table-foldl) #fn("n382;J@041AF<Gl2;34040:") Instructions #fn("n1702161:" #(princ- "\t")) #fn(memq) (loadv.l loadg.l setg.l) ref-s32-LE (loadv loadg setg)
+ #fn("\x871000.///W1000J60q?14z20[3:07060:@30q482JG07101E534725047060:@30q482<2305124051II252687>1?:5142527187>2?;514E288851b<I8<<8=L23\x8a24292:888<>2q7;53E8<<L23907250@30q4E87K~2<|48<8<<KM_48>2=8?2>523[08;8>8<<r45348:897?888<<52G5148<8<<r4M_@\x1912=8?2@523V08;8>8<<K5348:89888<<GG5148<8<<KM_@\xea12=8?2A523e08;8>8<<K5347B2C888<<G8>2DC70r3@30EM515148<8<<KM_@\xac12=8?2E523\\08;8>8<<r45347B2C7?888<<52515148<8<<r4M_@w12=8?2F523\xb808;8>8<<r88>2GC70r4@30EM5347B2C7?888<<52512H5248<8<<r4M_47B2C7?888<<52515148<8<<r4M_48>2GCY07B2H5147B2C7?888<<52512H5248<8<<r4M_@30q@\xe608?2Ic3^08;8>8<<r45347B2C7?888<<52512H5248<8<<r4M_@\xb202=8?2J523b08;8>8<<r25347B2K7L8<<7M888<<52M515248<8<<r2M_@w02=8?2N523b08;8>8<<r45347B2K7L8<<7?888<<52M515248<8<<r4M_@<08;8>8<<E53^1^1@\xd0-:" #(void+ fn-disasm newline #fn(fn-code) #fn(fn-vals) #1# #fn("n10\\3F00[JA070504710qAKM63:72061:" #(newline+ fn-disasm print) print-val) #fn("n370A3U0FEl23N071A72151523A0A182ML237023@4024751K~512602765:" #(princ+ >= 1- " >" " " hex5 ": " " ") print-inst) #fn(length)
+ #fn(table-foldl) #fn("n382;J@041AF<Gl2;34040:") Instructions #fn("n1702161:" #(princ "\t"))+ #fn(memq) (loadv.l loadg.l setg.l) ref-s32-LE (loadv loadg setg)
(loada seta loadc call tcall list + - * / < = vec argc vargc loadi8 apply tapply closure box
shift aref) princ #fn(num->str) aref (loada.l seta.l loadc.l argc.l vargc.l call.l tcall.l box.l)
(optargs keyargs) keyargs " " brbound (jmp brne brnn brn) "@" hex5 ref-s16-LE (jmp.l brne.l
@@ -390,7 +388,7 @@
length= princ "type error: expected " ", got " #fn(typeof) caddr ": " print bounds-error "index "
" out of bounds for " unbound-error "eval: variable " " has no value" error "error: " load-error
print-exception "in file " list? #fn(str?) "*** Unhandled exception: " *linefeed*) print-exception)
- print-stack-trace #fn("n1IIb5b620852185>1_51420862285>1_51473740r3523F075076370r5@40r452@300517778292:2;505252Eb92<2=868889>38762:" #(#0#+ print-stack-trace #fn("n1IIb5b620852185>1_51420862285>1_5147374252627505252Eb82829868788>37:05162:" #(#0# #fn("n32005182P2105121151C?022232487e361:25051E76278851512888A187>4|:" #(#fn(fn-name)#fn(fn-code)
#fn(raise) thrown-value
@@ -397,13 +395,14 @@
ffound #fn(fn-vals) 1-
#fn(length)
#fn("n170A0G513>0F<A0G929363:q:" #(closure?))) find-in-f)- #fn("n220A01>321{863E0722374758651522662:27:" #(#fn("n02021AF>292524q:" #(#fn(for-each)- #fn("n1A<0Fq63:")))- #fn("n10B3F00<20C?00T21C8072061:23061:" #(thrown-value- ffound caddr #fn(raise))) str-join #fn(map) str reverse! "/" "λ") fname) reverse! length>
- list-tail *interactive* filter closure? #fn(map) #fn("n10Z;380420061:" #(#fn(top-level-value)))+ #fn("n220A01>321{863E0722374758651522662:0[38027061:28:" #(#fn("n02021AF>292524q:" #(#fn(for-each)+ #fn("n1A<0Fq63:")))+ #fn("n10B3F00<20C?00T21C8072061:23061:" #(thrown-value+ ffound caddr #fn(raise))) str-join #fn(map) str reverse! "/" #fn(fn-name) "λ") fname) filter
+ closure? #fn(map) #fn("n10Z;380420061:" #(#fn(top-level-value))) #fn(environment) #fn(for-each) #fn("n17021A<0KGF52524222374051==52470257652492<El23?0770KG0EG52@30q49292<KM_:" #(princ- "(" #fn(for-each) #fn("n1702151472061:" #(princ " " print)) vec->list ")" *linefeed* fn-disasm))) print-stack-trace)+ "(" #fn(for-each) #fn("n1702151472061:" #(princ " " print)) vec->list ")" *linefeed* fn-disasm))+ reverse!) print-stack-trace)
print-to-str #fn("z02050212285>10524238561:" #(#fn(buffer)#fn(for-each)
#fn("n1200A62:" #(#fn(write)))--- a/src/compiler.sl
+++ b/src/compiler.sl
@@ -762,6 +762,8 @@
(str-lpad (num->str n 16) 5 #\0))
(def (fn-disasm f (ip NIL) . lev?)
+ (when (builtin? f)
+ (return (void)))
(when (not lev?)
(fn-disasm f ip 0)
(newline)
--- a/src/sl.c
+++ b/src/sl.c
@@ -916,10 +916,14 @@
int sz = top[-2]+1;
sl_v *bp = top-4-sz;
sl_v fn = bp[0];
- const u8int *ip0 = cvalue_data(fn_bcode(fn));
- intptr ip = ip1 - ip0 - 1; /* -1: ip1 is *after* the one that was being executed */
sl_v v = alloc_vec(sz+1, 0);
- vec_elt(v, 0) = fixnum(ip);
+ if(iscbuiltin(fn))
+ vec_elt(v, 0) = fn;
+ else{+ /* -1: ip1 is *after* the one that was being executed */
+ intptr ip = ip1 - (const u8int*)cvalue_data(fn_bcode(fn)) - 1;
+ vec_elt(v, 0) = fixnum(ip);
+ }
vec_elt(v, 1) = fn;
for(int i = 1; i < sz; i++){sl_v si = bp[i];
@@ -997,6 +1001,8 @@
{argcount(nargs, 1);
sl_v v = args[0];
+ if(sl_unlikely(iscbuiltin(v)))
+ return v;
if(sl_unlikely(!isfn(v)))
type_error("fn", v);return fn_bcode(v);
@@ -1007,6 +1013,8 @@
{argcount(nargs, 1);
sl_v v = args[0];
+ if(sl_unlikely(iscbuiltin(v)))
+ return sl_emptyvec;
if(sl_unlikely(!isfn(v)))
type_error("fn", v);return fn_vals(v);
@@ -1017,6 +1025,8 @@
{argcount(nargs, 1);
sl_v v = args[0];
+ if(sl_unlikely(iscbuiltin(v)))
+ return sl_nil;
if(sl_unlikely(!isfn(v)))
type_error("fn", v);return fn_env(v);
--- a/src/system.sl
+++ b/src/system.sl
@@ -1395,7 +1395,8 @@
(def (print-stack-trace st)
(def (find-in-f f tgt path)
(let ((path (cons (fn-name f) path)))
- (if (eq? (fn-code f) (fn-code tgt))
+ (if (eq? (fn-code f)
+ (fn-code tgt))
(throw 'ffound path)
(let ((v (fn-vals f)))
(for 0 (1- (length v))
@@ -1410,11 +1411,8 @@
NIL))))
(if p
(str-join (map str (reverse! p)) "/")
- "λ")))
- (let ((st (reverse! (if (length> st 3)
- (list-tail st (if *interactive* 5 4))
- st)))
- (e (filter closure? (map (λ (s) (and (bound? s)
+ (if (builtin? f) (fn-name f) "λ"))))
+ (let ((e (filter closure? (map (λ (s) (and (bound? s)
(top-level-value s)))
(environment))))
(n 0))
@@ -1427,7 +1425,7 @@
(when (= n 0)
(fn-disasm (aref f 1) (aref f 0)))
(set! n (+ n 1)))
- st)))
+ (reverse! st))))
(def (print-exception e)
(cond ((and (cons? e)
--- a/src/vm.h
+++ b/src/vm.h
@@ -86,9 +86,20 @@
#endif
}
}else if(sl_likely(iscbuiltin(v))){+ bp = sp-nargs;
+ *sp++ = sl_nil; // fn->env;
+ *sp++ = (sl_v)sl.curr_frame;
+ *sp++ = n;
+ *sp++ = v; // ip
+ sl.curr_frame = sp;
sl.sp = sp;
- sp -= n;
- sp[-1] = ((sl_cv*)ptr(v))->cbuiltin(sp, n);
+ v = ((sl_cv*)ptr(v))->cbuiltin(sp-n-4, n);
+ sp = sl.curr_frame;
+ sl.curr_frame = (sl_v*)sp[-3];
+ sp -= 4+n;
+ n = sl.curr_frame[-2];
+ bp = sl.curr_frame - 4 - n;
+ sp[-1] = v;
NEXT_OP;
}
sl.sp = sp;
--
⑨