compiler: re-architect low-level optimizer to allow more than one output value per instruction
parent
1625768a9e
commit
e27adb2830
|
@ -294,14 +294,14 @@ IN: compiler.cfg.alias-analysis.tests
|
|||
V{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##slot-imm f 2 0 1 0 }
|
||||
}
|
||||
] [
|
||||
V{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##slot-imm f 2 0 1 0 }
|
||||
} test-alias-analysis
|
||||
] unit-test
|
||||
|
@ -311,7 +311,7 @@ IN: compiler.cfg.alias-analysis.tests
|
|||
T{ ##peek f 0 D 0 }
|
||||
T{ ##peek f 1 D 1 }
|
||||
T{ ##set-slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##slot-imm f 2 0 1 0 }
|
||||
}
|
||||
] [
|
||||
|
@ -319,7 +319,7 @@ IN: compiler.cfg.alias-analysis.tests
|
|||
T{ ##peek f 0 D 0 }
|
||||
T{ ##peek f 1 D 1 }
|
||||
T{ ##set-slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##slot-imm f 2 0 1 0 }
|
||||
} test-alias-analysis
|
||||
] unit-test
|
||||
|
@ -330,7 +330,7 @@ IN: compiler.cfg.alias-analysis.tests
|
|||
T{ ##peek f 1 D 1 }
|
||||
T{ ##peek f 2 D 2 }
|
||||
T{ ##set-slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##set-slot-imm f 2 0 1 0 }
|
||||
}
|
||||
] [
|
||||
|
@ -339,7 +339,7 @@ IN: compiler.cfg.alias-analysis.tests
|
|||
T{ ##peek f 1 D 1 }
|
||||
T{ ##peek f 2 D 2 }
|
||||
T{ ##set-slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##set-slot-imm f 2 0 1 0 }
|
||||
} test-alias-analysis
|
||||
] unit-test
|
||||
|
@ -348,14 +348,14 @@ IN: compiler.cfg.alias-analysis.tests
|
|||
V{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##set-slot-imm f 1 0 1 0 }
|
||||
}
|
||||
] [
|
||||
V{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##slot-imm f 1 0 1 0 }
|
||||
T{ ##alien-invoke f "free" }
|
||||
T{ ##alien-invoke f { } { } { } 0 0 "free" }
|
||||
T{ ##set-slot-imm f 1 0 1 0 }
|
||||
} test-alias-analysis
|
||||
] unit-test
|
||||
|
|
|
@ -224,13 +224,13 @@ M: vreg-insn analyze-aliases
|
|||
! anywhere its used as a tagged pointer. Boxing allocates
|
||||
! a new value, except boxing instructions haven't been
|
||||
! inserted yet.
|
||||
dup defs-vreg [
|
||||
over defs-vreg-rep { int-rep tagged-rep } member?
|
||||
dup [
|
||||
{ int-rep tagged-rep } member?
|
||||
[ set-heap-ac ] [ set-new-ac ] if
|
||||
] when* ;
|
||||
] each-def-rep ;
|
||||
|
||||
M: ##phi analyze-aliases
|
||||
dup defs-vreg set-heap-ac ;
|
||||
dup dst>> set-heap-ac ;
|
||||
|
||||
M: ##allocation analyze-aliases
|
||||
#! A freshly allocated object is distinct from any other
|
||||
|
|
|
@ -21,9 +21,9 @@ M:: ##local-allot compute-stack-frame* ( insn -- )
|
|||
allot-area-align [ a max ] change
|
||||
allot-area-size [ a align [ insn offset<< ] [ s + ] bi ] change ;
|
||||
|
||||
M: ##stack-frame compute-stack-frame*
|
||||
M: alien-call-insn compute-stack-frame*
|
||||
frame-required
|
||||
stack-frame>> param-area-size [ max ] change ;
|
||||
stack-size>> param-area-size [ max ] change ;
|
||||
|
||||
: vm-frame-required ( -- )
|
||||
frame-required
|
||||
|
@ -33,8 +33,8 @@ M: ##call-gc compute-stack-frame* drop vm-frame-required ;
|
|||
M: ##box compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##unbox compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##box-long-long compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##begin-callback compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##end-callback compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##callback-inputs compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##callback-outputs compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##unary-float-function compute-stack-frame* drop vm-frame-required ;
|
||||
M: ##binary-float-function compute-stack-frame* drop vm-frame-required ;
|
||||
|
||||
|
|
|
@ -14,6 +14,19 @@ compiler.cfg.registers compiler.cfg.hats ;
|
|||
FROM: compiler.errors => no-such-symbol no-such-library ;
|
||||
IN: compiler.cfg.builder.alien
|
||||
|
||||
: with-param-regs* ( quot -- reg-values stack-values )
|
||||
'[
|
||||
V{ } clone reg-values set
|
||||
V{ } clone stack-values set
|
||||
@
|
||||
reg-values get
|
||||
stack-values get
|
||||
stack-params get
|
||||
struct-return-area get
|
||||
] with-param-regs
|
||||
struct-return-area set
|
||||
stack-params set ; inline
|
||||
|
||||
: unbox-parameters ( parameters -- vregs reps )
|
||||
[
|
||||
[ length iota <reversed> ] keep
|
||||
|
@ -30,32 +43,23 @@ IN: compiler.cfg.builder.alien
|
|||
] keep
|
||||
] [ drop f ] if ;
|
||||
|
||||
: caller-parameter ( vreg rep on-stack? -- insn )
|
||||
[ dup reg-class-of reg-class-full? ] dip or
|
||||
[ [ alloc-stack-param ] keep \ ##store-stack-param new-insn ]
|
||||
[ [ next-reg-param ] keep \ ##store-reg-param new-insn ]
|
||||
if ;
|
||||
|
||||
: (caller-parameters) ( vregs reps -- )
|
||||
! Place ##store-stack-param instructions first. This ensures
|
||||
! that no registers are used after the ##store-reg-param
|
||||
! instructions.
|
||||
[ first2 caller-parameter ] 2map
|
||||
[ ##store-stack-param? ] partition [ % ] bi@ ;
|
||||
[ first2 next-parameter ] 2each ;
|
||||
|
||||
: caller-parameters ( params -- stack-size )
|
||||
: caller-parameters ( params -- reg-inputs stack-inputs )
|
||||
[ abi>> ] [ parameters>> ] [ return>> ] tri
|
||||
'[
|
||||
_ unbox-parameters
|
||||
_ prepare-struct-caller struct-return-area set
|
||||
(caller-parameters)
|
||||
stack-params get
|
||||
struct-return-area get
|
||||
] with-param-regs
|
||||
struct-return-area set ;
|
||||
] with-param-regs* ;
|
||||
|
||||
: box-return* ( node -- )
|
||||
return>> [ ] [ base-type box-return ds-push ] if-void ;
|
||||
: prepare-caller-return ( params -- reg-outputs )
|
||||
return>> [ { } ] [ base-type load-return ] if-void ;
|
||||
|
||||
: caller-stack-frame ( params -- cleanup stack-size )
|
||||
[ stack-params get ] dip [ return>> ] [ abi>> ] bi stack-cleanup
|
||||
stack-params get ;
|
||||
|
||||
GENERIC# dlsym-valid? 1 ( symbols dll -- ? )
|
||||
|
||||
|
@ -79,79 +83,91 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
|
|||
} 2cleave
|
||||
4array ;
|
||||
|
||||
: alien-invoke-dlsym ( params -- symbols dll )
|
||||
: caller-linkage ( params -- symbols dll )
|
||||
[ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
|
||||
[ library>> load-library ]
|
||||
bi 2dup check-dlsym ;
|
||||
|
||||
: emit-stack-frame ( stack-size params -- )
|
||||
[ [ return>> ] [ abi>> ] bi stack-cleanup ##cleanup ]
|
||||
[ drop ##stack-frame ]
|
||||
2bi ;
|
||||
: caller-return ( params -- )
|
||||
return>> [ ] [
|
||||
[
|
||||
building get last reg-outputs>>
|
||||
flip [ { } { } ] [ first2 ] if-empty
|
||||
] dip
|
||||
base-type box-return ds-push
|
||||
] if-void ;
|
||||
|
||||
M: #alien-invoke emit-node
|
||||
params>>
|
||||
{
|
||||
[ caller-parameters ]
|
||||
[ ##prepare-var-args alien-invoke-dlsym <gc-map> ##alien-invoke ]
|
||||
[ emit-stack-frame ]
|
||||
[ box-return* ]
|
||||
} cleave ;
|
||||
[
|
||||
{
|
||||
[ caller-parameters ]
|
||||
[ prepare-caller-return ]
|
||||
[ caller-stack-frame ]
|
||||
[ caller-linkage ]
|
||||
} cleave
|
||||
<gc-map> ##alien-invoke
|
||||
]
|
||||
[ caller-return ]
|
||||
bi ;
|
||||
|
||||
M: #alien-indirect emit-node ( node -- )
|
||||
params>>
|
||||
[
|
||||
ds-pop ^^unbox-any-c-ptr
|
||||
[ caller-parameters ] dip
|
||||
[ ds-pop ^^unbox-any-c-ptr ] dip
|
||||
[ caller-parameters ]
|
||||
[ prepare-caller-return ]
|
||||
[ caller-stack-frame ] tri
|
||||
<gc-map> ##alien-indirect
|
||||
]
|
||||
[ emit-stack-frame ]
|
||||
[ box-return* ]
|
||||
tri ;
|
||||
[ caller-return ]
|
||||
bi ;
|
||||
|
||||
M: #alien-assembly emit-node
|
||||
params>> {
|
||||
[ caller-parameters ]
|
||||
[ quot>> <gc-map> ##alien-assembly ]
|
||||
[ emit-stack-frame ]
|
||||
[ box-return* ]
|
||||
} cleave ;
|
||||
params>>
|
||||
[
|
||||
{
|
||||
[ caller-parameters ]
|
||||
[ prepare-caller-return ]
|
||||
[ caller-stack-frame ]
|
||||
[ quot>> ]
|
||||
} cleave <gc-map> ##alien-assembly
|
||||
]
|
||||
[ caller-return ]
|
||||
bi ;
|
||||
|
||||
: callee-parameter ( rep on-stack? -- dst insn )
|
||||
[ next-vreg dup ] 2dip
|
||||
[ dup reg-class-of reg-class-full? ] dip or
|
||||
[ [ alloc-stack-param ] keep \ ##load-stack-param new-insn ]
|
||||
[ [ next-reg-param ] keep \ ##load-reg-param new-insn ]
|
||||
if ;
|
||||
: callee-parameter ( rep on-stack? -- dst )
|
||||
[ next-vreg dup ] 2dip next-parameter ;
|
||||
|
||||
: prepare-struct-callee ( c-type -- vreg )
|
||||
large-struct?
|
||||
[ int-rep struct-return-on-stack? callee-parameter , ] [ f ] if ;
|
||||
[ int-rep struct-return-on-stack? callee-parameter ] [ f ] if ;
|
||||
|
||||
: (callee-parameters) ( params -- vregs reps )
|
||||
[ flatten-parameter-type ] map
|
||||
[
|
||||
[ [ first2 callee-parameter ] 1 2 mnmap ] 1 2 mnmap
|
||||
concat [ ##load-reg-param? ] partition [ % ] bi@
|
||||
]
|
||||
[ [ [ first2 callee-parameter ] map ] map ]
|
||||
[ [ keys ] map ]
|
||||
bi ;
|
||||
|
||||
: box-parameters ( vregs reps params -- )
|
||||
##begin-callback [ box-parameter ds-push ] 3each ;
|
||||
parameters>> [ base-type box-parameter ds-push ] 3each ;
|
||||
|
||||
: callee-parameters ( params -- stack-size )
|
||||
: callee-parameters ( params -- vregs reps reg-outputs stack-outputs )
|
||||
[ abi>> ] [ return>> ] [ parameters>> ] tri
|
||||
'[
|
||||
_ prepare-struct-callee struct-return-area set
|
||||
_ [ base-type ] map [ (callee-parameters) ] [ box-parameters ] bi
|
||||
stack-params get
|
||||
struct-return-area get
|
||||
] with-param-regs
|
||||
struct-return-area set ;
|
||||
_ [ base-type ] map (callee-parameters)
|
||||
] with-param-regs* ;
|
||||
|
||||
: callback-stack-cleanup ( stack-size params -- )
|
||||
[ nip xt>> ] [ [ return>> ] [ abi>> ] bi stack-cleanup ] 2bi
|
||||
: callee-return ( params -- reg-inputs )
|
||||
return>> [ { } ] [
|
||||
[ ds-pop ] dip
|
||||
base-type unbox-return store-return
|
||||
] if-void ;
|
||||
|
||||
: callback-stack-cleanup ( params -- )
|
||||
[ xt>> ]
|
||||
[ [ stack-params get ] dip [ return>> ] [ abi>> ] bi stack-cleanup ] bi
|
||||
"stack-cleanup" set-word-prop ;
|
||||
|
||||
: needs-frame-pointer ( -- )
|
||||
|
@ -165,20 +181,15 @@ M: #alien-callback emit-node
|
|||
begin-word
|
||||
|
||||
{
|
||||
[ callee-parameters ]
|
||||
[ callee-parameters ##callback-inputs ]
|
||||
[ box-parameters ]
|
||||
[
|
||||
[
|
||||
make-kill-block
|
||||
quot>> ##alien-callback
|
||||
] emit-trivial-block
|
||||
]
|
||||
[
|
||||
return>> [ ##end-callback ] [
|
||||
[ ds-pop ] dip
|
||||
##end-callback
|
||||
base-type unbox-return
|
||||
] if-void
|
||||
]
|
||||
[ callee-return ##callback-outputs ]
|
||||
[ callback-stack-cleanup ]
|
||||
} cleave
|
||||
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types arrays assocs classes.struct fry
|
||||
kernel layouts locals math namespaces sequences
|
||||
sequences.generalizations system
|
||||
USING: accessors alien.c-types arrays assocs combinators
|
||||
classes.struct fry kernel layouts locals math namespaces
|
||||
sequences sequences.generalizations system
|
||||
compiler.cfg.builder.alien.params compiler.cfg.hats
|
||||
compiler.cfg.instructions cpu.architecture ;
|
||||
compiler.cfg.registers compiler.cfg.instructions cpu.architecture ;
|
||||
IN: compiler.cfg.builder.alien.boxing
|
||||
|
||||
SYMBOL: struct-return-area
|
||||
|
@ -45,15 +45,23 @@ M: struct-c-type flatten-c-type
|
|||
GENERIC: unbox ( src c-type -- vregs reps )
|
||||
|
||||
M: c-type unbox
|
||||
[ unboxer>> ] [ rep>> ] bi
|
||||
[ ^^unbox 1array ] [ nip f 2array 1array ] 2bi ;
|
||||
[ rep>> ] [ unboxer>> ] bi
|
||||
[
|
||||
{
|
||||
! { "to_float" [ drop ] }
|
||||
! { "to_double" [ drop ] }
|
||||
! { "alien_offset" [ drop ^^unbox-any-c-ptr ] }
|
||||
[ swap ^^unbox ]
|
||||
} case 1array
|
||||
]
|
||||
[ drop f 2array 1array ] 2bi ;
|
||||
|
||||
M: long-long-type unbox
|
||||
[ 8 cell f ^^local-allot ] dip '[ _ unboxer>> ##unbox-long-long ] keep
|
||||
0 cell [ int-rep f ^^load-memory-imm ] bi-curry@ bi 2array
|
||||
int-rep long-long-on-stack? 2array dup 2array ;
|
||||
|
||||
M: struct-c-type unbox ( src c-type -- vregs )
|
||||
M: struct-c-type unbox ( src c-type -- vregs reps )
|
||||
[ ^^unbox-any-c-ptr ] dip explode-struct ;
|
||||
|
||||
: frob-struct ( c-type -- c-type )
|
||||
|
@ -73,42 +81,41 @@ M: struct-c-type unbox-parameter
|
|||
1array { { int-rep f } }
|
||||
] if ;
|
||||
|
||||
GENERIC: unbox-return ( src c-type -- )
|
||||
: store-return ( vregs reps -- triples )
|
||||
[ [ dup next-return-reg 3array ] 2map ] with-return-regs ;
|
||||
|
||||
: store-return ( vregs reps -- )
|
||||
[
|
||||
[ [ next-return-reg ] keep ##store-reg-param ] 2each
|
||||
] with-return-regs ;
|
||||
GENERIC: unbox-return ( src c-type -- vregs reps )
|
||||
|
||||
: (unbox-return) ( src c-type -- vregs reps )
|
||||
M: abstract-c-type unbox-return
|
||||
! Don't care about on-stack? flag when looking at return
|
||||
! values.
|
||||
unbox keys ;
|
||||
|
||||
M: c-type unbox-return (unbox-return) store-return ;
|
||||
|
||||
M: long-long-type unbox-return (unbox-return) store-return ;
|
||||
|
||||
M: struct-c-type unbox-return
|
||||
dup return-struct-in-registers?
|
||||
[ (unbox-return) store-return ]
|
||||
[ [ struct-return-area get ] 2dip (unbox-return) implode-struct ] if ;
|
||||
[ call-next-method ]
|
||||
[ [ struct-return-area get ] 2dip unbox keys implode-struct { } { } ] if ;
|
||||
|
||||
GENERIC: flatten-parameter-type ( c-type -- reps )
|
||||
|
||||
M: c-type flatten-parameter-type flatten-c-type ;
|
||||
|
||||
M: long-long-type flatten-parameter-type flatten-c-type ;
|
||||
M: abstract-c-type flatten-parameter-type flatten-c-type ;
|
||||
|
||||
M: struct-c-type flatten-parameter-type frob-struct flatten-c-type ;
|
||||
|
||||
GENERIC: box ( vregs reps c-type -- dst )
|
||||
|
||||
M: c-type box
|
||||
[ first ] [ drop ] [ [ boxer>> ] [ rep>> ] bi ] tri* <gc-map> ^^box ;
|
||||
[ [ first ] bi@ ] [ boxer>> ] bi*
|
||||
{
|
||||
! { "from_float" [ drop ] }
|
||||
! { "from_double" [ drop ] }
|
||||
! { "allot_alien" [ drop ^^box-alien ] }
|
||||
[ swap <gc-map> ^^box ]
|
||||
} case ;
|
||||
|
||||
M: long-long-type box
|
||||
[ first2 ] [ drop ] [ boxer>> ] tri* <gc-map> ^^box-long-long ;
|
||||
[ first2 ] [ drop ] [ boxer>> ] tri*
|
||||
<gc-map> ^^box-long-long ;
|
||||
|
||||
M: struct-c-type box
|
||||
'[ _ heap-size <gc-map> ^^allot-byte-array dup ^^unbox-byte-array ] 2dip
|
||||
|
@ -116,30 +123,35 @@ M: struct-c-type box
|
|||
|
||||
GENERIC: box-parameter ( vregs reps c-type -- dst )
|
||||
|
||||
M: c-type box-parameter box ;
|
||||
|
||||
M: long-long-type box-parameter box ;
|
||||
M: abstract-c-type box-parameter box ;
|
||||
|
||||
M: struct-c-type box-parameter
|
||||
dup value-struct?
|
||||
[ [ [ drop first ] dip explode-struct keys ] keep ] unless
|
||||
box ;
|
||||
|
||||
GENERIC: box-return ( c-type -- dst )
|
||||
GENERIC: load-return ( c-type -- triples )
|
||||
|
||||
: load-return ( c-type -- vregs reps )
|
||||
M: abstract-c-type load-return
|
||||
[
|
||||
flatten-c-type keys
|
||||
[ [ [ next-return-reg ] keep ^^load-reg-param ] map ] keep
|
||||
[ [ next-vreg ] dip dup next-return-reg 3array ] map
|
||||
] with-return-regs ;
|
||||
|
||||
M: c-type box-return [ load-return ] keep box ;
|
||||
M: struct-c-type load-return
|
||||
dup return-struct-in-registers?
|
||||
[ call-next-method ] [ drop { } ] if ;
|
||||
|
||||
M: long-long-type box-return [ load-return ] keep box ;
|
||||
GENERIC: box-return ( vregs reps c-type -- dst )
|
||||
|
||||
M: abstract-c-type box-return box ;
|
||||
|
||||
M: struct-c-type box-return
|
||||
dup return-struct-in-registers?
|
||||
[ call-next-method ]
|
||||
[
|
||||
dup return-struct-in-registers?
|
||||
[ load-return ]
|
||||
[ [ struct-return-area get ] dip explode-struct keys ] if
|
||||
] keep box ;
|
||||
[
|
||||
[ [ { } assert-sequence= ] bi@ struct-return-area get ] dip
|
||||
explode-struct keys
|
||||
] keep box
|
||||
] if ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: cpu.architecture fry kernel layouts math math.order
|
||||
namespaces sequences vectors assocs ;
|
||||
namespaces sequences vectors assocs arrays ;
|
||||
IN: compiler.cfg.builder.alien.params
|
||||
|
||||
SYMBOL: stack-params
|
||||
|
@ -47,6 +47,13 @@ M: double-rep next-reg-param
|
|||
: with-param-regs ( abi quot -- )
|
||||
'[ param-regs init-regs 0 stack-params set @ ] with-scope ; inline
|
||||
|
||||
SYMBOLS: stack-values reg-values ;
|
||||
|
||||
: next-parameter ( vreg rep on-stack? -- )
|
||||
[ dup dup reg-class-of reg-class-full? ] dip or
|
||||
[ alloc-stack-param stack-values ] [ next-reg-param reg-values ] if
|
||||
[ 3array ] dip get push ;
|
||||
|
||||
: next-return-reg ( rep -- reg ) reg-class-of get pop ;
|
||||
|
||||
: with-return-regs ( quot -- )
|
||||
|
|
|
@ -46,7 +46,7 @@ M: ##phi visit-insn
|
|||
] if ;
|
||||
|
||||
M: vreg-insn visit-insn
|
||||
defs-vreg [ dup record-copy ] when* ;
|
||||
defs-vregs [ dup record-copy ] each ;
|
||||
|
||||
M: insn visit-insn drop ;
|
||||
|
||||
|
|
|
@ -28,11 +28,11 @@ SYMBOL: allocations
|
|||
|
||||
GENERIC: build-liveness-graph ( insn -- )
|
||||
|
||||
: add-edges ( insn register -- )
|
||||
[ uses-vregs ] dip liveness-graph get [ union ] change-at ;
|
||||
: add-edges ( uses def -- )
|
||||
liveness-graph get [ union ] change-at ;
|
||||
|
||||
: setter-liveness-graph ( insn vreg -- )
|
||||
dup allocation? [ add-edges ] [ 2drop ] if ;
|
||||
dup allocation? [ [ uses-vregs ] dip add-edges ] [ 2drop ] if ;
|
||||
|
||||
M: ##set-slot build-liveness-graph
|
||||
dup obj>> setter-liveness-graph ;
|
||||
|
@ -50,7 +50,7 @@ M: ##allot build-liveness-graph
|
|||
[ dst>> allocations get adjoin ] [ call-next-method ] bi ;
|
||||
|
||||
M: vreg-insn build-liveness-graph
|
||||
dup defs-vreg dup [ add-edges ] [ 2drop ] if ;
|
||||
[ uses-vregs ] [ defs-vregs ] bi [ add-edges ] with each ;
|
||||
|
||||
M: insn build-liveness-graph drop ;
|
||||
|
||||
|
@ -83,14 +83,9 @@ M: ##write-barrier compute-live-vregs
|
|||
M: ##write-barrier-imm compute-live-vregs
|
||||
dup src>> setter-live-vregs ;
|
||||
|
||||
M: ##fixnum-add compute-live-vregs record-live ;
|
||||
M: flushable-insn compute-live-vregs drop ;
|
||||
|
||||
M: ##fixnum-sub compute-live-vregs record-live ;
|
||||
|
||||
M: ##fixnum-mul compute-live-vregs record-live ;
|
||||
|
||||
M: vreg-insn compute-live-vregs
|
||||
dup defs-vreg [ drop ] [ record-live ] if ;
|
||||
M: vreg-insn compute-live-vregs record-live ;
|
||||
|
||||
M: insn compute-live-vregs drop ;
|
||||
|
||||
|
@ -104,15 +99,9 @@ M: ##write-barrier live-insn? src>> live-vreg? ;
|
|||
|
||||
M: ##write-barrier-imm live-insn? src>> live-vreg? ;
|
||||
|
||||
M: ##fixnum-add live-insn? drop t ;
|
||||
M: flushable-insn live-insn? defs-vregs [ live-vreg? ] any? ;
|
||||
|
||||
M: ##fixnum-sub live-insn? drop t ;
|
||||
|
||||
M: ##fixnum-mul live-insn? drop t ;
|
||||
|
||||
M: vreg-insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
|
||||
|
||||
M: insn live-insn? defs-vreg drop t ;
|
||||
M: insn live-insn? drop t ;
|
||||
|
||||
: eliminate-dead-code ( cfg -- cfg' )
|
||||
! Even though we don't use predecessors directly, we depend
|
||||
|
|
|
@ -121,7 +121,7 @@ M: rs-loc pprint* \ R pprint-loc ;
|
|||
post-order [
|
||||
instructions>> [
|
||||
[ [ temp-vregs ] [ temp-vreg-reps ] bi zip ]
|
||||
[ [ defs-vreg ] [ defs-vreg-rep ] bi 2dup and [ 2array ] [ 2drop f ] if ]
|
||||
bi [ suffix ] when*
|
||||
[ [ defs-vregs ] [ defs-vreg-reps ] bi zip ]
|
||||
bi append
|
||||
] map concat
|
||||
] map concat >hashtable representations set ;
|
||||
|
|
|
@ -33,4 +33,4 @@ V{
|
|||
5 6 edge
|
||||
|
||||
cfg new 1 get >>entry 0 set
|
||||
[ ] [ 0 get [ compute-defs ] [ compute-uses ] bi ] unit-test
|
||||
[ ] [ 0 get compute-defs ] unit-test
|
||||
|
|
|
@ -9,16 +9,14 @@ FROM: namespaces => set ;
|
|||
FROM: sets => members ;
|
||||
IN: compiler.cfg.def-use
|
||||
|
||||
GENERIC: defs-vreg ( insn -- vreg/f )
|
||||
GENERIC: defs-vregs ( insn -- seq )
|
||||
GENERIC: temp-vregs ( insn -- seq )
|
||||
GENERIC: uses-vregs ( insn -- seq )
|
||||
|
||||
M: insn defs-vreg drop f ;
|
||||
M: insn defs-vregs drop { } ;
|
||||
M: insn temp-vregs drop { } ;
|
||||
M: insn uses-vregs drop { } ;
|
||||
|
||||
M: ##phi uses-vregs inputs>> values ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: slot-array-quot ( slots -- quot )
|
||||
|
@ -29,33 +27,55 @@ M: ##phi uses-vregs inputs>> values ;
|
|||
[ '[ _ cleave _ narray ] ]
|
||||
} case ;
|
||||
|
||||
: define-defs-vreg-method ( insn -- )
|
||||
dup insn-def-slot dup [
|
||||
[ \ defs-vreg create-method ]
|
||||
[ name>> reader-word 1quotation ] bi*
|
||||
: define-vregs-method ( insn slots word -- )
|
||||
[ [ drop ] ] dip '[
|
||||
[ _ create-method ]
|
||||
[ [ name>> ] map slot-array-quot ] bi*
|
||||
define
|
||||
] [ 2drop ] if ;
|
||||
] if-empty ; inline
|
||||
|
||||
: define-defs-vregs-method ( insn -- )
|
||||
dup insn-def-slots \ defs-vregs define-vregs-method ;
|
||||
|
||||
: define-uses-vregs-method ( insn -- )
|
||||
dup insn-use-slots [ drop ] [
|
||||
[ \ uses-vregs create-method ]
|
||||
[ [ name>> ] map slot-array-quot ] bi*
|
||||
define
|
||||
] if-empty ;
|
||||
dup insn-use-slots \ uses-vregs define-vregs-method ;
|
||||
|
||||
: define-temp-vregs-method ( insn -- )
|
||||
dup insn-temp-slots [ drop ] [
|
||||
[ \ temp-vregs create-method ]
|
||||
[ [ name>> ] map slot-array-quot ] bi*
|
||||
define
|
||||
] if-empty ;
|
||||
dup insn-temp-slots \ temp-vregs define-vregs-method ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
CONSTANT: special-vreg-insns
|
||||
{ ##phi ##alien-invoke ##alien-indirect ##alien-assembly ##callback-inputs ##callback-outputs }
|
||||
|
||||
M: ##phi defs-vregs dst>> 1array ;
|
||||
|
||||
M: alien-call-insn defs-vregs
|
||||
reg-outputs>> [ first ] map ;
|
||||
|
||||
M: ##callback-inputs defs-vregs
|
||||
[ reg-outputs>> ] [ stack-outputs>> ] bi append [ first ] map ;
|
||||
|
||||
M: ##callback-outputs defs-vregs drop { } ;
|
||||
|
||||
M: ##phi uses-vregs inputs>> values ;
|
||||
|
||||
M: alien-call-insn uses-vregs
|
||||
[ reg-inputs>> ] [ stack-inputs>> ] bi append [ first ] map ;
|
||||
|
||||
M: ##alien-indirect uses-vregs
|
||||
[ call-next-method ] [ src>> ] bi prefix ;
|
||||
|
||||
M: ##callback-inputs uses-vregs
|
||||
drop { } ;
|
||||
|
||||
M: ##callback-outputs uses-vregs
|
||||
reg-inputs>> [ first ] map ;
|
||||
|
||||
[
|
||||
insn-classes get
|
||||
[ [ define-defs-vreg-method ] each ]
|
||||
[ { ##phi } diff [ define-uses-vregs-method ] each ]
|
||||
[ special-vreg-insns diff [ define-defs-vregs-method ] each ]
|
||||
[ special-vreg-insns diff [ define-uses-vregs-method ] each ]
|
||||
[ [ define-temp-vregs-method ] each ]
|
||||
tri
|
||||
] with-compilation-unit
|
||||
|
@ -69,7 +89,7 @@ SYMBOLS: defs insns uses ;
|
|||
: insn-of ( vreg -- insn ) insns get at ;
|
||||
|
||||
: set-def-of ( obj insn assoc -- )
|
||||
swap defs-vreg dup [ swap set-at ] [ 3drop ] if ;
|
||||
swap defs-vregs [ swap set-at ] with with each ;
|
||||
|
||||
: compute-defs ( cfg -- )
|
||||
H{ } clone [
|
||||
|
@ -89,16 +109,3 @@ SYMBOLS: defs insns uses ;
|
|||
] each
|
||||
] each-basic-block
|
||||
] keep insns set ;
|
||||
|
||||
:: compute-uses ( cfg -- )
|
||||
! Here, a phi node uses its argument in the block that it comes from.
|
||||
H{ } clone :> use
|
||||
cfg [| block |
|
||||
block instructions>> [
|
||||
dup ##phi?
|
||||
[ inputs>> [ use adjoin-at ] assoc-each ]
|
||||
[ uses-vregs [ block swap use adjoin-at ] each ]
|
||||
if
|
||||
] each
|
||||
] each-basic-block
|
||||
use [ members ] assoc-map uses set ;
|
||||
|
|
|
@ -45,7 +45,7 @@ M: node hashcode* nip number>> ;
|
|||
! we only care about local def-use
|
||||
H{ } clone :> definers
|
||||
nodes [| node |
|
||||
node insn>> defs-vreg [ node swap definers set-at ] when*
|
||||
node insn>> defs-vregs [ node swap definers set-at ] each
|
||||
node insn>> uses-vregs [ definers at [ node +data+ precedes ] when* ] each
|
||||
] each ;
|
||||
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: kernel compiler.cfg.gc-checks
|
||||
compiler.cfg.representations compiler.cfg.save-contexts
|
||||
compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
|
||||
compiler.cfg.linear-scan compiler.cfg.scheduling
|
||||
compiler.cfg.linear-scan
|
||||
compiler.cfg.stacks.uninitialized ;
|
||||
IN: compiler.cfg.finalization
|
||||
|
||||
|
|
|
@ -61,9 +61,7 @@ M: insn gc-check-offsets* 2drop ;
|
|||
GENERIC: allocation-size* ( insn -- n )
|
||||
|
||||
M: ##allot allocation-size* size>> ;
|
||||
|
||||
M: ##box-alien allocation-size* drop 5 cells ;
|
||||
|
||||
M: ##box-displaced-alien allocation-size* drop 5 cells ;
|
||||
|
||||
: allocation-size ( insns -- n )
|
||||
|
|
|
@ -36,7 +36,7 @@ IN: compiler.cfg.hats
|
|||
PRIVATE>
|
||||
|
||||
insn-classes get [
|
||||
dup [ insn-def-slot ] [ name>> "##" head? ] bi and
|
||||
dup [ insn-def-slots length 1 = ] [ name>> "##" head? ] bi and
|
||||
[ define-hat ] [ drop ] if
|
||||
] each
|
||||
|
||||
|
|
|
@ -19,42 +19,46 @@ TUPLE: insn ;
|
|||
! Instructions which use vregs
|
||||
TUPLE: vreg-insn < insn ;
|
||||
|
||||
! Instructions which do not have side effects; used for
|
||||
! dead code elimination
|
||||
TUPLE: flushable-insn < vreg-insn ;
|
||||
|
||||
! Instructions which are referentially transparent; used for
|
||||
! value numbering
|
||||
TUPLE: pure-insn < vreg-insn ;
|
||||
TUPLE: foldable-insn < flushable-insn ;
|
||||
|
||||
! Constants
|
||||
INSN: ##load-integer
|
||||
FOLDABLE-INSN: ##load-integer
|
||||
def: dst/int-rep
|
||||
literal: val ;
|
||||
|
||||
INSN: ##load-reference
|
||||
FOLDABLE-INSN: ##load-reference
|
||||
def: dst/tagged-rep
|
||||
literal: obj ;
|
||||
|
||||
! These three are inserted by representation selection
|
||||
INSN: ##load-tagged
|
||||
! These four are inserted by representation selection
|
||||
FLUSHABLE-INSN: ##load-tagged
|
||||
def: dst/tagged-rep
|
||||
literal: val ;
|
||||
|
||||
INSN: ##load-float
|
||||
FLUSHABLE-INSN: ##load-float
|
||||
def: dst/float-rep
|
||||
literal: val ;
|
||||
|
||||
INSN: ##load-double
|
||||
FLUSHABLE-INSN: ##load-double
|
||||
def: dst/double-rep
|
||||
literal: val ;
|
||||
|
||||
INSN: ##load-vector
|
||||
FLUSHABLE-INSN: ##load-vector
|
||||
def: dst
|
||||
literal: val rep ;
|
||||
|
||||
! Stack operations
|
||||
INSN: ##peek
|
||||
FLUSHABLE-INSN: ##peek
|
||||
def: dst/tagged-rep
|
||||
literal: loc ;
|
||||
|
||||
INSN: ##replace
|
||||
VREG-INSN: ##replace
|
||||
use: src/tagged-rep
|
||||
literal: loc ;
|
||||
|
||||
|
@ -84,750 +88,732 @@ INSN: ##return ;
|
|||
INSN: ##no-tco ;
|
||||
|
||||
! Jump tables
|
||||
INSN: ##dispatch
|
||||
VREG-INSN: ##dispatch
|
||||
use: src/int-rep
|
||||
temp: temp/int-rep ;
|
||||
|
||||
! Slot access
|
||||
INSN: ##slot
|
||||
FLUSHABLE-INSN: ##slot
|
||||
def: dst/tagged-rep
|
||||
use: obj/tagged-rep slot/int-rep
|
||||
literal: scale tag ;
|
||||
|
||||
INSN: ##slot-imm
|
||||
FLUSHABLE-INSN: ##slot-imm
|
||||
def: dst/tagged-rep
|
||||
use: obj/tagged-rep
|
||||
literal: slot tag ;
|
||||
|
||||
INSN: ##set-slot
|
||||
VREG-INSN: ##set-slot
|
||||
use: src/tagged-rep obj/tagged-rep slot/int-rep
|
||||
literal: scale tag ;
|
||||
|
||||
INSN: ##set-slot-imm
|
||||
VREG-INSN: ##set-slot-imm
|
||||
use: src/tagged-rep obj/tagged-rep
|
||||
literal: slot tag ;
|
||||
|
||||
! Register transfers
|
||||
INSN: ##copy
|
||||
FOLDABLE-INSN: ##copy
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##tagged>integer
|
||||
FOLDABLE-INSN: ##tagged>integer
|
||||
def: dst/int-rep
|
||||
use: src/tagged-rep ;
|
||||
|
||||
! Integer arithmetic
|
||||
PURE-INSN: ##add
|
||||
FOLDABLE-INSN: ##add
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##add-imm
|
||||
FOLDABLE-INSN: ##add-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##sub
|
||||
FOLDABLE-INSN: ##sub
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##sub-imm
|
||||
FOLDABLE-INSN: ##sub-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##mul
|
||||
FOLDABLE-INSN: ##mul
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##mul-imm
|
||||
FOLDABLE-INSN: ##mul-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##and
|
||||
FOLDABLE-INSN: ##and
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##and-imm
|
||||
FOLDABLE-INSN: ##and-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##or
|
||||
FOLDABLE-INSN: ##or
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##or-imm
|
||||
FOLDABLE-INSN: ##or-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##xor
|
||||
FOLDABLE-INSN: ##xor
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##xor-imm
|
||||
FOLDABLE-INSN: ##xor-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##shl
|
||||
FOLDABLE-INSN: ##shl
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##shl-imm
|
||||
FOLDABLE-INSN: ##shl-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##shr
|
||||
FOLDABLE-INSN: ##shr
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##shr-imm
|
||||
FOLDABLE-INSN: ##shr-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##sar
|
||||
FOLDABLE-INSN: ##sar
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##sar-imm
|
||||
FOLDABLE-INSN: ##sar-imm
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 ;
|
||||
|
||||
PURE-INSN: ##min
|
||||
FOLDABLE-INSN: ##min
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##max
|
||||
FOLDABLE-INSN: ##max
|
||||
def: dst/int-rep
|
||||
use: src1/int-rep src2/int-rep ;
|
||||
|
||||
PURE-INSN: ##not
|
||||
FOLDABLE-INSN: ##not
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
|
||||
PURE-INSN: ##neg
|
||||
FOLDABLE-INSN: ##neg
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
|
||||
PURE-INSN: ##log2
|
||||
FOLDABLE-INSN: ##log2
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
|
||||
PURE-INSN: ##bit-count
|
||||
FOLDABLE-INSN: ##bit-count
|
||||
def: dst/int-rep
|
||||
use: src/int-rep ;
|
||||
|
||||
! Float arithmetic
|
||||
PURE-INSN: ##add-float
|
||||
FOLDABLE-INSN: ##add-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
||||
PURE-INSN: ##sub-float
|
||||
FOLDABLE-INSN: ##sub-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
||||
PURE-INSN: ##mul-float
|
||||
FOLDABLE-INSN: ##mul-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
||||
PURE-INSN: ##div-float
|
||||
FOLDABLE-INSN: ##div-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
||||
PURE-INSN: ##min-float
|
||||
FOLDABLE-INSN: ##min-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
||||
PURE-INSN: ##max-float
|
||||
FOLDABLE-INSN: ##max-float
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep ;
|
||||
|
||||
PURE-INSN: ##sqrt
|
||||
FOLDABLE-INSN: ##sqrt
|
||||
def: dst/double-rep
|
||||
use: src/double-rep ;
|
||||
|
||||
! libc intrinsics
|
||||
PURE-INSN: ##unary-float-function
|
||||
FOLDABLE-INSN: ##unary-float-function
|
||||
def: dst/double-rep
|
||||
use: src/double-rep
|
||||
literal: func ;
|
||||
|
||||
PURE-INSN: ##binary-float-function
|
||||
FOLDABLE-INSN: ##binary-float-function
|
||||
def: dst/double-rep
|
||||
use: src1/double-rep src2/double-rep
|
||||
literal: func ;
|
||||
|
||||
! Single/double float conversion
|
||||
PURE-INSN: ##single>double-float
|
||||
FOLDABLE-INSN: ##single>double-float
|
||||
def: dst/double-rep
|
||||
use: src/float-rep ;
|
||||
|
||||
PURE-INSN: ##double>single-float
|
||||
FOLDABLE-INSN: ##double>single-float
|
||||
def: dst/float-rep
|
||||
use: src/double-rep ;
|
||||
|
||||
! Float/integer conversion
|
||||
PURE-INSN: ##float>integer
|
||||
FOLDABLE-INSN: ##float>integer
|
||||
def: dst/int-rep
|
||||
use: src/double-rep ;
|
||||
|
||||
PURE-INSN: ##integer>float
|
||||
FOLDABLE-INSN: ##integer>float
|
||||
def: dst/double-rep
|
||||
use: src/int-rep ;
|
||||
|
||||
! SIMD operations
|
||||
PURE-INSN: ##zero-vector
|
||||
FOLDABLE-INSN: ##zero-vector
|
||||
def: dst
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##fill-vector
|
||||
FOLDABLE-INSN: ##fill-vector
|
||||
def: dst
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##gather-vector-2
|
||||
FOLDABLE-INSN: ##gather-vector-2
|
||||
def: dst
|
||||
use: src1/scalar-rep src2/scalar-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##gather-int-vector-2
|
||||
FOLDABLE-INSN: ##gather-int-vector-2
|
||||
def: dst
|
||||
use: src1/int-rep src2/int-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##gather-vector-4
|
||||
FOLDABLE-INSN: ##gather-vector-4
|
||||
def: dst
|
||||
use: src1/scalar-rep src2/scalar-rep src3/scalar-rep src4/scalar-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##gather-int-vector-4
|
||||
FOLDABLE-INSN: ##gather-int-vector-4
|
||||
def: dst
|
||||
use: src1/int-rep src2/int-rep src3/int-rep src4/int-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##select-vector
|
||||
FOLDABLE-INSN: ##select-vector
|
||||
def: dst/int-rep
|
||||
use: src
|
||||
literal: n rep ;
|
||||
|
||||
PURE-INSN: ##shuffle-vector
|
||||
FOLDABLE-INSN: ##shuffle-vector
|
||||
def: dst
|
||||
use: src shuffle
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##shuffle-vector-halves-imm
|
||||
FOLDABLE-INSN: ##shuffle-vector-halves-imm
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: shuffle rep ;
|
||||
|
||||
PURE-INSN: ##shuffle-vector-imm
|
||||
FOLDABLE-INSN: ##shuffle-vector-imm
|
||||
def: dst
|
||||
use: src
|
||||
literal: shuffle rep ;
|
||||
|
||||
PURE-INSN: ##tail>head-vector
|
||||
FOLDABLE-INSN: ##tail>head-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##merge-vector-head
|
||||
FOLDABLE-INSN: ##merge-vector-head
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##merge-vector-tail
|
||||
FOLDABLE-INSN: ##merge-vector-tail
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##float-pack-vector
|
||||
FOLDABLE-INSN: ##float-pack-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##signed-pack-vector
|
||||
FOLDABLE-INSN: ##signed-pack-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##unsigned-pack-vector
|
||||
FOLDABLE-INSN: ##unsigned-pack-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##unpack-vector-head
|
||||
FOLDABLE-INSN: ##unpack-vector-head
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##unpack-vector-tail
|
||||
FOLDABLE-INSN: ##unpack-vector-tail
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##integer>float-vector
|
||||
FOLDABLE-INSN: ##integer>float-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##float>integer-vector
|
||||
FOLDABLE-INSN: ##float>integer-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##compare-vector
|
||||
FOLDABLE-INSN: ##compare-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep cc ;
|
||||
|
||||
PURE-INSN: ##test-vector
|
||||
FOLDABLE-INSN: ##test-vector
|
||||
def: dst/tagged-rep
|
||||
use: src1
|
||||
temp: temp/int-rep
|
||||
literal: rep vcc ;
|
||||
|
||||
INSN: ##test-vector-branch
|
||||
VREG-INSN: ##test-vector-branch
|
||||
use: src1
|
||||
temp: temp/int-rep
|
||||
literal: rep vcc ;
|
||||
|
||||
PURE-INSN: ##add-vector
|
||||
FOLDABLE-INSN: ##add-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##saturated-add-vector
|
||||
FOLDABLE-INSN: ##saturated-add-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##add-sub-vector
|
||||
FOLDABLE-INSN: ##add-sub-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##sub-vector
|
||||
FOLDABLE-INSN: ##sub-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##saturated-sub-vector
|
||||
FOLDABLE-INSN: ##saturated-sub-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##mul-vector
|
||||
FOLDABLE-INSN: ##mul-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##mul-high-vector
|
||||
FOLDABLE-INSN: ##mul-high-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##mul-horizontal-add-vector
|
||||
FOLDABLE-INSN: ##mul-horizontal-add-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##saturated-mul-vector
|
||||
FOLDABLE-INSN: ##saturated-mul-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##div-vector
|
||||
FOLDABLE-INSN: ##div-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##min-vector
|
||||
FOLDABLE-INSN: ##min-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##max-vector
|
||||
FOLDABLE-INSN: ##max-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##avg-vector
|
||||
FOLDABLE-INSN: ##avg-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##dot-vector
|
||||
FOLDABLE-INSN: ##dot-vector
|
||||
def: dst/scalar-rep
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##sad-vector
|
||||
FOLDABLE-INSN: ##sad-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##horizontal-add-vector
|
||||
FOLDABLE-INSN: ##horizontal-add-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##horizontal-sub-vector
|
||||
FOLDABLE-INSN: ##horizontal-sub-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##horizontal-shl-vector-imm
|
||||
FOLDABLE-INSN: ##horizontal-shl-vector-imm
|
||||
def: dst
|
||||
use: src1
|
||||
literal: src2 rep ;
|
||||
|
||||
PURE-INSN: ##horizontal-shr-vector-imm
|
||||
FOLDABLE-INSN: ##horizontal-shr-vector-imm
|
||||
def: dst
|
||||
use: src1
|
||||
literal: src2 rep ;
|
||||
|
||||
PURE-INSN: ##abs-vector
|
||||
FOLDABLE-INSN: ##abs-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##sqrt-vector
|
||||
FOLDABLE-INSN: ##sqrt-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##and-vector
|
||||
FOLDABLE-INSN: ##and-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##andn-vector
|
||||
FOLDABLE-INSN: ##andn-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##or-vector
|
||||
FOLDABLE-INSN: ##or-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##xor-vector
|
||||
FOLDABLE-INSN: ##xor-vector
|
||||
def: dst
|
||||
use: src1 src2
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##not-vector
|
||||
FOLDABLE-INSN: ##not-vector
|
||||
def: dst
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##shl-vector-imm
|
||||
FOLDABLE-INSN: ##shl-vector-imm
|
||||
def: dst
|
||||
use: src1
|
||||
literal: src2 rep ;
|
||||
|
||||
PURE-INSN: ##shr-vector-imm
|
||||
FOLDABLE-INSN: ##shr-vector-imm
|
||||
def: dst
|
||||
use: src1
|
||||
literal: src2 rep ;
|
||||
|
||||
PURE-INSN: ##shl-vector
|
||||
FOLDABLE-INSN: ##shl-vector
|
||||
def: dst
|
||||
use: src1 src2/int-scalar-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##shr-vector
|
||||
FOLDABLE-INSN: ##shr-vector
|
||||
def: dst
|
||||
use: src1 src2/int-scalar-rep
|
||||
literal: rep ;
|
||||
|
||||
! Scalar/vector conversion
|
||||
PURE-INSN: ##scalar>integer
|
||||
FOLDABLE-INSN: ##scalar>integer
|
||||
def: dst/int-rep
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##integer>scalar
|
||||
FOLDABLE-INSN: ##integer>scalar
|
||||
def: dst
|
||||
use: src/int-rep
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##vector>scalar
|
||||
FOLDABLE-INSN: ##vector>scalar
|
||||
def: dst/scalar-rep
|
||||
use: src
|
||||
literal: rep ;
|
||||
|
||||
PURE-INSN: ##scalar>vector
|
||||
FOLDABLE-INSN: ##scalar>vector
|
||||
def: dst
|
||||
use: src/scalar-rep
|
||||
literal: rep ;
|
||||
|
||||
! Boxing and unboxing aliens
|
||||
PURE-INSN: ##box-alien
|
||||
FOLDABLE-INSN: ##box-alien
|
||||
def: dst/tagged-rep
|
||||
use: src/int-rep
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##box-displaced-alien
|
||||
FOLDABLE-INSN: ##box-displaced-alien
|
||||
def: dst/tagged-rep
|
||||
use: displacement/int-rep base/tagged-rep
|
||||
temp: temp/int-rep
|
||||
literal: base-class ;
|
||||
|
||||
PURE-INSN: ##unbox-any-c-ptr
|
||||
FOLDABLE-INSN: ##unbox-any-c-ptr
|
||||
def: dst/int-rep
|
||||
use: src/tagged-rep ;
|
||||
|
||||
PURE-INSN: ##unbox-alien
|
||||
FOLDABLE-INSN: ##unbox-alien
|
||||
def: dst/int-rep
|
||||
use: src/tagged-rep ;
|
||||
|
||||
! Raw memory accessors
|
||||
INSN: ##load-memory
|
||||
FLUSHABLE-INSN: ##load-memory
|
||||
def: dst
|
||||
use: base/int-rep displacement/int-rep
|
||||
literal: scale offset rep c-type ;
|
||||
|
||||
INSN: ##load-memory-imm
|
||||
FLUSHABLE-INSN: ##load-memory-imm
|
||||
def: dst
|
||||
use: base/int-rep
|
||||
literal: offset rep c-type ;
|
||||
|
||||
INSN: ##store-memory
|
||||
VREG-INSN: ##store-memory
|
||||
use: src base/int-rep displacement/int-rep
|
||||
literal: scale offset rep c-type ;
|
||||
|
||||
INSN: ##store-memory-imm
|
||||
VREG-INSN: ##store-memory-imm
|
||||
use: src base/int-rep
|
||||
literal: offset rep c-type ;
|
||||
|
||||
! Memory allocation
|
||||
INSN: ##allot
|
||||
FLUSHABLE-INSN: ##allot
|
||||
def: dst/tagged-rep
|
||||
literal: size class
|
||||
temp: temp/int-rep ;
|
||||
|
||||
INSN: ##write-barrier
|
||||
VREG-INSN: ##write-barrier
|
||||
use: src/tagged-rep slot/int-rep
|
||||
literal: scale tag
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
INSN: ##write-barrier-imm
|
||||
VREG-INSN: ##write-barrier-imm
|
||||
use: src/tagged-rep
|
||||
literal: slot tag
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
INSN: ##alien-global
|
||||
FLUSHABLE-INSN: ##alien-global
|
||||
def: dst/int-rep
|
||||
literal: symbol library ;
|
||||
|
||||
INSN: ##vm-field
|
||||
FLUSHABLE-INSN: ##vm-field
|
||||
def: dst/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
INSN: ##set-vm-field
|
||||
VREG-INSN: ##set-vm-field
|
||||
use: src/tagged-rep
|
||||
literal: offset ;
|
||||
|
||||
! FFI
|
||||
INSN: ##stack-frame
|
||||
literal: stack-frame ;
|
||||
|
||||
INSN: ##unbox
|
||||
FOLDABLE-INSN: ##unbox
|
||||
def: dst
|
||||
use: src/tagged-rep
|
||||
literal: unboxer rep ;
|
||||
|
||||
INSN: ##unbox-long-long
|
||||
FOLDABLE-INSN: ##unbox-long-long
|
||||
use: src/tagged-rep out/int-rep
|
||||
literal: unboxer ;
|
||||
|
||||
INSN: ##store-reg-param
|
||||
use: src
|
||||
literal: reg rep ;
|
||||
|
||||
INSN: ##store-stack-param
|
||||
use: src
|
||||
literal: n rep ;
|
||||
|
||||
INSN: ##load-reg-param
|
||||
def: dst
|
||||
literal: reg rep ;
|
||||
|
||||
INSN: ##load-stack-param
|
||||
def: dst
|
||||
literal: n rep ;
|
||||
|
||||
INSN: ##local-allot
|
||||
FLUSHABLE-INSN: ##local-allot
|
||||
def: dst/int-rep
|
||||
literal: size align offset ;
|
||||
|
||||
INSN: ##box
|
||||
FOLDABLE-INSN: ##box
|
||||
def: dst/tagged-rep
|
||||
use: src
|
||||
literal: boxer rep gc-map ;
|
||||
|
||||
INSN: ##box-long-long
|
||||
FOLDABLE-INSN: ##box-long-long
|
||||
def: dst/tagged-rep
|
||||
use: src1/int-rep src2/int-rep
|
||||
literal: boxer gc-map ;
|
||||
|
||||
INSN: ##allot-byte-array
|
||||
FLUSHABLE-INSN: ##allot-byte-array
|
||||
def: dst/tagged-rep
|
||||
literal: size gc-map ;
|
||||
|
||||
INSN: ##prepare-var-args ;
|
||||
! Alien call inputs and outputs are arrays of triples with shape
|
||||
! { vreg rep stack#/reg }
|
||||
|
||||
INSN: ##alien-invoke
|
||||
literal: symbols dll gc-map ;
|
||||
VREG-INSN: ##alien-invoke
|
||||
literal: reg-inputs stack-inputs reg-outputs cleanup stack-size symbols dll gc-map ;
|
||||
|
||||
INSN: ##cleanup
|
||||
literal: n ;
|
||||
|
||||
INSN: ##alien-indirect
|
||||
VREG-INSN: ##alien-indirect
|
||||
use: src/int-rep
|
||||
literal: gc-map ;
|
||||
literal: reg-inputs stack-inputs reg-outputs cleanup stack-size gc-map ;
|
||||
|
||||
INSN: ##alien-assembly
|
||||
literal: quot gc-map ;
|
||||
VREG-INSN: ##alien-assembly
|
||||
literal: reg-inputs stack-inputs reg-outputs cleanup stack-size quot gc-map ;
|
||||
|
||||
INSN: ##begin-callback ;
|
||||
VREG-INSN: ##callback-inputs
|
||||
literal: reg-outputs stack-outputs ;
|
||||
|
||||
INSN: ##alien-callback
|
||||
literal: quot ;
|
||||
|
||||
INSN: ##end-callback ;
|
||||
VREG-INSN: ##callback-outputs
|
||||
literal: reg-inputs ;
|
||||
|
||||
! Control flow
|
||||
INSN: ##phi
|
||||
FLUSHABLE-INSN: ##phi
|
||||
def: dst
|
||||
literal: inputs ;
|
||||
|
||||
INSN: ##branch ;
|
||||
|
||||
! Tagged conditionals
|
||||
INSN: ##compare-branch
|
||||
VREG-INSN: ##compare-branch
|
||||
use: src1/tagged-rep src2/tagged-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##compare-imm-branch
|
||||
VREG-INSN: ##compare-imm-branch
|
||||
use: src1/tagged-rep
|
||||
literal: src2 cc ;
|
||||
|
||||
PURE-INSN: ##compare
|
||||
FOLDABLE-INSN: ##compare
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep
|
||||
literal: cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##compare-imm
|
||||
FOLDABLE-INSN: ##compare-imm
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep
|
||||
literal: src2 cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
! Integer conditionals
|
||||
INSN: ##compare-integer-branch
|
||||
VREG-INSN: ##compare-integer-branch
|
||||
use: src1/int-rep src2/int-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##compare-integer-imm-branch
|
||||
VREG-INSN: ##compare-integer-imm-branch
|
||||
use: src1/int-rep
|
||||
literal: src2 cc ;
|
||||
|
||||
INSN: ##test-branch
|
||||
VREG-INSN: ##test-branch
|
||||
use: src1/int-rep src2/int-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##test-imm-branch
|
||||
VREG-INSN: ##test-imm-branch
|
||||
use: src1/int-rep
|
||||
literal: src2 cc ;
|
||||
|
||||
PURE-INSN: ##compare-integer
|
||||
FOLDABLE-INSN: ##compare-integer
|
||||
def: dst/tagged-rep
|
||||
use: src1/int-rep src2/int-rep
|
||||
literal: cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##compare-integer-imm
|
||||
FOLDABLE-INSN: ##compare-integer-imm
|
||||
def: dst/tagged-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##test
|
||||
FOLDABLE-INSN: ##test
|
||||
def: dst/tagged-rep
|
||||
use: src1/int-rep src2/int-rep
|
||||
literal: cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##test-imm
|
||||
FOLDABLE-INSN: ##test-imm
|
||||
def: dst/tagged-rep
|
||||
use: src1/int-rep
|
||||
literal: src2 cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
! Float conditionals
|
||||
INSN: ##compare-float-ordered-branch
|
||||
VREG-INSN: ##compare-float-ordered-branch
|
||||
use: src1/double-rep src2/double-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##compare-float-unordered-branch
|
||||
VREG-INSN: ##compare-float-unordered-branch
|
||||
use: src1/double-rep src2/double-rep
|
||||
literal: cc ;
|
||||
|
||||
PURE-INSN: ##compare-float-ordered
|
||||
FOLDABLE-INSN: ##compare-float-ordered
|
||||
def: dst/tagged-rep
|
||||
use: src1/double-rep src2/double-rep
|
||||
literal: cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
PURE-INSN: ##compare-float-unordered
|
||||
FOLDABLE-INSN: ##compare-float-unordered
|
||||
def: dst/tagged-rep
|
||||
use: src1/double-rep src2/double-rep
|
||||
literal: cc
|
||||
temp: temp/int-rep ;
|
||||
|
||||
! Overflowing arithmetic
|
||||
INSN: ##fixnum-add
|
||||
VREG-INSN: ##fixnum-add
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##fixnum-sub
|
||||
VREG-INSN: ##fixnum-sub
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/tagged-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##fixnum-mul
|
||||
VREG-INSN: ##fixnum-mul
|
||||
def: dst/tagged-rep
|
||||
use: src1/tagged-rep src2/int-rep
|
||||
literal: cc ;
|
||||
|
||||
INSN: ##save-context
|
||||
VREG-INSN: ##save-context
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
! GC checks
|
||||
INSN: ##check-nursery-branch
|
||||
VREG-INSN: ##check-nursery-branch
|
||||
literal: size cc
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
INSN: ##call-gc literal: gc-map ;
|
||||
INSN: ##call-gc
|
||||
literal: gc-map ;
|
||||
|
||||
! Spills and reloads, inserted by register allocator
|
||||
TUPLE: spill-slot { n integer } ;
|
||||
C: <spill-slot> spill-slot
|
||||
|
||||
INSN: ##spill
|
||||
VREG-INSN: ##spill
|
||||
use: src
|
||||
literal: rep dst ;
|
||||
|
||||
INSN: ##reload
|
||||
VREG-INSN: ##reload
|
||||
def: dst
|
||||
literal: rep src ;
|
||||
|
||||
|
@ -878,17 +864,18 @@ TUPLE: gc-map scrub-d scrub-r gc-roots ;
|
|||
|
||||
: <gc-map> ( -- gc-map ) gc-map new ;
|
||||
|
||||
UNION: alien-call-insn
|
||||
##alien-invoke
|
||||
##alien-indirect
|
||||
##alien-assembly ;
|
||||
|
||||
! Instructions that clobber registers. They receive inputs and
|
||||
! produce outputs in spill slots.
|
||||
UNION: hairy-clobber-insn
|
||||
##load-reg-param
|
||||
##store-reg-param
|
||||
##call-gc
|
||||
##alien-invoke
|
||||
##alien-indirect
|
||||
##alien-assembly
|
||||
##begin-callback
|
||||
##end-callback ;
|
||||
alien-call-insn
|
||||
##callback-inputs
|
||||
##callback-outputs ;
|
||||
|
||||
! Instructions that clobber registers but are allowed to produce
|
||||
! outputs in registers. Inputs are in spill slots, except for
|
||||
|
|
|
@ -36,11 +36,8 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
] reduce drop
|
||||
] { } make ;
|
||||
|
||||
: find-def-slot ( slots -- slot/f )
|
||||
[ type>> def eq? ] find nip ;
|
||||
|
||||
: insn-def-slot ( class -- slot/f )
|
||||
"insn-slots" word-prop find-def-slot ;
|
||||
: insn-def-slots ( class -- slot/f )
|
||||
"insn-slots" word-prop [ type>> def eq? ] filter ;
|
||||
|
||||
: insn-use-slots ( class -- slots )
|
||||
"insn-slots" word-prop [ type>> use eq? ] filter ;
|
||||
|
@ -59,8 +56,11 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
: vreg-insn-word ( -- word )
|
||||
"vreg-insn" "compiler.cfg.instructions" lookup ;
|
||||
|
||||
: pure-insn-word ( -- word )
|
||||
"pure-insn" "compiler.cfg.instructions" lookup ;
|
||||
: flushable-insn-word ( -- word )
|
||||
"flushable-insn" "compiler.cfg.instructions" lookup ;
|
||||
|
||||
: foldable-insn-word ( -- word )
|
||||
"foldable-insn" "compiler.cfg.instructions" lookup ;
|
||||
|
||||
: insn-effect ( word -- effect )
|
||||
boa-effect in>> but-last { } <effect> ;
|
||||
|
@ -68,18 +68,14 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
: uses-vregs? ( specs -- ? )
|
||||
[ type>> { def use temp } member-eq? ] any? ;
|
||||
|
||||
: insn-superclass ( pure? specs -- superclass )
|
||||
pure-insn-word swap uses-vregs? vreg-insn-word insn-word ? ? ;
|
||||
|
||||
: define-insn-tuple ( class pure? specs -- )
|
||||
[ insn-superclass ] keep
|
||||
: define-insn-tuple ( class superclass specs -- )
|
||||
[ name>> ] map "insn#" suffix define-tuple-class ;
|
||||
|
||||
: define-insn-ctor ( class specs -- )
|
||||
[ dup '[ _ ] [ f ] [ boa , ] surround ] dip
|
||||
[ name>> ] map { } <effect> define-declared ;
|
||||
|
||||
: define-insn ( class pure? specs -- )
|
||||
: define-insn ( class superclass specs -- )
|
||||
parse-insn-slot-specs
|
||||
{
|
||||
[ nip "insn-slots" set-word-prop ]
|
||||
|
@ -89,6 +85,14 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
[ nip define-insn-ctor ]
|
||||
} 3cleave ;
|
||||
|
||||
SYNTAX: INSN: CREATE-CLASS f ";" parse-tokens define-insn ;
|
||||
SYNTAX: INSN:
|
||||
CREATE-CLASS insn-word ";" parse-tokens define-insn ;
|
||||
|
||||
SYNTAX: PURE-INSN: CREATE-CLASS t ";" parse-tokens define-insn ;
|
||||
SYNTAX: VREG-INSN:
|
||||
CREATE-CLASS vreg-insn-word ";" parse-tokens define-insn ;
|
||||
|
||||
SYNTAX: FLUSHABLE-INSN:
|
||||
CREATE-CLASS flushable-insn-word ";" parse-tokens define-insn ;
|
||||
|
||||
SYNTAX: FOLDABLE-INSN:
|
||||
CREATE-CLASS foldable-insn-word ";" parse-tokens define-insn ;
|
||||
|
|
|
@ -48,39 +48,59 @@ IN: compiler.cfg.linear-scan.allocation
|
|||
2dup spill-at-sync-point?
|
||||
[ swap n>> spill f ] [ 2drop t ] if ;
|
||||
|
||||
GENERIC: handle-progress* ( obj -- )
|
||||
: handle-interval ( live-interval -- )
|
||||
[ start>> deactivate-intervals ]
|
||||
[ start>> activate-intervals ]
|
||||
[ assign-register ]
|
||||
tri ;
|
||||
|
||||
M: live-interval handle-progress* drop ;
|
||||
|
||||
M: sync-point handle-progress*
|
||||
: (handle-sync-point) ( sync-point -- )
|
||||
active-intervals get values
|
||||
[ [ spill-at-sync-point ] with filter! drop ] with each ;
|
||||
|
||||
:: handle-progress ( n obj -- )
|
||||
n progress set
|
||||
n deactivate-intervals
|
||||
obj handle-progress*
|
||||
n activate-intervals ;
|
||||
: handle-sync-point ( sync-point -- )
|
||||
[ n>> deactivate-intervals ]
|
||||
[ (handle-sync-point) ]
|
||||
[ n>> activate-intervals ]
|
||||
tri ;
|
||||
|
||||
GENERIC: handle ( obj -- )
|
||||
|
||||
M: live-interval handle ( live-interval -- )
|
||||
[ [ start>> ] keep handle-progress ] [ assign-register ] bi ;
|
||||
|
||||
M: sync-point handle ( sync-point -- )
|
||||
[ n>> ] keep handle-progress ;
|
||||
|
||||
: smallest-heap ( heap1 heap2 -- heap )
|
||||
! If heap1 and heap2 have the same key, favors heap1.
|
||||
:: (allocate-registers-step) ( unhandled-intervals unhandled-sync-points -- )
|
||||
{
|
||||
{ [ dup heap-empty? ] [ drop ] }
|
||||
{ [ over heap-empty? ] [ nip ] }
|
||||
[ [ [ heap-peek nip ] bi@ <= ] most ]
|
||||
{
|
||||
[ unhandled-intervals heap-empty? ]
|
||||
[ unhandled-sync-points heap-pop drop handle-sync-point ]
|
||||
}
|
||||
{
|
||||
[ unhandled-sync-points heap-empty? ]
|
||||
[ unhandled-intervals heap-pop drop handle-interval ]
|
||||
}
|
||||
[
|
||||
unhandled-intervals heap-peek :> ( i ik )
|
||||
unhandled-sync-points heap-peek :> ( s sk )
|
||||
{
|
||||
{
|
||||
[ ik sk < ]
|
||||
[ unhandled-intervals heap-pop* i handle-interval ]
|
||||
}
|
||||
{
|
||||
[ ik sk > ]
|
||||
[ unhandled-sync-points heap-pop* s handle-sync-point ]
|
||||
}
|
||||
[
|
||||
unhandled-intervals heap-pop*
|
||||
i handle-interval
|
||||
s (handle-sync-point)
|
||||
]
|
||||
} cond
|
||||
]
|
||||
} cond ;
|
||||
|
||||
: (allocate-registers) ( -- )
|
||||
unhandled-intervals get unhandled-sync-points get smallest-heap
|
||||
dup heap-empty? [ drop ] [ heap-pop drop handle (allocate-registers) ] if ;
|
||||
: (allocate-registers) ( unhandled-intervals unhandled-sync-points -- )
|
||||
2dup [ heap-empty? ] both? [ 2drop ] [
|
||||
[ (allocate-registers-step) ]
|
||||
[ (allocate-registers) ]
|
||||
2bi
|
||||
] if ;
|
||||
|
||||
: finish-allocation ( -- )
|
||||
active-intervals inactive-intervals
|
||||
|
@ -89,6 +109,6 @@ M: sync-point handle ( sync-point -- )
|
|||
: allocate-registers ( live-intervals sync-point machine-registers -- live-intervals )
|
||||
init-allocator
|
||||
init-unhandled
|
||||
(allocate-registers)
|
||||
unhandled-intervals get unhandled-sync-points get (allocate-registers)
|
||||
finish-allocation
|
||||
handled-intervals get ;
|
||||
|
|
|
@ -90,6 +90,7 @@ ERROR: register-already-used live-interval ;
|
|||
! Any active intervals which have ended are moved to handled
|
||||
! Any active intervals which cover the current position
|
||||
! are moved to inactive
|
||||
dup progress set
|
||||
active-intervals {
|
||||
{ [ 2dup finished? ] [ finish ] }
|
||||
{ [ 2dup covers? not ] [ deactivate ] }
|
||||
|
|
|
@ -54,8 +54,11 @@ M: live-interval covers? ( insn# live-interval -- ? )
|
|||
covers?
|
||||
] if ;
|
||||
|
||||
: (find-use) ( insn# live-interval -- vreg-use )
|
||||
uses>> [ n>> <=> ] with search nip ;
|
||||
|
||||
:: find-use ( insn# live-interval -- vreg-use )
|
||||
insn# live-interval uses>> [ n>> <=> ] with search nip
|
||||
insn# live-interval (find-use)
|
||||
dup [ dup n>> insn# = [ drop f ] unless ] when ;
|
||||
|
||||
: add-new-range ( from to live-interval -- )
|
||||
|
@ -122,7 +125,7 @@ M: insn compute-live-intervals* drop ;
|
|||
|
||||
M: vreg-insn compute-live-intervals* ( insn -- )
|
||||
dup insn#>>
|
||||
[ [ defs-vreg ] dip '[ _ record-def ] when* ]
|
||||
[ [ defs-vregs ] dip '[ _ record-def ] each ]
|
||||
[ [ uses-vregs ] dip '[ _ record-use ] each ]
|
||||
[ [ temp-vregs ] dip '[ _ record-temp ] each ]
|
||||
2tri ;
|
||||
|
|
|
@ -16,7 +16,7 @@ BACKWARD-ANALYSIS: live
|
|||
GENERIC: visit-insn ( live-set insn -- live-set )
|
||||
|
||||
: kill-defs ( live-set insn -- live-set )
|
||||
defs-vreg [ over delete-at ] when* ; inline
|
||||
defs-vregs [ over delete-at ] each ; inline
|
||||
|
||||
: gen-uses ( live-set insn -- live-set )
|
||||
uses-vregs [ over conjoin ] each ; inline
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs fry functors generic.parser
|
||||
kernel lexer namespaces parser sequences slots words sets
|
||||
|
@ -22,22 +22,43 @@ GENERIC: rename-insn-defs ( insn -- )
|
|||
|
||||
M: insn rename-insn-defs drop ;
|
||||
|
||||
insn-classes get [ insn-def-slot ] filter [
|
||||
insn-classes get special-vreg-insns diff [ insn-def-slots empty? not ] filter [
|
||||
[ \ rename-insn-defs create-method-in ]
|
||||
[ insn-def-slot name>> 1array DEF-QUOT slot-change-quot ] bi
|
||||
[ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
|
||||
define
|
||||
] each
|
||||
|
||||
M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
|
||||
|
||||
M: alien-call-insn rename-insn-defs
|
||||
[ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs drop ;
|
||||
|
||||
M: ##callback-inputs rename-insn-defs
|
||||
[ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
|
||||
[ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
|
||||
drop ;
|
||||
|
||||
GENERIC: rename-insn-uses ( insn -- )
|
||||
|
||||
M: insn rename-insn-uses drop ;
|
||||
|
||||
insn-classes get { ##phi } diff [ insn-use-slots empty? not ] filter [
|
||||
insn-classes get special-vreg-insns diff [ insn-use-slots empty? not ] filter [
|
||||
[ \ rename-insn-uses create-method-in ]
|
||||
[ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
|
||||
define
|
||||
] each
|
||||
|
||||
M: alien-call-insn rename-insn-uses
|
||||
[ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
|
||||
[ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
|
||||
drop ;
|
||||
|
||||
M: ##alien-indirect rename-insn-uses
|
||||
USE-QUOT change-src call-next-method ;
|
||||
|
||||
M: ##callback-outputs rename-insn-uses
|
||||
[ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs drop ;
|
||||
|
||||
M: ##phi rename-insn-uses
|
||||
[ USE-QUOT assoc-map ] change-inputs drop ;
|
||||
|
||||
|
|
|
@ -12,7 +12,7 @@ SYMBOL: components
|
|||
: init-components ( cfg components -- )
|
||||
'[
|
||||
instructions>> [
|
||||
defs-vreg [ _ add-atom ] when*
|
||||
defs-vregs [ _ add-atom ] each
|
||||
] each
|
||||
] each-basic-block ;
|
||||
|
||||
|
|
|
@ -1,19 +1,20 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors sequences arrays fry namespaces generic
|
||||
words sets combinators generalizations sequences.generalizations
|
||||
cpu.architecture compiler.units compiler.cfg.utilities
|
||||
compiler.cfg compiler.cfg.rpo compiler.cfg.instructions
|
||||
compiler.cfg.def-use ;
|
||||
FROM: compiler.cfg.instructions.syntax => insn-def-slot insn-use-slots insn-temp-slots scalar-rep ;
|
||||
FROM: compiler.cfg.instructions.syntax => insn-def-slots
|
||||
insn-use-slots insn-temp-slots scalar-rep ;
|
||||
FROM: namespaces => set ;
|
||||
IN: compiler.cfg.representations.preferred
|
||||
|
||||
GENERIC: defs-vreg-rep ( insn -- rep/f )
|
||||
GENERIC: defs-vreg-reps ( insn -- reps )
|
||||
GENERIC: temp-vreg-reps ( insn -- reps )
|
||||
GENERIC: uses-vreg-reps ( insn -- reps )
|
||||
|
||||
M: insn defs-vreg-rep drop f ;
|
||||
M: insn defs-vreg-reps drop { } ;
|
||||
M: insn temp-vreg-reps drop { } ;
|
||||
M: insn uses-vreg-reps drop { } ;
|
||||
|
||||
|
@ -26,13 +27,6 @@ M: insn uses-vreg-reps drop { } ;
|
|||
[ [ drop ] swap suffix ]
|
||||
} case ;
|
||||
|
||||
: define-defs-vreg-rep-method ( insn -- )
|
||||
dup insn-def-slot dup [
|
||||
[ \ defs-vreg-rep create-method ]
|
||||
[ rep>> rep-getter-quot ]
|
||||
bi* define
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: reps-getter-quot ( reps -- quot )
|
||||
dup [ rep>> { f scalar-rep } member-eq? not ] all? [
|
||||
[ rep>> ] map [ drop ] swap suffix
|
||||
|
@ -45,32 +39,54 @@ M: insn uses-vreg-reps drop { } ;
|
|||
} case
|
||||
] if ;
|
||||
|
||||
: define-uses-vreg-reps-method ( insn -- )
|
||||
dup insn-use-slots [ drop ] [
|
||||
[ \ uses-vreg-reps create-method ]
|
||||
: define-vreg-reps-method ( insn slots word -- )
|
||||
[ [ drop ] ] dip '[
|
||||
[ _ create-method ]
|
||||
[ reps-getter-quot ]
|
||||
bi* define
|
||||
] if-empty ;
|
||||
|
||||
: define-defs-vreg-reps-method ( insn -- )
|
||||
dup insn-def-slots \ defs-vreg-reps define-vreg-reps-method ;
|
||||
|
||||
: define-uses-vreg-reps-method ( insn -- )
|
||||
dup insn-use-slots \ uses-vreg-reps define-vreg-reps-method ;
|
||||
|
||||
: define-temp-vreg-reps-method ( insn -- )
|
||||
dup insn-temp-slots [ drop ] [
|
||||
[ \ temp-vreg-reps create-method ]
|
||||
[ reps-getter-quot ]
|
||||
bi* define
|
||||
] if-empty ;
|
||||
dup insn-temp-slots \ temp-vreg-reps define-vreg-reps-method ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: alien-call-insn defs-vreg-reps
|
||||
reg-outputs>> [ second ] map ;
|
||||
|
||||
M: ##callback-inputs defs-vreg-reps
|
||||
[ reg-outputs>> ] [ stack-outputs>> ] bi append [ second ] map ;
|
||||
|
||||
M: ##callback-outputs defs-vreg-reps drop { } ;
|
||||
|
||||
M: alien-call-insn uses-vreg-reps
|
||||
[ reg-inputs>> ] [ stack-inputs>> ] bi append [ second ] map ;
|
||||
|
||||
M: ##alien-indirect uses-vreg-reps
|
||||
call-next-method int-rep prefix ;
|
||||
|
||||
M: ##callback-inputs uses-vreg-reps
|
||||
drop { } ;
|
||||
|
||||
M: ##callback-outputs uses-vreg-reps
|
||||
reg-inputs>> [ second ] map ;
|
||||
|
||||
[
|
||||
insn-classes get
|
||||
[ [ define-defs-vreg-rep-method ] each ]
|
||||
[ { ##phi } diff [ define-uses-vreg-reps-method ] each ]
|
||||
[ special-vreg-insns diff [ define-defs-vreg-reps-method ] each ]
|
||||
[ special-vreg-insns diff [ define-uses-vreg-reps-method ] each ]
|
||||
[ [ define-temp-vreg-reps-method ] each ]
|
||||
tri
|
||||
] with-compilation-unit
|
||||
|
||||
: each-def-rep ( insn vreg-quot: ( vreg rep -- ) -- )
|
||||
[ [ defs-vreg ] [ defs-vreg-rep ] bi ] dip with when* ; inline
|
||||
[ [ defs-vregs ] [ defs-vreg-reps ] bi ] dip 2each ; inline
|
||||
|
||||
: each-use-rep ( insn vreg-quot: ( vreg rep -- ) -- )
|
||||
[ [ uses-vregs ] [ uses-vreg-reps ] bi ] dip 2each ; inline
|
||||
|
@ -80,12 +96,3 @@ PRIVATE>
|
|||
|
||||
: each-rep ( insn vreg-quot: ( vreg rep -- ) -- )
|
||||
[ each-def-rep ] [ each-use-rep ] [ each-temp-rep ] 2tri ; inline
|
||||
|
||||
: with-vreg-reps ( cfg vreg-quot: ( vreg rep -- ) -- )
|
||||
'[
|
||||
[ basic-block set ] [
|
||||
[
|
||||
_ each-rep
|
||||
] each-non-phi
|
||||
] bi
|
||||
] each-basic-block ; inline
|
||||
|
|
|
@ -16,13 +16,13 @@ IN: compiler.cfg.representations
|
|||
} uses-vreg-reps
|
||||
] unit-test
|
||||
|
||||
[ double-rep ] [
|
||||
[ { double-rep } ] [
|
||||
T{ ##load-memory-imm
|
||||
{ dst 5 }
|
||||
{ base 3 }
|
||||
{ offset 0 }
|
||||
{ rep double-rep }
|
||||
} defs-vreg-rep
|
||||
} defs-vreg-reps
|
||||
] unit-test
|
||||
|
||||
H{ } clone representations set
|
||||
|
|
|
@ -44,10 +44,6 @@ V{
|
|||
|
||||
V{
|
||||
T{ ##inc-d f 3 }
|
||||
T{ ##load-reg-param f 0 RCX int-rep }
|
||||
T{ ##load-reg-param f 1 RDX int-rep }
|
||||
T{ ##load-reg-param f 2 R8 int-rep }
|
||||
T{ ##begin-callback }
|
||||
T{ ##box f 4 3 "from_signed_4" int-rep
|
||||
T{ gc-map { scrub-d B{ 0 0 0 } } { scrub-r B{ } } { gc-roots { } } }
|
||||
}
|
||||
|
@ -58,11 +54,7 @@ V{
|
|||
[
|
||||
V{
|
||||
T{ ##inc-d f 3 }
|
||||
T{ ##load-reg-param f 0 RCX int-rep }
|
||||
T{ ##load-reg-param f 1 RDX int-rep }
|
||||
T{ ##load-reg-param f 2 R8 int-rep }
|
||||
T{ ##save-context f 5 6 }
|
||||
T{ ##begin-callback }
|
||||
T{ ##box f 4 3 "from_signed_4" int-rep
|
||||
T{ gc-map { scrub-d B{ 0 0 0 } } { scrub-r B{ } } { gc-roots { } } }
|
||||
}
|
||||
|
|
|
@ -20,7 +20,7 @@ GENERIC: modifies-context? ( insn -- ? )
|
|||
|
||||
M: ##inc-d modifies-context? drop t ;
|
||||
M: ##inc-r modifies-context? drop t ;
|
||||
M: ##load-reg-param modifies-context? drop t ;
|
||||
M: ##callback-inputs modifies-context? drop t ;
|
||||
M: insn modifies-context? drop f ;
|
||||
|
||||
: save-context-offset ( bb -- n )
|
||||
|
|
|
@ -32,11 +32,15 @@ SYMBOL: defs
|
|||
! Set of vregs defined in more than one basic block
|
||||
SYMBOL: defs-multi
|
||||
|
||||
: compute-insn-defs ( bb insn -- )
|
||||
defs-vreg dup [
|
||||
GENERIC: compute-insn-defs ( bb insn -- )
|
||||
|
||||
M: insn compute-insn-defs 2drop ;
|
||||
|
||||
M: vreg-insn compute-insn-defs
|
||||
defs-vregs [
|
||||
defs get [ conjoin-at ] [ drop ] [ at assoc-size 1 > ] 2tri
|
||||
[ defs-multi get conjoin ] [ drop ] if
|
||||
] [ 2drop ] if ;
|
||||
] with each ;
|
||||
|
||||
: compute-defs ( cfg -- )
|
||||
H{ } clone defs set
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel locals fry sequences
|
||||
USING: accessors assocs kernel locals fry sequences sets
|
||||
cpu.architecture
|
||||
compiler.cfg.rpo
|
||||
compiler.cfg.def-use
|
||||
|
@ -18,7 +18,7 @@ IN: compiler.cfg.ssa.cssa
|
|||
! ##fixnum-add, ##fixnum-sub or ##fixnum-mul) then we don't
|
||||
! need to insert a copy since in fact doing so will result
|
||||
! in incorrect code.
|
||||
[ instructions>> last defs-vreg ] dip eq? not ;
|
||||
[ instructions>> last defs-vregs ] dip swap in? not ;
|
||||
|
||||
:: insert-copy ( bb src rep -- bb dst )
|
||||
bb src insert-copy? [
|
||||
|
|
|
@ -47,7 +47,7 @@ SYMBOL: class-element-map
|
|||
SYMBOL: copies
|
||||
|
||||
: value-of ( vreg -- value )
|
||||
insn-of dup ##tagged>integer? [ src>> ] [ dst>> ] if ;
|
||||
dup insn-of dup ##tagged>integer? [ nip src>> ] [ drop ] if ;
|
||||
|
||||
: init-coalescing ( -- )
|
||||
defs get
|
||||
|
@ -85,9 +85,9 @@ M: insn prepare-insn drop ;
|
|||
M: vreg-insn prepare-insn
|
||||
[ temp-vregs [ leader-map get conjoin ] each ]
|
||||
[
|
||||
[ defs-vreg ] [ uses-vregs ] bi
|
||||
2dup empty? not and [
|
||||
first
|
||||
[ defs-vregs ] [ uses-vregs ] bi
|
||||
2dup [ empty? not ] both? [
|
||||
[ first ] bi@
|
||||
2dup [ rep-of reg-class-of ] bi@ eq?
|
||||
[ maybe-eliminate-copy-later ] [ 2drop ] if
|
||||
] [ 2drop ] if
|
||||
|
|
|
@ -12,26 +12,26 @@ IN: compiler.cfg.ssa.interference.live-ranges
|
|||
|
||||
SYMBOLS: local-def-indices local-kill-indices ;
|
||||
|
||||
: record-def ( n insn -- )
|
||||
defs-vreg dup [ local-def-indices get set-at ] [ 2drop ] if ;
|
||||
: record-defs ( n insn -- )
|
||||
defs-vregs [ local-def-indices get set-at ] with each ;
|
||||
|
||||
: record-uses ( n insn -- )
|
||||
! Record live intervals so that all but the first input interfere
|
||||
! with the output. This lets us coalesce the output with the
|
||||
! first input.
|
||||
dup uses-vregs dup empty? [ 3drop ] [
|
||||
dup uses-vregs [ 2drop ] [
|
||||
swap def-is-use-insn?
|
||||
[ [ first local-kill-indices get set-at ] [ rest-slice ] 2bi ] unless
|
||||
[ 1 + ] dip [ local-kill-indices get set-at ] with each
|
||||
] if ;
|
||||
] if-empty ;
|
||||
|
||||
GENERIC: record-insn ( n insn -- )
|
||||
|
||||
M: ##phi record-insn
|
||||
record-def ;
|
||||
record-defs ;
|
||||
|
||||
M: vreg-insn record-insn
|
||||
[ 2 * ] dip [ record-def ] [ record-uses ] 2bi ;
|
||||
[ 2 * ] dip [ record-defs ] [ record-uses ] 2bi ;
|
||||
|
||||
M: insn record-insn
|
||||
2drop ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays classes classes.algebra combinators fry
|
||||
generic.parser kernel math namespaces quotations sequences slots
|
||||
words make
|
||||
words make sets
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.instructions.syntax
|
||||
compiler.cfg.value-numbering.graph ;
|
||||
|
@ -49,7 +49,8 @@ GENERIC: >expr ( insn -- expr )
|
|||
[ drop \ >expr create-method-in ] [ >expr-quot ] 2bi define ;
|
||||
|
||||
insn-classes get
|
||||
[ pure-insn class<= ] filter
|
||||
[ foldable-insn class<= ] filter
|
||||
{ ##copy ##load-integer ##load-reference } diff
|
||||
[
|
||||
dup "insn-slots" word-prop input-values
|
||||
define->expr-method
|
||||
|
|
|
@ -36,9 +36,12 @@ GENERIC: process-instruction ( insn -- insn' )
|
|||
[ redundant-instruction ] [ useful-instruction ] ?if ;
|
||||
|
||||
M: insn process-instruction
|
||||
dup rewrite [ process-instruction ] [ ] ?if ;
|
||||
|
||||
M: foldable-insn process-instruction
|
||||
dup rewrite
|
||||
[ process-instruction ]
|
||||
[ dup defs-vreg [ check-redundancy ] when ] ?if ;
|
||||
[ dup defs-vregs length 1 = [ check-redundancy ] when ] ?if ;
|
||||
|
||||
M: ##copy process-instruction
|
||||
dup [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
|
||||
|
|
|
@ -91,8 +91,6 @@ M: ##dispatch generate-insn
|
|||
! Special cases
|
||||
M: ##no-tco generate-insn drop ;
|
||||
|
||||
M: ##stack-frame generate-insn drop ;
|
||||
|
||||
M: ##prologue generate-insn
|
||||
drop
|
||||
cfg get stack-frame>>
|
||||
|
@ -287,21 +285,13 @@ CONDITIONAL: ##fixnum-mul %fixnum-mul
|
|||
! FFI
|
||||
CODEGEN: ##unbox %unbox
|
||||
CODEGEN: ##unbox-long-long %unbox-long-long
|
||||
CODEGEN: ##store-reg-param %store-reg-param
|
||||
CODEGEN: ##store-stack-param %store-stack-param
|
||||
CODEGEN: ##load-reg-param %load-reg-param
|
||||
CODEGEN: ##load-stack-param %load-stack-param
|
||||
CODEGEN: ##local-allot %local-allot
|
||||
CODEGEN: ##box %box
|
||||
CODEGEN: ##box-long-long %box-long-long
|
||||
CODEGEN: ##allot-byte-array %allot-byte-array
|
||||
CODEGEN: ##prepare-var-args %prepare-var-args
|
||||
CODEGEN: ##alien-invoke %alien-invoke
|
||||
CODEGEN: ##cleanup %cleanup
|
||||
CODEGEN: ##alien-indirect %alien-indirect
|
||||
CODEGEN: ##begin-callback %begin-callback
|
||||
CODEGEN: ##alien-assembly %alien-assembly
|
||||
CODEGEN: ##callback-inputs %callback-inputs
|
||||
CODEGEN: ##alien-callback %alien-callback
|
||||
CODEGEN: ##end-callback %end-callback
|
||||
|
||||
M: ##alien-assembly generate-insn
|
||||
[ gc-map>> gc-map set ] [ quot>> call( -- ) ] bi ;
|
||||
CODEGEN: ##callback-outputs %callback-outputs
|
||||
|
|
|
@ -587,10 +587,6 @@ HOOK: %unbox cpu ( dst src func rep -- )
|
|||
|
||||
HOOK: %unbox-long-long cpu ( src out func -- )
|
||||
|
||||
HOOK: %store-reg-param cpu ( src reg rep -- )
|
||||
|
||||
HOOK: %store-stack-param cpu ( src n rep -- )
|
||||
|
||||
HOOK: %local-allot cpu ( dst size align offset -- )
|
||||
|
||||
! Call a function to convert a value into a tagged pointer,
|
||||
|
@ -604,28 +600,18 @@ HOOK: %allot-byte-array cpu ( dst size gc-map -- )
|
|||
|
||||
HOOK: %save-context cpu ( temp1 temp2 -- )
|
||||
|
||||
HOOK: %prepare-var-args cpu ( -- )
|
||||
HOOK: %c-invoke cpu ( symbols dll gc-map -- )
|
||||
|
||||
M: object %prepare-var-args ;
|
||||
HOOK: %alien-invoke cpu ( reg-inputs stack-inputs reg-outputs cleanup stack-size symbols dll gc-map -- )
|
||||
|
||||
HOOK: %alien-invoke cpu ( function library gc-map -- )
|
||||
HOOK: %alien-indirect cpu ( src reg-inputs stack-inputs reg-outputs cleanup stack-size gc-map -- )
|
||||
|
||||
HOOK: %cleanup cpu ( n -- )
|
||||
HOOK: %alien-assembly cpu ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot gc-map -- )
|
||||
|
||||
M: object %cleanup ( n -- ) drop ;
|
||||
|
||||
HOOK: %alien-indirect cpu ( src gc-map -- )
|
||||
|
||||
HOOK: %load-reg-param cpu ( dst reg rep -- )
|
||||
|
||||
HOOK: %load-stack-param cpu ( dst n rep -- )
|
||||
|
||||
HOOK: %begin-callback cpu ( -- )
|
||||
HOOK: %callback-inputs cpu ( reg-outputs stack-outputs -- )
|
||||
|
||||
HOOK: %alien-callback cpu ( quot -- )
|
||||
|
||||
HOOK: %end-callback cpu ( -- )
|
||||
HOOK: %callback-outputs cpu ( reg-inputs -- )
|
||||
|
||||
HOOK: stack-cleanup cpu ( stack-size return abi -- n )
|
||||
|
||||
M: object stack-cleanup 3drop 0 ;
|
||||
|
|
|
@ -230,13 +230,13 @@ M: integer float-function-param* FMR ;
|
|||
|
||||
M:: ppc %unary-float-function ( dst src func -- )
|
||||
0 src float-function-param
|
||||
func f %alien-invoke
|
||||
func f %c-invoke
|
||||
dst float-function-return ;
|
||||
|
||||
M:: ppc %binary-float-function ( dst src1 src2 func -- )
|
||||
0 src1 float-function-param
|
||||
1 src2 float-function-param
|
||||
func f %alien-invoke
|
||||
func f %c-invoke
|
||||
dst float-function-return ;
|
||||
|
||||
! Internal format is always double-precision on PowerPC
|
||||
|
@ -513,7 +513,7 @@ M:: ppc %check-nursery-branch ( label size cc temp1 temp2 -- )
|
|||
M: ppc %call-gc ( gc-roots -- )
|
||||
3 swap gc-root-offsets %load-reference
|
||||
4 %load-vm-addr
|
||||
"inline_gc" f %alien-invoke ;
|
||||
"inline_gc" f %c-invoke ;
|
||||
|
||||
M: ppc %prologue ( n -- )
|
||||
0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
|
||||
|
@ -689,7 +689,7 @@ M: spill-slot store-param [ 1 ] dip n>> spill@ STW ;
|
|||
:: call-unbox-func ( src func -- )
|
||||
3 src load-param
|
||||
4 %load-vm-addr
|
||||
func f %alien-invoke ;
|
||||
func f %c-invoke ;
|
||||
|
||||
M:: ppc %unbox ( src n rep func -- )
|
||||
src func call-unbox-func
|
||||
|
@ -708,12 +708,12 @@ M:: ppc %unbox-large-struct ( src n c-type -- )
|
|||
4 src load-param
|
||||
3 1 n local@ ADDI
|
||||
c-type heap-size 5 LI
|
||||
"memcpy" "libc" load-library %alien-invoke ;
|
||||
"memcpy" "libc" load-library %c-invoke ;
|
||||
|
||||
M:: ppc %box ( dst n rep func -- )
|
||||
n [ 0 rep reg-class-of cdecl param-reg rep %load-param-reg ] when*
|
||||
rep double-rep? 5 4 ? %load-vm-addr
|
||||
func f %alien-invoke
|
||||
func f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
M:: ppc %box-long-long ( dst n func -- )
|
||||
|
@ -722,7 +722,7 @@ M:: ppc %box-long-long ( dst n func -- )
|
|||
4 1 n cell + local@ LWZ
|
||||
] when
|
||||
5 %load-vm-addr
|
||||
func f %alien-invoke
|
||||
func f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
: struct-return@ ( n -- n )
|
||||
|
@ -740,7 +740,7 @@ M:: ppc %box-large-struct ( dst n c-type -- )
|
|||
c-type heap-size 4 LI
|
||||
5 %load-vm-addr
|
||||
! Call the function
|
||||
"from_value_struct" f %alien-invoke
|
||||
"from_value_struct" f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
M:: ppc %restore-context ( temp1 temp2 -- )
|
||||
|
@ -754,7 +754,7 @@ M:: ppc %save-context ( temp1 temp2 -- )
|
|||
ds-reg temp1 "datastack" context-field-offset STW
|
||||
rs-reg temp1 "retainstack" context-field-offset STW ;
|
||||
|
||||
M: ppc %alien-invoke ( symbol dll -- )
|
||||
M: ppc %c-invoke ( symbol dll -- )
|
||||
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
|
||||
|
||||
M: ppc %alien-indirect ( src -- )
|
||||
|
@ -773,7 +773,7 @@ M:: ppc %box-small-struct ( dst c-type -- )
|
|||
#! Box a <= 16-byte struct returned in r3:r4:r5:r6
|
||||
c-type heap-size 7 LI
|
||||
8 %load-vm-addr
|
||||
"from_medium_struct" f %alien-invoke
|
||||
"from_medium_struct" f %c-invoke
|
||||
3 dst store-param ;
|
||||
|
||||
: %unbox-struct-1 ( -- )
|
||||
|
@ -802,7 +802,7 @@ M:: ppc %unbox-small-struct ( src c-type -- )
|
|||
|
||||
M: ppc %begin-callback ( -- )
|
||||
3 %load-vm-addr
|
||||
"begin_callback" f %alien-invoke ;
|
||||
"begin_callback" f %c-invoke ;
|
||||
|
||||
M: ppc %alien-callback ( quot -- )
|
||||
3 swap %load-reference
|
||||
|
@ -812,7 +812,7 @@ M: ppc %alien-callback ( quot -- )
|
|||
|
||||
M: ppc %end-callback ( -- )
|
||||
3 %load-vm-addr
|
||||
"end_callback" f %alien-invoke ;
|
||||
"end_callback" f %c-invoke ;
|
||||
|
||||
enable-float-functions
|
||||
|
||||
|
|
|
@ -106,8 +106,8 @@ M: x86.32 %prepare-jump
|
|||
dst ?spill-slot x87-insn execute
|
||||
] if ; inline
|
||||
|
||||
M: x86.32 %load-reg-param ( dst reg rep -- )
|
||||
{
|
||||
M: x86.32 %load-reg-param ( vreg rep reg -- )
|
||||
swap {
|
||||
{ int-rep [ int-rep %copy ] }
|
||||
{ float-rep [ drop \ FSTPS float-rep load-float-return ] }
|
||||
{ double-rep [ drop \ FSTPL double-rep load-float-return ] }
|
||||
|
@ -123,8 +123,8 @@ M: x86.32 %load-reg-param ( dst reg rep -- )
|
|||
src ?spill-slot x87-insn execute
|
||||
] if ; inline
|
||||
|
||||
M: x86.32 %store-reg-param ( src reg rep -- )
|
||||
{
|
||||
M: x86.32 %store-reg-param ( vreg rep reg -- )
|
||||
swap {
|
||||
{ int-rep [ swap int-rep %copy ] }
|
||||
{ float-rep [ drop \ FLDS float-rep store-float-return ] }
|
||||
{ double-rep [ drop \ FLDL double-rep store-float-return ] }
|
||||
|
@ -134,7 +134,7 @@ M: x86.32 %store-reg-param ( src reg rep -- )
|
|||
EAX src tagged-rep %copy
|
||||
4 save-vm-ptr
|
||||
0 stack@ EAX MOV
|
||||
func f f %alien-invoke ;
|
||||
func f f %c-invoke ;
|
||||
|
||||
M:: x86.32 %unbox ( dst src func rep -- )
|
||||
src func call-unbox-func
|
||||
|
@ -146,13 +146,13 @@ M:: x86.32 %unbox-long-long ( src out func -- )
|
|||
EAX out int-rep %copy
|
||||
4 stack@ EAX MOV
|
||||
8 save-vm-ptr
|
||||
func f f %alien-invoke ;
|
||||
func f f %c-invoke ;
|
||||
|
||||
M:: x86.32 %box ( dst src func rep gc-map -- )
|
||||
rep rep-size save-vm-ptr
|
||||
src rep %store-return
|
||||
0 stack@ rep %load-return
|
||||
func f gc-map %alien-invoke
|
||||
func f gc-map %c-invoke
|
||||
dst EAX tagged-rep %copy ;
|
||||
|
||||
M:: x86.32 %box-long-long ( dst src1 src2 func gc-map -- )
|
||||
|
@ -161,22 +161,22 @@ M:: x86.32 %box-long-long ( dst src1 src2 func gc-map -- )
|
|||
0 stack@ EAX int-rep %copy
|
||||
EAX src2 int-rep %copy
|
||||
4 stack@ EAX int-rep %copy
|
||||
func f gc-map %alien-invoke
|
||||
func f gc-map %c-invoke
|
||||
dst EAX tagged-rep %copy ;
|
||||
|
||||
M:: x86.32 %allot-byte-array ( dst size gc-map -- )
|
||||
4 save-vm-ptr
|
||||
0 stack@ size MOV
|
||||
"allot_byte_array" f gc-map %alien-invoke
|
||||
"allot_byte_array" f gc-map %c-invoke
|
||||
dst EAX tagged-rep %copy ;
|
||||
|
||||
M: x86.32 %alien-invoke
|
||||
M: x86.32 %c-invoke
|
||||
[ 0 CALL rc-relative rel-dlsym ] dip gc-map-here ;
|
||||
|
||||
M: x86.32 %begin-callback ( -- )
|
||||
0 save-vm-ptr
|
||||
4 stack@ 0 MOV
|
||||
"begin_callback" f f %alien-invoke ;
|
||||
"begin_callback" f f %c-invoke ;
|
||||
|
||||
M: x86.32 %alien-callback ( quot -- )
|
||||
[ EAX ] dip %load-reference
|
||||
|
@ -184,7 +184,7 @@ M: x86.32 %alien-callback ( quot -- )
|
|||
|
||||
M: x86.32 %end-callback ( -- )
|
||||
0 save-vm-ptr
|
||||
"end_callback" f f %alien-invoke ;
|
||||
"end_callback" f f %c-invoke ;
|
||||
|
||||
GENERIC: float-function-param ( n dst src -- )
|
||||
|
||||
|
@ -199,13 +199,13 @@ M:: register float-function-param ( n dst src -- )
|
|||
|
||||
M:: x86.32 %unary-float-function ( dst src func -- )
|
||||
0 dst src float-function-param
|
||||
func "libm" load-library f %alien-invoke
|
||||
func "libm" load-library f %c-invoke
|
||||
dst double-rep %load-return ;
|
||||
|
||||
M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
|
||||
0 dst src1 float-function-param
|
||||
8 dst src2 float-function-param
|
||||
func "libm" load-library f %alien-invoke
|
||||
func "libm" load-library f %c-invoke
|
||||
dst double-rep %load-return ;
|
||||
|
||||
: funny-large-struct-return? ( return abi -- ? )
|
||||
|
|
|
@ -81,38 +81,38 @@ M: x86.64 %mark-deck
|
|||
dup load-decks-offset
|
||||
[+] card-mark <byte> MOV ;
|
||||
|
||||
M:: x86.64 %load-reg-param ( dst reg rep -- )
|
||||
dst reg rep %copy ;
|
||||
M:: x86.64 %load-reg-param ( vreg rep reg -- )
|
||||
vreg reg rep %copy ;
|
||||
|
||||
M:: x86.64 %store-reg-param ( src reg rep -- )
|
||||
reg src rep %copy ;
|
||||
M:: x86.64 %store-reg-param ( vreg rep reg -- )
|
||||
reg vreg rep %copy ;
|
||||
|
||||
M:: x86.64 %unbox ( dst src func rep -- )
|
||||
param-reg-0 src tagged-rep %copy
|
||||
param-reg-1 %mov-vm-ptr
|
||||
func f f %alien-invoke
|
||||
func f f %c-invoke
|
||||
dst rep %load-return ;
|
||||
|
||||
M:: x86.64 %box ( dst src func rep gc-map -- )
|
||||
0 rep reg-class-of cdecl param-regs at nth src rep %copy
|
||||
rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
|
||||
func f gc-map %alien-invoke
|
||||
func f gc-map %c-invoke
|
||||
dst int-rep %load-return ;
|
||||
|
||||
M:: x86.64 %allot-byte-array ( dst size gc-map -- )
|
||||
param-reg-0 size MOV
|
||||
param-reg-1 %mov-vm-ptr
|
||||
"allot_byte_array" f gc-map %alien-invoke
|
||||
"allot_byte_array" f gc-map %c-invoke
|
||||
dst int-rep %load-return ;
|
||||
|
||||
M: x86.64 %alien-invoke
|
||||
M: x86.64 %c-invoke
|
||||
[ R11 0 MOV rc-absolute-cell rel-dlsym R11 CALL ] dip
|
||||
gc-map-here ;
|
||||
|
||||
M: x86.64 %begin-callback ( -- )
|
||||
param-reg-0 %mov-vm-ptr
|
||||
param-reg-1 0 MOV
|
||||
"begin_callback" f f %alien-invoke ;
|
||||
"begin_callback" f f %c-invoke ;
|
||||
|
||||
M: x86.64 %alien-callback ( quot -- )
|
||||
[ param-reg-0 ] dip %load-reference
|
||||
|
@ -120,14 +120,14 @@ M: x86.64 %alien-callback ( quot -- )
|
|||
|
||||
M: x86.64 %end-callback ( -- )
|
||||
param-reg-0 %mov-vm-ptr
|
||||
"end_callback" f f %alien-invoke ;
|
||||
"end_callback" f f %c-invoke ;
|
||||
|
||||
: float-function-param ( i src -- )
|
||||
[ float-regs cdecl param-regs at nth ] dip double-rep %copy ;
|
||||
|
||||
M:: x86.64 %unary-float-function ( dst src func -- )
|
||||
0 src float-function-param
|
||||
func "libm" load-library f %alien-invoke
|
||||
func "libm" load-library f %c-invoke
|
||||
dst double-rep %load-return ;
|
||||
|
||||
M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
|
||||
|
@ -135,9 +135,13 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
|
|||
! src2 is always a spill slot
|
||||
0 src1 float-function-param
|
||||
1 src2 float-function-param
|
||||
func "libm" load-library f %alien-invoke
|
||||
func "libm" load-library f %c-invoke
|
||||
dst double-rep %load-return ;
|
||||
|
||||
M: x86.64 stack-cleanup 3drop 0 ;
|
||||
|
||||
M: x86.64 %cleanup 0 assert= ;
|
||||
|
||||
M: x86.64 long-long-on-stack? f ;
|
||||
|
||||
M: x86.64 float-on-stack? f ;
|
||||
|
|
|
@ -587,14 +587,8 @@ M:: x86 %spill ( src rep dst -- )
|
|||
M:: x86 %reload ( dst rep src -- )
|
||||
dst src rep %copy ;
|
||||
|
||||
M:: x86 %store-stack-param ( src n rep -- )
|
||||
n reserved-stack-space + stack@ src rep %copy ;
|
||||
|
||||
: %load-return ( dst rep -- )
|
||||
[ reg-class-of return-regs at first ] keep %load-reg-param ;
|
||||
|
||||
: %store-return ( dst rep -- )
|
||||
[ reg-class-of return-regs at first ] keep %store-reg-param ;
|
||||
M:: x86 %local-allot ( dst size align offset -- )
|
||||
dst offset local-allot-offset special-offset stack@ LEA ;
|
||||
|
||||
: next-stack@ ( n -- operand )
|
||||
#! nth parameter from the next stack frame. Used to box
|
||||
|
@ -603,14 +597,62 @@ M:: x86 %store-stack-param ( src n rep -- )
|
|||
#! set up by the caller.
|
||||
[ frame-reg ] dip 2 cells + reserved-stack-space + [+] ;
|
||||
|
||||
M:: x86 %load-stack-param ( dst n rep -- )
|
||||
dst n next-stack@ rep %copy ;
|
||||
: return-reg ( rep -- reg )
|
||||
reg-class-of return-regs at first ;
|
||||
|
||||
M:: x86 %local-allot ( dst size align offset -- )
|
||||
dst offset local-allot-offset special-offset stack@ LEA ;
|
||||
:: %load-stack-param ( dst rep n -- )
|
||||
rep return-reg n next-stack@ rep %copy
|
||||
dst rep return-reg rep %copy ;
|
||||
|
||||
M: x86 %alien-indirect ( src gc-map -- )
|
||||
[ ?spill-slot CALL ] [ gc-map-here ] bi* ;
|
||||
:: %store-stack-param ( src rep n -- )
|
||||
rep return-reg src rep %copy
|
||||
n reserved-stack-space + stack@ rep return-reg rep %copy ;
|
||||
|
||||
HOOK: %load-reg-param cpu ( vreg rep reg -- )
|
||||
|
||||
HOOK: %store-reg-param cpu ( vreg rep reg -- )
|
||||
|
||||
: %load-return ( dst rep -- )
|
||||
dup return-reg %load-reg-param ;
|
||||
|
||||
: %store-return ( dst rep -- )
|
||||
dup return-reg %store-reg-param ;
|
||||
|
||||
HOOK: %prepare-var-args cpu ( -- )
|
||||
|
||||
HOOK: %cleanup cpu ( n -- )
|
||||
|
||||
:: emit-alien-insn ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot -- )
|
||||
stack-inputs [ first3 %store-stack-param ] each
|
||||
reg-inputs [ first3 %store-reg-param ] each
|
||||
quot call
|
||||
cleanup %cleanup
|
||||
reg-outputs [ first3 %load-reg-param ] each ; inline
|
||||
|
||||
M: x86 %alien-invoke ( reg-inputs stack-inputs reg-outputs cleanup stack-size symbols dll gc-map -- )
|
||||
'[ _ _ _ %c-invoke ] emit-alien-insn ;
|
||||
|
||||
M:: x86 %alien-indirect ( src reg-inputs stack-inputs reg-outputs cleanup stack-size gc-map -- )
|
||||
reg-inputs stack-inputs reg-outputs cleanup stack-size [
|
||||
src ?spill-slot CALL
|
||||
gc-map gc-map-here
|
||||
] emit-alien-insn ;
|
||||
|
||||
M: x86 %alien-assembly ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot gc-map -- )
|
||||
'[ _ _ gc-map set call( -- ) ] emit-alien-insn ;
|
||||
|
||||
HOOK: %begin-callback cpu ( -- )
|
||||
|
||||
M: x86 %callback-inputs ( reg-outputs stack-outputs -- )
|
||||
[ [ first3 %load-reg-param ] each ]
|
||||
[ [ first3 %load-stack-param ] each ] bi*
|
||||
%begin-callback ;
|
||||
|
||||
HOOK: %end-callback cpu ( -- )
|
||||
|
||||
M: x86 %callback-outputs ( reg-inputs -- )
|
||||
%end-callback
|
||||
[ first3 %store-reg-param ] each ;
|
||||
|
||||
M: x86 %loop-entry 16 alignment [ NOP ] times ;
|
||||
|
||||
|
@ -655,20 +697,20 @@ M: x86 immediate-bitwise? ( n -- ? )
|
|||
|
||||
:: (%compare-float) ( dst src1 src2 cc temp compare -- )
|
||||
cc {
|
||||
{ cc< [ src2 src1 \ compare call( a b -- ) dst temp \ CMOVA (%boolean) ] }
|
||||
{ cc<= [ src2 src1 \ compare call( a b -- ) dst temp \ CMOVAE (%boolean) ] }
|
||||
{ cc> [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVA (%boolean) ] }
|
||||
{ cc>= [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVAE (%boolean) ] }
|
||||
{ cc= [ src1 src2 \ compare call( a b -- ) dst temp \ %cmov-float= (%boolean) ] }
|
||||
{ cc<> [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVNE (%boolean) ] }
|
||||
{ cc<>= [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVNP (%boolean) ] }
|
||||
{ cc/< [ src2 src1 \ compare call( a b -- ) dst temp \ CMOVBE (%boolean) ] }
|
||||
{ cc/<= [ src2 src1 \ compare call( a b -- ) dst temp \ CMOVB (%boolean) ] }
|
||||
{ cc/> [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVBE (%boolean) ] }
|
||||
{ cc/>= [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVB (%boolean) ] }
|
||||
{ cc/= [ src1 src2 \ compare call( a b -- ) dst temp \ %cmov-float/= (%boolean) ] }
|
||||
{ cc/<> [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVE (%boolean) ] }
|
||||
{ cc/<>= [ src1 src2 \ compare call( a b -- ) dst temp \ CMOVP (%boolean) ] }
|
||||
{ cc< [ src2 src1 compare call( a b -- ) dst temp \ CMOVA (%boolean) ] }
|
||||
{ cc<= [ src2 src1 compare call( a b -- ) dst temp \ CMOVAE (%boolean) ] }
|
||||
{ cc> [ src1 src2 compare call( a b -- ) dst temp \ CMOVA (%boolean) ] }
|
||||
{ cc>= [ src1 src2 compare call( a b -- ) dst temp \ CMOVAE (%boolean) ] }
|
||||
{ cc= [ src1 src2 compare call( a b -- ) dst temp \ %cmov-float= (%boolean) ] }
|
||||
{ cc<> [ src1 src2 compare call( a b -- ) dst temp \ CMOVNE (%boolean) ] }
|
||||
{ cc<>= [ src1 src2 compare call( a b -- ) dst temp \ CMOVNP (%boolean) ] }
|
||||
{ cc/< [ src2 src1 compare call( a b -- ) dst temp \ CMOVBE (%boolean) ] }
|
||||
{ cc/<= [ src2 src1 compare call( a b -- ) dst temp \ CMOVB (%boolean) ] }
|
||||
{ cc/> [ src1 src2 compare call( a b -- ) dst temp \ CMOVBE (%boolean) ] }
|
||||
{ cc/>= [ src1 src2 compare call( a b -- ) dst temp \ CMOVB (%boolean) ] }
|
||||
{ cc/= [ src1 src2 compare call( a b -- ) dst temp \ %cmov-float/= (%boolean) ] }
|
||||
{ cc/<> [ src1 src2 compare call( a b -- ) dst temp \ CMOVE (%boolean) ] }
|
||||
{ cc/<>= [ src1 src2 compare call( a b -- ) dst temp \ CMOVP (%boolean) ] }
|
||||
} case ; inline
|
||||
|
||||
: %jump-float= ( label -- )
|
||||
|
@ -684,20 +726,20 @@ M: x86 immediate-bitwise? ( n -- ? )
|
|||
|
||||
:: (%compare-float-branch) ( label src1 src2 cc compare -- )
|
||||
cc {
|
||||
{ cc< [ src2 src1 \ compare call( a b -- ) label JA ] }
|
||||
{ cc<= [ src2 src1 \ compare call( a b -- ) label JAE ] }
|
||||
{ cc> [ src1 src2 \ compare call( a b -- ) label JA ] }
|
||||
{ cc>= [ src1 src2 \ compare call( a b -- ) label JAE ] }
|
||||
{ cc= [ src1 src2 \ compare call( a b -- ) label %jump-float= ] }
|
||||
{ cc<> [ src1 src2 \ compare call( a b -- ) label JNE ] }
|
||||
{ cc<>= [ src1 src2 \ compare call( a b -- ) label JNP ] }
|
||||
{ cc/< [ src2 src1 \ compare call( a b -- ) label JBE ] }
|
||||
{ cc/<= [ src2 src1 \ compare call( a b -- ) label JB ] }
|
||||
{ cc/> [ src1 src2 \ compare call( a b -- ) label JBE ] }
|
||||
{ cc/>= [ src1 src2 \ compare call( a b -- ) label JB ] }
|
||||
{ cc/= [ src1 src2 \ compare call( a b -- ) label %jump-float/= ] }
|
||||
{ cc/<> [ src1 src2 \ compare call( a b -- ) label JE ] }
|
||||
{ cc/<>= [ src1 src2 \ compare call( a b -- ) label JP ] }
|
||||
{ cc< [ src2 src1 compare call( a b -- ) label JA ] }
|
||||
{ cc<= [ src2 src1 compare call( a b -- ) label JAE ] }
|
||||
{ cc> [ src1 src2 compare call( a b -- ) label JA ] }
|
||||
{ cc>= [ src1 src2 compare call( a b -- ) label JAE ] }
|
||||
{ cc= [ src1 src2 compare call( a b -- ) label %jump-float= ] }
|
||||
{ cc<> [ src1 src2 compare call( a b -- ) label JNE ] }
|
||||
{ cc<>= [ src1 src2 compare call( a b -- ) label JNP ] }
|
||||
{ cc/< [ src2 src1 compare call( a b -- ) label JBE ] }
|
||||
{ cc/<= [ src2 src1 compare call( a b -- ) label JB ] }
|
||||
{ cc/> [ src1 src2 compare call( a b -- ) label JBE ] }
|
||||
{ cc/>= [ src1 src2 compare call( a b -- ) label JB ] }
|
||||
{ cc/= [ src1 src2 compare call( a b -- ) label %jump-float/= ] }
|
||||
{ cc/<> [ src1 src2 compare call( a b -- ) label JE ] }
|
||||
{ cc/<>= [ src1 src2 compare call( a b -- ) label JP ] }
|
||||
} case ;
|
||||
|
||||
enable-min/max
|
||||
|
|
Loading…
Reference in New Issue