diff --git a/core/cpu/x86/bootstrap.factor b/core/cpu/x86/bootstrap.factor
index 3c42814bcf..13c2b2edf4 100755
--- a/core/cpu/x86/bootstrap.factor
+++ b/core/cpu/x86/bootstrap.factor
@@ -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
diff --git a/core/generator/generator.factor b/core/generator/generator.factor
index 4128559d35..a1a9c9be81 100755
--- a/core/generator/generator.factor
+++ b/core/generator/generator.factor
@@ -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 -- )
diff --git a/vm/callstack.c b/vm/callstack.c
index 536be88bda..a53578f78c 100755
--- a/vm/callstack.c
+++ b/vm/callstack.c
@@ -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);
diff --git a/vm/code_heap.c b/vm/code_heap.c
index 3234a0c0bf..51833703cb 100755
--- a/vm/code_heap.c
+++ b/vm/code_heap.c
@@ -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)
diff --git a/vm/data_gc.c b/vm/data_gc.c
index 8016ad4234..6d953134dc 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -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();
diff --git a/vm/data_gc.h b/vm/data_gc.h
index ae11c5746a..d9c3d8eb1c 100755
--- a/vm/data_gc.h
+++ b/vm/data_gc.h
@@ -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())
diff --git a/vm/errors.c b/vm/errors.c
index d306ea1aff..e82942af55 100755
--- a/vm/errors.c
+++ b/vm/errors.c
@@ -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);
}
diff --git a/vm/os-unix.c b/vm/os-unix.c
old mode 100644
new mode 100755
index b33c879d88..55d55f312b
--- a/vm/os-unix.c
+++ b/vm/os-unix.c
@@ -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)
diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c
index 2b08d5f394..e356c2f674 100755
--- a/vm/os-windows-nt.c
+++ b/vm/os-windows-nt.c
@@ -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)
diff --git a/vm/os-windows.c b/vm/os-windows.c
index 9d7bd85465..54baf56212 100755
--- a/vm/os-windows.c
+++ b/vm/os-windows.c
@@ -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)
diff --git a/vm/quotations.c b/vm/quotations.c
index 60c6d729d7..2810eb5121 100755
--- a/vm/quotations.c
+++ b/vm/quotations.c
@@ -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)
diff --git a/vm/quotations.h b/vm/quotations.h
old mode 100644
new mode 100755
index e8da6093cd..ebbacb8f45
--- a/vm/quotations.h
+++ b/vm/quotations.h
@@ -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);
diff --git a/vm/run.c b/vm/run.c
index afd50ec783..13e9ba76ba 100755
--- a/vm/run.c
+++ b/vm/run.c
@@ -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);
diff --git a/vm/run.h b/vm/run.h
old mode 100644
new mode 100755
index 7075999b7f..45810f6fa7
--- a/vm/run.h
+++ b/vm/run.h
@@ -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;
diff --git a/vm/types.h b/vm/types.h
index 78c42d3a54..de3c46f563 100755
--- a/vm/types.h
+++ b/vm/types.h
@@ -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))