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

Improved JIT compiler design; better REGISTER_ROOT/UNREGISTER_ROOT stuff

db4
Slava Pestov 2007-12-26 01:45:16 -05:00
parent 500ec89b56
commit c09af2f2c6
15 changed files with 226 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
core/cpu/x86/bootstrap.factor
View File

@ -13,11 +13,11 @@ big-endian off
: scan-save stack-reg 3 bootstrap-cells [+] ;
[
! arg0 0 MOV ! load quotation
arg0 0 [] MOV ! load quotation
arg1 arg0 quot-xt@ [+] MOV ! load XT
arg0 arg0 quot-array@ [+] MOV ! load array
scan-reg arg0 scan@ [+] LEA ! initialize scan pointer
] rc-absolute-cell rt-literal 1 jit-setup jit-define
] rc-absolute-cell rt-literal 2 jit-setup jit-define
[
stack-frame-size PUSH ! save stack frame size
@ -30,27 +30,24 @@ big-endian off
: advance-scan scan-reg bootstrap-cell ADD ;
[
arg0 0 [] MOV ! load literal
advance-scan
ds-reg bootstrap-cell ADD ! increment datastack pointer
arg0 scan-reg [] MOV ! load literal
ds-reg [] arg0 MOV ! store literal on datastack
] f f f jit-push-literal jit-define
[
advance-scan
ds-reg bootstrap-cell ADD ! increment datastack pointer
arg0 scan-reg [] MOV ! load wrapper
arg0 dup wrapper@ [+] MOV ! load wrapper-obj slot
ds-reg [] arg0 MOV ! store literal on datastack
] f f f jit-push-wrapper jit-define
] rc-absolute-cell rt-literal 2 jit-push-literal jit-define
[
arg1 stack-reg MOV ! pass callstack pointer as arg 2
] f f f jit-word-primitive-jump jit-define
(JMP) drop ! go
] rc-relative rt-primitive 3 jit-word-primitive-jump jit-define
[
advance-scan
arg1 stack-reg bootstrap-cell neg [+] LEA ! pass callstack pointer as arg 2
] f f f jit-word-primitive-call jit-define
scan-save scan-reg MOV ! save scan pointer
(CALL) drop ! go
scan-reg scan-save MOV ! restore scan pointer
] rc-relative rt-primitive 12 jit-word-primitive-call jit-define
[
arg0 scan-reg bootstrap-cell [+] MOV ! load word
@ -65,35 +62,25 @@ big-endian off
scan-reg scan-save MOV ! restore scan pointer
] f f f jit-word-call jit-define
: load-branch
[
arg1 0 MOV ! load addr of true quotation
arg0 ds-reg [] MOV ! load boolean
ds-reg bootstrap-cell SUB ! pop boolean
arg0 \ f tag-number CMP ! compare it with f
arg0 scan-reg 2 bootstrap-cells [+] CMOVE ! load false branch if equal
arg0 scan-reg 1 bootstrap-cells [+] CMOVNE ! load true branch if not equal
scan-reg 3 bootstrap-cells ADD ! advance scan pointer
arg0 quot-xt@ [+] ! load quotation-xt
;
[
load-branch JMP
] f f f jit-if-jump jit-define
[
load-branch
scan-save scan-reg MOV ! save scan pointer
CALL ! call quotation
scan-reg scan-save MOV ! restore scan pointer
] f f f jit-if-call jit-define
arg0 arg1 [] CMOVNE ! load true branch if not equal
arg0 arg1 bootstrap-cell [+] CMOVE ! load false branch if equal
arg0 quot-xt@ [+] JMP ! jump to quotation-xt
] rc-absolute-cell rt-literal 1 jit-if-jump jit-define
[
arg1 0 [] MOV ! load dispatch table
arg0 ds-reg [] MOV ! load index
fixnum>slot@ ! turn it into an array offset
ds-reg bootstrap-cell SUB ! pop index
arg0 scan-reg bootstrap-cell [+] ADD ! compute quotation location
arg0 arg1 ADD ! compute quotation location
arg0 arg0 array-start [+] MOV ! load quotation
arg0 quot-xt@ [+] JMP ! jump to quotation-xt
] f f f jit-dispatch jit-define
arg0 quot-xt@ [+] JMP ! execute branch
] rc-absolute-cell rt-literal 2 jit-dispatch jit-define
[
stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame

6
core/generator/generator.factor
View File

@ -15,7 +15,7 @@ SYMBOL: compiled
: begin-compiling ( word -- )
f swap compiled get set-at ;
: finish-compiling ( word literals words rel labels code profiler-prologue -- )
: finish-compiling ( word literals words relocation labels code profiler-prologue -- )
6array swap compiled get set-at ;
: queue-compile ( word -- )
@ -39,10 +39,10 @@ SYMBOL: compiled-stack-traces?
t compiled-stack-traces? set-global
: init-generator ( -- )
: init-generator ( compiling -- )
V{ } clone literal-table set
V{ } clone word-table set
compiled-stack-traces? get compiling-word get f ?
compiled-stack-traces? get swap f ?
literal-table get push ;
: generate-1 ( word label node quot -- )

2
vm/callstack.c
View File

@ -205,7 +205,7 @@ DEFINE_PRIMITIVE(set_innermost_stack_frame_quot)
REGISTER_UNTAGGED(quot);
if(quot->compiledp == F)
jit_compile(quot);
jit_compile(tag_object(quot));
UNREGISTER_UNTAGGED(quot);
UNREGISTER_UNTAGGED(callstack);

27
vm/code_heap.c
View File

@ -258,9 +258,9 @@ F_COMPILED *add_compiled_block(
CELL code_format = compiled_code_format();
CELL code_length = align8(array_capacity(code) * code_format);
CELL rel_length = (relocation ? array_capacity(relocation) * sizeof(unsigned int) : 0);
CELL words_length = (words ? array_capacity(words) * CELLS : 0);
CELL literals_length = (literals ? array_capacity(literals) * CELLS : 0);
CELL rel_length = array_capacity(relocation) * sizeof(unsigned int);
CELL words_length = array_capacity(words) * CELLS;
CELL literals_length = array_capacity(literals) * CELLS;
REGISTER_UNTAGGED(code);
REGISTER_UNTAGGED(labels);
@ -295,25 +295,16 @@ F_COMPILED *add_compiled_block(
here += code_length;
/* relation info */
if(relocation)
{
deposit_integers(here,relocation,sizeof(unsigned int));
here += rel_length;
}
deposit_integers(here,relocation,sizeof(unsigned int));
here += rel_length;
/* literals */
if(literals)
{
deposit_objects(here,literals);
here += literals_length;
}
deposit_objects(here,literals);
here += literals_length;
/* words */
if(words)
{
deposit_objects(here,words);
here += words_length;
}
deposit_objects(here,words);
here += words_length;
/* fixup labels */
if(labels)

17
vm/data_gc.c
View File

@ -126,6 +126,9 @@ void init_data_heap(CELL gens,
{
set_data_heap(alloc_data_heap(gens,young_size,aging_size));
gc_locals_region = alloc_segment(getpagesize());
gc_locals = gc_locals_region->start - CELLS;
extra_roots_region = alloc_segment(getpagesize());
extra_roots = extra_roots_region->start - CELLS;
@ -369,10 +372,9 @@ void collect_cards(void)
/* Copy all tagged pointers in a range of memory */
void collect_stack(F_SEGMENT *region, CELL top)
{
CELL bottom = region->start;
CELL ptr;
CELL ptr = region->start;
for(ptr = bottom; ptr <= top; ptr += CELLS)
for(; ptr <= top; ptr += CELLS)
copy_handle((CELL*)ptr);
}
@ -398,6 +400,14 @@ void collect_callstack(F_CONTEXT *stacks)
iterate_callstack(top,bottom,collect_stack_frame);
}
void collect_gc_locals(void)
{
CELL ptr = gc_locals_region->start;
for(; ptr <= gc_locals; ptr += CELLS)
copy_handle(*(CELL **)ptr);
}
/* Copy roots over at the start of GC, namely various constants, stacks,
the user environment and extra roots registered with REGISTER_ROOT */
void collect_roots(void)
@ -407,6 +417,7 @@ void collect_roots(void)
copy_handle(&bignum_pos_one);
copy_handle(&bignum_neg_one);
collect_gc_locals();
collect_stack(extra_roots_region,extra_roots);
save_stacks();

30
vm/data_gc.h
View File

@ -228,14 +228,38 @@ void garbage_collection(volatile CELL gen,
/* If a runtime function needs to call another function which potentially
allocates memory, it must store any local variable references to Factor
objects on the root stack */
/* GC locals: stores addresses of pointers to objects. The GC updates these
pointers, so you can do
REGISTER_ROOT(some_local);
... allocate memory ...
foo(some_local);
...
UNREGISTER_ROOT(some_local); */
F_SEGMENT *gc_locals_region;
CELL gc_locals;
DEFPUSHPOP(gc_local_,gc_locals)
#define REGISTER_ROOT(obj) gc_local_push((CELL)&obj)
#define UNREGISTER_ROOT(obj) \
{ \
if(gc_local_pop() != (CELL)&obj) \
critical_error("Mismatched REGISTER_ROOT/UNREGISTER_ROOT",0); \
}
/* Extra roots: stores pointers to objects in the heap. Requires extra work
(you have to unregister before accessing the object) but more flexible. */
F_SEGMENT *extra_roots_region;
CELL extra_roots;
DEFPUSHPOP(root_,extra_roots)
#define REGISTER_ROOT(obj) root_push(obj)
#define UNREGISTER_ROOT(obj) obj = root_pop()
#define REGISTER_UNTAGGED(obj) root_push(obj ? tag_object(obj) : 0)
#define UNREGISTER_UNTAGGED(obj) obj = untag_object(root_pop())

11
vm/errors.c
View File

@ -23,7 +23,8 @@ void throw_error(CELL error, F_STACK_FRAME *callstack_top)
gc_off = false;
/* Reset local roots */
extra_roots = stack_chain->extra_roots;
gc_locals = gc_locals_region->start - CELLS;
extra_roots = extra_roots_region->start - CELLS;
/* If we had an underflow or overflow, stack pointers might be
out of bounds */
@ -104,10 +105,14 @@ void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack)
general_error(ERROR_RS_OVERFLOW,F,F,native_stack);
else if(in_page(addr, nursery->end, 0, 0))
critical_error("allot_object() missed GC check",0);
else if(in_page(addr, gc_locals_region->start, 0, -1))
critical_error("gc locals underflow",0);
else if(in_page(addr, gc_locals_region->end, 0, 0))
critical_error("gc locals overflow",0);
else if(in_page(addr, extra_roots_region->start, 0, -1))
critical_error("local root underflow",0);
critical_error("extra roots underflow",0);
else if(in_page(addr, extra_roots_region->end, 0, 0))
critical_error("local root overflow",0);
critical_error("extra roots overflow",0);
else
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
}

12
vm/os-unix.c Normal file → Executable file
View File

@ -94,6 +94,7 @@ DEFINE_PRIMITIVE(read_dir)
{
DIR* dir = opendir(unbox_char_string());
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
if(dir != NULL)
{
@ -101,18 +102,17 @@ DEFINE_PRIMITIVE(read_dir)
while((file = readdir(dir)) != NULL)
{
REGISTER_UNTAGGED(result);
CELL pair = parse_dir_entry(file);
UNREGISTER_UNTAGGED(result);
GROWABLE_ADD(result,pair);
}
closedir(dir);
}
UNREGISTER_ROOT(result);
GROWABLE_TRIM(result);
dpush(tag_object(result));
dpush(result);
}
DEFINE_PRIMITIVE(cwd)
@ -131,19 +131,19 @@ DEFINE_PRIMITIVE(cd)
DEFINE_PRIMITIVE(os_envs)
{
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
char **env = environ;
while(*env)
{
REGISTER_UNTAGGED(result);
CELL string = tag_object(from_char_string(*env));
UNREGISTER_UNTAGGED(result);
GROWABLE_ADD(result,string);
env++;
}
UNREGISTER_ROOT(result);
GROWABLE_TRIM(result);
dpush(tag_object(result));
dpush(result);
}
F_SEGMENT *alloc_segment(CELL size)

6
vm/os-windows-nt.c
View File

@ -26,6 +26,7 @@ DEFINE_PRIMITIVE(cd)
DEFINE_PRIMITIVE(os_envs)
{
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
TCHAR *env = GetEnvironmentStrings();
TCHAR *finger = env;
@ -38,9 +39,7 @@ DEFINE_PRIMITIVE(os_envs)
if(scan == finger)
break;
REGISTER_UNTAGGED(result);
CELL string = tag_object(from_u16_string(finger));
UNREGISTER_UNTAGGED(result);
GROWABLE_ADD(result,string);
finger = scan + 1;
@ -48,8 +47,9 @@ DEFINE_PRIMITIVE(os_envs)
FreeEnvironmentStrings(env);
UNREGISTER_ROOT(result);
GROWABLE_TRIM(result);
dpush(tag_object(result));
dpush(result);
}
long exception_handler(PEXCEPTION_POINTERS pe)

6
vm/os-windows.c
View File

@ -173,25 +173,25 @@ DEFINE_PRIMITIVE(read_dir)
F_CHAR *path = unbox_u16_string();
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
{
do
{
REGISTER_UNTAGGED(result);
CELL name = tag_object(from_u16_string(find_data.cFileName));
CELL dirp = tag_boolean(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
CELL pair = allot_array_2(name,dirp);
UNREGISTER_UNTAGGED(result);
GROWABLE_ADD(result,pair);
}
while (FindNextFile(dir, &find_data));
CloseHandle(dir);
}
UNREGISTER_ROOT(result);
GROWABLE_TRIM(result);
dpush(tag_object(result));
dpush(result);
}
F_SEGMENT *alloc_segment(CELL size)

196
vm/quotations.c
View File

@ -5,7 +5,7 @@ the second one is written in Factor and performs a lot of optimizations.
See core/compiler/compiler.factor */
bool jit_fast_if_p(F_ARRAY *array, CELL i)
{
return (i + 3) <= array_capacity(array)
return (i + 3) == array_capacity(array)
&& type_of(array_nth(array,i)) == QUOTATION_TYPE
&& type_of(array_nth(array,i + 1)) == QUOTATION_TYPE
&& array_nth(array,i + 2) == userenv[JIT_IF_WORD];
@ -14,6 +14,7 @@ bool jit_fast_if_p(F_ARRAY *array, CELL i)
bool jit_fast_dispatch_p(F_ARRAY *array, CELL i)
{
return (i + 2) == array_capacity(array)
&& type_of(array_nth(array,i)) == ARRAY_TYPE
&& array_nth(array,i + 1) == userenv[JIT_DISPATCH_WORD];
}
@ -22,10 +23,44 @@ F_ARRAY *code_to_emit(CELL name)
return untag_object(array_nth(untag_object(userenv[name]),0));
}
#define EMIT(name) { \
REGISTER_UNTAGGED(array); \
F_REL rel_to_emit(CELL name, CELL code_format, CELL code_length,
CELL rel_argument, bool *rel_p)
{
F_ARRAY *quadruple = untag_object(userenv[name]);
CELL rel_class = array_nth(quadruple,1);
CELL rel_type = array_nth(quadruple,2);
CELL offset = array_nth(quadruple,3);
F_REL rel;
if(rel_class == F)
{
*rel_p = false;
rel.type = 0;
rel.offset = 0;
}
else
{
*rel_p = true;
rel.type = to_fixnum(rel_type)
| (to_fixnum(rel_class) << 8)
| (rel_argument << 16);
rel.offset = code_length * code_format + to_fixnum(offset);
}
return rel;
}
#define EMIT(name,rel_argument) { \
bool rel_p; \
F_REL rel = rel_to_emit(name,code_format,code_count, \
rel_argument,&rel_p); \
if(rel_p) \
{ \
GROWABLE_ADD(relocation,allot_cell(rel.type)); \
GROWABLE_ADD(relocation,allot_cell(rel.offset)); \
} \
GROWABLE_APPEND(code,code_to_emit(name)); \
UNREGISTER_UNTAGGED(array); \
}
bool jit_stack_frame_p(F_ARRAY *array)
@ -52,32 +87,47 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code)
quot->compiledp = T;
}
void jit_compile(F_QUOTATION *quot)
/* Might GC */
void jit_compile(CELL quot)
{
F_ARRAY *array = untag_object(quot->array);
CELL code_format = compiled_code_format();
REGISTER_UNTAGGED(quot);
REGISTER_ROOT(quot);
CELL array = untag_quotation(quot)->array;
REGISTER_ROOT(array);
REGISTER_UNTAGGED(array);
GROWABLE_ARRAY(code);
UNREGISTER_UNTAGGED(array);
REGISTER_ROOT(code);
bool stack_frame = jit_stack_frame_p(array);
GROWABLE_ARRAY(relocation);
REGISTER_ROOT(relocation);
EMIT(JIT_SETUP);
GROWABLE_ARRAY(literals);
REGISTER_ROOT(literals);
GROWABLE_ARRAY(words);
REGISTER_ROOT(words);
GROWABLE_ADD(literals,quot);
bool stack_frame = jit_stack_frame_p(untag_object(array));
EMIT(JIT_SETUP,0);
if(stack_frame)
EMIT(JIT_PROLOG);
EMIT(JIT_PROLOG,0);
CELL i;
CELL length = array_capacity(array);
CELL length = array_capacity(untag_object(array));
bool tail_call = false;
for(i = 0; i < length; i++)
{
CELL obj = array_nth(array,i);
CELL obj = array_nth(untag_object(array),i);
F_WORD *word;
bool primitive_p;
F_WRAPPER *wrapper;
switch(type_of(obj))
{
@ -91,57 +141,65 @@ void jit_compile(F_QUOTATION *quot)
if(i == length - 1)
{
if(stack_frame)
EMIT(JIT_EPILOG);
EMIT(JIT_EPILOG,0);
if(primitive_p)
EMIT(JIT_WORD_PRIMITIVE_JUMP);
EMIT(JIT_WORD_JUMP);
{
EMIT(JIT_WORD_PRIMITIVE_JUMP,
to_fixnum(word->def));
}
else
EMIT(JIT_WORD_JUMP,0);
tail_call = true;
}
else
{
if(primitive_p)
EMIT(JIT_WORD_PRIMITIVE_CALL);
EMIT(JIT_WORD_CALL);
{
EMIT(JIT_WORD_PRIMITIVE_CALL,
to_fixnum(word->def));
}
else
EMIT(JIT_WORD_CALL,0);
}
break;
case WRAPPER_TYPE:
EMIT(JIT_PUSH_WRAPPER);
wrapper = untag_object(obj);
GROWABLE_ADD(literals,wrapper->object);
EMIT(JIT_PUSH_LITERAL,literals_count - 1);
break;
case QUOTATION_TYPE:
if(jit_fast_if_p(array,i))
if(jit_fast_if_p(untag_object(array),i))
{
if(stack_frame)
EMIT(JIT_EPILOG,0);
GROWABLE_ADD(literals,array_nth(untag_object(array),i));
GROWABLE_ADD(literals,array_nth(untag_object(array),i + 1));
EMIT(JIT_IF_JUMP,literals_count - 2);
i += 2;
if(i == length - 1)
{
if(stack_frame)
EMIT(JIT_EPILOG);
EMIT(JIT_IF_JUMP);
tail_call = true;
}
else
EMIT(JIT_IF_CALL);
tail_call = true;
break;
}
case ARRAY_TYPE:
if(jit_fast_dispatch_p(array,i))
if(jit_fast_dispatch_p(untag_object(array),i))
{
i++;
if(stack_frame)
EMIT(JIT_EPILOG);
EMIT(JIT_EPILOG,0);
EMIT(JIT_DISPATCH);
GROWABLE_ADD(literals,array_nth(untag_object(array),i));
EMIT(JIT_DISPATCH,literals_count - 1);
i++;
tail_call = true;
break;
}
default:
EMIT(JIT_PUSH_LITERAL);
GROWABLE_ADD(literals,obj);
EMIT(JIT_PUSH_LITERAL,literals_count - 1);
break;
}
}
@ -149,52 +207,44 @@ void jit_compile(F_QUOTATION *quot)
if(!tail_call)
{
if(stack_frame)
EMIT(JIT_EPILOG);
EMIT(JIT_EPILOG,0);
EMIT(JIT_RETURN);
EMIT(JIT_RETURN,0);
}
GROWABLE_TRIM(code);
GROWABLE_TRIM(relocation);
GROWABLE_TRIM(literals);
GROWABLE_TRIM(words);
UNREGISTER_UNTAGGED(quot);
REGISTER_UNTAGGED(quot);
F_COMPILED *compiled = add_compiled_block(
QUOTATION_TYPE,
0,
untag_object(code),
NULL,
untag_object(relocation),
untag_object(words),
untag_object(literals));
REGISTER_UNTAGGED(code);
F_ARRAY *literals = allot_array(ARRAY_TYPE,1,tag_object(quot));
UNREGISTER_UNTAGGED(code);
F_COMPILED *compiled = add_compiled_block(QUOTATION_TYPE,0,code,NULL,NULL,NULL,literals);
iterate_code_heap_step(compiled,finalize_code_block);
UNREGISTER_UNTAGGED(quot);
set_quot_xt(quot,compiled);
set_quot_xt(untag_object(quot),compiled);
UNREGISTER_ROOT(words);
UNREGISTER_ROOT(literals);
UNREGISTER_ROOT(relocation);
UNREGISTER_ROOT(code);
UNREGISTER_ROOT(array);
UNREGISTER_ROOT(quot);
}
F_FASTCALL CELL primitive_jit_compile(CELL tagged, F_STACK_FRAME *stack)
F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack)
{
stack_chain->callstack_top = stack;
REGISTER_ROOT(tagged);
jit_compile(untag_quotation(tagged));
UNREGISTER_ROOT(tagged);
return tagged;
}
XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset)
{
if(offset != -1)
critical_error("Not yet implemented",0);
CELL xt = 0;
xt += array_capacity(code_to_emit(JIT_SETUP));
bool stack_frame = jit_stack_frame_p(untag_array(quot->array));
if(stack_frame)
xt += array_capacity(code_to_emit(JIT_PROLOG));
xt *= compiled_code_format();
return quot->xt + xt;
REGISTER_ROOT(quot);
jit_compile(quot);
UNREGISTER_ROOT(quot);
return quot;
}
DEFINE_PRIMITIVE(curry)

