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

Get optimizing compiler working without global register variables in VM

db4
Slava Pestov 2009-12-22 15:42:49 +13:00
parent 63edd20a55
commit e96404327e
28 changed files with 213 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/alien/c-types/c-types.factor
View File

@ -344,7 +344,7 @@ SYMBOLS:
bootstrap-cell >>align bootstrap-cell >>align
bootstrap-cell >>align-first bootstrap-cell >>align-first
[ >c-ptr ] >>unboxer-quot [ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer "allot_alien" >>boxer
"alien_offset" >>unboxer "alien_offset" >>unboxer
\ void* define-primitive-type \ void* define-primitive-type
@ -355,7 +355,7 @@ SYMBOLS:
[ set-alien-signed-8 ] >>setter [ set-alien-signed-8 ] >>setter
8 >>size 8 >>size
8-byte-alignment 8-byte-alignment
"box_signed_8" >>boxer "from_signed_8" >>boxer
"to_signed_8" >>unboxer "to_signed_8" >>unboxer
\ longlong define-primitive-type \ longlong define-primitive-type
@ -366,7 +366,7 @@ SYMBOLS:
[ set-alien-unsigned-8 ] >>setter [ set-alien-unsigned-8 ] >>setter
8 >>size 8 >>size
8-byte-alignment 8-byte-alignment
"box_unsigned_8" >>boxer "from_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer "to_unsigned_8" >>unboxer
\ ulonglong define-primitive-type \ ulonglong define-primitive-type
@ -378,7 +378,7 @@ SYMBOLS:
bootstrap-cell >>size bootstrap-cell >>size
bootstrap-cell >>align bootstrap-cell >>align
bootstrap-cell >>align-first bootstrap-cell >>align-first
"box_signed_cell" >>boxer "from_signed_cell" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
\ long define-primitive-type \ long define-primitive-type
@ -390,7 +390,7 @@ SYMBOLS:
bootstrap-cell >>size bootstrap-cell >>size
bootstrap-cell >>align bootstrap-cell >>align
bootstrap-cell >>align-first bootstrap-cell >>align-first
"box_unsigned_cell" >>boxer "from_unsigned_cell" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
\ ulong define-primitive-type \ ulong define-primitive-type
@ -402,7 +402,7 @@ SYMBOLS:
4 >>size 4 >>size
4 >>align 4 >>align
4 >>align-first 4 >>align-first
"box_signed_4" >>boxer "from_signed_4" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
\ int define-primitive-type \ int define-primitive-type
@ -414,7 +414,7 @@ SYMBOLS:
4 >>size 4 >>size
4 >>align 4 >>align
4 >>align-first 4 >>align-first
"box_unsigned_4" >>boxer "from_unsigned_4" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
\ uint define-primitive-type \ uint define-primitive-type
@ -426,7 +426,7 @@ SYMBOLS:
2 >>size 2 >>size
2 >>align 2 >>align
2 >>align-first 2 >>align-first
"box_signed_2" >>boxer "from_signed_2" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
\ short define-primitive-type \ short define-primitive-type
@ -438,7 +438,7 @@ SYMBOLS:
2 >>size 2 >>size
2 >>align 2 >>align
2 >>align-first 2 >>align-first
"box_unsigned_2" >>boxer "from_unsigned_2" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
\ ushort define-primitive-type \ ushort define-primitive-type
@ -450,7 +450,7 @@ SYMBOLS:
1 >>size 1 >>size
1 >>align 1 >>align
1 >>align-first 1 >>align-first
"box_signed_1" >>boxer "from_signed_1" >>boxer
"to_fixnum" >>unboxer "to_fixnum" >>unboxer
\ char define-primitive-type \ char define-primitive-type
@ -462,7 +462,7 @@ SYMBOLS:
1 >>size 1 >>size
1 >>align 1 >>align
1 >>align-first 1 >>align-first
"box_unsigned_1" >>boxer "from_unsigned_1" >>boxer
"to_cell" >>unboxer "to_cell" >>unboxer
\ uchar define-primitive-type \ uchar define-primitive-type
@ -473,7 +473,7 @@ SYMBOLS:
4 >>size 4 >>size
4 >>align 4 >>align
4 >>align-first 4 >>align-first
"box_boolean" >>boxer "from_boolean" >>boxer
"to_boolean" >>unboxer "to_boolean" >>unboxer
] [ ] [
<c-type> <c-type>
@ -482,7 +482,7 @@ SYMBOLS:
1 >>size 1 >>size
1 >>align 1 >>align
1 >>align-first 1 >>align-first
"box_boolean" >>boxer "from_boolean" >>boxer
"to_boolean" >>unboxer "to_boolean" >>unboxer
] if ] if
\ bool define-primitive-type \ bool define-primitive-type
@ -495,7 +495,7 @@ SYMBOLS:
4 >>size 4 >>size
4 >>align 4 >>align
4 >>align-first 4 >>align-first
"box_float" >>boxer "from_float" >>boxer
"to_float" >>unboxer "to_float" >>unboxer
float-rep >>rep float-rep >>rep
[ >float ] >>unboxer-quot [ >float ] >>unboxer-quot
@ -508,7 +508,7 @@ SYMBOLS:
[ [ >float ] 2dip set-alien-double ] >>setter [ [ >float ] 2dip set-alien-double ] >>setter
8 >>size 8 >>size
8-byte-alignment 8-byte-alignment
"box_double" >>boxer "from_double" >>boxer
"to_double" >>unboxer "to_double" >>unboxer
double-rep >>rep double-rep >>rep
[ >float ] >>unboxer-quot [ >float ] >>unboxer-quot

