Fixing tools.interpreter

extra/tools/interpreter/debug/debug.factor

@@ -11,7 +11,8 @@ IN: tools.interpreter.debug
     [
         "out" set
         [ f swap 2array restore "out" get continue ] callcc0
-    ] swap [ datastack "datastack" set stop ] 3append callcc0 ;
+    ] swap [ datastack "datastack" set stop ]
+    3append callcc0 ;
 
 : test-interpreter ( quot -- )
     init-interpreter run-interpreter "datastack" get ;

extra/tools/interpreter/interpreter-tests.factor

@@ -88,6 +88,10 @@ IN: temporary
     [ [ 2 2 + number>string print ] string-out ] test-interpreter
 ] unit-test
 
+[ { 1 2 3 } ] [
+    [ { 1 2 3 } set-datastack ] test-interpreter
+] unit-test
+
 [ { 6 } ]
 [ [ 3 [ nip continue ] callcc0 2 * ] test-interpreter ] unit-test
 
@@ -97,6 +101,10 @@ IN: temporary
 [ { 6 } ]
 [ [ [ 3 throw ] catch 2 * ] test-interpreter ] unit-test
 
+[ { "{ 1 2 3 }\n" } ] [
+    [ [ { 1 2 3 } . ] string-out ] test-interpreter
+] unit-test
+
 : meta-catch interpreter get continuation-catch ;
 
 ! Step back test

extra/tools/interpreter/interpreter.factor

@@ -26,7 +26,8 @@ M: continuation restore
     clone interpreter set ;
 
 M: pair restore
-    first2 restore [ nip f ] curry with-interpreter-datastack ;
+    first2 clone interpreter set
+    [ nip f ] curry with-interpreter-datastack ;
 
 M: f restore
     drop interpreter off ;
@@ -49,17 +50,21 @@ M: f restore
         ] if
     ] ?if ;
 
+: (step-into-continuation)
+    continuation callstack over set-continuation-call break ;
+
 {
     { call [ (step-into-call) ] }
     { (throw) [ (step-into-call) ] }
     { execute [ (step-into-execute) ] }
     { if [ (step-into-if) ] }
     { dispatch [ (step-into-dispatch) ] }
+    { continuation [ (step-into-continuation) ] }
 } [ "step-into" set-word-prop ] assoc-each
 
 {
     >n ndrop >c c>
-    continuation continue continue-with
+    continue continue-with
     (continue-with) stop break
 } [
     dup [ execute break ] curry
@@ -72,9 +77,12 @@ SYMBOL: history
 : save-interpreter ( -- )
     history get [ interpreter get clone swap push ] when* ;
 
+: restore-interpreter ( interp -- )
+    clone interpreter set ;
+
 : step-back ( -- )
     history get dup empty?
-    [ drop ] [ pop restore ] if ;
+    [ drop ] [ pop restore-interpreter ] if ;
 
 : (continue) ( continuation -- )
     >continuation<

vm/callstack.c

@@ -227,26 +227,29 @@ DEFINE_PRIMITIVE(innermost_stack_frame_scan)
 
 DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
 {
-	CELL callstack = dpop();
+	F_CALLSTACK *callstack = untag_callstack(dpop());
-
-	REGISTER_ROOT(callstack);
 	F_QUOTATION *quot = untag_quotation(dpop());
+
+	REGISTER_UNTAGGED(callstack);
 	REGISTER_UNTAGGED(quot);
 
 	if(quot->compiled == F)
 		jit_compile(quot);
 
 	UNREGISTER_UNTAGGED(quot);
-	UNREGISTER_ROOT(callstack);
+	UNREGISTER_UNTAGGED(callstack);
 
-	F_STACK_FRAME *inner = innermost_stack_frame(
+	F_STACK_FRAME *inner = innermost_stack_frame(callstack);
-		untag_callstack(callstack));
 	type_check(QUOTATION_TYPE,frame_executing(inner));
 
-
 	CELL scan = inner->scan - inner->array;
 
 #ifdef CALLSTACK_UP_P
+	CELL top = (CELL)(callstack + 1);
+	CELL bottom = top + untag_fixnum_fast(callstack->length);
+	CELL base = callstack->bottom;
+	CELL delta = (bottom - base);
+
 	F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(inner,delta);
 	CELL offset = *(XT *)(next + 1) - inner->xt;
 #else