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

Get vm/callstack.c to compile on x86

release
Slava 2007-10-03 18:53:43 -04:00
parent d37a17bd68
commit 443fc8fb04
1 changed files with 31 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
vm/callstack.c
View File

@ -1,5 +1,7 @@
#include "master.h"
/* This code is very ugly. Perhaps unavoidably so. */
/* called before entry into Factor code. */
F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom)
{
@ -183,11 +185,31 @@ DEFINE_PRIMITIVE(callstack_to_array)
dpush(tag_object(array));
}
F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack)
{
#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 *frame = (F_STACK_FRAME *)bottom - 1;
while(frame >= (F_STACK_FRAME *)top
&& REBASE_FRAME_SUCCESSOR(frame,delta) >= (F_STACK_FRAME *)top)
frame = REBASE_FRAME_SUCCESSOR(frame,delta);
return frame;
#else
return FIRST_STACK_FRAME(callstack);
#endif
}
/* Some primitives implementing a limited form of callstack mutation.
Used by the single stepper. */
DEFINE_PRIMITIVE(innermost_stack_frame_quot)
{
F_STACK_FRAME *inner = FIRST_STACK_FRAME(
F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(dpop()));
type_check(QUOTATION_TYPE,frame_executing(inner));
@ -196,7 +218,7 @@ DEFINE_PRIMITIVE(innermost_stack_frame_quot)
DEFINE_PRIMITIVE(innermost_stack_frame_scan)
{
F_STACK_FRAME *inner = FIRST_STACK_FRAME(
F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(dpop()));
type_check(QUOTATION_TYPE,frame_executing(inner));
@ -217,13 +239,19 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
UNREGISTER_UNTAGGED(quot);
UNREGISTER_ROOT(callstack);
F_STACK_FRAME *inner = FIRST_STACK_FRAME(
F_STACK_FRAME *inner = innermost_stack_frame(
untag_callstack(callstack));
type_check(QUOTATION_TYPE,frame_executing(inner));
CELL scan = inner->scan - inner->array;
#ifdef CALLSTACK_UP_P
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(inner,delta);
CELL offset = *(XT *)(next + 1) - inner->xt;
#else
CELL offset = inner->return_address - inner->xt;
#endif
inner->array = quot->array;
inner->scan = quot->array + scan;
@ -231,7 +259,6 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
inner->xt = quot->xt;
#ifdef CALLSTACK_UP_P
F_STACK_FRAME *next = REBASE_FRAME_SUCCESSOR(frame,delta);
*(XT *)(next + 1) = quot->xt + offset;
#else
inner->return_address = quot->xt + offset;