The JIT now compiles quotations when first invoked, not when constructed

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 ;

core/bootstrap/primitives.factor

@@ -452,6 +452,13 @@ num-types get f <array> builtins set
         { "quotation-array" "quotations.private" }
         f
     }
+    {
+        { "object" "kernel" }
+        "compiled?"
+        2
+        { "quotation-compiled?" "quotations" }
+        f
+    }
 } define-builtin
 
 "dll" "alien" create "dll?" "alien" create

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 */ \
+	mflr r0 XX         /* get caller's return address */ \
-        stwu r1,-FRAME(r1) ; /* create a stack frame to hold non-volatile registers */
+        stwu r1,-FRAME(r1) XX /* create a stack frame to hold non-volatile registers */ \
         SAVE_LR(r0)
 
 #define EPILOGUE \
-	LOAD_LR(r0) ; \
+	LOAD_LR(r0) XX \
-        lwz r1,0(r1) ;     /* destroy the stack frame */ \
+        lwz r1,0(r1) XX    /* destroy the stack frame */ \
-        mtlr r0            /* get ready to return */ \
+        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 */
+	SAVE(r3,18)        /* save quot */
-	b MANGLE(jit_compile)
+	bl MANGLE(jit_compile)
-	RESTORE(r3,19)     /* restore quotation */
+	RESTORE(r3,18)
 	EPILOGUE
         JUMP_QUOT          /* call the quotation */
 

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("#<not a string: ");
@@ -14,7 +19,11 @@ void print_word(F_WORD* word, CELL nesting)
 
 void print_string(F_STRING* str)
 {
-	printf("\"%s\"",to_char_string(str,true));
+	putchar('"');
+	CELL i;
+	for(i = 0; i < string_capacity(str); i++)
+		putchar(cget(SREF(str,i)));
+	putchar('"');
 }
 
 void print_array(F_ARRAY* array, CELL nesting)

vm/factor.c

@@ -126,14 +126,6 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
 	userenv[EXECUTABLE_ENV] = tag_object(from_native_string(executable_path));
 	userenv[EMBEDDED_ENV] = (embedded ? T : F);
 
-	if(!untag_quotation(userenv[BOOT_ENV])->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();

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)
+	if(word->compiledp == F)
-		code_fixup(&word->xt);
+		word->xt = default_word_xt(word);
 	else
-		update_xt(word);
+		code_fixup(&word->xt);
 }
 
 void fixup_quotation(F_QUOTATION *quot)
 {
-	code_fixup(&quot->xt);
+	if(quot->compiled == F)
-	if(!in_code_heap_p(quot->xt))
 		quot->xt = lazy_jit_compile;
+	else
+		code_fixup(&quot->xt);
 }
 
 void fixup_alien(F_ALIEN *d)

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)

vm/jit.h

@@ -1,3 +1,2 @@
-DLLEXPORT void jit_compile(F_QUOTATION *quot);
+DLLEXPORT FASTCALL void jit_compile(CELL tagged, F_STACK_FRAME *stack);
-jit_compile_all(void);
 XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset);

vm/layouts.h

@@ -194,6 +194,8 @@ typedef struct {
 	CELL header;
 	/* tagged */
 	CELL array;
+	/* tagged */
+	CELL compiled;
 	/* untagged */
 	XT xt;
 } F_QUOTATION;

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)

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

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)