ref: dfdd1961a70d071736ccdc9741cfc58380674241
parent: d229b8ba4abe771ef305a1a9c1c647ac67e9e8bd
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Nov 6 22:35:37 EST 2024
do less when recording which function is currently running just to never throw any exceptions
--- a/cvalues.c
+++ b/cvalues.c
@@ -198,6 +198,23 @@
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,6 +37,7 @@
#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.c
+++ b/flisp.c
@@ -29,11 +29,11 @@
static value_t *GCHandleStack[N_GC_HANDLES];
static uint32_t N_GCHND = 0;
-uint32_t N_STACK;
value_t *Stack;
uint32_t SP = 0;
-uint32_t curr_frame = 0;
-char *curr_fname = nil;
+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,14 +148,31 @@
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_fname != nil){- n = snprintf(msgbuf, sizeof(msgbuf), "%s: ", curr_fname);
- curr_fname = nil;
+ if(curr_func != NIL){+ f = curr_func_name();
+ n = snprintf(msgbuf, sizeof(msgbuf), "%s: ", f != nil ? f : "???");
+ curr_func = NIL;
}else{n = 0;
}
@@ -181,19 +198,19 @@
_Noreturn void
type_error(char *expected, value_t got)
{- fl_raise(fl_listn(4, TypeError, symbol(curr_fname), symbol(expected), got));
+ fl_raise(fl_listn(4, TypeError, symbol(curr_func_name()), symbol(expected), got));
}
_Noreturn void
bounds_error(value_t arr, value_t ind)
{- fl_raise(fl_listn(4, BoundsError, symbol(curr_fname), arr, ind));
+ fl_raise(fl_listn(4, BoundsError, symbol(curr_func_name()), arr, ind));
}
_Noreturn void
unbound_error(value_t sym)
{- fl_raise(fl_listn(3, UnboundError, symbol(curr_fname), sym));
+ fl_raise(fl_listn(3, UnboundError, symbol(curr_func_name()), sym));
}
// safe cast operators --------------------------------------------------------
@@ -605,24 +622,6 @@
// utils ----------------------------------------------------------------------
-static char *
-cvalue_name(value_t v)
-{- cvalue_t *cv = ptr(v);
- static char name[64];
- 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;
-}
-
-
// apply function with n args on the stack
static value_t
_applyn(uint32_t n)
@@ -630,8 +629,8 @@
value_t f = Stack[SP-n-1];
uint32_t saveSP = SP;
value_t v;
+ curr_func = f;
if(iscbuiltin(f)){- curr_fname = cvalue_name(f);
v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n);
}else if(isfunction(f)){v = apply_cl(n);
@@ -640,7 +639,6 @@
if(ptr(tab) == nil)
unbound_error(tab);
Stack[SP-n-1] = vector_elt(tab, uintval(f));
- curr_fname = builtins[uintval(f)].name;
v = apply_cl(n);
}else{ type_error("function", f);@@ -981,8 +979,7 @@
op = *ip++;
while(1){- if(op < nelem(builtins) && builtins[op].name != nil)
- curr_fname = builtins[op].name;
+ curr_func = builtin(op);
switch(op){OP(OP_LOADA0)
@@ -1027,6 +1024,7 @@
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,10 +1035,9 @@
Stack[curr_frame-2] = (uintptr_t)ip;
}
nargs = n;
- function_t *fn = (function_t*)ptr(func);
- curr_fname = fn->name == LAMBDA ? "λ" : symbol_name(fn->name);
goto apply_cl_top;
}else{+ curr_func = func;
i = uintval(func);
if(isbuiltin(func)){s = builtins[i].nargs;
@@ -1052,7 +1049,6 @@
for(s = SP-n-1; s < (int)SP-1; s++)
Stack[s] = Stack[s+1];
SP--;
- curr_fname = builtins[i].name;
switch(i){case OP_LIST: goto apply_list;
case OP_VECTOR: goto apply_vector;
@@ -1068,8 +1064,8 @@
}
}
}else if(iscbuiltin(func)){+ curr_func = func;
s = SP;
- curr_fname = cvalue_name(func);
v = (((builtin_t*)ptr(func))[3])(&Stack[SP-n], n);
SP = s-n;
Stack[SP-1] = v;
@@ -2232,7 +2228,7 @@
PUSH(sys_image_iostream);
saveSP = SP;
FL_TRY{- curr_fname = "bootstrap";
+ curr_func = NIL;
while(1){e = fl_read_sexpr(Stack[SP-1]);
if(ios_eof(value2c(ios_t*, Stack[SP-1])))
--- a/flisp.h
+++ b/flisp.h
@@ -164,9 +164,6 @@
extern value_t *Stack;
extern uint32_t SP;
-extern uint32_t N_STACK;
-extern uint32_t curr_frame;
-extern char *curr_fname;
extern value_t FL_NIL, FL_T, FL_F, FL_EOF, QUOTE;
extern value_t NIL, LAMBDA, IF, TRYCATCH;