Fix GC root safety in word-xt primitive

diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor
index c3dacbaf148921a1492b45101b8f97980e42f973..b9d6e80630af59151923deea6d7010afa573ddf3 100755 (executable)
--- a/core/words/words-tests.factor
+++ b/core/words/words-tests.factor
@@ -125,3 +125,5 @@ DEFER: x
         keys [ "forgotten" word-prop ] filter
     ] map harvest
 ] unit-test
+
+[ "hi" word-xt ] must-fail

diff --git a/vm/words.cpp b/vm/words.cpp
index ce25313ea25b0dac4cbbe9cc28f6883ebcfbb1c4..b6f7097f71401d29a3b4f0a52ff75dd72aad6a6d 100644 (file)
--- a/vm/words.cpp
+++ b/vm/words.cpp
@@ -44,10 +44,19 @@ PRIMITIVE_FORWARD(word)
 /* word-xt ( word -- start end ) */
 inline void factor_vm::primitive_word_xt()
 {
-       word *w = untag_check<word>(dpop());
-       code_block *code = (profiling_p ? w->profiling : w->code);
-       dpush(allot_cell((cell)code->xt()));
-       dpush(allot_cell((cell)code + code->size));
+       gc_root<word> w(dpop(),this);
+       w.untag_check(this);
+
+       if(profiling_p)
+       {
+               dpush(allot_cell((cell)w->profiling->xt()));
+               dpush(allot_cell((cell)w->profiling + w->profiling->size));
+       }
+       else
+       {
+               dpush(allot_cell((cell)w->code->xt()));
+               dpush(allot_cell((cell)w->code + w->code->size));
+       }
 }
 
 PRIMITIVE_FORWARD(word_xt)