5
vm/quotations.h Normal file → Executable file
View File

@ -1,7 +1,6 @@
void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code);
void jit_compile(F_QUOTATION *quot);
F_FASTCALL CELL primitive_jit_compile(CELL tagged, F_STACK_FRAME *stack);
XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset);
void jit_compile(CELL quot);
F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack);
void uncurry(CELL obj);
DECLARE_PRIMITIVE(curry);
DECLARE_PRIMITIVE(array_to_quotation);

4
vm/run.c
View File

@ -54,8 +54,6 @@ void nest_stacks(void)
new_stacks->datastack_region = alloc_segment(ds_size);
new_stacks->retainstack_region = alloc_segment(rs_size);
new_stacks->extra_roots = extra_roots;
new_stacks->next = stack_chain;
stack_chain = new_stacks;
@ -76,8 +74,6 @@ void unnest_stacks(void)
userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save;
userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save;
extra_roots = stack_chain->extra_roots;
F_CONTEXT *old_stacks = stack_chain;
stack_chain = old_stacks->next;
free(old_stacks);

3
vm/run.h Normal file → Executable file
View File

@ -183,9 +183,6 @@ typedef struct _F_CONTEXT {
CELL catchstack_save;
CELL current_callback_save;
/* saved extra_roots pointer on entry to callback */
CELL extra_roots;
struct _F_CONTEXT *next;
} F_CONTEXT;

