diff --git a/extra/tools/interpreter/debug/debug.factor b/extra/tools/interpreter/debug/debug.factor index dcc9a510af..c9e40feba6 100644 --- a/extra/tools/interpreter/debug/debug.factor +++ b/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 ; diff --git a/extra/tools/interpreter/interpreter-tests.factor b/extra/tools/interpreter/interpreter-tests.factor index 288368b9e6..902953d781 100644 --- a/extra/tools/interpreter/interpreter-tests.factor +++ b/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 diff --git a/extra/tools/interpreter/interpreter.factor b/extra/tools/interpreter/interpreter.factor index bb635b0027..5eb1438618 100644 --- a/extra/tools/interpreter/interpreter.factor +++ b/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< diff --git a/vm/callstack.c b/vm/callstack.c index a4b7945c9f..a7cfe903c0 100644 --- a/vm/callstack.c +++ b/vm/callstack.c @@ -227,26 +227,29 @@ DEFINE_PRIMITIVE(innermost_stack_frame_scan) DEFINE_PRIMITIVE(set_innermost_stack_frame_quot) { - CELL callstack = dpop(); - - REGISTER_ROOT(callstack); + F_CALLSTACK *callstack = untag_callstack(dpop()); 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( - untag_callstack(callstack)); + F_STACK_FRAME *inner = innermost_stack_frame(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