Non-optimizing compiler now compiles dip, 2dip, 3dip, if, with direct branches instead of indirect branches. 8% bootstrap time improvement on Core Duo 2

basis/bootstrap/image/image.factor

@@ -127,7 +127,8 @@ SYMBOL: jit-word-call
 SYMBOL: jit-push-literal
 SYMBOL: jit-push-immediate
 SYMBOL: jit-if-word
-SYMBOL: jit-if-jump
+SYMBOL: jit-if-1
+SYMBOL: jit-if-2
 SYMBOL: jit-dispatch-word
 SYMBOL: jit-dispatch
 SYMBOL: jit-dip-word
@@ -157,7 +158,7 @@ SYMBOL: undefined-quot
         { jit-word-call 27 }
         { jit-push-literal 28 }
         { jit-if-word 29 }
-        { jit-if-jump 30 }
+        { jit-if-1 30 }
         { jit-dispatch-word 31 }
         { jit-dispatch 32 }
         { jit-epilog 33 }
@@ -172,6 +173,7 @@ SYMBOL: undefined-quot
         { jit-2dip 47 }
         { jit-3dip-word 48 }
         { jit-3dip 49 }
+        { jit-if-2 50 }
         { undefined-quot 60 }
     } ; inline
 
@@ -472,7 +474,8 @@ M: quotation '
         jit-push-literal
         jit-push-immediate
         jit-if-word
-        jit-if-jump
+        jit-if-1
+        jit-if-2
         jit-dispatch-word
         jit-dispatch
         jit-dip-word

basis/bootstrap/stage2.factor

@@ -32,8 +32,8 @@ SYMBOL: bootstrap-time
 : count-words ( pred -- )
     all-words swap count number>string write ;
 
-: print-time ( us -- )
+: print-time ( ms -- )
-    1000000 /i
+    1000 /i
     60 /mod swap
     number>string write
     " minutes and " write number>string write " seconds." print ;
@@ -52,7 +52,7 @@ SYMBOL: bootstrap-time
 
 [
     ! We time bootstrap
-    micros
+    millis
 
     default-image-name "output-image" set-global
 
@@ -77,7 +77,7 @@ SYMBOL: bootstrap-time
     [
         load-components
 
-        micros over - core-bootstrap-time set-global
+        millis over - core-bootstrap-time set-global
 
         run-bootstrap-init
     ] with-compiler-errors
@@ -100,7 +100,7 @@ SYMBOL: bootstrap-time
             ] [ print-error 1 exit ] recover
         ] set-boot-quot
 
-        micros swap - bootstrap-time set-global
+        millis swap - bootstrap-time set-global
         print-report
 
         "output-image" get save-image-and-exit

basis/cpu/x86/assembler/assembler.factor

@@ -308,18 +308,21 @@ M: operand MOV HEX: 88 2-operand ;
 ! Control flow
 GENERIC: JMP ( op -- )
 : (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ;
+M: f JMP (JMP) 2drop ;
 M: callable JMP (JMP) rel-word ;
 M: label JMP (JMP) label-fixup ;
 M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
 
 GENERIC: CALL ( op -- )
 : (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ;
+M: f CALL (CALL) 2drop ;
 M: callable CALL (CALL) rel-word ;
 M: label CALL (CALL) label-fixup ;
 M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
 
 GENERIC# JUMPcc 1 ( addr opcode -- )
 : (JUMPcc) ( n -- rel-class ) extended-opcode, 0 4, rc-relative ;
+M: f JUMPcc nip (JUMPcc) drop ;
 M: callable JUMPcc (JUMPcc) rel-word ;
 M: label JUMPcc (JUMPcc) label-fixup ;
 

basis/cpu/x86/bootstrap.factor

@@ -45,22 +45,23 @@ big-endian off
 ] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
 
 [
-    (JMP) drop
+    f JMP
 ] rc-relative rt-xt 1 jit-word-jump jit-define
 
 [
-    (CALL) drop
+    f CALL
 ] rc-relative rt-xt 1 jit-word-call jit-define
 
 [
-    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 \ f tag-number CMP                    ! compare boolean with f
-    arg0 arg1 [] CMOVNE                        ! load true branch if not equal
+    f JNE                                      ! jump to true branch if not equal
-    arg0 arg1 bootstrap-cell [+] CMOVE         ! load false branch if equal
+] rc-relative rt-xt 10 rex-length 3 * + jit-if-1 jit-define
-    arg0 quot-xt-offset [+] JMP                ! jump to quotation-xt
+
-] rc-absolute-cell rt-literal 1 rex-length + jit-if-jump jit-define
+[
+    f JMP                                      ! jump to false branch if equal
+] rc-relative rt-xt 1 jit-if-2 jit-define
 
 [
     arg1 0 MOV                                 ! load dispatch table
@@ -73,79 +74,71 @@ big-endian off
     arg0 quot-xt-offset [+] JMP                ! execute branch
 ] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
 
