diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 0f61eb4c83..c749ec3dad 100644 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -36,7 +36,7 @@ IN: bootstrap.image : wrapper@ bootstrap-cell object tag-number - ; : word-xt@ 8 bootstrap-cells object tag-number - ; : quot-array@ bootstrap-cell object tag-number - ; -: quot-xt@ 2 bootstrap-cells object tag-number - ; +: quot-xt@ 3 bootstrap-cells object tag-number - ; ! The image being constructed; a vector of word-size integers SYMBOL: image @@ -312,6 +312,7 @@ M: quotation ' quotation-array ' quotation type-number object tag-number [ emit ! array + f ' emit ! compiled? 0 emit ! XT ] emit-object ] cache ; diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 5e7bc1f338..edd1d42dcf 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -452,6 +452,13 @@ num-types get f builtins set { "quotation-array" "quotations.private" } f } + { + { "object" "kernel" } + "compiled?" + 2 + { "quotation-compiled?" "quotations" } + f + } } define-builtin "dll" "alien" create "dll?" "alien" create diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S index b1f8298eb0..ba539c1fdc 100644 --- a/vm/cpu-ppc.S +++ b/vm/cpu-ppc.S @@ -4,7 +4,7 @@ in the public domain. */ /* Note that the XT is passed to the quotation in r11 */ #define CALL_OR_JUMP_QUOT \ - lwz r11,5(r3) /* load quotation-xt slot */ XX \ + lwz r11,9(r3) /* load quotation-xt slot */ XX \ #define CALL_QUOT \ CALL_OR_JUMP_QUOT XX \ @@ -41,14 +41,14 @@ in the public domain. */ #define RESTORE(register,offset) lwz register,SAVE_AT(offset)(r1) #define PROLOGUE \ - mflr r0 ; /* get caller's return address */ \ - stwu r1,-FRAME(r1) ; /* create a stack frame to hold non-volatile registers */ + mflr r0 XX /* get caller's return address */ \ + stwu r1,-FRAME(r1) XX /* create a stack frame to hold non-volatile registers */ \ SAVE_LR(r0) #define EPILOGUE \ - LOAD_LR(r0) ; \ - lwz r1,0(r1) ; /* destroy the stack frame */ \ - mtlr r0 /* get ready to return */ \ + LOAD_LR(r0) XX \ + lwz r1,0(r1) XX /* destroy the stack frame */ \ + mtlr r0 /* get ready to return */ DEF(void,c_to_factor,(CELL quot)): PROLOGUE @@ -173,9 +173,9 @@ DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)): DEF(void,lazy_jit_compile,(CELL quot)): mr r4,r1 /* save stack pointer */ PROLOGUE - SAVE(r3,19) /* save quotation since we're about to mangle it */ - b MANGLE(jit_compile) - RESTORE(r3,19) /* restore quotation */ + SAVE(r3,18) /* save quot */ + bl MANGLE(jit_compile) + RESTORE(r3,18) EPILOGUE JUMP_QUOT /* call the quotation */ diff --git a/vm/debug.c b/vm/debug.c index b7fb4ff68f..57d195e2ba 100644 --- a/vm/debug.c +++ b/vm/debug.c @@ -3,7 +3,12 @@ void print_word(F_WORD* word, CELL nesting) { if(type_of(word->name) == STRING_TYPE) - printf("%s",to_char_string(untag_string(word->name),true)); + { + F_STRING *string = untag_string(word->name); + CELL i; + for(i = 0; i < string_capacity(string); i++) + putchar(cget(SREF(string,i))); + } else { printf("#xt) - { - /* This can only happen when we're starting a stage2 bootstrap. - The stage1 bootstrapper doesn't attempt to compile quotations, - so we do it here. */ - jit_compile_all(); - } - nest_stacks(); c_to_factor_toplevel(userenv[BOOT_ENV]); unnest_stacks(); diff --git a/vm/image.c b/vm/image.c index d0f4635f82..a4fd08af00 100644 --- a/vm/image.c +++ b/vm/image.c @@ -154,17 +154,18 @@ void fixup_word(F_WORD *word) { /* If this is a compiled word, relocate the code pointer. Otherwise, reset it based on the primitive number of the word. */ - if(word->compiledp != F) - code_fixup(&word->xt); + if(word->compiledp == F) + word->xt = default_word_xt(word); else - update_xt(word); + code_fixup(&word->xt); } void fixup_quotation(F_QUOTATION *quot) { - code_fixup("->xt); - if(!in_code_heap_p(quot->xt)) + if(quot->compiled == F) quot->xt = lazy_jit_compile; + else + code_fixup("->xt); } void fixup_alien(F_ALIEN *d) diff --git a/vm/jit.c b/vm/jit.c index c6904414b5..d10f25c325 100644 --- a/vm/jit.c +++ b/vm/jit.c @@ -34,8 +34,11 @@ bool jit_stack_frame_p(F_ARRAY *array) return false; } -void jit_compile(F_QUOTATION *quot) +FASTCALL void jit_compile(CELL tagged, F_STACK_FRAME *stack) { + stack_chain->callstack_top = stack; + + F_QUOTATION *quot = untag_quotation(tagged); F_ARRAY *array = untag_object(quot->array); REGISTER_UNTAGGED(quot); @@ -150,6 +153,7 @@ void jit_compile(F_QUOTATION *quot) UNREGISTER_UNTAGGED(quot); quot->xt = xt; + quot->compiled = T; } XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset) diff --git a/vm/jit.h b/vm/jit.h index b3a54d604f..26a67490f4 100644 --- a/vm/jit.h +++ b/vm/jit.h @@ -1,3 +1,2 @@ -DLLEXPORT void jit_compile(F_QUOTATION *quot); -jit_compile_all(void); +DLLEXPORT FASTCALL void jit_compile(CELL tagged, F_STACK_FRAME *stack); XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset); diff --git a/vm/layouts.h b/vm/layouts.h index e5419d1470..fc59802f36 100644 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -194,6 +194,8 @@ typedef struct { CELL header; /* tagged */ CELL array; + /* tagged */ + CELL compiled; /* untagged */ XT xt; } F_QUOTATION; diff --git a/vm/run.c b/vm/run.c index 2b946b0722..255be845d3 100644 --- a/vm/run.c +++ b/vm/run.c @@ -20,23 +20,21 @@ void uncurry(CELL obj) } } -void update_xt(F_WORD* word) +XT default_word_xt(F_WORD *word) { - word->compiledp = F; - if(word->def == T) - word->xt = dosym; + return dosym; else if(type_of(word->def) == QUOTATION_TYPE) { if(profiling) - word->xt = docol_profiling; + return docol_profiling; else - word->xt = docol; + return docol; } else if(type_of(word->def) == FIXNUM_TYPE) - word->xt = primitives[to_fixnum(word->def)]; + return primitives[to_fixnum(word->def)]; else - word->xt = undefined; + return undefined; } DEFINE_PRIMITIVE(uncurry) diff --git a/vm/run.h b/vm/run.h index 4d031350d3..72ee7eea17 100644 --- a/vm/run.h +++ b/vm/run.h @@ -145,7 +145,7 @@ INLINE CELL type_of(CELL tagged) DEFPUSHPOP(d,ds) DEFPUSHPOP(r,rs) -void update_xt(F_WORD* word); +XT default_word_xt(F_WORD *word); DECLARE_PRIMITIVE(execute); DECLARE_PRIMITIVE(call); diff --git a/vm/types.c b/vm/types.c index a17999a98b..d6cb96508a 100644 --- a/vm/types.c +++ b/vm/types.c @@ -132,6 +132,7 @@ DEFINE_PRIMITIVE(array_to_quotation) F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION)); quot->array = dpeek(); quot->xt = lazy_jit_compile; + quot->compiled = F; drepl(tag_object(quot)); } @@ -477,7 +478,8 @@ F_WORD *allot_word(CELL vocab, CELL name) word->def = F; word->props = F; word->counter = tag_fixnum(0); - update_xt(word); + word->compiledp = F; + word->xt = default_word_xt(word); return word; } @@ -490,7 +492,9 @@ DEFINE_PRIMITIVE(word) DEFINE_PRIMITIVE(update_xt) { - update_xt(untag_word(dpop())); + F_WORD *word = untag_word(dpop()); + word->compiledp = F; + word->xt = default_word_xt(word); } DEFINE_PRIMITIVE(word_xt)