Lazy JIT

vm/cpu-ppc.S

@@ -40,11 +40,19 @@ in the public domain. */
 
 #define RESTORE(register,offset) lwz register,SAVE_AT(offset)(r1)
 
-DEF(void,c_to_factor,(CELL quot)):
+#define PROLOGUE \
-        mflr r0            /* get caller's return address */
+	mflr r0 ;          /* get caller's return address */ \
-        stwu r1,-FRAME(r1) /* create a stack frame to hold non-volatile registers */
+        stwu r1,-FRAME(r1) ; /* 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 */ \
+
+DEF(void,c_to_factor,(CELL quot)):
+        PROLOGUE
+
 	SAVE(r13,0)        /* save GPRs */
                            /* don't save ds pointer */
                            /* don't save rs pointer */
@@ -92,9 +100,7 @@ DEF(void,c_to_factor,(CELL quot)):
                            /* don't restore ds pointer */
         RESTORE(r13,0)
 
-        LOAD_LR(r0)
+        EPILOGUE
-        lwz r1,0(r1)       /* destroy the stack frame */
-        mtlr r0            /* get ready to return */
         blr
 
 /* The JIT compiles an 'mr r4,r1' in front of every primitive call, since a
@@ -164,6 +170,15 @@ DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
 	mtlr r0
 	JUMP_QUOT          /* call the quotation */
 
+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 */
+	EPILOGUE
+        JUMP_QUOT          /* call the quotation */
+
 /* Thanks to Joshua Grams for this code.
 
 On PowerPC processors, we must flush the instruction cache manually

vm/cpu-ppc.h

@@ -11,6 +11,7 @@ void docol(CELL word);
 void undefined(CELL word);
 void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy);
 void throw_impl(CELL quot, F_STACK_FRAME *rewind);
+void lazy_jit_compile(CELL quot);
 void flush_icache(CELL start, CELL len);
 
 #define FRAME_SUCCESSOR(frame) (frame)->previous

vm/data_gc.c

@@ -553,7 +553,7 @@ CELL collect_next(CELL scan)
 		break;
 	case QUOTATION_TYPE:
 		quot = (F_QUOTATION *)scan;
-		if(collecting_code && quot->xt != NULL)
+		if(collecting_code && quot->xt != lazy_jit_compile)
 			recursive_mark(quot->xt);
 		break;
 	case CALLSTACK_TYPE:

vm/image.c

@@ -162,10 +162,9 @@ void fixup_word(F_WORD *word)
 
 void fixup_quotation(F_QUOTATION *quot)
 {
-	/* quot->xt is only ever NULL at the start of stage2 bootstrap,
-	in this case the JIT compiles all quotations */
-	if(quot->xt)
 	code_fixup(&quot->xt);
+	if(!in_code_heap_p(quot->xt))
+		quot->xt = lazy_jit_compile;
 }
 
 void fixup_alien(F_ALIEN *d)

vm/jit.c

@@ -152,21 +152,6 @@ void jit_compile(F_QUOTATION *quot)
 	quot->xt = xt;
 }
 
-void jit_compile_all(void)
-{
-	begin_scan();
-
-	CELL obj;
-	while((obj = next_object()) != F)
-	{
-		if(type_of(obj) == QUOTATION_TYPE)
-			jit_compile(untag_quotation(obj));
-	}
-
-	/* End the scan */
-	gc_off = false;
-}
-
 XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset)
 {
 	if(offset != -1)

vm/jit.h

@@ -1,3 +1,3 @@
-void jit_compile(F_QUOTATION *quot);
+DLLEXPORT void jit_compile(F_QUOTATION *quot);
-void jit_compile_all(void);
+jit_compile_all(void);
 XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset);

vm/types.c

@@ -131,12 +131,7 @@ DEFINE_PRIMITIVE(array_to_quotation)
 {
 	F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
 	quot->array = dpeek();
-	quot->xt = NULL;
+	quot->xt = lazy_jit_compile;
-
-	REGISTER_UNTAGGED(quot);
-	jit_compile(quot);
-	UNREGISTER_UNTAGGED(quot);
-
 	drepl(tag_object(quot));
 }