3
basis/compiler/cfg/instructions/instructions.factor
View File

@ -748,8 +748,7 @@ temp: temp1/int-rep temp2/int-rep
literal: size data-values tagged-values uninitialized-locs ; literal: size data-values tagged-values uninitialized-locs ;
INSN: ##save-context INSN: ##save-context
temp: temp1/int-rep temp2/int-rep temp: temp1/int-rep temp2/int-rep ;
literal: callback-allowed? ;
! Instructions used by machine IR only. ! Instructions used by machine IR only.
INSN: _prologue INSN: _prologue

2
basis/compiler/cfg/save-contexts/save-contexts-tests.factor
View File

@ -15,7 +15,7 @@ V{
[ [
V{ V{
T{ ##save-context f 1 2 f } T{ ##save-context f 1 2 }
T{ ##unary-float-function f 2 3 "sqrt" } T{ ##unary-float-function f 2 3 "sqrt" }
T{ ##branch } T{ ##branch }
} }

9
basis/compiler/cfg/save-contexts/save-contexts.factor
View File

@ -17,19 +17,10 @@ IN: compiler.cfg.save-contexts
} 1|| } 1||
] any? ; ] any? ;
: needs-callback-context? ( insns -- ? )
[
{
[ ##alien-invoke? ]
[ ##alien-indirect? ]
} 1||
] any? ;
: insert-save-context ( bb -- ) : insert-save-context ( bb -- )
dup instructions>> dup needs-save-context? [ dup instructions>> dup needs-save-context? [
int-rep next-vreg-rep int-rep next-vreg-rep
int-rep next-vreg-rep int-rep next-vreg-rep
pick needs-callback-context?
\ ##save-context new-insn prefix \ ##save-context new-insn prefix
>>instructions drop >>instructions drop
] [ 2drop ] if ; ] [ 2drop ] if ;

8
basis/compiler/codegen/codegen.factor
View File

@ -283,7 +283,7 @@ M: ##gc generate-insn
[ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ] [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
[ data-values>> save-data-regs ] [ data-values>> save-data-regs ]
[ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ] [ [ 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>> length ] [ temp1>> ] bi %call-gc ]
[ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ] [ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
[ data-values>> load-data-regs ] [ 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 -- ) : unbox-parameters ( offset node -- )
parameters>> swap parameters>> swap
'[ prepare-unbox-parameters [ %prepare-unbox [ _ + ] dip unbox-parameter ] 3each ] '[ prepare-unbox-parameters [ %pop-stack [ _ + ] dip unbox-parameter ] 3each ]
[ length neg %inc-d ] [ length neg %inc-d ]
bi ; bi ;
@ -407,7 +407,7 @@ M: c-type-name flatten-value-type c-type flatten-value-type ;
] with-param-regs ; ] with-param-regs ;
: box-return* ( node -- ) : box-return* ( node -- )
return>> [ ] [ box-return ] if-void ; return>> [ ] [ box-return %push-stack ] if-void ;
: check-dlsym ( symbols dll -- ) : check-dlsym ( symbols dll -- )
dup dll-valid? [ dup dll-valid? [
@ -452,7 +452,7 @@ M: ##alien-indirect generate-insn
! ##alien-callback ! ##alien-callback
: box-parameters ( params -- ) : box-parameters ( params -- )
alien-parameters [ box-parameter ] each-parameter ; alien-parameters [ box-parameter %push-context-stack ] each-parameter ;
: registers>objects ( node -- ) : registers>objects ( node -- )
! Generate code for boxing input parameters in a callback. ! Generate code for boxing input parameters in a callback.

2
basis/compiler/tests/alien.factor
View File

@ -94,6 +94,8 @@ FUNCTION: TINY ffi_test_17 int x ;
{ 1 1 } [ indirect-test-1 ] must-infer-as { 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 [ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
: indirect-test-1' ( ptr -- ) : indirect-test-1' ( ptr -- )

27
basis/cpu/architecture/architecture.factor
View File

@ -503,8 +503,27 @@ HOOK: dummy-int-params? cpu ( -- ? )
! If t, all int parameters are shadowed by dummy FP parameters ! If t, all int parameters are shadowed by dummy FP parameters
HOOK: dummy-fp-params? cpu ( -- ? ) 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 cpu ( n rep func -- )
HOOK: %unbox-long-long cpu ( n 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 -- ) 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 cpu ( n rep func -- )
HOOK: %box-long-long cpu ( n 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: %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 ( -- ) HOOK: %prepare-var-args cpu ( -- )

8
basis/cpu/ppc/ppc.factor
View File

@ -590,7 +590,7 @@ M:: ppc %save-param-reg ( stack reg rep -- )
M:: ppc %load-param-reg ( stack reg rep -- ) M:: ppc %load-param-reg ( stack reg rep -- )
reg stack local@ rep load-from-frame ; reg stack local@ rep load-from-frame ;
M: ppc %prepare-unbox ( n -- ) M: ppc %pop-stack ( n -- )
[ 3 ] dip <ds-loc> loc>operand LWZ ; [ 3 ] dip <ds-loc> loc>operand LWZ ;
M: ppc %unbox ( n rep func -- ) 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* [ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
5 %load-vm-addr 5 %load-vm-addr
! Call the function ! Call the function
"box_value_struct" f %alien-invoke ; "from_value_struct" f %alien-invoke ;
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- ) M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a #! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace #! callback which does a GC, which must reliably trace
#! all roots. #! all roots.
temp1 "stack_chain" %load-vm-field-addr temp1 "ctx" %load-vm-field-addr
temp1 temp1 0 LWZ temp1 temp1 0 LWZ
1 temp1 0 STW 1 temp1 0 STW
callback-allowed? [ callback-allowed? [
@ -703,7 +703,7 @@ M: ppc %box-small-struct ( c-type -- )
#! Box a <= 16-byte struct returned in r3:r4:r5:r6 #! Box a <= 16-byte struct returned in r3:r4:r5:r6
heap-size 7 LI heap-size 7 LI
8 %load-vm-addr 8 %load-vm-addr
"box_medium_struct" f %alien-invoke ; "from_medium_struct" f %alien-invoke ;
: %unbox-struct-1 ( -- ) : %unbox-struct-1 ( -- )
! Alien must be in r3. ! Alien must be in r3.

26
basis/cpu/x86/32/32.factor
View File

@ -136,7 +136,7 @@ M:: x86.32 %box-large-struct ( n c-type -- )
8 save-vm-ptr 8 save-vm-ptr
4 stack@ c-type heap-size MOV 4 stack@ c-type heap-size MOV
0 stack@ EDX MOV 0 stack@ EDX MOV
"box_value_struct" f %alien-invoke ; "from_value_struct" f %alien-invoke ;
M: x86.32 %prepare-box-struct ( -- ) M: x86.32 %prepare-box-struct ( -- )
! Compute target address for value struct return ! 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 8 stack@ swap heap-size MOV
4 stack@ EDX MOV 4 stack@ EDX MOV
0 stack@ EAX 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 ; 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 -- ) : call-unbox-func ( func -- )
4 save-vm-ptr 4 save-vm-ptr
0 stack@ EAX MOV 0 stack@ EAX MOV
@ -224,21 +230,23 @@ M: x86.32 %unnest-stacks ( -- )
"unnest_stacks" f %alien-invoke ; "unnest_stacks" f %alien-invoke ;
M: x86.32 %prepare-alien-indirect ( -- ) M: x86.32 %prepare-alien-indirect ( -- )
0 save-vm-ptr EAX ds-reg [] MOV
"unbox_alien" f %alien-invoke ds-reg 4 SUB
4 save-vm-ptr
0 stack@ EAX MOV
"pinned_alien_offset" f %alien-invoke
EBP EAX MOV ; EBP EAX MOV ;
M: x86.32 %alien-indirect ( -- ) M: x86.32 %alien-indirect ( -- )
EBP CALL ; EBP CALL ;
M: x86.32 %alien-callback ( quot -- ) M: x86.32 %alien-callback ( quot -- )
! Fastcall EAX swap %load-reference
param-reg-1 swap %load-reference EDX %mov-vm-ptr
param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke ; "c_to_factor" f %alien-invoke ;
M: x86.32 %callback-value ( ctype -- ) M: x86.32 %callback-value ( ctype -- )
0 %prepare-unbox %pop-context-stack
4 stack@ EAX MOV 4 stack@ EAX MOV
0 save-vm-ptr 0 save-vm-ptr
! Restore data/call/retain stacks ! Restore data/call/retain stacks

8
basis/cpu/x86/64/64.factor
View File

@ -88,7 +88,7 @@ M: x86 %load-param-reg [ swap param@ ] dip %copy ;
call call
] with-scope ; inline ] with-scope ; inline
M: x86.64 %prepare-unbox ( n -- ) M: x86.64 %pop-stack ( n -- )
param-reg-1 swap ds-reg reg-stack MOV ; param-reg-1 swap ds-reg reg-stack MOV ;
M:: x86.64 %unbox ( n rep func -- ) 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-1 0 box-struct-field@ MOV
param-reg-2 1 box-struct-field@ MOV param-reg-2 1 box-struct-field@ MOV
param-reg-4 %mov-vm-ptr param-reg-4 %mov-vm-ptr
"box_small_struct" f %alien-invoke "from_small_struct" f %alien-invoke
] with-return-regs ; ] with-return-regs ;
: struct-return@ ( n -- operand ) : 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-1 swap struct-return@ LEA
param-reg-3 %mov-vm-ptr param-reg-3 %mov-vm-ptr
! Copy the struct from the C stack ! 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 ( -- ) M: x86.64 %prepare-box-struct ( -- )
! Compute target address for value struct return ! Compute target address for value struct return
@ -219,7 +219,7 @@ M: x86.64 %alien-callback ( quot -- )
"c_to_factor" f %alien-invoke ; "c_to_factor" f %alien-invoke ;
M: x86.64 %callback-value ( ctype -- ) M: x86.64 %callback-value ( ctype -- )
0 %prepare-unbox 0 %pop-stack
RSP 8 SUB RSP 8 SUB
param-reg-1 PUSH param-reg-1 PUSH
param-reg-1 %mov-vm-ptr param-reg-1 %mov-vm-ptr

68
basis/cpu/x86/x86.factor
View File

@ -472,6 +472,23 @@ M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
M: x86 %alien-global ( dst symbol library -- ) M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ; [ 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 ; M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
:: %boolean ( dst temp word -- ) :: %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 } } { 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 ; } 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 -- ) M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
rep signed-rep { rep signed-rep {
{ float-4-rep [ { float-4-rep [
@ -883,6 +863,7 @@ M: x86 %float>integer-vector-reps
: (%compare-float-vector) ( dst src rep double single -- ) : (%compare-float-vector) ( dst src rep double single -- )
[ double-2-rep eq? ] 2dip if ; inline [ double-2-rep eq? ] 2dip if ; inline
: %compare-float-vector ( dst src rep cc -- ) : %compare-float-vector ( dst src rep cc -- )
{ {
{ cc< [ [ CMPLTPD ] [ CMPLTPS ] (%compare-float-vector) ] } { cc< [ [ CMPLTPD ] [ CMPLTPS ] (%compare-float-vector) ] }
@ -903,6 +884,7 @@ M: x86 %float>integer-vector-reps
{ short-8-rep [ int16 call ] } { short-8-rep [ int16 call ] }
{ char-16-rep [ int8 call ] } { char-16-rep [ int8 call ] }
} case ; inline } case ; inline
: %compare-int-vector ( dst src rep cc -- ) : %compare-int-vector ( dst src rep cc -- )
{ {
{ cc= [ [ PCMPEQQ ] [ PCMPEQD ] [ PCMPEQW ] [ PCMPEQB ] (%compare-int-vector) ] } { 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 } } { 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 } } { sse4.1? { longlong-2-rep ulonglong-2-rep } }
} available-reps ; } available-reps ;
: %compare-vector-ord-reps ( -- reps ) : %compare-vector-ord-reps ( -- reps )
{ {
{ sse? { float-4-rep } } { sse? { float-4-rep } }
@ -1409,6 +1392,7 @@ M: x86 %integer>scalar drop MOVD ;
} case ; } case ;
M: x86.32 %scalar>integer ( dst src rep -- ) %scalar>integer-32 ; M: x86.32 %scalar>integer ( dst src rep -- ) %scalar>integer-32 ;
M: x86.64 %scalar>integer ( dst src rep -- ) M: x86.64 %scalar>integer ( dst src rep -- )
{ {
{ longlong-scalar-rep [ MOVD ] } { 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 %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 #! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace #! callback which does a GC, which must reliably trace
#! all roots. #! all roots.
temp1 "stack_chain" %vm-field-ptr temp1 "ctx" %vm-field-ptr
temp1 temp1 [] MOV temp1 temp1 [] MOV
temp2 stack-reg cell neg [+] LEA temp2 stack-reg cell neg [+] LEA
temp1 [] temp2 MOV temp1 [] temp2 MOV
callback-allowed? [ temp1 2 cells [+] ds-reg MOV
temp1 2 cells [+] ds-reg MOV temp1 3 cells [+] rs-reg MOV ;
temp1 3 cells [+] rs-reg MOV
] when ;
M: x86 value-struct? drop t ; M: x86 value-struct? drop t ;

2
basis/io/backend/unix/macosx/macosx.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.backend system namespaces io.backend.unix.bsd USING: io.backend system namespaces io.backend.unix.bsd
io.backend.unix.multiplexers io.backend.unix.multiplexers.run-loop ; io.backend.unix.multiplexers io.backend.unix.multiplexers.run-loop ;
IN: io.backend.macosx IN: io.backend.unix.macosx
M: macosx init-io ( -- ) M: macosx init-io ( -- )
<run-loop-mx> mx set-global ; <run-loop-mx> mx set-global ;

21
basis/vm/vm.factor
View File

@ -4,7 +4,20 @@ USING: classes.struct alien.c-types alien.syntax ;
IN: vm IN: vm
TYPEDEF: uintptr_t cell 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 STRUCT: zone
{ start cell } { start cell }
@ -13,10 +26,10 @@ STRUCT: zone
{ end cell } ; { end cell } ;
STRUCT: vm STRUCT: vm
{ stack_chain context* } { ctx context* }
{ nursery zone } { nursery zone }
{ cards_offset cell } { cards-offset cell }
{ decks_offset cell } { decks-offset cell }
{ userenv cell[70] } ; { userenv cell[70] } ;
: vm-field-offset ( field -- offset ) vm offset-of ; inline : vm-field-offset ( field -- offset ) vm offset-of ; inline

15
build-support/factor.sh
View File

@ -63,20 +63,6 @@ check_ret() {
fi 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() { set_downloader() {
test_program_installed wget curl test_program_installed wget curl
if [[ $? -ne 0 ]] ; then if [[ $? -ne 0 ]] ; then
@ -124,7 +110,6 @@ check_installed_programs() {
ensure_program_installed make gmake ensure_program_installed make gmake
ensure_program_installed md5sum md5 ensure_program_installed md5sum md5
ensure_program_installed cut ensure_program_installed cut
check_gcc_version
} }
check_library_exists() { check_library_exists() {

3
vm/Config.openbsd
View File

@ -2,6 +2,5 @@ include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
CC = egcc CC = egcc
CPP = eg++ CPP = eg++
# -fno-inline-functions works around a gcc 4.2.0 bug CFLAGS += -export-dynamic
CFLAGS += -export-dynamic -fno-inline-functions
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread

3
vm/Config.x86.32
View File

@ -1,5 +1,2 @@
BOOT_ARCH = x86 BOOT_ARCH = x86
PLAF_DLL_OBJS += vm/cpu-x86.32.o PLAF_DLL_OBJS += vm/cpu-x86.32.o
# gcc bug workaround
CFLAGS += -fno-builtin-strlen -fno-builtin-strcat

3
vm/aging_collector.cpp
View File

@ -49,8 +49,7 @@ void factor_vm::collect_aging()
collector.cheneys_algorithm(); collector.cheneys_algorithm();
data->reset_generation(&nursery); data->reset_generation(&nursery);
code->points_to_nursery.clear(); code->clear_remembered_set();
code->points_to_aging.clear();
} }
} }

24
vm/alien.cpp
View File

@ -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 */ /* 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); byte_array *bytes = allot_byte_array(size);
memcpy(bytes->data<void>(),src,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. */ /* 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]; cell data[2];
data[0] = x; data[0] = x;
data[1] = y; 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. */ /* 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]; cell data[4];
data[0] = x1; data[0] = x1;
data[1] = x2; data[1] = x2;
data[2] = x3; data[2] = x3;
data[3] = x4; 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() void factor_vm::primitive_vm_ptr()

6
vm/alien.hpp
View File

@ -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 char *pinned_alien_offset(cell object, factor_vm *vm);
VM_C_API cell allot_alien(void *address, 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 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 cell from_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 cell from_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_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *vm);
} }

6
vm/code_blocks.hpp
View File

@ -36,7 +36,11 @@ struct code_block
cell size() const cell size() const
{ {
return header & ~7; cell size = header & ~7;
#ifdef FACTOR_DEBUG
assert(size > 0);
#endif
return size;
} }
void *xt() const void *xt() const

3
vm/contexts.cpp
View File

@ -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->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK]; new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
new_ctx->reset_datastack();
new_ctx->reset_retainstack();
new_ctx->next = ctx; new_ctx->next = ctx;
ctx = new_ctx; ctx = new_ctx;
} }

21
vm/cpu-ppc.hpp
View File

@ -4,9 +4,6 @@ namespace factor
#define FACTOR_CPU_STRING "ppc" #define FACTOR_CPU_STRING "ppc"
#define VM_ASM_API VM_C_API #define VM_ASM_API VM_C_API
register cell ds asm("r13");
register cell rs asm("r14");
/* In the instruction sequence: /* In the instruction sequence:
LOAD32 r3,... LOAD32 r3,...
@ -81,14 +78,16 @@ inline static unsigned int fpu_status(unsigned int status)
} }
/* Defined in assembly */ /* Defined in assembly */
VM_ASM_API void c_to_factor(cell quot, void *vm); VM_C_API void c_to_factor(cell quot, void *vm);
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind, void *vm); VM_C_API void throw_impl(cell quot, void *new_stack, void *vm);
VM_ASM_API void lazy_jit_compile(cell quot, void *vm); VM_C_API void lazy_jit_compile(cell quot, void *vm);
VM_ASM_API void flush_icache(cell start, cell len); VM_C_API void flush_icache(cell start, cell len);
VM_ASM_API void set_callstack(stack_frame *to, VM_C_API void set_callstack(
stack_frame *from, void *vm,
cell length, stack_frame *to,
void *(*memcpy)(void*,const void*, size_t)); stack_frame *from,
cell length,
void *(*memcpy)(void*,const void*, size_t));
} }

13
vm/cpu-x86.64.S
View File

@ -2,6 +2,7 @@
#define STACK_REG %rsp #define STACK_REG %rsp
#define DS_REG %r14 #define DS_REG %r14
#define RS_REG %r15
#define RETURN_REG %rax #define RETURN_REG %rax
#define CELL_SIZE 8 #define CELL_SIZE 8
@ -18,6 +19,8 @@
#define ARG3 %r9 #define ARG3 %r9
#define PUSH_NONVOLATILE \ #define PUSH_NONVOLATILE \
push %r15 ; \
push %r14 ; \
push %r12 ; \ push %r12 ; \
push %r13 ; \ push %r13 ; \
push %rdi ; \ push %rdi ; \
@ -31,7 +34,9 @@
pop %rsi ; \ pop %rsi ; \
pop %rdi ; \ pop %rdi ; \
pop %r13 ; \ pop %r13 ; \
pop %r12 pop %r12 ; \
pop %r14 ; \
pop %r15
#else #else
@ -44,9 +49,13 @@
push %rbx ; \ push %rbx ; \
push %rbp ; \ push %rbp ; \
push %r12 ; \ push %r12 ; \
push %r13 push %r13 ; \
push %r14 ; \
push %r15
#define POP_NONVOLATILE \ #define POP_NONVOLATILE \
pop %r15 ; \
pop %r14 ; \
pop %r13 ; \ pop %r13 ; \
pop %r12 ; \ pop %r12 ; \
pop %rbp ; \ pop %rbp ; \

5
vm/cpu-x86.64.hpp
View File

@ -2,9 +2,6 @@ namespace factor
{ {
#define FACTOR_CPU_STRING "x86.64" #define FACTOR_CPU_STRING "x86.64"
register cell ds asm("r14");
register cell rs asm("r15");
#define VM_ASM_API VM_C_API #define VM_ASM_API VM_C_API
} }

44
vm/cpu-x86.S
View File

@ -3,27 +3,30 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
mov ARG0,NV0 mov ARG0,NV0
mov ARG1,NV1 mov ARG1,NV1
/* Save old stack pointer and align */ push ARG0
mov STACK_REG,ARG0 push ARG1
and $-16,STACK_REG
add $CELL_SIZE,STACK_REG
push ARG0
/* 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 sub $32,STACK_REG
/* Load context */ /* Load context */
mov (NV1),ARG0 mov (NV1),ARG0
/* Save ctx->callstack_bottom */ /* Save ctx->callstack_bottom */
lea -CELL_SIZE(STACK_REG),ARG1 lea -CELL_SIZE(STACK_REG),ARG1
mov ARG1,CELL_SIZE(ARG0) mov ARG1,CELL_SIZE(ARG0)
/* Load ctx->datastack */ /* Load ctx->datastack */
mov (CELL_SIZE * 2)(ARG0),DS_REG mov (CELL_SIZE * 2)(ARG0),DS_REG
/* Load ctx->retainstack */ /* Load ctx->retainstack */
mov (CELL_SIZE * 3)(ARG0),RS_REG mov (CELL_SIZE * 3)(ARG0),RS_REG
/* Call quot-xt */ /* Call quot-xt */
mov NV0,ARG0 mov NV0,ARG0
@ -33,8 +36,19 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
/* Tear down register shadow area */ /* Tear down register shadow area */
add $32,STACK_REG add $32,STACK_REG
/* Undo stack alignment */ /* Undo stack alignment */
mov (STACK_REG),STACK_REG 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 POP_NONVOLATILE
ret ret

20
vm/data_heap_checker.cpp
View File

@ -42,16 +42,16 @@ struct slot_checker {
char slot_card_value = *(char *)slot_card_pointer; char slot_card_value = *(char *)slot_card_pointer;
if((slot_card_value & mask) != mask) if((slot_card_value & mask) != mask)
{ {
printf("card not marked\n"); std::cout << "card not marked" << std::endl;
printf("source generation: %d\n",gen); std::cout << "source generation: " << gen << std::endl;
printf("target generation: %d\n",target); std::cout << "target generation: " << target << std::endl;
printf("object: 0x%lx\n",(cell)obj); std::cout << "object: 0x" << std::hex << (cell)obj << std::dec << std::endl;
printf("object type: %ld\n",obj->type()); std::cout << "object type: " << obj->type() << std::endl;
printf("slot pointer: 0x%lx\n",(cell)slot_ptr); std::cout << "slot pointer: 0x" << std::hex << (cell)slot_ptr << std::dec << std::endl;
printf("slot value: 0x%lx\n",*slot_ptr); std::cout << "slot value: 0x" << std::hex << *slot_ptr << std::dec << std::endl;
printf("card of object: 0x%lx\n",object_card_pointer); std::cout << "card of object: 0x" << std::hex << object_card_pointer << std::dec << std::endl;
printf("card of slot: 0x%lx\n",slot_card_pointer); std::cout << "card of slot: 0x" << std::hex << slot_card_pointer << std::dec << std::endl;
printf("\n"); std::cout << std::endl;
parent->factorbug(); parent->factorbug();
} }
} }

9
vm/free_list.hpp
View File

@ -15,11 +15,18 @@ struct free_heap_block
cell size() const cell size() const
{ {
return header & ~7; cell size = header & ~7;
#ifdef FACTOR_DEBUG
assert(size > 0);
#endif
return size;
} }
void make_free(cell size) void make_free(cell size)
{ {
#ifdef FACTOR_DEBUG
assert(size > 0);
#endif
header = size | 1; header = size | 1;
} }
}; };

6
vm/vm.hpp
View File

@ -591,9 +591,9 @@ struct factor_vm
void primitive_vm_ptr(); void primitive_vm_ptr();
char *alien_offset(cell obj); char *alien_offset(cell obj);
void to_value_struct(cell src, void *dest, cell size); void to_value_struct(cell src, void *dest, cell size);
void box_value_struct(void *src, cell size); cell from_value_struct(void *src, cell size);
void box_small_struct(cell x, cell y, cell size); cell from_small_struct(cell x, cell y, cell size);
void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size); cell from_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
//quotations //quotations
void primitive_jit_compile(); void primitive_jit_compile();