shithub: femtolisp

Download patch

ref: dfdd1961a70d071736ccdc9741cfc58380674241
parent: d229b8ba4abe771ef305a1a9c1c647ac67e9e8bd
author: Sigrid Solveig Haflínudóttir <[email protected]>
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;