11
vm/types.h
View File

@ -194,7 +194,7 @@ DECLARE_PRIMITIVE(wrapper);
/* Macros to simulate a vector in C */
#define GROWABLE_ARRAY(result) \
CELL result##_count = 0; \
F_ARRAY *result = allot_array(ARRAY_TYPE,100,F)
CELL result = tag_object(allot_array(ARRAY_TYPE,100,F))
INLINE F_ARRAY *growable_add(F_ARRAY *result, CELL elt, CELL *result_count)
{
@ -214,7 +214,7 @@ INLINE F_ARRAY *growable_add(F_ARRAY *result, CELL elt, CELL *result_count)
}
#define GROWABLE_ADD(result,elt) \
result = growable_add(result,elt,&result##_count)
result = tag_object(growable_add(untag_object(result),elt,&result##_count))
INLINE F_ARRAY *growable_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count)
{
@ -236,6 +236,7 @@ INLINE F_ARRAY *growable_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_cou
}
#define GROWABLE_APPEND(result,elts) \
result = growable_append(result,elts,&result##_count)
#define GROWABLE_TRIM(result) result = reallot_array(result,result##_count,F)
result = tag_object(growable_append(untag_object(result),elts,&result##_count))
#define GROWABLE_TRIM(result) \
result = tag_object(reallot_array(untag_object(result),result##_count,F))