backtraces more useful

TODO.FACTOR.txt

@@ -34,7 +34,6 @@
 + kernel:
 
 - do partial objects cause problems?
-- profiler is inaccurate: wrong word on cs
 - better i/o scheduler
 - remove sbufs
 - cat, reverse-cat primitives

native/primitives.c

@@ -1,6 +1,6 @@
 #include "factor.h"
 
-XT primitives[] = {
+void* primitives[] = {
 	undefined,
 	docol,
 	dosym,

native/primitives.h

@@ -1,4 +1,4 @@
-extern XT primitives[];
+extern void* primitives[];
 #define PRIMITIVE_COUNT 195
 
 CELL primitive_to_xt(CELL primitive);

native/run.c

@@ -9,7 +9,10 @@ void clear_environment(void)
 	executing = F;
 }
 
-#define EXECUTE(w) ((XT)(untag_word_fast(w)->xt))()
+INLINE void execute(F_WORD* word)
+{
+	((XT)(word->xt))(word);
+}
 
 void run(void)
 {
@@ -45,7 +48,7 @@ void run(void)
 		if(callframe == F)
 		{
 			callframe = cpop();
-			cpop();
+			executing = cpop();
 			continue;
 		}
 
@@ -54,10 +57,7 @@ void run(void)
 		callframe = get(callframe + CELLS);
 
 		if(TAG(next) == WORD_TYPE)
-		{
-			executing = next;
-			EXECUTE(executing);
-		}
+			execute(untag_word_fast(next));
 		else
 			dpush(next);
 	}
@@ -73,28 +73,27 @@ void run(void)
 }
 
 /* XT of deferred words */
-void undefined()
+void undefined(F_WORD* word)
 {
-	general_error(ERROR_UNDEFINED_WORD,executing);
+	general_error(ERROR_UNDEFINED_WORD,tag_word(word));
 }
 
 /* XT of compound definitions */
-void docol(void)
+void docol(F_WORD* word)
 {
-	call(untag_word_fast(executing)->parameter);
+	call(word->parameter);
+	executing = tag_word(word);
 }
 
 /* pushes word parameter */
-void dosym(void)
+void dosym(F_WORD* word)
 {
-	dpush(untag_word_fast(executing)->parameter);
+	dpush(word->parameter);
 }
 
 void primitive_execute(void)
 {
-	type_check(WORD_TYPE,dpeek());
-	executing = dpop();
-	EXECUTE(executing);
+	execute(untag_word(dpop()));
 }
 
 void primitive_call(void)

native/run.h

@@ -78,20 +78,23 @@ INLINE void cpush(CELL top)
 INLINE void call(CELL quot)
 {
 	/* tail call optimization */
-	if(callframe != F)
+	if(callframe == F)
+		/* put(cs - CELLS,executing) */;
+	else
 	{
 		cpush(executing);
 		cpush(callframe);
 	}
+
 	callframe = quot;
 }
 
 void clear_environment(void);
 
 void run(void);
-void undefined(void);
-void docol(void);
-void dosym(void);
+void undefined(F_WORD* word);
+void docol(F_WORD* word);
+void dosym(F_WORD* word);
 void primitive_execute(void);
 void primitive_call(void);
 void primitive_ifte(void);

native/word.h

@@ -1,5 +1,3 @@
-typedef void (*XT)(void);
-
 typedef struct {
 	/* TAGGED header */
 	CELL header;
@@ -19,6 +17,8 @@ typedef struct {
 	CELL allot_count;
 } F_WORD;
 
+typedef void (*XT)(F_WORD* word);
+
 INLINE F_WORD* untag_word_fast(CELL tagged)
 {
 	return (F_WORD*)UNTAG(tagged);