ref: e8d69c4cd659cee7e94e8fb024a0cd26c05d277f
parent: e731ef03287102cc360f9058afb76ff845fa6aab
author: Sigrid Solveig Haflínudóttir <[email protected]>
date: Thu Nov 7 13:42:58 EST 2024
stop with the curr_func stuff, leave the proper stack trace construction to system.lsp
--- a/cvalues.c
+++ b/cvalues.c
@@ -198,23 +198,6 @@
return cv;
}
-char *
-cvalue_cbuiltin_name(value_t v)
-{- cvalue_t *cv = ptr(v);
- static char name[128];
- value_t label;
-
- void *data = cptr(v);
- void *fptr = *(void**)data;
- label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
- if(label == (value_t)HT_NOTFOUND)
- snprintf(name, sizeof(name), "#<builtin @%p>", fptr);
- else
- snprintf(name, sizeof(name), "#fn(%s)", symbol_name(label));
- return name;
-}
-
value_t
cvalue_string(size_t sz)
{--- a/cvalues.h
+++ b/cvalues.h
@@ -37,7 +37,6 @@
#define cvalue_nofinalizer(type, sz) cvalue_(type, sz, true)
value_t cvalue_from_data(fltype_t *type, void *data, size_t sz);
value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent);
-char *cvalue_cbuiltin_name(value_t v);
value_t cvalue_string(size_t sz);
value_t cvalue_static_cstring(const char *str);
value_t string_from_cstrn(char *str, size_t n);
--- a/flisp.boot
+++ b/flisp.boot
@@ -19,43 +19,46 @@
#fn("8000n30182p:" #()) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 00 0 0 0 0 0 0 0 0 0 0)
*interactive* #f *syntax-environment*
- #table(letrec #fn("?000|1202021e12223052e122240522515154e1222605262:" #(#fn(nconc)- λ #fn(map) #.car #fn("9000n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))- #fn(copy-list) #fn("6000n17060:" #(void)))) quasiquote #fn("8000n1700E62:" #(bq-process)) when #fn("<000|1200211POe4:" #(if- begin)) unwind-protect #fn("8000n220>2150215062:" #(#fn("@000n220121qFe3e2e12223A210e1241e1250e2e3e3e31e1e3e3:" #(let- λ prog1 trycatch begin raise)) #fn(gensym))) dotimes #fn(";000|120>0<0T62:" #(#fn("=000n220E211Ke32223e10e1e124F5153e4:" #(for- - #fn(nconc) λ #fn(copy-list))))) define-macro #fn("?000|120210<e22223e10=e12415153e3:" #(set-syntax!- quote #fn(nconc) λ #fn(copy-list))) receive #fn("@000|22021q1e32221e10e123825153e3:" #(call-with-values- λ #fn(nconc) #fn(copy-list))) unless #fn("=000|1200O211Pe4:" #(if begin)) let* #fn("A000|10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)- λ #fn(copy-list) caar let* cadar)) case #fn(":000|120>D61:" #(#fn("7000n120?0421>225061:" #(#fn("9000n2120C5020:1J40O:1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74251523=0260271e2e3:280271e2e3:" #(else- eq? quote-value eqv? every #.symbol? memq quote memv) vals->cond)
- #fn("<000n1200910e2e12122e12324>9115252e3:" #(let #fn(nconc) cond #fn(map)- #fn("8000n1910A0<520=P:" #())))- #fn(gensym))))) catch #fn("7000n220>215061:" #(#fn("@000n120F210e12223240e225260e22728e2e325290e2Ae3e42:0e22;0e2e4e3e3:" #(trycatch- λ if and pair? eq car quote thrown-value cadr caddr raise))
- #fn(gensym))) assert #fn("<000n1200D2122230e2e2e2e4:" #(if- raise quote assert-failed)) do #fn("A000|220>21501<22230522224052222505265:" #(#fn("B000n520021822212324e125F=51522324e12590251230e18452e153e4e3e2e1230e18352e3:" #(letrec- λ if #fn(nconc) begin #fn(copy-list))) #fn(gensym)
- #fn(map) #.car #.cadr #fn("7000n170051B38071061:0<:" #(cddr caddr)))) with-input-from #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings *input-stream* #fn(copy-list))) let #fn(":000|120>O61:" #(#fn("<000n1AR3D0A?04F<z004F=z01@30D420>2122e12324A52e125F51532326A5262:" #(#fn("8000n2A3@020A0e2e1Ae3@3001P:" #(letrec))- #fn(nconc) λ #fn(map) #fn("6000n10B3500<:0:" #())- #fn(copy-list) #fn("6000n10B3500T:7060:" #(void)))))) cond #fn("9000|020>D61:" #(#fn("7000n120>?040A61:" #(#fn("7000n10H340O:20>0<61:" #(#fn(":000n10<20Q;I7040<DQ3@00=J500<:210=P:0=J@0220<910A=51e3:0T23CW07475051513A026>77750515161:28>295061:2:0<210=P910A=51e4:" #(else+ #table(with-input-from #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)+ with-bindings *input-stream* #fn(copy-list))) unless #fn("=000|1200O211Pe4:" #(if+ begin)) time #fn("7000n120>215061:" #(#fn(">000n120021e1e2e122A23242521e10e326e4e3e3:" #(let+ time-now prog1 princ "Elapsed time: " - " seconds\n"))
+ #fn(gensym))) cond #fn("9000|020>D61:" #(#fn("7000n120>?040A61:" #(#fn("7000n10H340O:20>0<61:" #(#fn(":000n10<20Q;I7040<DQ3@00=J500<:210=P:0=J@0220<910A=51e3:0T23CW07475051513A026>77750515161:28>295061:2:0<210=P910A=51e4:" #(else begin or => 1arg-lambda? caddr #fn("=000n1200A<e2e1210227374A5151P920910=51e4e3:" #(let if begin cddr caddr)) caadr #fn("<000n1200A<e2e121072A510e2920910=51e4e3:" #(let- if caddr)) #fn(gensym) if))) cond-clauses->if))))) throw #fn(":000n220212223e201e4e2:" #(raise- list quote thrown-value)) time #fn("7000n120>215061:" #(#fn(">000n120021e1e2e122A23242521e10e326e4e3e3:" #(let- time-now prog1 princ "Elapsed time: " - " seconds\n"))
- #fn(gensym))) with-output-to #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings *output-stream* #fn(copy-list))) with-bindings #fn(">000|120>21220522123052212405263:" #(#fn("B000n32021e1222382053e1242225015351262027e124F51522027e1242228082535152e3e164:" #(#fn(nconc)+ if caddr)) #fn(gensym) if))) cond-clauses->if))))) do #fn("A000|220>21501<22230522224052222505265:" #(#fn("B000n520021822212324e125F=51522324e12590251230e18452e153e4e3e2e1230e18352e3:" #(letrec+ λ if #fn(nconc) begin #fn(copy-list))) #fn(gensym)
+ #fn(map) #.car #.cadr #fn("7000n170051B38071061:0<:" #(cddr caddr)))) with-bindings #fn(">000|120>21220522123052212405263:" #(#fn("B000n32021e1222382053e1242225015351262027e124F51522027e1242228082535152e3e164:" #(#fn(nconc) let #fn(map) #.list #fn(copy-list) #fn("8000n22001e3:" #(set!)) unwind-protect begin #fn("8000n22001e3:" #(set!))))- #fn(map) #.car #.cadr #fn("6000n12060:" #(#fn(gensym))))))+ #fn(map) #.car #.cadr #fn("6000n12060:" #(#fn(gensym))))) let #fn(":000|120>O61:" #(#fn("<000n1AR3D0A?04F<z004F=z01@30D420>2122e12324A52e125F51532326A5262:" #(#fn("8000n2A3@020A0e2e1Ae3@3001P:" #(letrec))+ #fn(nconc) λ #fn(map) #fn("6000n10B3500<:0:" #())+ #fn(copy-list) #fn("6000n10B3500T:7060:" #(void)))))) define-macro #fn("?000|120210<e22223e10=e12415153e3:" #(set-syntax!+ quote #fn(nconc) λ #fn(copy-list))) quasiquote #fn("8000n1700E62:" #(bq-process)) when #fn("<000|1200211POe4:" #(if+ begin)) with-output-to #fn("=000|12021e1220e2e1e12315163:" #(#fn(nconc)+ with-bindings
+ *output-stream*
+ #fn(copy-list))) catch #fn("7000n220>215061:" #(#fn("@000n120F210e12223240e225260e22728e2e325290e2Ae3e42:0e22;0e2e4e3e3:" #(trycatch+ λ if and pair? eq car quote thrown-value cadr caddr raise))
+ #fn(gensym))) let* #fn("A000|10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)+ λ #fn(copy-list) caar let* cadar)) letrec #fn("?000|1202021e12223052e122240522515154e1222605262:" #(#fn(nconc)+ λ #fn(map) #.car #fn("9000n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))+ #fn(copy-list) #fn("6000n17060:" #(void)))) assert #fn("<000n1200D2122230e2e2e2e4:" #(if+ raise quote assert-failed)) case #fn(":000|120>D61:" #(#fn("7000n120?0421>225061:" #(#fn("9000n2120C5020:1J40O:1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74251523=0260271e2e3:280271e2e3:" #(else+ eq? quote-value eqv? every #.symbol? memq quote memv) vals->cond)
+ #fn("<000n1200910e2e12122e12324>9115252e3:" #(let #fn(nconc) cond #fn(map)+ #fn("8000n1910A0<520=P:" #())))+ #fn(gensym))))) receive #fn("@000|22021q1e32221e10e123825153e3:" #(call-with-values+ λ #fn(nconc) #fn(copy-list))) unwind-protect #fn("8000n220>2150215062:" #(#fn("@000n220121qFe3e2e12223A210e1241e1250e2e3e3e31e1e3e3:" #(let+ λ prog1 trycatch begin raise)) #fn(gensym))) dotimes #fn(";000|120>0<0T62:" #(#fn("=000n220E211Ke32223e10e1e124F5153e4:" #(for+ - #fn(nconc) λ #fn(copy-list))))) throw #fn(":000n220212223e201e4e2:" #(raise+ list quote thrown-value)))
1+ #fn("7000n10KM:" #() 1+) 1- #fn("7000n10K\x80:" #() 1-) 1arg-lambda? #fn("8000n10B;3^040<20Q;I8040<20Q;3J040=B;3B040TB;3:04710TK62:" #(λlength=) 1arg-lambda?)
<= #fn("7000n210L;IB0470051;380470151S:" #(nan?) <=) > #fn("7000n210L:" #() >) >= #fn("7000n201L;IB0470051;380470151S:" #(nan?) >=)- Instructions #table(not 35 vargc 76 load1 27 = 60 setc.l 75 sub2 80 brne.l 85 largc 81 brnn 26 loadc.l 70 loadi8 66 < 28 nop 46 set-cdr! 30 loada 8 neg 37 bound? 42 / 58 brn.l 88 lvargc 82 brt 25 trycatch 77 null? 38 load0 21 jmp.l 48 loadv 2 seta 15 keyargs 91 * 57 function? 44 builtin? 43 aref 23 optargs 89 loadt 20 vector? 45 cdr 13 brf 3 loadc00 17 symbol? 34 cadr 36 pop 4 pair? 18 for 78 closure 14 loadf 31 compare 61 loadv.l 67 setg.l 72 brn 87 eqv? 51 aset! 64 atom? 24 eq? 33 boolean? 39 brt.l 50 tapply 79 dummy_nil 94 loada0 0 brbound 90 dup 11 loadc01 22 list 53 loadc 9 apply 54 dummy_t 93 setg 71 loada1 1 tcall.l 84 jmp 16 fixnum? 41 cons 32 loadg.l 68 tcall 6 dummy_eof 95 call 5 - 56 brf.l 49 + 55 dummy_f 92 add2 29 seta.l 73 loadnil 65 brnn.l 86 setc 74 set-car! 47 loadg 7 vector 63 loada.l 69 argc 62 div0 59 ret 10 car 12 number? 40 equal? 52 call.l 83 brne 19)
+ Instructions #table(call.l 83 largc 81 trycatch 77 loadg.l 68 cadr 36 setg 71 argc 62 load0 21 vector? 45 fixnum? 41 loada0 0 div0 59 keyargs 91 call 5 loada.l 69 brt.l 50 pair? 18 sub2 80 add2 29 loadc.l 70 loadc 9 builtin? 43 set-car! 47 brt 25 loadi8 66 tapply 79 ret 10 loada1 1 boolean? 39 cdr 13 atom? 24 brne.l 85 / 58 loadf 31 equal? 52 apply 54 jmp.l 48 loadt 20 dup 11 = 60 not 35 null? 38 set-cdr! 30 loadc01 22 eq? 33 * 57 load1 27 dummy_t 93 bound? 42 brf 3 function? 44 setc.l 75 < 28 brnn.l 86 for 78 loadv 2 jmp 16 lvargc 82 dummy_eof 95 + 55 dummy_f 92 setc 74 brne 19 compare 61 neg 37 loadv.l 67 brn 87 vargc 76 number? 40 brbound 90 vector 63 setg.l 72 aref 23 brf.l 49 symbol? 34 aset! 64 car 12 cons 32 tcall.l 84 - 56 brn.l 88 optargs 89 nop 46 closure 14 pop 4 eqv? 51 list 53 seta 15 seta.l 73 brnn 26 loadnil 65 loadc00 17 loadg 7 loada 8 dummy_nil 94 tcall 6)
__init_globals #fn("6000n020w1422w3474w5476w7478w9:" #("/"*directory-separator*
"\n"
@@ -79,7 +82,7 @@
__start #fn("8000n1705040=B3D00=w14Ow24730T51@C00w14Dw24745047550426E61:" #(__init_globals*argv* *interactive* __script __rcscript repl #fn(exit)) __start)
abs #fn("7000n10EL3500U:0:" #() abs) any- #fn("8000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(null? 1 atom? 1 eq? 2 boolean? 1 function? 1 builtin? 1 = 2 aref 2 vector? 1 cdr 1 symbol? 1 cadr 1 pair? 1 set-car! 2 compare 2 < 2 fixnum? 1 div0 2 car 1 set-cdr! 2 number? 1 equal? 2 cons 2 bound? 1 eqv? 2 aset! 3 not 1)+ #fn("8000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(bound? 1 function? 1 symbol? 1 aset! 3 car 1 cons 2 cadr 1 < 2 vector? 1 boolean? 1 fixnum? 1 atom? 1 cdr 1 div0 2 equal? 2 eqv? 2 pair? 1 compare 2 null? 1 = 2 number? 1 not 1 set-cdr! 2 eq? 2 builtin? 1 set-car! 2 aref 2) argc-error #fn("<000n2702102211Kl37023@402465:" #(error "compile error: "" expects " " argument."
" arguments.") argc-error)
@@ -356,12 +359,11 @@
#fn("7000n1A50420061:" #(#fn(raise))))) #fn("6000n0Aw0:" #(*print-readably*)))) *print-readably*) princ) print #fn(":000|07021062:" #(for-each #fn(write)) print)- print-exception #fn("=000n10B;3D040<20Q;3:04710r4523P072230T247505126554777805151@\x0a00B;3D040<29Q;3:04710r4523N0720T2:780512;544777505151@\xd300B;3@040<2<Q;36040=B3B0722=750512>53@\xac00B;38040<2?Q3B0722@514720=f2@\x8d00B;38040<2AQ3G07B75051514722C0T52@i07D051;3:04710r2523I0770<514722E5142F0T51@>0722G514770514727H61:" #(type-error- length= princ "type error: " ": expected " caddr ", got " print cadddr
- bounds-error ": index " " out of bounds for " unbound-error "eval: variable "
- " has no value" error "error: " load-error print-exception "in file " list?
- ": " #fn("8000n120051;I5040R37071@4072061:" #(#fn(string?) princ print))- "*** Unhandled exception: " *linefeed*) print-exception)
+ print-exception #fn("=000n10B;3D040<20Q;3:04710r3523I072230T24534757605151@\x0600B;3D040<27Q;3:04710r3523I072287605129534750T51@\xd400B;3D040<2:Q;3:04710r2523?0722;0T2<53@\xac00B;38040<2=Q3B0722>514720=f2@\x8d00B;38040<2?Q3G07@76051514722A0T52@i07B051;3:04710r2523I0750<514722C5142D0T51@>0722E514750514727F61:" #(type-error+ length= princ "type error: expected " ", got " print caddr bounds-error "index "
+ " out of bounds for " unbound-error "eval: variable " " has no value" error
+ "error: " load-error print-exception "in file " list? ": " #fn("8000n120051;I5040R37071@4072061:" #(#fn(string?)+ princ print)) "*** Unhandled exception: " *linefeed*) print-exception)
print-stack-trace #fn("8000n120>DD62:" #(#fn(">000n220>?0421>?1422>7374Ar3523F075A76370r5@40r452@30A517778292:2;505252E63:" #(#fn("8000n320>2105182P61:" #(#fn("9000n120A5120F51C>02122230e361:24>25A5161:" #(#fn(function:code) #fn(raise) thrown-value ffound #fn(":000n1E70210515122>~:" #(1- #fn(length) #fn("9000n170A0G513A0930A0G92191063:D:" #(closure?))))--- a/flisp.c
+++ b/flisp.c
@@ -33,7 +33,6 @@
uint32_t SP = 0;
static uint32_t N_STACK;
static uint32_t curr_frame = 0;
-static value_t curr_func;
value_t FL_NIL, FL_T, FL_F, FL_EOF, QUOTE;
value_t NIL, LAMBDA, IF, TRYCATCH;
@@ -148,47 +147,16 @@
longjmp(thisctx->buf, 1);
}
-static char *
-curr_func_name(void)
-{- if(iscbuiltin(curr_func))
- return cvalue_cbuiltin_name(curr_func);
- if(isbuiltin(curr_func))
- return builtins[uintval(curr_func)].name;
- if(isfunction(curr_func)){- function_t *fn = ptr(curr_func);
- return fn->name == LAMBDA ? "λ" : symbol_name(fn->name);
- }
-
- return "???";
-}
-
-static value_t
-make_error_msg(char *format, va_list args)
-{- char msgbuf[512], *s;
- const char *f;
- int n;
- if(curr_func != NIL){- f = curr_func_name();
- n = snprintf(msgbuf, sizeof(msgbuf), "%s: ", f != nil ? f : "???");
- curr_func = NIL;
- }else{- n = 0;
- }
- s = msgbuf + n;
- n = sizeof(msgbuf) - n;
- vsnprintf(s, n, format, args);
- return string_from_cstr(msgbuf);
-}
-
_Noreturn void
lerrorf(value_t e, char *format, ...)
{+ char msgbuf[256];
va_list args;
+
PUSH(e);
va_start(args, format);
- value_t msg = make_error_msg(format, args);
+ vsnprintf(msgbuf, sizeof(msgbuf), format, args);
+ value_t msg = string_from_cstr(msgbuf);
va_end(args);
e = POP();
@@ -198,19 +166,19 @@
_Noreturn void
type_error(char *expected, value_t got)
{- fl_raise(fl_listn(4, TypeError, symbol(curr_func_name()), symbol(expected), got));
+ fl_raise(fl_listn(3, TypeError, symbol(expected), got));
}
_Noreturn void
bounds_error(value_t arr, value_t ind)
{- fl_raise(fl_listn(4, BoundsError, symbol(curr_func_name()), arr, ind));
+ fl_raise(fl_listn(3, BoundsError, arr, ind));
}
_Noreturn void
unbound_error(value_t sym)
{- fl_raise(fl_listn(3, UnboundError, symbol(curr_func_name()), sym));
+ fl_raise(fl_listn(2, UnboundError, sym));
}
// safe cast operators --------------------------------------------------------
@@ -629,7 +597,6 @@
value_t f = Stack[SP-n-1];
uint32_t saveSP = SP;
value_t v;
- curr_func = f;
if(iscbuiltin(f)){v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n);
}else if(isfunction(f)){@@ -979,8 +946,6 @@
op = *ip++;
while(1){- curr_func = builtin(op);
-
switch(op){OP(OP_LOADA0)
PUSH(captured ? vector_elt(Stack[bp], 0) : Stack[bp]);
@@ -1024,7 +989,6 @@
do_call:
func = Stack[SP-n-1];
if(tag(func) == TAG_FUNCTION){- curr_func = func;
if(func > (N_BUILTINS<<3)){ if(tail){curr_frame = Stack[curr_frame-4];
@@ -1037,7 +1001,6 @@
nargs = n;
goto apply_cl_top;
}else{- curr_func = func;
i = uintval(func);
if(isbuiltin(func)){s = builtins[i].nargs;
@@ -1064,7 +1027,6 @@
}
}
}else if(iscbuiltin(func)){- curr_func = func;
s = SP;
v = (((builtin_t*)ptr(func))[3])(&Stack[SP-n], n);
SP = s-n;
@@ -2228,7 +2190,6 @@
PUSH(sys_image_iostream);
saveSP = SP;
FL_TRY{- curr_func = NIL;
while(1){e = fl_read_sexpr(Stack[SP-1]);
if(ios_eof(value2c(ios_t*, Stack[SP-1])))
--- a/opcodes.h
+++ b/opcodes.h
@@ -99,38 +99,38 @@
};
static const Builtin builtins[] = {- [OP_NUMBERP] = {"number?", 1},- [OP_NUMEQ] = {"=", 2},+ [OP_SETCAR] = {"set-car!", 2},+ [OP_CDR] = {"cdr", 1}, [OP_BOOLEANP] = {"boolean?", 1},- [OP_IDIV] = {"div0", 2},- [OP_DIV] = {"/", -1},- [OP_PAIRP] = {"pair?", 1},- [OP_ATOMP] = {"atom?", 1},- [OP_SYMBOLP] = {"symbol?", 1},+ [OP_FUNCTIONP] = {"function?", 1},+ [OP_CADR] = {"cadr", 1},+ [OP_SETCDR] = {"set-cdr!", 2},+ [OP_EQ] = {"eq?", 2}, [OP_APPLY] = {"apply", -2},- [OP_BOUNDP] = {"bound?", 1},- [OP_EQV] = {"eqv?", 2},- [OP_NOT] = {"not", 1},- [OP_SUB] = {"-", -1}, [OP_NULLP] = {"null?", 1},- [OP_CAR] = {"car", 1},- [OP_VECTOR] = {"vector", ANYARGS}, [OP_ASET] = {"aset!", 3},- [OP_FUNCTIONP] = {"function?", 1},- [OP_EQ] = {"eq?", 2},- [OP_BUILTINP] = {"builtin?", 1},+ [OP_ATOMP] = {"atom?", 1},+ [OP_NOT] = {"not", 1}, [OP_LIST] = {"list", ANYARGS},- [OP_AREF] = {"aref", 2},- [OP_FIXNUMP] = {"fixnum?", 1},- [OP_VECTORP] = {"vector?", 1},- [OP_ADD] = {"+", ANYARGS}, [OP_CONS] = {"cons", 2},- [OP_SETCDR] = {"set-cdr!", 2},- [OP_COMPARE] = {"compare", 2},- [OP_SETCAR] = {"set-car!", 2},+ [OP_NUMBERP] = {"number?", 1},+ [OP_BOUNDP] = {"bound?", 1}, [OP_LT] = {"<", 2},- [OP_EQUAL] = {"equal?", 2},+ [OP_VECTORP] = {"vector?", 1},+ [OP_CAR] = {"car", 1},+ [OP_EQV] = {"eqv?", 2},+ [OP_IDIV] = {"div0", 2},+ [OP_FIXNUMP] = {"fixnum?", 1},+ [OP_NUMEQ] = {"=", 2},+ [OP_SYMBOLP] = {"symbol?", 1},+ [OP_BUILTINP] = {"builtin?", 1},+ [OP_SUB] = {"-", -1},+ [OP_COMPARE] = {"compare", 2},+ [OP_PAIRP] = {"pair?", 1}, [OP_MUL] = {"*", ANYARGS},- [OP_CADR] = {"cadr", 1},- [OP_CDR] = {"cdr", 1},+ [OP_AREF] = {"aref", 2},+ [OP_ADD] = {"+", ANYARGS},+ [OP_DIV] = {"/", -1},+ [OP_VECTOR] = {"vector", ANYARGS},+ [OP_EQUAL] = {"equal?", 2},};
--- a/system.lsp
+++ b/system.lsp
@@ -951,20 +951,20 @@
(define (print-exception e)
(cond ((and (pair? e)
(eq? (car e) 'type-error)
- (length= e 4))
- (princ "type error: " (cadr e) ": expected " (caddr e) ", got ")
- (print (cadddr e)))
+ (length= e 3))
+ (princ "type error: expected " (cadr e) ", got ")
+ (print (caddr e)))
((and (pair? e)
(eq? (car e) 'bounds-error)
- (length= e 4))
- (princ (cadr e) ": index " (cadddr e) " out of bounds for ")
- (print (caddr e)))
+ (length= e 3))
+ (princ "index " (caddr e) " out of bounds for ")
+ (print (cadr e)))
((and (pair? e)
(eq? (car e) 'unbound-error)
- (pair? (cdr e)))
- (princ "eval: variable " (caddr e) " has no value"))
+ (length= e 2))
+ (princ "eval: variable " (cadr e) " has no value"))
((and (pair? e)
(eq? (car e) 'error))