Get optimizing compiler working without global register variables in VM
Slava Pestov
parent
63edd20a55
commit
e96404327e
|
|
@ -344,7 +344,7 @@ SYMBOLS:
|
|||
bootstrap-cell >>align
|
||||
bootstrap-cell >>align-first
|
||||
[ >c-ptr ] >>unboxer-quot
|
||||
"box_alien" >>boxer
|
||||
"allot_alien" >>boxer
|
||||
"alien_offset" >>unboxer
|
||||
\ void* define-primitive-type
|
||||
|
||||
|
|
@ -355,7 +355,7 @@ SYMBOLS:
|
|||
[ set-alien-signed-8 ] >>setter
|
||||
8 >>size
|
||||
8-byte-alignment
|
||||
"box_signed_8" >>boxer
|
||||
"from_signed_8" >>boxer
|
||||
"to_signed_8" >>unboxer
|
||||
\ longlong define-primitive-type
|
||||
|
||||
|
|
@ -366,7 +366,7 @@ SYMBOLS:
|
|||
[ set-alien-unsigned-8 ] >>setter
|
||||
8 >>size
|
||||
8-byte-alignment
|
||||
"box_unsigned_8" >>boxer
|
||||
"from_unsigned_8" >>boxer
|
||||
"to_unsigned_8" >>unboxer
|
||||
\ ulonglong define-primitive-type
|
||||
|
||||
|
|
@ -378,7 +378,7 @@ SYMBOLS:
|
|||
bootstrap-cell >>size
|
||||
bootstrap-cell >>align
|
||||
bootstrap-cell >>align-first
|
||||
"box_signed_cell" >>boxer
|
||||
"from_signed_cell" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
\ long define-primitive-type
|
||||
|
||||
|
|
@ -390,7 +390,7 @@ SYMBOLS:
|
|||
bootstrap-cell >>size
|
||||
bootstrap-cell >>align
|
||||
bootstrap-cell >>align-first
|
||||
"box_unsigned_cell" >>boxer
|
||||
"from_unsigned_cell" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
\ ulong define-primitive-type
|
||||
|
||||
|
|
@ -402,7 +402,7 @@ SYMBOLS:
|
|||
4 >>size
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
"box_signed_4" >>boxer
|
||||
"from_signed_4" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
\ int define-primitive-type
|
||||
|
||||
|
|
@ -414,7 +414,7 @@ SYMBOLS:
|
|||
4 >>size
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
"box_unsigned_4" >>boxer
|
||||
"from_unsigned_4" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
\ uint define-primitive-type
|
||||
|
||||
|
|
@ -426,7 +426,7 @@ SYMBOLS:
|
|||
2 >>size
|
||||
2 >>align
|
||||
2 >>align-first
|
||||
"box_signed_2" >>boxer
|
||||
"from_signed_2" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
\ short define-primitive-type
|
||||
|
||||
|
|
@ -438,7 +438,7 @@ SYMBOLS:
|
|||
2 >>size
|
||||
2 >>align
|
||||
2 >>align-first
|
||||
"box_unsigned_2" >>boxer
|
||||
"from_unsigned_2" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
\ ushort define-primitive-type
|
||||
|
||||
|
|
@ -450,7 +450,7 @@ SYMBOLS:
|
|||
1 >>size
|
||||
1 >>align
|
||||
1 >>align-first
|
||||
"box_signed_1" >>boxer
|
||||
"from_signed_1" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
\ char define-primitive-type
|
||||
|
||||
|
|
@ -462,7 +462,7 @@ SYMBOLS:
|
|||
1 >>size
|
||||
1 >>align
|
||||
1 >>align-first
|
||||
"box_unsigned_1" >>boxer
|
||||
"from_unsigned_1" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
\ uchar define-primitive-type
|
||||
|
||||
|
|
@ -473,7 +473,7 @@ SYMBOLS:
|
|||
4 >>size
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
"box_boolean" >>boxer
|
||||
"from_boolean" >>boxer
|
||||
"to_boolean" >>unboxer
|
||||
] [
|
||||
<c-type>
|
||||
|
|
@ -482,7 +482,7 @@ SYMBOLS:
|
|||
1 >>size
|
||||
1 >>align
|
||||
1 >>align-first
|
||||
"box_boolean" >>boxer
|
||||
"from_boolean" >>boxer
|
||||
"to_boolean" >>unboxer
|
||||
] if
|
||||
\ bool define-primitive-type
|
||||
|
|
@ -495,7 +495,7 @@ SYMBOLS:
|
|||
4 >>size
|
||||
4 >>align
|
||||
4 >>align-first
|
||||
"box_float" >>boxer
|
||||
"from_float" >>boxer
|
||||
"to_float" >>unboxer
|
||||
float-rep >>rep
|
||||
[ >float ] >>unboxer-quot
|
||||
|
|
@ -508,7 +508,7 @@ SYMBOLS:
|
|||
[ [ >float ] 2dip set-alien-double ] >>setter
|
||||
8 >>size
|
||||
8-byte-alignment
|
||||
"box_double" >>boxer
|
||||
"from_double" >>boxer
|
||||
"to_double" >>unboxer
|
||||
double-rep >>rep
|
||||
[ >float ] >>unboxer-quot
|
||||
|
|
|
|||
|
|
@ -748,8 +748,7 @@ temp: temp1/int-rep temp2/int-rep
|
|||
literal: size data-values tagged-values uninitialized-locs ;
|
||||
|
||||
INSN: ##save-context
|
||||
temp: temp1/int-rep temp2/int-rep
|
||||
literal: callback-allowed? ;
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
! Instructions used by machine IR only.
|
||||
INSN: _prologue
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ V{
|
|||
|
||||
[
|
||||
V{
|
||||
T{ ##save-context f 1 2 f }
|
||||
T{ ##save-context f 1 2 }
|
||||
T{ ##unary-float-function f 2 3 "sqrt" }
|
||||
T{ ##branch }
|
||||
}
|
||||
|
|
|
|||
|
|
@ -17,19 +17,10 @@ IN: compiler.cfg.save-contexts
|
|||
} 1||
|
||||
] any? ;
|
||||
|
||||
: needs-callback-context? ( insns -- ? )
|
||||
[
|
||||
{
|
||||
[ ##alien-invoke? ]
|
||||
[ ##alien-indirect? ]
|
||||
} 1||
|
||||
] any? ;
|
||||
|
||||
: insert-save-context ( bb -- )
|
||||
dup instructions>> dup needs-save-context? [
|
||||
int-rep next-vreg-rep
|
||||
int-rep next-vreg-rep
|
||||
pick needs-callback-context?
|
||||
\ ##save-context new-insn prefix
|
||||
>>instructions drop
|
||||
] [ 2drop ] if ;
|
||||
|
|
|
|||
|
|
@ -283,7 +283,7 @@ M: ##gc generate-insn
|
|||
[ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
|
||||
[ data-values>> save-data-regs ]
|
||||
[ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
|
||||
[ [ temp1>> ] [ temp2>> ] bi t %save-context ]
|
||||
[ [ temp1>> ] [ temp2>> ] bi %save-context ]
|
||||
[ [ tagged-values>> length ] [ temp1>> ] bi %call-gc ]
|
||||
[ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
|
||||
[ data-values>> load-data-regs ]
|
||||
|
|
@ -384,7 +384,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
|
|||
|
||||
: unbox-parameters ( offset node -- )
|
||||
parameters>> swap
|
||||
'[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ]
|
||||
'[ prepare-unbox-parameters [ %pop-stack [ _ + ] dip unbox-parameter ] 3each ]
|
||||
[ length neg %inc-d ]
|
||||
bi ;
|
||||
|
||||
|
|
@ -407,7 +407,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
|
|||
] with-param-regs ;
|
||||
|
||||
: box-return* ( node -- )
|
||||
return>> [ ] [ box-return ] if-void ;
|
||||
return>> [ ] [ box-return %push-stack ] if-void ;
|
||||
|
||||
: check-dlsym ( symbols dll -- )
|
||||
dup dll-valid? [
|
||||
|
|
@ -452,7 +452,7 @@ M: ##alien-indirect generate-insn
|
|||
|
||||
! ##alien-callback
|
||||
: box-parameters ( params -- )
|
||||
alien-parameters [ box-parameter ] each-parameter ;
|
||||
alien-parameters [ box-parameter %push-context-stack ] each-parameter ;
|
||||
|
||||
: registers>objects ( node -- )
|
||||
! Generate code for boxing input parameters in a callback.
|
||||
|
|
|
|||
|
|
@ -94,6 +94,8 @@ FUNCTION: TINY ffi_test_17 int x ;
|
|||
|
||||
{ 1 1 } [ indirect-test-1 ] must-infer-as
|
||||
|
||||
[ B{ } indirect-test-1 ] [ { "kernel-error" 3 6 B{ } } = ] must-fail-with
|
||||
|
||||
[ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
|
||||
|
||||
: indirect-test-1' ( ptr -- )
|
||||
|
|
|
|||
|
|
@ -503,8 +503,27 @@ HOOK: dummy-int-params? cpu ( -- ? )
|
|||
! If t, all int parameters are shadowed by dummy FP parameters
|
||||
HOOK: dummy-fp-params? cpu ( -- ? )
|
||||
|
||||
HOOK: %prepare-unbox cpu ( n -- )
|
||||
! Load a value (from the data stack in the ds register).
|
||||
! The value is then passed as a parameter to a VM to_*() function
|
||||
HOOK: %pop-stack cpu ( n -- )
|
||||
|
||||
! Store a value (to the data stack in the VM's current context)
|
||||
! The value is passed to a VM to_*() function -- used for
|
||||
! callback returns
|
||||
HOOK: %pop-context-stack cpu ( -- )
|
||||
|
||||
! Store a value (to the data stack in the ds register).
|
||||
! The value was returned from a VM from_*() function
|
||||
HOOK: %push-stack cpu ( -- )
|
||||
|
||||
! Store a value (to the data stack in the VM's current context)
|
||||
! The value is returned from a VM from_*() function -- used for
|
||||
! callback parameters
|
||||
HOOK: %push-context-stack cpu ( -- )
|
||||
|
||||
! Call a function to convert a tagged pointer returned by
|
||||
! %pop-stack or %pop-context-stack into a value that can be
|
||||
! passed to a C function, or returned from a callback
|
||||
HOOK: %unbox cpu ( n rep func -- )
|
||||
|
||||
HOOK: %unbox-long-long cpu ( n func -- )
|
||||
|
|
@ -513,6 +532,10 @@ HOOK: %unbox-small-struct cpu ( c-type -- )
|
|||
|
||||
HOOK: %unbox-large-struct cpu ( n c-type -- )
|
||||
|
||||
! Call a function to convert a value into a tagged pointer,
|
||||
! possibly allocating a bignum, float, or alien instance,
|
||||
! which is then pushed on the data stack by %push-stack or
|
||||
! %push-context-stack
|
||||
HOOK: %box cpu ( n rep func -- )
|
||||
|
||||
HOOK: %box-long-long cpu ( n func -- )
|
||||
|
|
@ -527,7 +550,7 @@ HOOK: %save-param-reg cpu ( stack reg rep -- )
|
|||
|
||||
HOOK: %load-param-reg cpu ( stack reg rep -- )
|
||||
|
||||
HOOK: %save-context cpu ( temp1 temp2 callback-allowed? -- )
|
||||
HOOK: %save-context cpu ( temp1 temp2 -- )
|
||||
|
||||
HOOK: %prepare-var-args cpu ( -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -590,7 +590,7 @@ M:: ppc %save-param-reg ( stack reg rep -- )
|
|||
M:: ppc %load-param-reg ( stack reg rep -- )
|
||||
reg stack local@ rep load-from-frame ;
|
||||
|
||||
M: ppc %prepare-unbox ( n -- )
|
||||
M: ppc %pop-stack ( n -- )
|
||||
[ 3 ] dip <ds-loc> loc>operand LWZ ;
|
||||
|
||||
M: ppc %unbox ( n rep func -- )
|
||||
|
|
@ -650,13 +650,13 @@ M: ppc %box-large-struct ( n c-type -- )
|
|||
[ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
|
||||
5 %load-vm-addr
|
||||
! Call the function
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
"from_value_struct" f %alien-invoke ;
|
||||
|
||||
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
|
||||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp1 "stack_chain" %load-vm-field-addr
|
||||
temp1 "ctx" %load-vm-field-addr
|
||||
temp1 temp1 0 LWZ
|
||||
1 temp1 0 STW
|
||||
callback-allowed? [
|
||||
|
|
@ -703,7 +703,7 @@ M: ppc %box-small-struct ( c-type -- )
|
|||
#! Box a <= 16-byte struct returned in r3:r4:r5:r6
|
||||
heap-size 7 LI
|
||||
8 %load-vm-addr
|
||||
"box_medium_struct" f %alien-invoke ;
|
||||
"from_medium_struct" f %alien-invoke ;
|
||||
|
||||
: %unbox-struct-1 ( -- )
|
||||
! Alien must be in r3.
|
||||
|
|
|
|||
|
|
@ -136,7 +136,7 @@ M:: x86.32 %box-large-struct ( n c-type -- )
|
|||
8 save-vm-ptr
|
||||
4 stack@ c-type heap-size MOV
|
||||
0 stack@ EDX MOV
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
"from_value_struct" f %alien-invoke ;
|
||||
|
||||
M: x86.32 %prepare-box-struct ( -- )
|
||||
! Compute target address for value struct return
|
||||
|
|
@ -150,11 +150,17 @@ M: x86.32 %box-small-struct ( c-type -- )
|
|||
8 stack@ swap heap-size MOV
|
||||
4 stack@ EDX MOV
|
||||
0 stack@ EAX MOV
|
||||
"box_small_struct" f %alien-invoke ;
|
||||
"from_small_struct" f %alien-invoke ;
|
||||
|
||||
M: x86.32 %prepare-unbox ( -- )
|
||||
M: x86.32 %pop-stack ( n -- )
|
||||
EAX swap ds-reg reg-stack MOV ;
|
||||
|
||||
M: x86.32 %pop-context-stack ( -- )
|
||||
temp-reg %load-context-datastack
|
||||
EAX temp-reg [] MOV
|
||||
EAX EAX [] MOV
|
||||
temp-reg [] bootstrap-cell SUB ;
|
||||
|
||||
: call-unbox-func ( func -- )
|
||||
4 save-vm-ptr
|
||||
0 stack@ EAX MOV
|
||||
|
|
@ -224,21 +230,23 @@ M: x86.32 %unnest-stacks ( -- )
|
|||
"unnest_stacks" f %alien-invoke ;
|
||||
|
||||
M: x86.32 %prepare-alien-indirect ( -- )
|
||||
0 save-vm-ptr
|
||||
"unbox_alien" f %alien-invoke
|
||||
EAX ds-reg [] MOV
|
||||
ds-reg 4 SUB
|
||||
4 save-vm-ptr
|
||||
0 stack@ EAX MOV
|
||||
"pinned_alien_offset" f %alien-invoke
|
||||
EBP EAX MOV ;
|
||||
|
||||
M: x86.32 %alien-indirect ( -- )
|
||||
EBP CALL ;
|
||||
|
||||
M: x86.32 %alien-callback ( quot -- )
|
||||
! Fastcall
|
||||
param-reg-1 swap %load-reference
|
||||
param-reg-2 %mov-vm-ptr
|
||||
EAX swap %load-reference
|
||||
EDX %mov-vm-ptr
|
||||
"c_to_factor" f %alien-invoke ;
|
||||
|
||||
M: x86.32 %callback-value ( ctype -- )
|
||||
0 %prepare-unbox
|
||||
%pop-context-stack
|
||||
4 stack@ EAX MOV
|
||||
0 save-vm-ptr
|
||||
! Restore data/call/retain stacks
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ;
|
|||
call
|
||||
] with-scope ; inline
|
||||
|
||||
M: x86.64 %prepare-unbox ( n -- )
|
||||
M: x86.64 %pop-stack ( n -- )
|
||||
param-reg-1 swap ds-reg reg-stack MOV ;
|
||||
|
||||
M:: x86.64 %unbox ( n rep func -- )
|
||||
|
|
@ -167,7 +167,7 @@ M: x86.64 %box-small-struct ( c-type -- )
|
|||
param-reg-1 0 box-struct-field@ MOV
|
||||
param-reg-2 1 box-struct-field@ MOV
|
||||
param-reg-4 %mov-vm-ptr
|
||||
"box_small_struct" f %alien-invoke
|
||||
"from_small_struct" f %alien-invoke
|
||||
] with-return-regs ;
|
||||
|
||||
: struct-return@ ( n -- operand )
|
||||
|
|
@ -180,7 +180,7 @@ M: x86.64 %box-large-struct ( n c-type -- )
|
|||
param-reg-1 swap struct-return@ LEA
|
||||
param-reg-3 %mov-vm-ptr
|
||||
! Copy the struct from the C stack
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
"from_value_struct" f %alien-invoke ;
|
||||
|
||||
M: x86.64 %prepare-box-struct ( -- )
|
||||
! Compute target address for value struct return
|
||||
|
|
@ -219,7 +219,7 @@ M: x86.64 %alien-callback ( quot -- )
|
|||
"c_to_factor" f %alien-invoke ;
|
||||
|
||||
M: x86.64 %callback-value ( ctype -- )
|
||||
0 %prepare-unbox
|
||||
0 %pop-stack
|
||||
RSP 8 SUB
|
||||
param-reg-1 PUSH
|
||||
param-reg-1 %mov-vm-ptr
|
||||
|
|
|
|||
|
|
@ -472,6 +472,23 @@ M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
|
|||
M: x86 %alien-global ( dst symbol library -- )
|
||||
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
|
||||
|
||||
M: x86 %push-stack ( -- )
|
||||
ds-reg cell ADD
|
||||
ds-reg [] int-regs return-reg MOV ;
|
||||
|
||||
:: %load-context-datastack ( dst -- )
|
||||
! Load context struct
|
||||
dst "ctx" %vm-field-ptr
|
||||
dst dst [] MOV
|
||||
! Load context datastack pointer
|
||||
dst "datastack" context-field-offset ADD ;
|
||||
|
||||
M: x86 %push-context-stack ( -- )
|
||||
temp-reg %load-context-datastack
|
||||
temp-reg [] bootstrap-cell ADD
|
||||
temp-reg temp-reg [] MOV
|
||||
temp-reg [] int-regs return-reg MOV ;
|
||||
|
||||
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
|
||||
|
||||
:: %boolean ( dst temp word -- )
|
||||
|
|
@ -649,43 +666,6 @@ M: x86 %fill-vector-reps
|
|||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
|
||||
} available-reps ;
|
||||
|
||||
! M:: x86 %broadcast-vector ( dst src rep -- )
|
||||
! rep signed-rep {
|
||||
! { float-4-rep [
|
||||
! dst src float-4-rep %copy
|
||||
! dst dst { 0 0 0 0 } SHUFPS
|
||||
! ] }
|
||||
! { double-2-rep [
|
||||
! dst src MOVDDUP
|
||||
! ] }
|
||||
! { longlong-2-rep [
|
||||
! dst src =
|
||||
! [ dst dst PUNPCKLQDQ ]
|
||||
! [ dst src { 0 1 0 1 } PSHUFD ]
|
||||
! if
|
||||
! ] }
|
||||
! { int-4-rep [
|
||||
! dst src { 0 0 0 0 } PSHUFD
|
||||
! ] }
|
||||
! { short-8-rep [
|
||||
! dst src { 0 0 0 0 } PSHUFLW
|
||||
! dst dst PUNPCKLQDQ
|
||||
! ] }
|
||||
! { char-16-rep [
|
||||
! dst src char-16-rep %copy
|
||||
! dst dst PUNPCKLBW
|
||||
! dst dst { 0 0 0 0 } PSHUFLW
|
||||
! dst dst PUNPCKLQDQ
|
||||
! ] }
|
||||
! } case ;
|
||||
!
|
||||
! M: x86 %broadcast-vector-reps
|
||||
! {
|
||||
! ! Can't do this with sse1 since it will want to unbox
|
||||
! ! a double-precision float and convert to single precision
|
||||
! { sse2? { float-4-rep double-2-rep longlong-2-rep ulonglong-2-rep int-4-rep uint-4-rep short-8-rep ushort-8-rep char-16-rep uchar-16-rep } }
|
||||
! } available-reps ;
|
||||
|
||||
M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
|
||||
rep signed-rep {
|
||||
{ float-4-rep [
|
||||
|
|
@ -883,6 +863,7 @@ M: x86 %float>integer-vector-reps
|
|||
|
||||
: (%compare-float-vector) ( dst src rep double single -- )
|
||||
[ double-2-rep eq? ] 2dip if ; inline
|
||||
|
||||
: %compare-float-vector ( dst src rep cc -- )
|
||||
{
|
||||
{ cc< [ [ CMPLTPD ] [ CMPLTPS ] (%compare-float-vector) ] }
|
||||
|
|
@ -903,6 +884,7 @@ M: x86 %float>integer-vector-reps
|
|||
{ short-8-rep [ int16 call ] }
|
||||
{ char-16-rep [ int8 call ] }
|
||||
} case ; inline
|
||||
|
||||
: %compare-int-vector ( dst src rep cc -- )
|
||||
{
|
||||
{ cc= [ [ PCMPEQQ ] [ PCMPEQD ] [ PCMPEQW ] [ PCMPEQB ] (%compare-int-vector) ] }
|
||||
|
|
@ -921,6 +903,7 @@ M: x86 %compare-vector ( dst src1 src2 rep cc -- )
|
|||
{ sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
|
||||
{ sse4.1? { longlong-2-rep ulonglong-2-rep } }
|
||||
} available-reps ;
|
||||
|
||||
: %compare-vector-ord-reps ( -- reps )
|
||||
{
|
||||
{ sse? { float-4-rep } }
|
||||
|
|
@ -1409,6 +1392,7 @@ M: x86 %integer>scalar drop MOVD ;
|
|||
} case ;
|
||||
|
||||
M: x86.32 %scalar>integer ( dst src rep -- ) %scalar>integer-32 ;
|
||||
|
||||
M: x86.64 %scalar>integer ( dst src rep -- )
|
||||
{
|
||||
{ longlong-scalar-rep [ MOVD ] }
|
||||
|
|
@ -1424,18 +1408,16 @@ M:: x86 %reload ( dst rep src -- ) dst src rep %copy ;
|
|||
|
||||
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
|
||||
|
||||
M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
|
||||
M:: x86 %save-context ( temp1 temp2 -- )
|
||||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp1 "stack_chain" %vm-field-ptr
|
||||
temp1 "ctx" %vm-field-ptr
|
||||
temp1 temp1 [] MOV
|
||||
temp2 stack-reg cell neg [+] LEA
|
||||
temp1 [] temp2 MOV
|
||||
callback-allowed? [
|
||||
temp1 2 cells [+] ds-reg MOV
|
||||
temp1 3 cells [+] rs-reg MOV
|
||||
] when ;
|
||||
temp1 2 cells [+] ds-reg MOV
|
||||
temp1 3 cells [+] rs-reg MOV ;
|
||||
|
||||
M: x86 value-struct? drop t ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend system namespaces io.backend.unix.bsd
|
||||
io.backend.unix.multiplexers io.backend.unix.multiplexers.run-loop ;
|
||||
IN: io.backend.macosx
|
||||
IN: io.backend.unix.macosx
|
||||
|
||||
M: macosx init-io ( -- )
|
||||
<run-loop-mx> mx set-global ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,20 @@ USING: classes.struct alien.c-types alien.syntax ;
|
|||
IN: vm
|
||||
|
||||
TYPEDEF: uintptr_t cell
|
||||
C-TYPE: context
|
||||
|
||||
STRUCT: context
|
||||
{ callstack-top void* }
|
||||
{ callstack-bottom void* }
|
||||
{ datastack cell }
|
||||
{ callstack cell }
|
||||
{ magic-frame void* }
|
||||
{ datastack-region void* }
|
||||
{ retainstack-region void* }
|
||||
{ catchstack-save cell }
|
||||
{ current-callback-save cell }
|
||||
{ next context* } ;
|
||||
|
||||
: context-field-offset ( field -- offset ) context offset-of ; inline
|
||||
|
||||
STRUCT: zone
|
||||
{ start cell }
|
||||
|
|
@ -13,10 +26,10 @@ STRUCT: zone
|
|||
{ end cell } ;
|
||||
|
||||
STRUCT: vm
|
||||
{ stack_chain context* }
|
||||
{ ctx context* }
|
||||
{ nursery zone }
|
||||
{ cards_offset cell }
|
||||
{ decks_offset cell }
|
||||
{ cards-offset cell }
|
||||
{ decks-offset cell }
|
||||
{ userenv cell[70] } ;
|
||||
|
||||
: vm-field-offset ( field -- offset ) vm offset-of ; inline
|
||||
|
|
|
|||
|
|
@ -63,20 +63,6 @@ check_ret() {
|
|||
fi
|
||||
}
|
||||
|
||||
check_gcc_version() {
|
||||
$ECHO -n "Checking gcc version..."
|
||||
GCC_VERSION=`$CC --version`
|
||||
check_ret gcc
|
||||
if [[ $GCC_VERSION == *3.3.* ]] ; then
|
||||
$ECHO "You have a known buggy version of gcc (3.3)"
|
||||
$ECHO "Install gcc 3.4 or higher and try again."
|
||||
exit_script 3
|
||||
elif [[ $GCC_VERSION == *4.3.* ]] ; then
|
||||
MAKE_OPTS="$MAKE_OPTS SITE_CFLAGS=-fno-forward-propagate"
|
||||
fi
|
||||
$ECHO "ok."
|
||||
}
|
||||
|
||||
set_downloader() {
|
||||
test_program_installed wget curl
|
||||
if [[ $? -ne 0 ]] ; then
|
||||
|
|
@ -124,7 +110,6 @@ check_installed_programs() {
|
|||
ensure_program_installed make gmake
|
||||
ensure_program_installed md5sum md5
|
||||
ensure_program_installed cut
|
||||
check_gcc_version
|
||||
}
|
||||
|
||||
check_library_exists() {
|
||||
|
|
|
|||
|
|
@ -2,6 +2,5 @@ include vm/Config.unix
|
|||
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
|
||||
CC = egcc
|
||||
CPP = eg++
|
||||
# -fno-inline-functions works around a gcc 4.2.0 bug
|
||||
CFLAGS += -export-dynamic -fno-inline-functions
|
||||
CFLAGS += -export-dynamic
|
||||
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread
|
||||
|
|
|
|||
|
|
@ -1,5 +1,2 @@
|
|||
BOOT_ARCH = x86
|
||||
PLAF_DLL_OBJS += vm/cpu-x86.32.o
|
||||
|
||||
# gcc bug workaround
|
||||
CFLAGS += -fno-builtin-strlen -fno-builtin-strcat
|
||||
|
|
|
|||
|
|
@ -49,8 +49,7 @@ void factor_vm::collect_aging()
|
|||
collector.cheneys_algorithm();
|
||||
|
||||
data->reset_generation(&nursery);
|
||||
code->points_to_nursery.clear();
|
||||
code->points_to_aging.clear();
|
||||
code->clear_remembered_set();
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
24
vm/alien.cpp
24
vm/alien.cpp
|
|
@ -211,46 +211,46 @@ VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *parent
|
|||
}
|
||||
|
||||
/* For FFI callbacks receiving structs by value */
|
||||
void factor_vm::box_value_struct(void *src, cell size)
|
||||
cell factor_vm::from_value_struct(void *src, cell size)
|
||||
{
|
||||
byte_array *bytes = allot_byte_array(size);
|
||||
memcpy(bytes->data<void>(),src,size);
|
||||
ctx->push(tag<byte_array>(bytes));
|
||||
return tag<byte_array>(bytes);
|
||||
}
|
||||
|
||||
VM_C_API void box_value_struct(void *src, cell size,factor_vm *parent)
|
||||
VM_C_API cell from_value_struct(void *src, cell size, factor_vm *parent)
|
||||
{
|
||||
return parent->box_value_struct(src,size);
|
||||
return parent->from_value_struct(src,size);
|
||||
}
|
||||
|
||||
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
|
||||
void factor_vm::box_small_struct(cell x, cell y, cell size)
|
||||
cell factor_vm::from_small_struct(cell x, cell y, cell size)
|
||||
{
|
||||
cell data[2];
|
||||
data[0] = x;
|
||||
data[1] = y;
|
||||
box_value_struct(data,size);
|
||||
return from_value_struct(data,size);
|
||||
}
|
||||
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size, factor_vm *parent)
|
||||
VM_C_API cell from_small_struct(cell x, cell y, cell size, factor_vm *parent)
|
||||
{
|
||||
return parent->box_small_struct(x,y,size);
|
||||
return parent->from_small_struct(x,y,size);
|
||||
}
|
||||
|
||||
/* On OS X/PPC, complex numbers are returned in registers. */
|
||||
void factor_vm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
||||
cell factor_vm::from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
||||
{
|
||||
cell data[4];
|
||||
data[0] = x1;
|
||||
data[1] = x2;
|
||||
data[2] = x3;
|
||||
data[3] = x4;
|
||||
box_value_struct(data,size);
|
||||
return from_value_struct(data,size);
|
||||
}
|
||||
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *parent)
|
||||
VM_C_API cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *parent)
|
||||
{
|
||||
return parent->box_medium_struct(x1, x2, x3, x4, size);
|
||||
return parent->from_medium_struct(x1, x2, x3, x4, size);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_vm_ptr()
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ VM_C_API char *alien_offset(cell object, factor_vm *vm);
|
|||
VM_C_API char *pinned_alien_offset(cell object, factor_vm *vm);
|
||||
VM_C_API cell allot_alien(void *address, factor_vm *vm);
|
||||
VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *vm);
|
||||
VM_C_API void box_value_struct(void *src, cell size,factor_vm *vm);
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size,factor_vm *vm);
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factor_vm *vm);
|
||||
VM_C_API cell from_value_struct(void *src, cell size, factor_vm *vm);
|
||||
VM_C_API cell from_small_struct(cell x, cell y, cell size, factor_vm *vm);
|
||||
VM_C_API cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *vm);
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -36,7 +36,11 @@ struct code_block
|
|||
|
||||
cell size() const
|
||||
{
|
||||
return header & ~7;
|
||||
cell size = header & ~7;
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(size > 0);
|
||||
#endif
|
||||
return size;
|
||||
}
|
||||
|
||||
void *xt() const
|
||||
|
|
|
|||
|
|
@ -54,6 +54,9 @@ void factor_vm::nest_stacks(stack_frame *magic_frame)
|
|||
new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
|
||||
new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
|
||||
|
||||
new_ctx->reset_datastack();
|
||||
new_ctx->reset_retainstack();
|
||||
|
||||
new_ctx->next = ctx;
|
||||
ctx = new_ctx;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,9 +4,6 @@ namespace factor
|
|||
#define FACTOR_CPU_STRING "ppc"
|
||||
#define VM_ASM_API VM_C_API
|
||||
|
||||
register cell ds asm("r13");
|
||||
register cell rs asm("r14");
|
||||
|
||||
/* In the instruction sequence:
|
||||
|
||||
LOAD32 r3,...
|
||||
|
|
@ -81,14 +78,16 @@ inline static unsigned int fpu_status(unsigned int status)
|
|||
}
|
||||
|
||||
/* Defined in assembly */
|
||||
VM_ASM_API void c_to_factor(cell quot, void *vm);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind, void *vm);
|
||||
VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
|
||||
VM_ASM_API void flush_icache(cell start, cell len);
|
||||
VM_C_API void c_to_factor(cell quot, void *vm);
|
||||
VM_C_API void throw_impl(cell quot, void *new_stack, void *vm);
|
||||
VM_C_API void lazy_jit_compile(cell quot, void *vm);
|
||||
VM_C_API void flush_icache(cell start, cell len);
|
||||
|
||||
VM_ASM_API void set_callstack(stack_frame *to,
|
||||
stack_frame *from,
|
||||
cell length,
|
||||
void *(*memcpy)(void*,const void*, size_t));
|
||||
VM_C_API void set_callstack(
|
||||
void *vm,
|
||||
stack_frame *to,
|
||||
stack_frame *from,
|
||||
cell length,
|
||||
void *(*memcpy)(void*,const void*, size_t));
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
#define STACK_REG %rsp
|
||||
#define DS_REG %r14
|
||||
#define RS_REG %r15
|
||||
#define RETURN_REG %rax
|
||||
|
||||
#define CELL_SIZE 8
|
||||
|
|
@ -18,6 +19,8 @@
|
|||
#define ARG3 %r9
|
||||
|
||||
#define PUSH_NONVOLATILE \
|
||||
push %r15 ; \
|
||||
push %r14 ; \
|
||||
push %r12 ; \
|
||||
push %r13 ; \
|
||||
push %rdi ; \
|
||||
|
|
@ -31,7 +34,9 @@
|
|||
pop %rsi ; \
|
||||
pop %rdi ; \
|
||||
pop %r13 ; \
|
||||
pop %r12
|
||||
pop %r12 ; \
|
||||
pop %r14 ; \
|
||||
pop %r15
|
||||
|
||||
#else
|
||||
|
||||
|
|
@ -44,9 +49,13 @@
|
|||
push %rbx ; \
|
||||
push %rbp ; \
|
||||
push %r12 ; \
|
||||
push %r13
|
||||
push %r13 ; \
|
||||
push %r14 ; \
|
||||
push %r15
|
||||
|
||||
#define POP_NONVOLATILE \
|
||||
pop %r15 ; \
|
||||
pop %r14 ; \
|
||||
pop %r13 ; \
|
||||
pop %r12 ; \
|
||||
pop %rbp ; \
|
||||
|
|
|
|||
|
|
@ -2,9 +2,6 @@ namespace factor
|
|||
{
|
||||
|
||||
#define FACTOR_CPU_STRING "x86.64"
|
||||
|
||||
register cell ds asm("r14");
|
||||
register cell rs asm("r15");
|
||||
|
||||
#define VM_ASM_API VM_C_API
|
||||
|
||||
}
|
||||
|
|
|
|||
44
vm/cpu-x86.S
44
vm/cpu-x86.S
|
|
@ -3,27 +3,30 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
|
|||
mov ARG0,NV0
|
||||
mov ARG1,NV1
|
||||
|
||||
/* Save old stack pointer and align */
|
||||
mov STACK_REG,ARG0
|
||||
and $-16,STACK_REG
|
||||
add $CELL_SIZE,STACK_REG
|
||||
push ARG0
|
||||
push ARG0
|
||||
push ARG1
|
||||
|
||||
/* Create register shadow area for Win64 */
|
||||
/* Save old stack pointer and align */
|
||||
mov STACK_REG,ARG0
|
||||
and $-16,STACK_REG
|
||||
add $CELL_SIZE,STACK_REG
|
||||
push ARG0
|
||||
|
||||
/* Create register shadow area (required for Win64 only) */
|
||||
sub $32,STACK_REG
|
||||
|
||||
/* Load context */
|
||||
mov (NV1),ARG0
|
||||
mov (NV1),ARG0
|
||||
|
||||
/* Save ctx->callstack_bottom */
|
||||
/* Save ctx->callstack_bottom */
|
||||
lea -CELL_SIZE(STACK_REG),ARG1
|
||||
mov ARG1,CELL_SIZE(ARG0)
|
||||
mov ARG1,CELL_SIZE(ARG0)
|
||||
|
||||
/* Load ctx->datastack */
|
||||
mov (CELL_SIZE * 2)(ARG0),DS_REG
|
||||
/* Load ctx->datastack */
|
||||
mov (CELL_SIZE * 2)(ARG0),DS_REG
|
||||
|
||||
/* Load ctx->retainstack */
|
||||
mov (CELL_SIZE * 3)(ARG0),RS_REG
|
||||
/* Load ctx->retainstack */
|
||||
mov (CELL_SIZE * 3)(ARG0),RS_REG
|
||||
|
||||
/* Call quot-xt */
|
||||
mov NV0,ARG0
|
||||
|
|
@ -33,8 +36,19 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
|
|||
/* Tear down register shadow area */
|
||||
add $32,STACK_REG
|
||||
|
||||
/* Undo stack alignment */
|
||||
mov (STACK_REG),STACK_REG
|
||||
/* Undo stack alignment */
|
||||
mov (STACK_REG),STACK_REG
|
||||
|
||||
/* Load context */
|
||||
pop ARG1
|
||||
pop ARG0
|
||||
mov (ARG1),ARG0
|
||||
|
||||
/* Save ctx->datastack */
|
||||
mov DS_REG,(CELL_SIZE * 2)(ARG0)
|
||||
|
||||
/* Save ctx->retainstack */
|
||||
mov RS_REG,(CELL_SIZE * 3)(ARG0)
|
||||
|
||||
POP_NONVOLATILE
|
||||
ret
|
||||
|
|
|
|||
|
|
@ -42,16 +42,16 @@ struct slot_checker {
|
|||
char slot_card_value = *(char *)slot_card_pointer;
|
||||
if((slot_card_value & mask) != mask)
|
||||
{
|
||||
printf("card not marked\n");
|
||||
printf("source generation: %d\n",gen);
|
||||
printf("target generation: %d\n",target);
|
||||
printf("object: 0x%lx\n",(cell)obj);
|
||||
printf("object type: %ld\n",obj->type());
|
||||
printf("slot pointer: 0x%lx\n",(cell)slot_ptr);
|
||||
printf("slot value: 0x%lx\n",*slot_ptr);
|
||||
printf("card of object: 0x%lx\n",object_card_pointer);
|
||||
printf("card of slot: 0x%lx\n",slot_card_pointer);
|
||||
printf("\n");
|
||||
std::cout << "card not marked" << std::endl;
|
||||
std::cout << "source generation: " << gen << std::endl;
|
||||
std::cout << "target generation: " << target << std::endl;
|
||||
std::cout << "object: 0x" << std::hex << (cell)obj << std::dec << std::endl;
|
||||
std::cout << "object type: " << obj->type() << std::endl;
|
||||
std::cout << "slot pointer: 0x" << std::hex << (cell)slot_ptr << std::dec << std::endl;
|
||||
std::cout << "slot value: 0x" << std::hex << *slot_ptr << std::dec << std::endl;
|
||||
std::cout << "card of object: 0x" << std::hex << object_card_pointer << std::dec << std::endl;
|
||||
std::cout << "card of slot: 0x" << std::hex << slot_card_pointer << std::dec << std::endl;
|
||||
std::cout << std::endl;
|
||||
parent->factorbug();
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,11 +15,18 @@ struct free_heap_block
|
|||
|
||||
cell size() const
|
||||
{
|
||||
return header & ~7;
|
||||
cell size = header & ~7;
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(size > 0);
|
||||
#endif
|
||||
return size;
|
||||
}
|
||||
|
||||
void make_free(cell size)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(size > 0);
|
||||
#endif
|
||||
header = size | 1;
|
||||
}
|
||||
};
|
||||
|
|
|
|||
|
|
@ -591,9 +591,9 @@ struct factor_vm
|
|||
void primitive_vm_ptr();
|
||||
char *alien_offset(cell obj);
|
||||
void to_value_struct(cell src, void *dest, cell size);
|
||||
void box_value_struct(void *src, cell size);
|
||||
void box_small_struct(cell x, cell y, cell size);
|
||||
void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
|
||||
cell from_value_struct(void *src, cell size);
|
||||
cell from_small_struct(cell x, cell y, cell size);
|
||||
cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
|
||||
|
||||
//quotations
|
||||
void primitive_jit_compile();
|
||||
|
|
|
|||
Loading…
Reference in New Issue