backtraces more useful

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 9b4fd2232e1164f9cdda34f18234161f5c1be2fa..5c06251c604ef7942221de0a97d54e7d996bcbd7 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -34,7 +34,6 @@
 + kernel:\r
 \r
 - do partial objects cause problems?\r
-- profiler is inaccurate: wrong word on cs\r
 - better i/o scheduler\r
 - remove sbufs\r
 - cat, reverse-cat primitives\r

diff --git a/native/primitives.c b/native/primitives.c
index 663522b87ac492fd3683a2fd2517a57de2d0be0c..dd7d6a652a591ec6e7e1505170df1cae9b1512db 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -1,6 +1,6 @@
 #include "factor.h"
 
-XT primitives[] = {
+void* primitives[] = {
        undefined,
        docol,
        dosym,

diff --git a/native/primitives.h b/native/primitives.h
index ea9414b4d834b39076a8fcf72cca1bf3d0672f31..60736374aa5814f19d3e983acd43746304248f1c 100644 (file)
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
-extern XT primitives[];
+extern void* primitives[];
 #define PRIMITIVE_COUNT 195
 
 CELL primitive_to_xt(CELL primitive);

diff --git a/native/run.c b/native/run.c
index cda04953e4954f069a4297fdf334c58f5cdfe848..403fd84e3dafd4a59b8e99be52c11592b12f9790 100644 (file)
--- a/native/run.c
+++ b/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)

diff --git a/native/run.h b/native/run.h
index 42c92460e6c6da00cfa8f382fdd1e3ec09696590..f98220b664551fa1d41ddb1330be3587ea3ad927 100644 (file)
--- a/native/run.h
+++ b/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);

diff --git a/native/word.h b/native/word.h
index e2dbe972335d917b091c79f0ac19324f7e5fa926..f06d7612873f7b304a7e2da463175ec72338e56d 100644 (file)
--- a/native/word.h
+++ b/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);