executing global was not GC'd

diff --git a/native/debug.c b/native/debug.c
index bea8212ef4d4a2ef085711fe63c7d7a92143c7ec..1c1b3ebe140604724960564076d261e4135ab334 100644 (file)
--- a/native/debug.c
+++ b/native/debug.c
@@ -121,7 +121,7 @@ void dump_stacks(void)
        print_obj(callframe);
        fprintf(stderr,"\n");
        fprintf(stderr,"*** Executing:\n");
-       print_word(executing);
+       print_obj(executing);
        fprintf(stderr,"\n");
        fflush(stderr);
 }

diff --git a/native/gc.c b/native/gc.c
index 78229c55d744ed0951b91a0f361531ede800c669..53ebc7fdbc34c155d4e7f15e3fcc877667d4244f 100644 (file)
--- a/native/gc.c
+++ b/native/gc.c
@@ -21,6 +21,7 @@ void collect_roots(void)
        /* the bignum 0 1 -1 constants must be the next three */
        copy_bignum_constants();
        copy_object(&callframe);
+       copy_object(&executing);
 
        for(ptr = ds_bot; ptr <= ds; ptr += CELLS)
                copy_object((void*)ptr);

diff --git a/native/memory.c b/native/memory.c
index 71e9ac0bc88862fe8fb8da9dc3631ebc2b8f2b33..dac4bca476bbfbf45472b87b7cb86b3b75dea752 100644 (file)
--- a/native/memory.c
+++ b/native/memory.c
@@ -77,7 +77,9 @@ void allot_profile_step(CELL a)
                        untag_word(obj)->allot_count += a;
        }
 
-       executing->allot_count += a;
+       if(in_zone(&prior,executing))
+               critical_error("executing in prior zone",executing);
+       untag_word_fast(executing)->allot_count += a;
 }
 
 void flip_zones()

diff --git a/native/run.c b/native/run.c
index b61bc920f0600eb6dce533c33b332fcc121838e0..cda04953e4954f069a4297fdf334c58f5cdfe848 100644 (file)
--- a/native/run.c
+++ b/native/run.c
@@ -6,9 +6,10 @@ void clear_environment(void)
        for(i = 0; i < USER_ENV; i++)
                userenv[i] = F;
        profile_depth = 0;
+       executing = F;
 }
 
-#define EXECUTE(w) ((XT)(w->xt))()
+#define EXECUTE(w) ((XT)(untag_word_fast(w)->xt))()
 
 void run(void)
 {
@@ -54,7 +55,7 @@ void run(void)
 
                if(TAG(next) == WORD_TYPE)
                {
-                       executing = (F_WORD*)UNTAG(next);
+                       executing = next;
                        EXECUTE(executing);
                }
                else
@@ -74,24 +75,25 @@ void run(void)
 /* XT of deferred words */
 void undefined()
 {
-       general_error(ERROR_UNDEFINED_WORD,tag_word(executing));
+       general_error(ERROR_UNDEFINED_WORD,executing);
 }
 
 /* XT of compound definitions */
 void docol(void)
 {
-       call(executing->parameter);
+       call(untag_word_fast(executing)->parameter);
 }
 
 /* pushes word parameter */
 void dosym(void)
 {
-       dpush(executing->parameter);
+       dpush(untag_word_fast(executing)->parameter);
 }
 
 void primitive_execute(void)
 {
-       executing = untag_word(dpop());
+       type_check(WORD_TYPE,dpeek());
+       executing = dpop();
        EXECUTE(executing);
 }
 

diff --git a/native/run.h b/native/run.h
index 97331a143082871dc8e0afa2140c36020e927826..42c92460e6c6da00cfa8f382fdd1e3ec09696590 100644 (file)
--- a/native/run.h
+++ b/native/run.h
@@ -29,8 +29,8 @@ sigjmp_buf toplevel;
 /* TAGGED currently executing quotation */
 CELL callframe;
 
-/* raw pointer to currently executing word */
-F_WORD* executing;
+/* TAGGED pointer to currently executing word */
+CELL executing;
 
 /* TAGGED user environment data; see getenv/setenv prims */
 CELL userenv[USER_ENV];
@@ -80,7 +80,7 @@ INLINE void call(CELL quot)
        /* tail call optimization */
        if(callframe != F)
        {
-               cpush(tag_word(executing));
+               cpush(executing);
                cpush(callframe);
        }
        callframe = quot;

diff --git a/native/unix/signal.c b/native/unix/signal.c
index 41d3f489ba4a63c18d709fdc05846d8abba13151..b941eea43d9489e8f45739d9737e1a31887b86b1 100644 (file)
--- a/native/unix/signal.c
+++ b/native/unix/signal.c
@@ -33,7 +33,7 @@ void call_profiling_step(int signal, siginfo_t* siginfo, void* uap)
                        untag_word(obj)->call_count++;
        }
 
-       executing->call_count++;
+       untag_word_fast(executing)->call_count++;
 }
 
 void init_signals(void)

diff --git a/native/word.h b/native/word.h
index f06233be9867c95e359bd918b104a3edecae4a82..e2dbe972335d917b091c79f0ac19324f7e5fa926 100644 (file)
--- a/native/word.h
+++ b/native/word.h
@@ -19,10 +19,15 @@ typedef struct {
        CELL allot_count;
 } F_WORD;
 
+INLINE F_WORD* untag_word_fast(CELL tagged)
+{
+       return (F_WORD*)UNTAG(tagged);
+}
+
 INLINE F_WORD* untag_word(CELL tagged)
 {
        type_check(WORD_TYPE,tagged);
-       return (F_WORD*)UNTAG(tagged);
+       return untag_word_fast(tagged);
 }
 
 INLINE CELL tag_word(F_WORD* word)