From 6ac8fdb22f9534140cf3a28218d25238c8ae69d2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 31 Dec 2004 07:38:58 +0000
Subject: [PATCH] executing global was not GC'd

---
 native/debug.c       |  2 +-
 native/gc.c          |  1 +
 native/memory.c      |  4 +++-
 native/run.c         | 14 ++++++++------
 native/run.h         |  6 +++---
 native/unix/signal.c |  2 +-
 native/word.h        |  7 ++++++-
 7 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/native/debug.c b/native/debug.c
index bea8212ef4..1c1b3ebe14 100644
--- 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 78229c55d7..53ebc7fdbc 100644
--- 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 71e9ac0bc8..dac4bca476 100644
--- 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 b61bc920f0..cda04953e4 100644
--- 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 97331a1430..42c92460e6 100644
--- 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 41d3f489ba..b941eea43d 100644
--- 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 f06233be98..e2dbe97233 100644
--- 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)