steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing tools.interpreter

release
Slava 2007-10-03 20:49:17 -04:00
parent 1ef514ebdb
commit 0183a40717
4 changed files with 31 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/tools/interpreter/debug/debug.factor
View File

@ -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 ;

8
extra/tools/interpreter/interpreter-tests.factor
View File

@ -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

14
extra/tools/interpreter/interpreter.factor
View File

@ -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<

17
vm/callstack.c
View File

@ -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