steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2008-11-24 00:23:17 -06:00
parent 915bf0c449
commit d86524f4bc
8 changed files with 63 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/bootstrap/image/image.factor
View File

@ -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

10
basis/bootstrap/stage2.factor
View File

@ -32,8 +32,8 @@ SYMBOL: bootstrap-time
: count-words ( pred -- )
all-words swap count number>string write ;
: print-time ( us -- )
1000000 /i
: print-time ( ms -- )
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

3
basis/cpu/x86/assembler/assembler.factor
View File

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

61
basis/cpu/x86/bootstrap.factor
View File

@ -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 arg1 [] CMOVNE ! load true branch if not equal
arg0 arg1 bootstrap-cell [+] CMOVE ! load false branch if equal
arg0 quot-xt-offset [+] JMP ! jump to quotation-xt
] rc-absolute-cell rt-literal 1 rex-length + jit-if-jump jit-define
arg0 \ f tag-number CMP ! compare boolean with f
f JNE ! jump to true branch if not equal
] rc-relative rt-xt 10 rex-length 3 * + jit-if-1 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

8
vm/code_heap.c
View File

@ -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:

18
vm/image.c
View File

@ -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++)

15
vm/quotations.c
View File

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

3
vm/run.h
View File

@ -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,