-! The jit->r words cannot clobber arg0
-
 : jit->r ( -- )
     rs-reg bootstrap-cell ADD
-    temp-reg ds-reg [] MOV
+    arg0 ds-reg [] MOV
     ds-reg bootstrap-cell SUB
-    rs-reg [] temp-reg MOV ;
+    rs-reg [] arg0 MOV ;
 
 : jit-2>r ( -- )
     rs-reg 2 bootstrap-cells ADD
-    temp-reg ds-reg [] MOV
+    arg0 ds-reg [] MOV
     arg1 ds-reg -1 bootstrap-cells [+] MOV
     ds-reg 2 bootstrap-cells SUB
-    rs-reg [] temp-reg MOV
+    rs-reg [] arg0 MOV
     rs-reg -1 bootstrap-cells [+] arg1 MOV ;
 
 : jit-3>r ( -- )
     rs-reg 3 bootstrap-cells ADD
-    temp-reg ds-reg [] MOV
+    arg0 ds-reg [] MOV
     arg1 ds-reg -1 bootstrap-cells [+] MOV
     arg2 ds-reg -2 bootstrap-cells [+] MOV
     ds-reg 3 bootstrap-cells SUB
-    rs-reg [] temp-reg MOV
+    rs-reg [] arg0 MOV
     rs-reg -1 bootstrap-cells [+] arg1 MOV
     rs-reg -2 bootstrap-cells [+] arg2 MOV ;
 
 : jit-r> ( -- )
     ds-reg bootstrap-cell ADD
-    temp-reg rs-reg [] MOV
+    arg0 rs-reg [] MOV
     rs-reg bootstrap-cell SUB
-    ds-reg [] temp-reg MOV ;
+    ds-reg [] arg0 MOV ;
 
 : jit-2r> ( -- )
     ds-reg 2 bootstrap-cells ADD
-    temp-reg rs-reg [] MOV
+    arg0 rs-reg [] MOV
     arg1 rs-reg -1 bootstrap-cells [+] MOV
     rs-reg 2 bootstrap-cells SUB
-    ds-reg [] temp-reg MOV
+    ds-reg [] arg0 MOV
     ds-reg -1 bootstrap-cells [+] arg1 MOV ;
 
 : jit-3r> ( -- )
     ds-reg 3 bootstrap-cells ADD
-    temp-reg rs-reg [] MOV
+    arg0 rs-reg [] MOV
     arg1 rs-reg -1 bootstrap-cells [+] MOV
     arg2 rs-reg -2 bootstrap-cells [+] MOV
     rs-reg 3 bootstrap-cells SUB
