Now that #foo and ##foo are symbols we can remove a bunch of \
Slava Pestov
parent
8e7baef1a0
commit
910748819d
|
|
@ -209,9 +209,9 @@ M: ##slot insn-object obj>> resolve ;
|
|||
M: ##slot-imm insn-object obj>> resolve ;
|
||||
M: ##set-slot insn-object obj>> resolve ;
|
||||
M: ##set-slot-imm insn-object obj>> resolve ;
|
||||
M: ##alien-global insn-object drop \ ##alien-global ;
|
||||
M: ##vm-field insn-object drop \ ##vm-field ;
|
||||
M: ##set-vm-field insn-object drop \ ##vm-field ;
|
||||
M: ##alien-global insn-object drop ##alien-global ;
|
||||
M: ##vm-field insn-object drop ##vm-field ;
|
||||
M: ##set-vm-field insn-object drop ##vm-field ;
|
||||
|
||||
GENERIC: analyze-aliases ( insn -- insn' )
|
||||
|
||||
|
|
@ -281,7 +281,7 @@ M: ##copy analyze-aliases
|
|||
M: ##compare analyze-aliases
|
||||
call-next-method
|
||||
dup useless-compare? [
|
||||
dst>> f \ ##load-reference new-insn
|
||||
dst>> f ##load-reference new-insn
|
||||
analyze-aliases
|
||||
] when ;
|
||||
|
||||
|
|
@ -317,8 +317,8 @@ M: insn eliminate-dead-stores drop t ;
|
|||
dead-stores get table>> clear-assoc
|
||||
|
||||
next-ac heap-ac set
|
||||
\ ##vm-field set-new-ac
|
||||
\ ##alien-global set-new-ac ;
|
||||
##vm-field set-new-ac
|
||||
##alien-global set-new-ac ;
|
||||
|
||||
: alias-analysis-step ( insns -- insns' )
|
||||
reset-alias-analysis
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
|
|||
2 <clumps> [
|
||||
first2 allocation-size
|
||||
cc<= int-rep next-vreg-rep int-rep next-vreg-rep
|
||||
\ ##check-nursery-branch new-insn
|
||||
##check-nursery-branch new-insn
|
||||
swap push
|
||||
] each ;
|
||||
|
||||
|
|
|
|||
|
|
@ -47,8 +47,8 @@ M: insn visit-insn drop ;
|
|||
[ <reversed> [ visit-insn ] each ]
|
||||
[
|
||||
[ [ ##inc-d? ] [ ##inc-r? ] bi or not ] filter!
|
||||
ds-height get [ \ ##inc-d new-insn prefix ] unless-zero
|
||||
rs-height get [ \ ##inc-r new-insn prefix ] unless-zero
|
||||
ds-height get [ ##inc-d new-insn prefix ] unless-zero
|
||||
rs-height get [ ##inc-r new-insn prefix ] unless-zero
|
||||
] bi ;
|
||||
|
||||
: normalize-height ( cfg -- cfg' )
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ M: insn modifies-context? drop f ;
|
|||
[
|
||||
int-rep next-vreg-rep
|
||||
int-rep next-vreg-rep
|
||||
\ ##save-context new-insn
|
||||
##save-context new-insn
|
||||
] dip
|
||||
[ save-context-offset ] keep
|
||||
[ insert-nth ] change-instructions drop
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ M: vreg-insn compute-insn-defs
|
|||
SYMBOL: inserting-phis
|
||||
|
||||
: insert-phi-later ( vreg bb -- )
|
||||
[ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
|
||||
[ predecessors>> over '[ _ ] H{ } map>assoc ##phi new-insn ] keep
|
||||
inserting-phis get push-at ;
|
||||
|
||||
: compute-phis-for ( vreg bbs -- )
|
||||
|
|
|
|||
|
|
@ -34,15 +34,15 @@ IN: compiler.cfg.tco
|
|||
'[
|
||||
instructions>>
|
||||
[ pop* ] [ pop ] [ ] tri
|
||||
[ [ \ ##safepoint new-insn ] dip push ]
|
||||
[ [ \ ##epilogue new-insn ] dip push ]
|
||||
[ [ ##safepoint new-insn ] dip push ]
|
||||
[ [ ##epilogue new-insn ] dip push ]
|
||||
[ _ dip push ] tri
|
||||
]
|
||||
[ successors>> delete-all ]
|
||||
bi ; inline
|
||||
|
||||
: convert-word-tail-call ( bb -- )
|
||||
[ word>> \ ##jump new-insn ] convert-tail-call ;
|
||||
[ word>> ##jump new-insn ] convert-tail-call ;
|
||||
|
||||
: loop-tail-call? ( bb -- ? )
|
||||
instructions>> penultimate
|
||||
|
|
@ -54,8 +54,8 @@ IN: compiler.cfg.tco
|
|||
instructions>> {
|
||||
[ pop* ]
|
||||
[ pop* ]
|
||||
[ [ \ ##safepoint new-insn ] dip push ]
|
||||
[ [ \ ##branch new-insn ] dip push ]
|
||||
[ [ ##safepoint new-insn ] dip push ]
|
||||
[ [ ##branch new-insn ] dip push ]
|
||||
} cleave
|
||||
]
|
||||
[ successors>> delete-all ]
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ IN: compiler.cfg.useless-conditionals
|
|||
|
||||
: delete-conditional ( bb -- )
|
||||
[ first skip-empty-blocks 1vector ] change-successors
|
||||
instructions>> [ pop* ] [ [ \ ##branch new-insn ] dip push ] bi ;
|
||||
instructions>> [ pop* ] [ [ ##branch new-insn ] dip push ] bi ;
|
||||
|
||||
: delete-useless-conditionals ( cfg -- cfg' )
|
||||
dup [
|
||||
|
|
|
|||
|
|
@ -78,4 +78,4 @@ SYMBOL: visited
|
|||
predecessors>> first ; inline
|
||||
|
||||
: <copy> ( dst src -- insn )
|
||||
any-rep \ ##copy new-insn ;
|
||||
any-rep ##copy new-insn ;
|
||||
|
|
|
|||
|
|
@ -82,8 +82,8 @@ M: ##store-memory-imm alien-insn-value src>> ;
|
|||
|
||||
GENERIC: new-alien-insn ( value base displacement scale offset rep c-type insn -- insn )
|
||||
|
||||
M: ##load-memory-imm new-alien-insn drop \ ##load-memory new-insn ;
|
||||
M: ##store-memory-imm new-alien-insn drop \ ##store-memory new-insn ;
|
||||
M: ##load-memory-imm new-alien-insn drop ##load-memory new-insn ;
|
||||
M: ##store-memory-imm new-alien-insn drop ##store-memory new-insn ;
|
||||
|
||||
: fuse-displacement ( insn -- insn' )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -86,27 +86,27 @@ UNION: general-compare-insn scalar-compare-insn ##test-vector ;
|
|||
|
||||
: rewrite-boolean-comparison ( insn -- insn )
|
||||
src1>> vreg>insn {
|
||||
{ [ dup ##compare? ] [ >compare< \ ##compare-branch new-insn ] }
|
||||
{ [ dup ##compare-imm? ] [ >compare< \ ##compare-imm-branch new-insn ] }
|
||||
{ [ dup ##compare-integer? ] [ >compare< \ ##compare-integer-branch new-insn ] }
|
||||
{ [ dup ##compare-integer-imm? ] [ >compare< \ ##compare-integer-imm-branch new-insn ] }
|
||||
{ [ dup ##test? ] [ >compare< \ ##test-branch new-insn ] }
|
||||
{ [ dup ##test-imm? ] [ >compare< \ ##test-imm-branch new-insn ] }
|
||||
{ [ dup ##compare-float-unordered? ] [ >compare< \ ##compare-float-unordered-branch new-insn ] }
|
||||
{ [ dup ##compare-float-ordered? ] [ >compare< \ ##compare-float-ordered-branch new-insn ] }
|
||||
{ [ dup ##test-vector? ] [ >test-vector< \ ##test-vector-branch new-insn ] }
|
||||
{ [ dup ##compare? ] [ >compare< ##compare-branch new-insn ] }
|
||||
{ [ dup ##compare-imm? ] [ >compare< ##compare-imm-branch new-insn ] }
|
||||
{ [ dup ##compare-integer? ] [ >compare< ##compare-integer-branch new-insn ] }
|
||||
{ [ dup ##compare-integer-imm? ] [ >compare< ##compare-integer-imm-branch new-insn ] }
|
||||
{ [ dup ##test? ] [ >compare< ##test-branch new-insn ] }
|
||||
{ [ dup ##test-imm? ] [ >compare< ##test-imm-branch new-insn ] }
|
||||
{ [ dup ##compare-float-unordered? ] [ >compare< ##compare-float-unordered-branch new-insn ] }
|
||||
{ [ dup ##compare-float-ordered? ] [ >compare< ##compare-float-ordered-branch new-insn ] }
|
||||
{ [ dup ##test-vector? ] [ >test-vector< ##test-vector-branch new-insn ] }
|
||||
} cond ;
|
||||
|
||||
: fold-branch ( ? -- insn )
|
||||
0 1 ?
|
||||
basic-block get [ nth 1vector ] change-successors drop
|
||||
\ ##branch new-insn ;
|
||||
##branch new-insn ;
|
||||
|
||||
: fold-compare-imm-branch ( insn -- insn/f )
|
||||
evaluate-compare-imm fold-branch ;
|
||||
|
||||
: >test-branch ( insn -- insn )
|
||||
[ src1>> ] [ src1>> ] [ cc>> ] tri \ ##test-branch new-insn ;
|
||||
[ src1>> ] [ src1>> ] [ cc>> ] tri ##test-branch new-insn ;
|
||||
|
||||
M: ##compare-imm-branch rewrite
|
||||
{
|
||||
|
|
@ -143,12 +143,12 @@ M: ##test-imm-branch rewrite
|
|||
: >compare-imm-branch ( insn swap? -- insn' )
|
||||
(>compare-imm-branch)
|
||||
[ vreg>literal ] dip
|
||||
\ ##compare-imm-branch new-insn ; inline
|
||||
##compare-imm-branch new-insn ; inline
|
||||
|
||||
: >compare-integer-imm-branch ( insn swap? -- insn' )
|
||||
(>compare-imm-branch)
|
||||
[ vreg>integer ] dip
|
||||
\ ##compare-integer-imm-branch new-insn ; inline
|
||||
##compare-integer-imm-branch new-insn ; inline
|
||||
|
||||
: evaluate-self-compare ( insn -- ? )
|
||||
cc>> { cc= cc<= cc>= } member-eq? ;
|
||||
|
|
@ -179,15 +179,15 @@ M: ##compare-integer-branch rewrite
|
|||
: >compare-imm ( insn swap? -- insn' )
|
||||
(>compare-imm)
|
||||
[ vreg>literal ] dip
|
||||
next-vreg \ ##compare-imm new-insn ; inline
|
||||
next-vreg ##compare-imm new-insn ; inline
|
||||
|
||||
: >compare-integer-imm ( insn swap? -- insn' )
|
||||
(>compare-imm)
|
||||
[ vreg>integer ] dip
|
||||
next-vreg \ ##compare-integer-imm new-insn ; inline
|
||||
next-vreg ##compare-integer-imm new-insn ; inline
|
||||
|
||||
: >boolean-insn ( insn ? -- insn' )
|
||||
[ dst>> ] dip \ ##load-reference new-insn ;
|
||||
[ dst>> ] dip ##load-reference new-insn ;
|
||||
|
||||
: rewrite-self-compare ( insn -- insn' )
|
||||
dup evaluate-self-compare >boolean-insn ;
|
||||
|
|
@ -217,14 +217,14 @@ M: ##compare-integer rewrite
|
|||
|
||||
: rewrite-redundant-comparison ( insn -- insn' )
|
||||
[ cc>> ] [ dst>> ] [ src1>> vreg>insn ] tri {
|
||||
{ [ dup ##compare? ] [ >compare< next-vreg \ ##compare new-insn ] }
|
||||
{ [ dup ##compare-imm? ] [ >compare< next-vreg \ ##compare-imm new-insn ] }
|
||||
{ [ dup ##compare-integer? ] [ >compare< next-vreg \ ##compare-integer new-insn ] }
|
||||
{ [ dup ##compare-integer-imm? ] [ >compare< next-vreg \ ##compare-integer-imm new-insn ] }
|
||||
{ [ dup ##test? ] [ >compare< next-vreg \ ##test new-insn ] }
|
||||
{ [ dup ##test-imm? ] [ >compare< next-vreg \ ##test-imm new-insn ] }
|
||||
{ [ dup ##compare-float-unordered? ] [ >compare< next-vreg \ ##compare-float-unordered new-insn ] }
|
||||
{ [ dup ##compare-float-ordered? ] [ >compare< next-vreg \ ##compare-float-ordered new-insn ] }
|
||||
{ [ dup ##compare? ] [ >compare< next-vreg ##compare new-insn ] }
|
||||
{ [ dup ##compare-imm? ] [ >compare< next-vreg ##compare-imm new-insn ] }
|
||||
{ [ dup ##compare-integer? ] [ >compare< next-vreg ##compare-integer new-insn ] }
|
||||
{ [ dup ##compare-integer-imm? ] [ >compare< next-vreg ##compare-integer-imm new-insn ] }
|
||||
{ [ dup ##test? ] [ >compare< next-vreg ##test new-insn ] }
|
||||
{ [ dup ##test-imm? ] [ >compare< next-vreg ##test-imm new-insn ] }
|
||||
{ [ dup ##compare-float-unordered? ] [ >compare< next-vreg ##compare-float-unordered new-insn ] }
|
||||
{ [ dup ##compare-float-ordered? ] [ >compare< next-vreg ##compare-float-ordered new-insn ] }
|
||||
} cond
|
||||
swap cc= eq? [ [ negate-cc ] change-cc ] when ;
|
||||
|
||||
|
|
@ -243,7 +243,7 @@ M: ##compare-imm rewrite
|
|||
|
||||
: >test ( insn -- insn' )
|
||||
{ [ dst>> ] [ src1>> ] [ src1>> ] [ cc>> ] [ temp>> ] } cleave
|
||||
\ ##test new-insn ;
|
||||
##test new-insn ;
|
||||
|
||||
M: ##compare-integer-imm rewrite
|
||||
{
|
||||
|
|
@ -265,18 +265,18 @@ M: ##compare-integer-imm rewrite
|
|||
[ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline
|
||||
|
||||
: simplify-test-imm ( insn -- insn )
|
||||
[ dst>> ] [ (simplify-test-imm) ] [ temp>> ] tri \ ##test-imm new-insn ; inline
|
||||
[ dst>> ] [ (simplify-test-imm) ] [ temp>> ] tri ##test-imm new-insn ; inline
|
||||
|
||||
: simplify-test-imm-branch ( insn -- insn )
|
||||
(simplify-test-imm) \ ##test-imm-branch new-insn ; inline
|
||||
(simplify-test-imm) ##test-imm-branch new-insn ; inline
|
||||
|
||||
: >test-imm ( insn ? -- insn' )
|
||||
(>compare-imm) [ vreg>integer ] dip next-vreg
|
||||
\ ##test-imm new-insn ; inline
|
||||
##test-imm new-insn ; inline
|
||||
|
||||
: >test-imm-branch ( insn ? -- insn' )
|
||||
(>compare-imm-branch) [ vreg>integer ] dip
|
||||
\ ##test-imm-branch new-insn ; inline
|
||||
##test-imm-branch new-insn ; inline
|
||||
|
||||
M: ##test rewrite
|
||||
{
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ M: ##shl-imm binary-constant-fold* drop shift ;
|
|||
: binary-constant-fold ( insn -- insn' )
|
||||
[ dst>> ]
|
||||
[ [ src1>> vreg>integer ] [ src2>> ] [ ] tri binary-constant-fold* ] bi
|
||||
\ ##load-integer new-insn ; inline
|
||||
##load-integer new-insn ; inline
|
||||
|
||||
: unary-constant-fold? ( insn -- ? )
|
||||
src>> vreg>insn ##load-integer? ; inline
|
||||
|
|
@ -36,4 +36,4 @@ M: ##neg unary-constant-fold* drop neg ;
|
|||
|
||||
: unary-constant-fold ( insn -- insn' )
|
||||
[ dst>> ] [ [ src>> vreg>integer ] [ ] bi unary-constant-fold* ] bi
|
||||
\ ##load-integer new-insn ; inline
|
||||
##load-integer new-insn ; inline
|
||||
|
|
|
|||
|
|
@ -18,8 +18,8 @@ IN: compiler.cfg.value-numbering.math
|
|||
|
||||
M: ##tagged>integer rewrite
|
||||
[ dst>> ] [ src>> vreg>insn ] bi {
|
||||
{ [ dup ##load-integer? ] [ val>> tag-fixnum \ ##load-integer new-insn ] }
|
||||
{ [ dup f-insn? ] [ drop \ f type-number \ ##load-integer new-insn ] }
|
||||
{ [ dup ##load-integer? ] [ val>> tag-fixnum ##load-integer new-insn ] }
|
||||
{ [ dup f-insn? ] [ drop \ f type-number ##load-integer new-insn ] }
|
||||
[ 2drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -76,14 +76,14 @@ M: ##add-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##add-imm? ] [ \ ##add-imm reassociate-arithmetic ] }
|
||||
{ [ dup src1>> vreg>insn ##add-imm? ] [ ##add-imm reassociate-arithmetic ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
: sub-imm>add-imm ( insn -- insn' )
|
||||
[ dst>> ] [ src1>> ] [ src2>> neg ] tri
|
||||
dup immediate-arithmetic?
|
||||
\ ##add-imm ?new-insn ;
|
||||
##add-imm ?new-insn ;
|
||||
|
||||
M: ##sub-imm rewrite sub-imm>add-imm ;
|
||||
|
||||
|
|
@ -92,14 +92,14 @@ M: ##sub-imm rewrite sub-imm>add-imm ;
|
|||
src2>> -1 = ;
|
||||
|
||||
: mul-to-neg ( insn -- insn' )
|
||||
[ dst>> ] [ src1>> ] bi \ ##neg new-insn ;
|
||||
[ dst>> ] [ src1>> ] bi ##neg new-insn ;
|
||||
|
||||
! Convert ##mul-imm 2^X => ##shl-imm X
|
||||
: mul-to-shl? ( insn -- ? )
|
||||
src2>> power-of-2? ;
|
||||
|
||||
: mul-to-shl ( insn -- insn' )
|
||||
[ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi \ ##shl-imm new-insn ;
|
||||
[ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi ##shl-imm new-insn ;
|
||||
|
||||
! Distribution converts
|
||||
! ##+-imm 2 1 X
|
||||
|
|
@ -135,7 +135,7 @@ M: ##mul-imm rewrite
|
|||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup mul-to-neg? ] [ mul-to-neg ] }
|
||||
{ [ dup mul-to-shl? ] [ mul-to-shl ] }
|
||||
{ [ dup src1>> vreg>insn ##mul-imm? ] [ \ ##mul-imm reassociate-arithmetic ] }
|
||||
{ [ dup src1>> vreg>insn ##mul-imm? ] [ ##mul-imm reassociate-arithmetic ] }
|
||||
{ [ dup distribute-over-add? ] [ \ ##add-imm, \ ##mul-imm, distribute ] }
|
||||
{ [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##mul-imm, distribute ] }
|
||||
[ drop f ]
|
||||
|
|
@ -144,8 +144,8 @@ M: ##mul-imm rewrite
|
|||
M: ##and-imm rewrite
|
||||
{
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##and-imm? ] [ \ ##and-imm reassociate-bitwise ] }
|
||||
{ [ dup src2>> 0 = ] [ dst>> 0 \ ##load-integer new-insn ] }
|
||||
{ [ dup src1>> vreg>insn ##and-imm? ] [ ##and-imm reassociate-bitwise ] }
|
||||
{ [ dup src2>> 0 = ] [ dst>> 0 ##load-integer new-insn ] }
|
||||
{ [ dup src2>> -1 = ] [ identity ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
|
@ -153,18 +153,18 @@ M: ##and-imm rewrite
|
|||
M: ##or-imm rewrite
|
||||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup src2>> -1 = ] [ dst>> -1 \ ##load-integer new-insn ] }
|
||||
{ [ dup src2>> -1 = ] [ dst>> -1 ##load-integer new-insn ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##or-imm? ] [ \ ##or-imm reassociate-bitwise ] }
|
||||
{ [ dup src1>> vreg>insn ##or-imm? ] [ ##or-imm reassociate-bitwise ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##xor-imm rewrite
|
||||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup src2>> -1 = ] [ [ dst>> ] [ src1>> ] bi \ ##not new-insn ] }
|
||||
{ [ dup src2>> -1 = ] [ [ dst>> ] [ src1>> ] bi ##not new-insn ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##xor-imm? ] [ \ ##xor-imm reassociate-bitwise ] }
|
||||
{ [ dup src1>> vreg>insn ##xor-imm? ] [ ##xor-imm reassociate-bitwise ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -172,7 +172,7 @@ M: ##shl-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##shl-imm? ] [ \ ##shl-imm reassociate-shift ] }
|
||||
{ [ dup src1>> vreg>insn ##shl-imm? ] [ ##shl-imm reassociate-shift ] }
|
||||
{ [ dup distribute-over-add? ] [ \ ##add-imm, \ ##shl-imm, distribute ] }
|
||||
{ [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##shl-imm, distribute ] }
|
||||
[ drop f ]
|
||||
|
|
@ -182,7 +182,7 @@ M: ##shr-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##shr-imm? ] [ \ ##shr-imm reassociate-shift ] }
|
||||
{ [ dup src1>> vreg>insn ##shr-imm? ] [ ##shr-imm reassociate-shift ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -190,7 +190,7 @@ M: ##sar-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>insn ##sar-imm? ] [ \ ##sar-imm reassociate-shift ] }
|
||||
{ [ dup src1>> vreg>insn ##sar-imm? ] [ ##sar-imm reassociate-shift ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -207,8 +207,8 @@ M: ##sar-imm rewrite
|
|||
|
||||
M: ##add rewrite
|
||||
{
|
||||
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##add-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-arithmetic? ] [ \ ##add-imm t insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-arithmetic? ] [ ##add-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-arithmetic? ] [ ##add-imm t insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -217,7 +217,7 @@ M: ##add rewrite
|
|||
|
||||
! ##sub 2 1 1 => ##load-integer 2 0
|
||||
: rewrite-subtraction-identity ( insn -- insn' )
|
||||
dst>> 0 \ ##load-integer new-insn ;
|
||||
dst>> 0 ##load-integer new-insn ;
|
||||
|
||||
! ##load-integer 1 0
|
||||
! ##sub 3 1 2
|
||||
|
|
@ -227,61 +227,61 @@ M: ##add rewrite
|
|||
src1>> vreg>insn zero-insn? ;
|
||||
|
||||
: sub-to-neg ( ##sub -- insn )
|
||||
[ dst>> ] [ src2>> ] bi \ ##neg new-insn ;
|
||||
[ dst>> ] [ src2>> ] bi ##neg new-insn ;
|
||||
|
||||
M: ##sub rewrite
|
||||
{
|
||||
{ [ dup sub-to-neg? ] [ sub-to-neg ] }
|
||||
{ [ dup diagonal? ] [ rewrite-subtraction-identity ] }
|
||||
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##sub-imm f insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-arithmetic? ] [ ##sub-imm f insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##mul rewrite
|
||||
{
|
||||
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##mul-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-arithmetic? ] [ \ ##mul-imm t insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-arithmetic? ] [ ##mul-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-arithmetic? ] [ ##mul-imm t insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##and rewrite
|
||||
{
|
||||
{ [ dup diagonal? ] [ identity ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##and-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##and-imm t insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ ##and-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-bitwise? ] [ ##and-imm t insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##or rewrite
|
||||
{
|
||||
{ [ dup diagonal? ] [ identity ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##or-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##or-imm t insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ ##or-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-bitwise? ] [ ##or-imm t insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##xor rewrite
|
||||
{
|
||||
{ [ dup diagonal? ] [ dst>> 0 \ ##load-integer new-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##xor-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##xor-imm t insn>imm-insn ] }
|
||||
{ [ dup diagonal? ] [ dst>> 0 ##load-integer new-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ ##xor-imm f insn>imm-insn ] }
|
||||
{ [ dup src1>> vreg-immediate-bitwise? ] [ ##xor-imm t insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##shl rewrite
|
||||
{
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##shl-imm f insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ ##shl-imm f insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##shr rewrite
|
||||
{
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##shr-imm f insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ ##shr-imm f insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##sar rewrite
|
||||
{
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##sar-imm f insn>imm-insn ] }
|
||||
{ [ dup src2>> vreg-immediate-bitwise? ] [ ##sar-imm f insn>imm-insn ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
|
|
|||
|
|
@ -10,5 +10,5 @@ M: ##replace rewrite
|
|||
[ loc>> ] [ src>> vreg>insn ] bi
|
||||
dup literal-insn? [
|
||||
insn>literal dup immediate-store?
|
||||
[ swap \ ##replace-imm new-insn ] [ 2drop f ] if
|
||||
[ swap ##replace-imm new-insn ] [ 2drop f ] if
|
||||
] [ 2drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ IN: compiler.cfg.value-numbering.simd
|
|||
[ [ dst>> ] [ src>> ] bi* ]
|
||||
[ [ shuffle>> ] bi@ nths ]
|
||||
[ drop rep>> ]
|
||||
2tri \ ##shuffle-vector-imm new-insn
|
||||
2tri ##shuffle-vector-imm new-insn
|
||||
] [ 2drop f ] if ;
|
||||
|
||||
: (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' )
|
||||
|
|
@ -34,7 +34,7 @@ IN: compiler.cfg.value-numbering.simd
|
|||
|
||||
: fold-shuffle-vector-imm ( outer inner -- insn' )
|
||||
[ [ dst>> ] [ shuffle>> ] bi ] [ obj>> ] bi*
|
||||
(fold-shuffle-vector-imm) \ ##load-reference new-insn ;
|
||||
(fold-shuffle-vector-imm) ##load-reference new-insn ;
|
||||
|
||||
M: ##shuffle-vector-imm rewrite
|
||||
dup src>> vreg>insn {
|
||||
|
|
@ -53,7 +53,7 @@ M: ##shuffle-vector-imm rewrite
|
|||
|
||||
: (fold-scalar>vector) ( insn bytes -- insn' )
|
||||
[ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat
|
||||
\ ##load-reference new-insn ;
|
||||
##load-reference new-insn ;
|
||||
|
||||
: fold-scalar>vector ( outer inner -- insn' )
|
||||
over rep>> scalar-value (fold-scalar>vector) ;
|
||||
|
|
@ -68,7 +68,7 @@ M: ##scalar>vector rewrite
|
|||
:: fold-gather-vector-2 ( insn src1 src2 -- insn )
|
||||
insn dst>>
|
||||
src1 src2 [ insn rep>> scalar-value ] bi@ append
|
||||
\ ##load-reference new-insn ;
|
||||
##load-reference new-insn ;
|
||||
|
||||
: rewrite-gather-vector-2 ( insn -- insn/f )
|
||||
dup [ src1>> vreg>insn ] [ src2>> vreg>insn ] bi {
|
||||
|
|
@ -86,7 +86,7 @@ M: ##gather-int-vector-2 rewrite rewrite-gather-vector-2 ;
|
|||
src1 src2 src3 src4
|
||||
[ insn rep>> scalar-value ] 4 napply
|
||||
] B{ } append-outputs-as
|
||||
\ ##load-reference new-insn ;
|
||||
##load-reference new-insn ;
|
||||
|
||||
: rewrite-gather-vector-4 ( insn -- insn/f )
|
||||
dup { [ src1>> ] [ src2>> ] [ src3>> ] [ src4>> ] } cleave [ vreg>insn ] 4 napply
|
||||
|
|
@ -101,7 +101,7 @@ M: ##gather-int-vector-4 rewrite rewrite-gather-vector-4 ;
|
|||
|
||||
: fold-shuffle-vector ( insn src1 src2 -- insn )
|
||||
[ dst>> ] [ obj>> ] [ obj>> ] tri*
|
||||
swap nths \ ##load-reference new-insn ;
|
||||
swap nths ##load-reference new-insn ;
|
||||
|
||||
M: ##shuffle-vector rewrite
|
||||
dup [ src>> vreg>insn ] [ shuffle>> vreg>insn ] bi
|
||||
|
|
@ -112,7 +112,7 @@ M: ##shuffle-vector rewrite
|
|||
|
||||
M: ##xor-vector rewrite
|
||||
dup diagonal?
|
||||
[ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ;
|
||||
[ [ dst>> ] [ rep>> ] bi ##zero-vector new-insn ] [ drop f ] if ;
|
||||
|
||||
: vector-not? ( insn -- ? )
|
||||
{
|
||||
|
|
@ -139,7 +139,7 @@ M: ##and-vector rewrite
|
|||
[ src1>> vreg>insn vector-not-src ]
|
||||
[ src2>> ]
|
||||
[ rep>> ]
|
||||
} cleave \ ##andn-vector new-insn
|
||||
} cleave ##andn-vector new-insn
|
||||
] }
|
||||
{ [ dup src2>> vreg>insn vector-not? ] [
|
||||
{
|
||||
|
|
@ -147,7 +147,7 @@ M: ##and-vector rewrite
|
|||
[ src2>> vreg>insn vector-not-src ]
|
||||
[ src1>> ]
|
||||
[ rep>> ]
|
||||
} cleave \ ##andn-vector new-insn
|
||||
} cleave ##andn-vector new-insn
|
||||
] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
|
@ -159,5 +159,5 @@ M: ##andn-vector rewrite
|
|||
[ src1>> vreg>insn vector-not-src ]
|
||||
[ src2>> ]
|
||||
[ rep>> ]
|
||||
} cleave \ ##and-vector new-insn
|
||||
} cleave ##and-vector new-insn
|
||||
] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -123,14 +123,14 @@ M: #if node>quot
|
|||
M: #dispatch node>quot
|
||||
children>> [ nodes>quot ] map , \ dispatch , ;
|
||||
|
||||
M: #alien-invoke node>quot params>> , \ #alien-invoke , ;
|
||||
M: #alien-invoke node>quot params>> , #alien-invoke , ;
|
||||
|
||||
M: #alien-indirect node>quot params>> , \ #alien-indirect , ;
|
||||
M: #alien-indirect node>quot params>> , #alien-indirect , ;
|
||||
|
||||
M: #alien-assembly node>quot params>> , \ #alien-assembly , ;
|
||||
M: #alien-assembly node>quot params>> , #alien-assembly , ;
|
||||
|
||||
M: #alien-callback node>quot
|
||||
[ params>> , ] [ child>> nodes>quot , ] bi \ #alien-callback , ;
|
||||
[ params>> , ] [ child>> nodes>quot , ] bi #alien-callback , ;
|
||||
|
||||
M: node node>quot drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@ TUPLE: node < identity-tuple ;
|
|||
TUPLE: #introduce < node out-d ;
|
||||
|
||||
: <#introduce> ( out-d -- node )
|
||||
\ #introduce new swap >>out-d ;
|
||||
#introduce new swap >>out-d ;
|
||||
|
||||
TUPLE: #call < node word in-d out-d body method class info ;
|
||||
|
||||
: <#call> ( inputs outputs word -- node )
|
||||
\ #call new
|
||||
#call new
|
||||
swap >>word
|
||||
swap >>out-d
|
||||
swap >>in-d ;
|
||||
|
|
@ -26,7 +26,7 @@ TUPLE: #call < node word in-d out-d body method class info ;
|
|||
TUPLE: #call-recursive < node label in-d out-d info ;
|
||||
|
||||
: <#call-recursive> ( inputs outputs label -- node )
|
||||
\ #call-recursive new
|
||||
#call-recursive new
|
||||
swap >>label
|
||||
swap >>out-d
|
||||
swap >>in-d ;
|
||||
|
|
@ -34,7 +34,7 @@ TUPLE: #call-recursive < node label in-d out-d info ;
|
|||
TUPLE: #push < node literal out-d ;
|
||||
|
||||
: <#push> ( literal value -- node )
|
||||
\ #push new
|
||||
#push new
|
||||
swap 1array >>out-d
|
||||
swap >>literal ;
|
||||
|
||||
|
|
@ -43,7 +43,7 @@ TUPLE: #renaming < node ;
|
|||
TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
|
||||
|
||||
: <#shuffle> ( in-d out-d in-r out-r mapping -- node )
|
||||
\ #shuffle new
|
||||
#shuffle new
|
||||
swap >>mapping
|
||||
swap >>out-r
|
||||
swap >>in-r
|
||||
|
|
@ -59,7 +59,7 @@ TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
|
|||
TUPLE: #terminate < node in-d in-r ;
|
||||
|
||||
: <#terminate> ( in-d in-r -- node )
|
||||
\ #terminate new
|
||||
#terminate new
|
||||
swap >>in-r
|
||||
swap >>in-d ;
|
||||
|
||||
|
|
@ -73,17 +73,17 @@ TUPLE: #branch < node in-d children live-branches ;
|
|||
TUPLE: #if < #branch ;
|
||||
|
||||
: <#if> ( ? true false -- node )
|
||||
2array \ #if new-branch ;
|
||||
2array #if new-branch ;
|
||||
|
||||
TUPLE: #dispatch < #branch ;
|
||||
|
||||
: <#dispatch> ( n branches -- node )
|
||||
\ #dispatch new-branch ;
|
||||
#dispatch new-branch ;
|
||||
|
||||
TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ;
|
||||
|
||||
: <#phi> ( d-phi-in d-phi-out terminated -- node )
|
||||
\ #phi new
|
||||
#phi new
|
||||
swap >>terminated
|
||||
swap >>out-d
|
||||
swap >>phi-in-d ;
|
||||
|
|
@ -91,19 +91,19 @@ TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ;
|
|||
TUPLE: #declare < node declaration ;
|
||||
|
||||
: <#declare> ( declaration -- node )
|
||||
\ #declare new
|
||||
#declare new
|
||||
swap >>declaration ;
|
||||
|
||||
TUPLE: #return < node in-d info ;
|
||||
|
||||
: <#return> ( stack -- node )
|
||||
\ #return new
|
||||
#return new
|
||||
swap >>in-d ;
|
||||
|
||||
TUPLE: #recursive < node in-d word label loop? child ;
|
||||
|
||||
: <#recursive> ( label inputs child -- node )
|
||||
\ #recursive new
|
||||
#recursive new
|
||||
swap >>child
|
||||
swap >>in-d
|
||||
swap >>label ;
|
||||
|
|
@ -111,7 +111,7 @@ TUPLE: #recursive < node in-d word label loop? child ;
|
|||
TUPLE: #enter-recursive < node in-d out-d label info ;
|
||||
|
||||
: <#enter-recursive> ( label inputs outputs -- node )
|
||||
\ #enter-recursive new
|
||||
#enter-recursive new
|
||||
swap >>out-d
|
||||
swap >>in-d
|
||||
swap >>label ;
|
||||
|
|
@ -119,7 +119,7 @@ TUPLE: #enter-recursive < node in-d out-d label info ;
|
|||
TUPLE: #return-recursive < #renaming in-d out-d label info ;
|
||||
|
||||
: <#return-recursive> ( label inputs outputs -- node )
|
||||
\ #return-recursive new
|
||||
#return-recursive new
|
||||
swap >>out-d
|
||||
swap >>in-d
|
||||
swap >>label ;
|
||||
|
|
@ -127,7 +127,7 @@ TUPLE: #return-recursive < #renaming in-d out-d label info ;
|
|||
TUPLE: #copy < #renaming in-d out-d ;
|
||||
|
||||
: <#copy> ( inputs outputs -- node )
|
||||
\ #copy new
|
||||
#copy new
|
||||
swap >>out-d
|
||||
swap >>in-d ;
|
||||
|
||||
|
|
@ -142,22 +142,22 @@ TUPLE: #alien-node < node params ;
|
|||
TUPLE: #alien-invoke < #alien-node in-d out-d ;
|
||||
|
||||
: <#alien-invoke> ( params -- node )
|
||||
\ #alien-invoke new-alien-node ;
|
||||
#alien-invoke new-alien-node ;
|
||||
|
||||
TUPLE: #alien-indirect < #alien-node in-d out-d ;
|
||||
|
||||
: <#alien-indirect> ( params -- node )
|
||||
\ #alien-indirect new-alien-node ;
|
||||
#alien-indirect new-alien-node ;
|
||||
|
||||
TUPLE: #alien-assembly < #alien-node in-d out-d ;
|
||||
|
||||
: <#alien-assembly> ( params -- node )
|
||||
\ #alien-assembly new-alien-node ;
|
||||
#alien-assembly new-alien-node ;
|
||||
|
||||
TUPLE: #alien-callback < node params child ;
|
||||
|
||||
: <#alien-callback> ( params child -- node )
|
||||
\ #alien-callback new
|
||||
#alien-callback new
|
||||
swap >>child
|
||||
swap >>params ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue