From 576e725662fcfde28082163d21cc7f1ecb098b83 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 24 Sep 2009 04:31:11 -0500
Subject: [PATCH] vm: Fix potential crash in <word> primitive if profiling is
 enabled

---
 basis/tools/profiler/profiler-tests.factor | 5 +++++
 vm/words.cpp                               | 8 +++++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor
index d2e605ecdc..dda531faee 100644
--- a/basis/tools/profiler/profiler-tests.factor
+++ b/basis/tools/profiler/profiler-tests.factor
@@ -59,3 +59,8 @@ words ;
 [ ] [ [ [ ] compile-call ] profile ] unit-test
 
 [ [ gensym execute ] profile ] [ T{ undefined } = ] must-fail-with
+
+: crash-bug-1 ( -- x ) "hi" "bye" <word> ;
+: crash-bug-2 ( -- ) 100000 [ crash-bug-1 drop ] times ;
+
+[ ] [ [ crash-bug-2 ] profile ] unit-test
diff --git a/vm/words.cpp b/vm/words.cpp
index f3c511efe9..a98d3ffa81 100644
--- a/vm/words.cpp
+++ b/vm/words.cpp
@@ -66,7 +66,13 @@ void factorvm::update_word_xt(cell w_)
 	if(profiling_p)
 	{
 		if(!w->profiling)
-			w->profiling = compile_profiling_stub(w.value());
+		{
+			/* Note: can't do w->profiling = ... since if LHS
+			evaluates before RHS, since in that case if RHS does a
+			GC, we will have an invalid pointer on the LHS */
+			code_block *profiling = compile_profiling_stub(w.value());
+			w->profiling = profiling;
+		}
 
 		w->xt = w->profiling->xt();
 	}