-    ds-reg [] temp-reg MOV
+    ds-reg [] arg0 MOV
     ds-reg -1 bootstrap-cells [+] arg1 MOV
     ds-reg -2 bootstrap-cells [+] arg2 MOV ;
 
 [
-    arg0 0 MOV                                 ! load quotation addr
-    arg0 arg0 [] MOV                           ! load quotation
     jit->r
-    arg0 quot-xt-offset [+] CALL               ! call quotation
+    f CALL
     jit-r>
-] rc-absolute-cell rt-literal 1 rex-length + jit-dip jit-define
+] rc-relative rt-xt 11 rex-length 4 * + jit-dip jit-define
 
 [
-    arg0 0 MOV                                 ! load quotation addr
-    arg0 arg0 [] MOV                           ! load quotation
     jit-2>r
-    arg0 quot-xt-offset [+] CALL               ! call quotation
+    f CALL
     jit-2r>
-] rc-absolute-cell rt-literal 1 rex-length + jit-2dip jit-define
+] rc-relative rt-xt 17 rex-length 6 * + jit-2dip jit-define
 
 [
-    arg0 0 MOV                                 ! load quotation addr
-    arg0 arg0 [] MOV                           ! load quotation
     jit-3>r                                    
-    arg0 quot-xt-offset [+] CALL               ! call quotation
+    f CALL
     jit-3r>
-] rc-absolute-cell rt-literal 1 rex-length + jit-3dip jit-define
+] rc-relative rt-xt 23 rex-length 8 * + jit-3dip jit-define
 
 [
     stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame

vm/code_heap.c

@@ -55,6 +55,8 @@ void *get_rel_symbol(F_REL *rel, CELL literals_start)
 INLINE CELL compute_code_rel(F_REL *rel,
 	CELL code_start, CELL literals_start)
 {
+	CELL obj;
+
 	switch(REL_TYPE(rel))
 	{
 	case RT_PRIMITIVE:
@@ -66,7 +68,11 @@ INLINE CELL compute_code_rel(F_REL *rel,
 	case RT_IMMEDIATE:
 		return get(CREF(literals_start,REL_ARGUMENT(rel)));
 	case RT_XT:
-		return (CELL)untag_word(get(CREF(literals_start,REL_ARGUMENT(rel))))->xt;
+		obj = get(CREF(literals_start,REL_ARGUMENT(rel)));
+		if(type_of(obj) == WORD_TYPE)
+			return (CELL)untag_word(obj)->xt;
+		else
+			return (CELL)untag_quotation(obj)->xt;
 	case RT_HERE:
 		return rel->offset + code_start + (short)REL_ARGUMENT(rel);
 	case RT_LABEL:

vm/image.c

@@ -174,21 +174,6 @@ void primitive_save_image(void)
 	save_image(unbox_native_string());
 }
 
-void strip_compiled_quotations(void)
-{
-	begin_scan();
-	CELL obj;
-	while((obj = next_object()) != F)
-	{
-		if(type_of(obj) == QUOTATION_TYPE)
-		{
-			F_QUOTATION *quot = untag_object(obj);
-			quot->compiledp = F;
-		}
-	}
-	gc_off = false;
-}
-
 void primitive_save_image_and_exit(void)
 {
 	/* We unbox this before doing anything else. This is the only point
@@ -198,9 +183,6 @@ void primitive_save_image_and_exit(void)
 
 	REGISTER_C_STRING(path);
 
-	/* This reduces deployed image size */
-	strip_compiled_quotations();
-
 	/* strip out userenv data which is set on startup anyway */
 	CELL i;
 	for(i = 0; i < FIRST_SAVE_ENV; i++)

vm/quotations.c

@@ -251,9 +251,13 @@ void jit_compile(CELL quot, bool relocate)
 				if(stack_frame)
 					EMIT(userenv[JIT_EPILOG],0);
 
+				jit_compile(array_nth(untag_object(array),i),true);
+				jit_compile(array_nth(untag_object(array),i + 1),true);
+
 				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
+				EMIT(userenv[JIT_IF_1],literals_count - 1);
 				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
-				EMIT(userenv[JIT_IF_JUMP],literals_count - 2);
+				EMIT(userenv[JIT_IF_2],literals_count - 1);
 
 				i += 2;
 
@@ -262,6 +266,8 @@ void jit_compile(CELL quot, bool relocate)
 			}
 			else if(jit_fast_dip_p(untag_object(array),i))
 			{
+				jit_compile(obj,true);
+
 				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 				EMIT(userenv[JIT_DIP],literals_count - 1);
 
@@ -270,6 +276,8 @@ void jit_compile(CELL quot, bool relocate)
 			}
 			else if(jit_fast_2dip_p(untag_object(array),i))
 			{
+				jit_compile(obj,true);
+
 				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 				EMIT(userenv[JIT_2DIP],literals_count - 1);
 
@@ -278,6 +286,8 @@ void jit_compile(CELL quot, bool relocate)
 			}
 			else if(jit_fast_3dip_p(untag_object(array),i))
 			{
+				jit_compile(obj,true);
+
 				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 				EMIT(userenv[JIT_3DIP],literals_count - 1);
 
@@ -413,7 +423,8 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 				if(stack_frame)
 					COUNT(userenv[JIT_EPILOG],i)
 
-				COUNT(userenv[JIT_IF_JUMP],i)
+				COUNT(userenv[JIT_IF_1],i)
+				COUNT(userenv[JIT_IF_2],i)
 				i += 2;
 
 				tail_call = true;

vm/run.h

@@ -41,7 +41,7 @@ typedef enum {
 	JIT_WORD_CALL,
 	JIT_PUSH_LITERAL,
 	JIT_IF_WORD,
-	JIT_IF_JUMP,
+	JIT_IF_1,
 	JIT_DISPATCH_WORD,
 	JIT_DISPATCH,
 	JIT_EPILOG,
@@ -56,6 +56,7 @@ typedef enum {
 	JIT_2DIP,
 	JIT_3DIP_WORD,
 	JIT_3DIP,
+	JIT_IF_2,
 
 	STACK_TRACES_ENV    = 59,