The deploy tool would coalesce equal quotations into one. This created a problem

for the non-optimizing compiler because if the new 'leader' quotation was not
compiled but some of the ones that it replaces were, then calls to the quotation
from contexts where they have to be compiled (eg, compiled if and dip) would no
longer work. Add a `jit-compile' primitive to compile quotations, and call it
as appropriate in `compress-quotations`.

basis/tools/deploy/shaker/shaker.factor

@@ -321,20 +321,27 @@ IN: tools.deploy.shaker
         ] with-compilation-unit
     ] unless ;
 
-: compress ( pred string -- )
+: compress ( pred post-process string -- )
     "Compressing " prepend show
-    instances
-    dup H{ } clone [ [ ] cache ] curry map
+    [ instances dup H{ } clone [ [ ] cache ] curry map ] dip call
     become ; inline
 
 : compress-byte-arrays ( -- )
-    [ byte-array? ] "byte arrays" compress ;
+    [ byte-array? ] [ ] "byte arrays" compress ;
+
+: remain-compiled ( old new -- old new )
+    #! Quotations which were formerly compiled must remain
+    #! compiled.
+    2dup [
+        2dup [ compiled>> ] [ compiled>> not ] bi* and
+        [ nip jit-compile ] [ 2drop ] if
+    ] 2each ;
 
 : compress-quotations ( -- )
-    [ quotation? ] "quotations" compress ;
+    [ quotation? ] [ remain-compiled ] "quotations" compress ;
 
 : compress-strings ( -- )
-    [ string? ] "strings" compress ;
+    [ string? ] [ ] "strings" compress ;
 
 : finish-deploy ( final-image -- )
     "Finishing up" show

core/bootstrap/primitives.factor

@@ -533,6 +533,7 @@ tuple
     { "dll-valid?" "alien" }
     { "unimplemented" "kernel.private" }
     { "gc-reset" "memory" }
+    { "jit-compile" "quotations" }
 }
 [ [ first2 ] dip make-primitive ] each-index
 

vm/cpu-arm.S

@@ -117,7 +117,7 @@ DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
 DEF(void,lazy_jit_compile,(CELL quot)):
 	mov r1,sp            /* save stack pointer */
 	PROLOGUE
-	bl MANGLE(primitive_jit_compile)
+	bl MANGLE(lazy_jit_compile_impl)
 	EPILOGUE
         JUMP_QUOT            /* call the quotation */
 

vm/cpu-ppc.S

@@ -165,7 +165,7 @@ 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
-	bl MANGLE(primitive_jit_compile)
+	bl MANGLE(lazy_jit_compile_impl)
 	EPILOGUE
 	JUMP_QUOT	   /* call the quotation */
 

vm/cpu-x86.S

@@ -27,7 +27,7 @@ DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
 DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
 	mov STACK_REG,ARG1           /* Save stack pointer */
 	sub $STACK_PADDING,STACK_REG
-	call MANGLE(primitive_jit_compile)
+	call MANGLE(lazy_jit_compile_impl)
 	mov RETURN_REG,ARG0          /* No-op on 32-bit */
 	add $STACK_PADDING,STACK_REG
         jmp *QUOT_XT_OFFSET(ARG0)    /* Call the quotation */

vm/primitives.c

@@ -140,4 +140,5 @@ void *primitives[] = {
 	primitive_dll_validp,
 	primitive_unimplemented,
 	primitive_gc_reset,
+	primitive_jit_compile,
 };

vm/quotations.c

@@ -493,7 +493,7 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 	return -1;
 }
 
-F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack)
+F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack)
 {
 	stack_chain->callstack_top = stack;
 	REGISTER_ROOT(quot);
@@ -502,6 +502,11 @@ F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack)
 	return quot;
 }
 
+void primitive_jit_compile(void)
+{
+	jit_compile(dpop(),true);
+}
+
 /* push a new quotation on the stack */
 void primitive_array_to_quotation(void)
 {

vm/quotations.h

@@ -1,6 +1,7 @@
 void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code);
 void jit_compile(CELL quot, bool relocate);
-F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack);
+F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack);
 F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset);
 void primitive_array_to_quotation(void);
 void primitive_quotation_xt(void);
+void primitive_jit_compile(void);