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

Now that #foo and ##foo are symbols we can remove a bunch of \

db4
Slava Pestov 2011-11-12 22:04:26 -08:00
parent 8e7baef1a0
commit 910748819d
16 changed files with 118 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/compiler/cfg/alias-analysis/alias-analysis.factor
View File

@ -209,9 +209,9 @@ M: ##slot insn-object obj>> resolve ;
M: ##slot-imm insn-object obj>> resolve ; M: ##slot-imm insn-object obj>> resolve ;
M: ##set-slot insn-object obj>> resolve ; M: ##set-slot insn-object obj>> resolve ;
M: ##set-slot-imm insn-object obj>> resolve ; M: ##set-slot-imm insn-object obj>> resolve ;
M: ##alien-global insn-object drop \ ##alien-global ; M: ##alien-global insn-object drop ##alien-global ;
M: ##vm-field insn-object drop \ ##vm-field ; M: ##vm-field insn-object drop ##vm-field ;
M: ##set-vm-field insn-object drop \ ##vm-field ; M: ##set-vm-field insn-object drop ##vm-field ;
GENERIC: analyze-aliases ( insn -- insn' ) GENERIC: analyze-aliases ( insn -- insn' )
@ -281,7 +281,7 @@ M: ##copy analyze-aliases
M: ##compare analyze-aliases M: ##compare analyze-aliases
call-next-method call-next-method
dup useless-compare? [ dup useless-compare? [
dst>> f \ ##load-reference new-insn dst>> f ##load-reference new-insn
analyze-aliases analyze-aliases
] when ; ] when ;
@ -317,8 +317,8 @@ M: insn eliminate-dead-stores drop t ;
dead-stores get table>> clear-assoc dead-stores get table>> clear-assoc
next-ac heap-ac set next-ac heap-ac set
\ ##vm-field set-new-ac ##vm-field set-new-ac
\ ##alien-global set-new-ac ; ##alien-global set-new-ac ;
: alias-analysis-step ( insns -- insns' ) : alias-analysis-step ( insns -- insns' )
reset-alias-analysis reset-alias-analysis

2
basis/compiler/cfg/gc-checks/gc-checks.factor
View File

@ -76,7 +76,7 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
2 <clumps> [ 2 <clumps> [
first2 allocation-size first2 allocation-size
cc<= int-rep next-vreg-rep int-rep next-vreg-rep cc<= int-rep next-vreg-rep int-rep next-vreg-rep
\ ##check-nursery-branch new-insn ##check-nursery-branch new-insn
swap push swap push
] each ; ] each ;

4
basis/compiler/cfg/height/height.factor
View File

@ -47,8 +47,8 @@ M: insn visit-insn drop ;
[ <reversed> [ visit-insn ] each ] [ <reversed> [ visit-insn ] each ]
[ [
[ [ ##inc-d? ] [ ##inc-r? ] bi or not ] filter! [ [ ##inc-d? ] [ ##inc-r? ] bi or not ] filter!
ds-height get [ \ ##inc-d 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 rs-height get [ ##inc-r new-insn prefix ] unless-zero
] bi ; ] bi ;
: normalize-height ( cfg -- cfg' ) : normalize-height ( cfg -- cfg' )

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

@ -37,7 +37,7 @@ M: insn modifies-context? drop f ;
[ [
int-rep next-vreg-rep int-rep next-vreg-rep
int-rep next-vreg-rep int-rep next-vreg-rep
\ ##save-context new-insn ##save-context new-insn
] dip ] dip
[ save-context-offset ] keep [ save-context-offset ] keep
[ insert-nth ] change-instructions drop [ insert-nth ] change-instructions drop

2
basis/compiler/cfg/ssa/construction/construction.factor
View File

@ -60,7 +60,7 @@ M: vreg-insn compute-insn-defs
SYMBOL: inserting-phis SYMBOL: inserting-phis
: insert-phi-later ( vreg bb -- ) : 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 ; inserting-phis get push-at ;
: compute-phis-for ( vreg bbs -- ) : compute-phis-for ( vreg bbs -- )

10
basis/compiler/cfg/tco/tco.factor
View File

@ -34,15 +34,15 @@ IN: compiler.cfg.tco
'[ '[
instructions>> instructions>>
[ pop* ] [ pop ] [ ] tri [ pop* ] [ pop ] [ ] tri
[ [ \ ##safepoint new-insn ] dip push ] [ [ ##safepoint new-insn ] dip push ]
[ [ \ ##epilogue new-insn ] dip push ] [ [ ##epilogue new-insn ] dip push ]
[ _ dip push ] tri [ _ dip push ] tri
] ]
[ successors>> delete-all ] [ successors>> delete-all ]
bi ; inline bi ; inline
: convert-word-tail-call ( bb -- ) : convert-word-tail-call ( bb -- )
[ word>> \ ##jump new-insn ] convert-tail-call ; [ word>> ##jump new-insn ] convert-tail-call ;
: loop-tail-call? ( bb -- ? ) : loop-tail-call? ( bb -- ? )
instructions>> penultimate instructions>> penultimate
@ -54,8 +54,8 @@ IN: compiler.cfg.tco
instructions>> { instructions>> {
[ pop* ] [ pop* ]
[ pop* ] [ pop* ]
[ [ \ ##safepoint new-insn ] dip push ] [ [ ##safepoint new-insn ] dip push ]
[ [ \ ##branch new-insn ] dip push ] [ [ ##branch new-insn ] dip push ]
} cleave } cleave
] ]
[ successors>> delete-all ] [ successors>> delete-all ]

2
basis/compiler/cfg/useless-conditionals/useless-conditionals.factor
View File

@ -23,7 +23,7 @@ IN: compiler.cfg.useless-conditionals
: delete-conditional ( bb -- ) : delete-conditional ( bb -- )
[ first skip-empty-blocks 1vector ] change-successors [ 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' ) : delete-useless-conditionals ( cfg -- cfg' )
dup [ dup [

2
basis/compiler/cfg/utilities/utilities.factor
View File

@ -78,4 +78,4 @@ SYMBOL: visited
predecessors>> first ; inline predecessors>> first ; inline
: <copy> ( dst src -- insn ) : <copy> ( dst src -- insn )
any-rep \ ##copy new-insn ; any-rep ##copy new-insn ;

4
basis/compiler/cfg/value-numbering/alien/alien.factor
View File

@ -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 ) 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: ##load-memory-imm new-alien-insn drop ##load-memory new-insn ;
M: ##store-memory-imm new-alien-insn drop \ ##store-memory new-insn ; M: ##store-memory-imm new-alien-insn drop ##store-memory new-insn ;
: fuse-displacement ( insn -- insn' ) : fuse-displacement ( insn -- insn' )
{ {

58
basis/compiler/cfg/value-numbering/comparisons/comparisons.factor
View File

@ -86,27 +86,27 @@ UNION: general-compare-insn scalar-compare-insn ##test-vector ;
: rewrite-boolean-comparison ( insn -- insn ) : rewrite-boolean-comparison ( insn -- insn )
src1>> vreg>insn { src1>> vreg>insn {
{ [ dup ##compare? ] [ >compare< \ ##compare-branch new-insn ] } { [ dup ##compare? ] [ >compare< ##compare-branch new-insn ] }
{ [ dup ##compare-imm? ] [ >compare< \ ##compare-imm-branch new-insn ] } { [ dup ##compare-imm? ] [ >compare< ##compare-imm-branch new-insn ] }
{ [ dup ##compare-integer? ] [ >compare< \ ##compare-integer-branch new-insn ] } { [ dup ##compare-integer? ] [ >compare< ##compare-integer-branch new-insn ] }
{ [ dup ##compare-integer-imm? ] [ >compare< \ ##compare-integer-imm-branch new-insn ] } { [ dup ##compare-integer-imm? ] [ >compare< ##compare-integer-imm-branch new-insn ] }
{ [ dup ##test? ] [ >compare< \ ##test-branch new-insn ] } { [ dup ##test? ] [ >compare< ##test-branch new-insn ] }
{ [ dup ##test-imm? ] [ >compare< \ ##test-imm-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-unordered? ] [ >compare< ##compare-float-unordered-branch new-insn ] }
{ [ dup ##compare-float-ordered? ] [ >compare< \ ##compare-float-ordered-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 ##test-vector? ] [ >test-vector< ##test-vector-branch new-insn ] }
} cond ; } cond ;
: fold-branch ( ? -- insn ) : fold-branch ( ? -- insn )
0 1 ? 0 1 ?
basic-block get [ nth 1vector ] change-successors drop basic-block get [ nth 1vector ] change-successors drop
\ ##branch new-insn ; ##branch new-insn ;
: fold-compare-imm-branch ( insn -- insn/f ) : fold-compare-imm-branch ( insn -- insn/f )
evaluate-compare-imm fold-branch ; evaluate-compare-imm fold-branch ;
: >test-branch ( insn -- insn ) : >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 M: ##compare-imm-branch rewrite
{ {
@ -143,12 +143,12 @@ M: ##test-imm-branch rewrite
: >compare-imm-branch ( insn swap? -- insn' ) : >compare-imm-branch ( insn swap? -- insn' )
(>compare-imm-branch) (>compare-imm-branch)
[ vreg>literal ] dip [ vreg>literal ] dip
\ ##compare-imm-branch new-insn ; inline ##compare-imm-branch new-insn ; inline
: >compare-integer-imm-branch ( insn swap? -- insn' ) : >compare-integer-imm-branch ( insn swap? -- insn' )
(>compare-imm-branch) (>compare-imm-branch)
[ vreg>integer ] dip [ vreg>integer ] dip
\ ##compare-integer-imm-branch new-insn ; inline ##compare-integer-imm-branch new-insn ; inline
: evaluate-self-compare ( insn -- ? ) : evaluate-self-compare ( insn -- ? )
cc>> { cc= cc<= cc>= } member-eq? ; cc>> { cc= cc<= cc>= } member-eq? ;
@ -179,15 +179,15 @@ M: ##compare-integer-branch rewrite
: >compare-imm ( insn swap? -- insn' ) : >compare-imm ( insn swap? -- insn' )
(>compare-imm) (>compare-imm)
[ vreg>literal ] dip [ vreg>literal ] dip
next-vreg \ ##compare-imm new-insn ; inline next-vreg ##compare-imm new-insn ; inline
: >compare-integer-imm ( insn swap? -- insn' ) : >compare-integer-imm ( insn swap? -- insn' )
(>compare-imm) (>compare-imm)
[ vreg>integer ] dip [ vreg>integer ] dip
next-vreg \ ##compare-integer-imm new-insn ; inline next-vreg ##compare-integer-imm new-insn ; inline
: >boolean-insn ( insn ? -- insn' ) : >boolean-insn ( insn ? -- insn' )
[ dst>> ] dip \ ##load-reference new-insn ; [ dst>> ] dip ##load-reference new-insn ;
: rewrite-self-compare ( insn -- insn' ) : rewrite-self-compare ( insn -- insn' )
dup evaluate-self-compare >boolean-insn ; dup evaluate-self-compare >boolean-insn ;
@ -217,14 +217,14 @@ M: ##compare-integer rewrite
: rewrite-redundant-comparison ( insn -- insn' ) : rewrite-redundant-comparison ( insn -- insn' )
[ cc>> ] [ dst>> ] [ src1>> vreg>insn ] tri { [ cc>> ] [ dst>> ] [ src1>> vreg>insn ] tri {
{ [ dup ##compare? ] [ >compare< next-vreg \ ##compare new-insn ] } { [ dup ##compare? ] [ >compare< next-vreg ##compare new-insn ] }
{ [ dup ##compare-imm? ] [ >compare< next-vreg \ ##compare-imm 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? ] [ >compare< next-vreg ##compare-integer new-insn ] }
{ [ dup ##compare-integer-imm? ] [ >compare< next-vreg \ ##compare-integer-imm new-insn ] } { [ dup ##compare-integer-imm? ] [ >compare< next-vreg ##compare-integer-imm new-insn ] }
{ [ dup ##test? ] [ >compare< next-vreg \ ##test new-insn ] } { [ dup ##test? ] [ >compare< next-vreg ##test new-insn ] }
{ [ dup ##test-imm? ] [ >compare< next-vreg \ ##test-imm 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-unordered? ] [ >compare< next-vreg ##compare-float-unordered new-insn ] }
{ [ dup ##compare-float-ordered? ] [ >compare< next-vreg \ ##compare-float-ordered new-insn ] } { [ dup ##compare-float-ordered? ] [ >compare< next-vreg ##compare-float-ordered new-insn ] }
} cond } cond
swap cc= eq? [ [ negate-cc ] change-cc ] when ; swap cc= eq? [ [ negate-cc ] change-cc ] when ;
@ -243,7 +243,7 @@ M: ##compare-imm rewrite
: >test ( insn -- insn' ) : >test ( insn -- insn' )
{ [ dst>> ] [ src1>> ] [ src1>> ] [ cc>> ] [ temp>> ] } cleave { [ dst>> ] [ src1>> ] [ src1>> ] [ cc>> ] [ temp>> ] } cleave
\ ##test new-insn ; ##test new-insn ;
M: ##compare-integer-imm rewrite M: ##compare-integer-imm rewrite
{ {
@ -265,18 +265,18 @@ M: ##compare-integer-imm rewrite
[ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline [ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ] [ cc>> ] bi ; inline
: simplify-test-imm ( insn -- insn ) : 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-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' ) : >test-imm ( insn ? -- insn' )
(>compare-imm) [ vreg>integer ] dip next-vreg (>compare-imm) [ vreg>integer ] dip next-vreg
\ ##test-imm new-insn ; inline ##test-imm new-insn ; inline
: >test-imm-branch ( insn ? -- insn' ) : >test-imm-branch ( insn ? -- insn' )
(>compare-imm-branch) [ vreg>integer ] dip (>compare-imm-branch) [ vreg>integer ] dip
\ ##test-imm-branch new-insn ; inline ##test-imm-branch new-insn ; inline
M: ##test rewrite M: ##test rewrite
{ {

4
basis/compiler/cfg/value-numbering/folding/folding.factor
View File

@ -24,7 +24,7 @@ M: ##shl-imm binary-constant-fold* drop shift ;
: binary-constant-fold ( insn -- insn' ) : binary-constant-fold ( insn -- insn' )
[ dst>> ] [ dst>> ]
[ [ src1>> vreg>integer ] [ src2>> ] [ ] tri binary-constant-fold* ] bi [ [ src1>> vreg>integer ] [ src2>> ] [ ] tri binary-constant-fold* ] bi
\ ##load-integer new-insn ; inline ##load-integer new-insn ; inline
: unary-constant-fold? ( insn -- ? ) : unary-constant-fold? ( insn -- ? )
src>> vreg>insn ##load-integer? ; inline src>> vreg>insn ##load-integer? ; inline
@ -36,4 +36,4 @@ M: ##neg unary-constant-fold* drop neg ;
: unary-constant-fold ( insn -- insn' ) : unary-constant-fold ( insn -- insn' )
[ dst>> ] [ [ src>> vreg>integer ] [ ] bi unary-constant-fold* ] bi [ dst>> ] [ [ src>> vreg>integer ] [ ] bi unary-constant-fold* ] bi
\ ##load-integer new-insn ; inline ##load-integer new-insn ; inline

66
basis/compiler/cfg/value-numbering/math/math.factor
View File

@ -18,8 +18,8 @@ IN: compiler.cfg.value-numbering.math
M: ##tagged>integer rewrite M: ##tagged>integer rewrite
[ dst>> ] [ src>> vreg>insn ] bi { [ dst>> ] [ src>> vreg>insn ] bi {
{ [ dup ##load-integer? ] [ val>> tag-fixnum \ ##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 ] } { [ dup f-insn? ] [ drop \ f type-number ##load-integer new-insn ] }
[ 2drop f ] [ 2drop f ]
} cond ; } cond ;
@ -76,14 +76,14 @@ M: ##add-imm rewrite
{ {
{ [ dup src2>> 0 = ] [ identity ] } { [ dup src2>> 0 = ] [ identity ] }
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] } { [ 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 ] [ drop f ]
} cond ; } cond ;
: sub-imm>add-imm ( insn -- insn' ) : sub-imm>add-imm ( insn -- insn' )
[ dst>> ] [ src1>> ] [ src2>> neg ] tri [ dst>> ] [ src1>> ] [ src2>> neg ] tri
dup immediate-arithmetic? dup immediate-arithmetic?
\ ##add-imm ?new-insn ; ##add-imm ?new-insn ;
M: ##sub-imm rewrite sub-imm>add-imm ; M: ##sub-imm rewrite sub-imm>add-imm ;
@ -92,14 +92,14 @@ M: ##sub-imm rewrite sub-imm>add-imm ;
src2>> -1 = ; src2>> -1 = ;
: mul-to-neg ( insn -- insn' ) : 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 ! Convert ##mul-imm 2^X => ##shl-imm X
: mul-to-shl? ( insn -- ? ) : mul-to-shl? ( insn -- ? )
src2>> power-of-2? ; src2>> power-of-2? ;
: mul-to-shl ( insn -- insn' ) : 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 ! Distribution converts
! ##+-imm 2 1 X ! ##+-imm 2 1 X
@ -135,7 +135,7 @@ M: ##mul-imm rewrite
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] } { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup mul-to-neg? ] [ mul-to-neg ] } { [ dup mul-to-neg? ] [ mul-to-neg ] }
{ [ dup mul-to-shl? ] [ mul-to-shl ] } { [ 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-add? ] [ \ ##add-imm, \ ##mul-imm, distribute ] }
{ [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##mul-imm, distribute ] } { [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##mul-imm, distribute ] }
[ drop f ] [ drop f ]
@ -144,8 +144,8 @@ M: ##mul-imm rewrite
M: ##and-imm rewrite M: ##and-imm rewrite
{ {
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] } { [ dup binary-constant-fold? ] [ binary-constant-fold ] }
{ [ dup src1>> vreg>insn ##and-imm? ] [ \ ##and-imm reassociate-bitwise ] } { [ dup src1>> vreg>insn ##and-imm? ] [ ##and-imm reassociate-bitwise ] }
{ [ dup src2>> 0 = ] [ dst>> 0 \ ##load-integer new-insn ] } { [ dup src2>> 0 = ] [ dst>> 0 ##load-integer new-insn ] }
{ [ dup src2>> -1 = ] [ identity ] } { [ dup src2>> -1 = ] [ identity ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
@ -153,18 +153,18 @@ M: ##and-imm rewrite
M: ##or-imm rewrite M: ##or-imm rewrite
{ {
{ [ dup src2>> 0 = ] [ identity ] } { [ 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 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 ] [ drop f ]
} cond ; } cond ;
M: ##xor-imm rewrite M: ##xor-imm rewrite
{ {
{ [ dup src2>> 0 = ] [ identity ] } { [ 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 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 ] [ drop f ]
} cond ; } cond ;
@ -172,7 +172,7 @@ M: ##shl-imm rewrite
{ {
{ [ dup src2>> 0 = ] [ identity ] } { [ dup src2>> 0 = ] [ identity ] }
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] } { [ 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-add? ] [ \ ##add-imm, \ ##shl-imm, distribute ] }
{ [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##shl-imm, distribute ] } { [ dup distribute-over-sub? ] [ \ ##sub-imm, \ ##shl-imm, distribute ] }
[ drop f ] [ drop f ]
@ -182,7 +182,7 @@ M: ##shr-imm rewrite
{ {
{ [ dup src2>> 0 = ] [ identity ] } { [ dup src2>> 0 = ] [ identity ] }
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] } { [ 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 ] [ drop f ]
} cond ; } cond ;
@ -190,7 +190,7 @@ M: ##sar-imm rewrite
{ {
{ [ dup src2>> 0 = ] [ identity ] } { [ dup src2>> 0 = ] [ identity ] }
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] } { [ 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 ] [ drop f ]
} cond ; } cond ;
@ -207,8 +207,8 @@ M: ##sar-imm rewrite
M: ##add rewrite M: ##add rewrite
{ {
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##add-imm f 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 ] } { [ dup src1>> vreg-immediate-arithmetic? ] [ ##add-imm t insn>imm-insn ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
@ -217,7 +217,7 @@ M: ##add rewrite
! ##sub 2 1 1 => ##load-integer 2 0 ! ##sub 2 1 1 => ##load-integer 2 0
: rewrite-subtraction-identity ( insn -- insn' ) : rewrite-subtraction-identity ( insn -- insn' )
dst>> 0 \ ##load-integer new-insn ; dst>> 0 ##load-integer new-insn ;
! ##load-integer 1 0 ! ##load-integer 1 0
! ##sub 3 1 2 ! ##sub 3 1 2
@ -227,61 +227,61 @@ M: ##add rewrite
src1>> vreg>insn zero-insn? ; src1>> vreg>insn zero-insn? ;
: sub-to-neg ( ##sub -- insn ) : sub-to-neg ( ##sub -- insn )
[ dst>> ] [ src2>> ] bi \ ##neg new-insn ; [ dst>> ] [ src2>> ] bi ##neg new-insn ;
M: ##sub rewrite M: ##sub rewrite
{ {
{ [ dup sub-to-neg? ] [ sub-to-neg ] } { [ dup sub-to-neg? ] [ sub-to-neg ] }
{ [ dup diagonal? ] [ rewrite-subtraction-identity ] } { [ 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 ] [ drop f ]
} cond ; } cond ;
M: ##mul rewrite M: ##mul rewrite
{ {
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##mul-imm f 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 ] } { [ dup src1>> vreg-immediate-arithmetic? ] [ ##mul-imm t insn>imm-insn ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
M: ##and rewrite M: ##and rewrite
{ {
{ [ dup diagonal? ] [ identity ] } { [ dup diagonal? ] [ identity ] }
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##and-imm f 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 ] } { [ dup src1>> vreg-immediate-bitwise? ] [ ##and-imm t insn>imm-insn ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
M: ##or rewrite M: ##or rewrite
{ {
{ [ dup diagonal? ] [ identity ] } { [ dup diagonal? ] [ identity ] }
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##or-imm f 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 ] } { [ dup src1>> vreg-immediate-bitwise? ] [ ##or-imm t insn>imm-insn ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
M: ##xor rewrite M: ##xor rewrite
{ {
{ [ dup diagonal? ] [ dst>> 0 \ ##load-integer new-insn ] } { [ dup diagonal? ] [ dst>> 0 ##load-integer new-insn ] }
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##xor-imm f insn>imm-insn ] } { [ dup src2>> vreg-immediate-bitwise? ] [ ##xor-imm f insn>imm-insn ] }
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##xor-imm t insn>imm-insn ] } { [ dup src1>> vreg-immediate-bitwise? ] [ ##xor-imm t insn>imm-insn ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
M: ##shl rewrite 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 ] [ drop f ]
} cond ; } cond ;
M: ##shr rewrite 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 ] [ drop f ]
} cond ; } cond ;
M: ##sar rewrite 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 ] [ drop f ]
} cond ; } cond ;

2
basis/compiler/cfg/value-numbering/misc/misc.factor
View File

@ -10,5 +10,5 @@ M: ##replace rewrite
[ loc>> ] [ src>> vreg>insn ] bi [ loc>> ] [ src>> vreg>insn ] bi
dup literal-insn? [ dup literal-insn? [
insn>literal dup immediate-store? insn>literal dup immediate-store?
[ swap \ ##replace-imm new-insn ] [ 2drop f ] if [ swap ##replace-imm new-insn ] [ 2drop f ] if
] [ 2drop f ] if ; ] [ 2drop f ] if ;

20
basis/compiler/cfg/value-numbering/simd/simd.factor
View File

@ -26,7 +26,7 @@ IN: compiler.cfg.value-numbering.simd
[ [ dst>> ] [ src>> ] bi* ] [ [ dst>> ] [ src>> ] bi* ]
[ [ shuffle>> ] bi@ nths ] [ [ shuffle>> ] bi@ nths ]
[ drop rep>> ] [ drop rep>> ]
2tri \ ##shuffle-vector-imm new-insn 2tri ##shuffle-vector-imm new-insn
] [ 2drop f ] if ; ] [ 2drop f ] if ;
: (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' ) : (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' )
@ -34,7 +34,7 @@ IN: compiler.cfg.value-numbering.simd
: fold-shuffle-vector-imm ( outer inner -- insn' ) : fold-shuffle-vector-imm ( outer inner -- insn' )
[ [ dst>> ] [ shuffle>> ] bi ] [ obj>> ] bi* [ [ 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 M: ##shuffle-vector-imm rewrite
dup src>> vreg>insn { dup src>> vreg>insn {
@ -53,7 +53,7 @@ M: ##shuffle-vector-imm rewrite
: (fold-scalar>vector) ( insn bytes -- insn' ) : (fold-scalar>vector) ( insn bytes -- insn' )
[ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat [ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat
\ ##load-reference new-insn ; ##load-reference new-insn ;
: fold-scalar>vector ( outer inner -- insn' ) : fold-scalar>vector ( outer inner -- insn' )
over rep>> scalar-value (fold-scalar>vector) ; over rep>> scalar-value (fold-scalar>vector) ;
@ -68,7 +68,7 @@ M: ##scalar>vector rewrite
:: fold-gather-vector-2 ( insn src1 src2 -- insn ) :: fold-gather-vector-2 ( insn src1 src2 -- insn )
insn dst>> insn dst>>
src1 src2 [ insn rep>> scalar-value ] bi@ append src1 src2 [ insn rep>> scalar-value ] bi@ append
\ ##load-reference new-insn ; ##load-reference new-insn ;
: rewrite-gather-vector-2 ( insn -- insn/f ) : rewrite-gather-vector-2 ( insn -- insn/f )
dup [ src1>> vreg>insn ] [ src2>> vreg>insn ] bi { 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 src1 src2 src3 src4
[ insn rep>> scalar-value ] 4 napply [ insn rep>> scalar-value ] 4 napply
] B{ } append-outputs-as ] B{ } append-outputs-as
\ ##load-reference new-insn ; ##load-reference new-insn ;
: rewrite-gather-vector-4 ( insn -- insn/f ) : rewrite-gather-vector-4 ( insn -- insn/f )
dup { [ src1>> ] [ src2>> ] [ src3>> ] [ src4>> ] } cleave [ vreg>insn ] 4 napply 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 ) : fold-shuffle-vector ( insn src1 src2 -- insn )
[ dst>> ] [ obj>> ] [ obj>> ] tri* [ dst>> ] [ obj>> ] [ obj>> ] tri*
swap nths \ ##load-reference new-insn ; swap nths ##load-reference new-insn ;
M: ##shuffle-vector rewrite M: ##shuffle-vector rewrite
dup [ src>> vreg>insn ] [ shuffle>> vreg>insn ] bi dup [ src>> vreg>insn ] [ shuffle>> vreg>insn ] bi
@ -112,7 +112,7 @@ M: ##shuffle-vector rewrite
M: ##xor-vector rewrite M: ##xor-vector rewrite
dup diagonal? 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 -- ? ) : vector-not? ( insn -- ? )
{ {
@ -139,7 +139,7 @@ M: ##and-vector rewrite
[ src1>> vreg>insn vector-not-src ] [ src1>> vreg>insn vector-not-src ]
[ src2>> ] [ src2>> ]
[ rep>> ] [ rep>> ]
} cleave \ ##andn-vector new-insn } cleave ##andn-vector new-insn
] } ] }
{ [ dup src2>> vreg>insn vector-not? ] [ { [ dup src2>> vreg>insn vector-not? ] [
{ {
@ -147,7 +147,7 @@ M: ##and-vector rewrite
[ src2>> vreg>insn vector-not-src ] [ src2>> vreg>insn vector-not-src ]
[ src1>> ] [ src1>> ]
[ rep>> ] [ rep>> ]
} cleave \ ##andn-vector new-insn } cleave ##andn-vector new-insn
] } ] }
[ drop f ] [ drop f ]
} cond ; } cond ;
@ -159,5 +159,5 @@ M: ##andn-vector rewrite
[ src1>> vreg>insn vector-not-src ] [ src1>> vreg>insn vector-not-src ]
[ src2>> ] [ src2>> ]
[ rep>> ] [ rep>> ]
} cleave \ ##and-vector new-insn } cleave ##and-vector new-insn
] [ drop f ] if ; ] [ drop f ] if ;

8
basis/compiler/tree/debugger/debugger.factor
View File

@ -123,14 +123,14 @@ M: #if node>quot
M: #dispatch node>quot M: #dispatch node>quot
children>> [ nodes>quot ] map , \ dispatch , ; 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 M: #alien-callback node>quot
[ params>> , ] [ child>> nodes>quot , ] bi \ #alien-callback , ; [ params>> , ] [ child>> nodes>quot , ] bi #alien-callback , ;
M: node node>quot drop ; M: node node>quot drop ;

38
basis/compiler/tree/tree.factor
View File

@ -13,12 +13,12 @@ TUPLE: node < identity-tuple ;
TUPLE: #introduce < node out-d ; TUPLE: #introduce < node out-d ;
: <#introduce> ( out-d -- node ) : <#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 ; TUPLE: #call < node word in-d out-d body method class info ;
: <#call> ( inputs outputs word -- node ) : <#call> ( inputs outputs word -- node )
\ #call new #call new
swap >>word swap >>word
swap >>out-d swap >>out-d
swap >>in-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 ; TUPLE: #call-recursive < node label in-d out-d info ;
: <#call-recursive> ( inputs outputs label -- node ) : <#call-recursive> ( inputs outputs label -- node )
\ #call-recursive new #call-recursive new
swap >>label swap >>label
swap >>out-d swap >>out-d
swap >>in-d ; swap >>in-d ;
@ -34,7 +34,7 @@ TUPLE: #call-recursive < node label in-d out-d info ;
TUPLE: #push < node literal out-d ; TUPLE: #push < node literal out-d ;
: <#push> ( literal value -- node ) : <#push> ( literal value -- node )
\ #push new #push new
swap 1array >>out-d swap 1array >>out-d
swap >>literal ; swap >>literal ;
@ -43,7 +43,7 @@ TUPLE: #renaming < node ;
TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ; TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
: <#shuffle> ( in-d out-d in-r out-r mapping -- node ) : <#shuffle> ( in-d out-d in-r out-r mapping -- node )
\ #shuffle new #shuffle new
swap >>mapping swap >>mapping
swap >>out-r swap >>out-r
swap >>in-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 ; TUPLE: #terminate < node in-d in-r ;
: <#terminate> ( in-d in-r -- node ) : <#terminate> ( in-d in-r -- node )
\ #terminate new #terminate new
swap >>in-r swap >>in-r
swap >>in-d ; swap >>in-d ;
@ -73,17 +73,17 @@ TUPLE: #branch < node in-d children live-branches ;
TUPLE: #if < #branch ; TUPLE: #if < #branch ;
: <#if> ( ? true false -- node ) : <#if> ( ? true false -- node )
2array \ #if new-branch ; 2array #if new-branch ;
TUPLE: #dispatch < #branch ; TUPLE: #dispatch < #branch ;
: <#dispatch> ( n branches -- node ) : <#dispatch> ( n branches -- node )
\ #dispatch new-branch ; #dispatch new-branch ;
TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ; TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ;
: <#phi> ( d-phi-in d-phi-out terminated -- node ) : <#phi> ( d-phi-in d-phi-out terminated -- node )
\ #phi new #phi new
swap >>terminated swap >>terminated
swap >>out-d swap >>out-d
swap >>phi-in-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 ; TUPLE: #declare < node declaration ;
: <#declare> ( declaration -- node ) : <#declare> ( declaration -- node )
\ #declare new #declare new
swap >>declaration ; swap >>declaration ;
TUPLE: #return < node in-d info ; TUPLE: #return < node in-d info ;
: <#return> ( stack -- node ) : <#return> ( stack -- node )
\ #return new #return new
swap >>in-d ; swap >>in-d ;
TUPLE: #recursive < node in-d word label loop? child ; TUPLE: #recursive < node in-d word label loop? child ;
: <#recursive> ( label inputs child -- node ) : <#recursive> ( label inputs child -- node )
\ #recursive new #recursive new
swap >>child swap >>child
swap >>in-d swap >>in-d
swap >>label ; 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 ; TUPLE: #enter-recursive < node in-d out-d label info ;
: <#enter-recursive> ( label inputs outputs -- node ) : <#enter-recursive> ( label inputs outputs -- node )
\ #enter-recursive new #enter-recursive new
swap >>out-d swap >>out-d
swap >>in-d swap >>in-d
swap >>label ; 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 ; TUPLE: #return-recursive < #renaming in-d out-d label info ;
: <#return-recursive> ( label inputs outputs -- node ) : <#return-recursive> ( label inputs outputs -- node )
\ #return-recursive new #return-recursive new
swap >>out-d swap >>out-d
swap >>in-d swap >>in-d
swap >>label ; swap >>label ;
@ -127,7 +127,7 @@ TUPLE: #return-recursive < #renaming in-d out-d label info ;
TUPLE: #copy < #renaming in-d out-d ; TUPLE: #copy < #renaming in-d out-d ;
: <#copy> ( inputs outputs -- node ) : <#copy> ( inputs outputs -- node )
\ #copy new #copy new
swap >>out-d swap >>out-d
swap >>in-d ; swap >>in-d ;
@ -142,22 +142,22 @@ TUPLE: #alien-node < node params ;
TUPLE: #alien-invoke < #alien-node in-d out-d ; TUPLE: #alien-invoke < #alien-node in-d out-d ;
: <#alien-invoke> ( params -- node ) : <#alien-invoke> ( params -- node )
\ #alien-invoke new-alien-node ; #alien-invoke new-alien-node ;
TUPLE: #alien-indirect < #alien-node in-d out-d ; TUPLE: #alien-indirect < #alien-node in-d out-d ;
: <#alien-indirect> ( params -- node ) : <#alien-indirect> ( params -- node )
\ #alien-indirect new-alien-node ; #alien-indirect new-alien-node ;
TUPLE: #alien-assembly < #alien-node in-d out-d ; TUPLE: #alien-assembly < #alien-node in-d out-d ;
: <#alien-assembly> ( params -- node ) : <#alien-assembly> ( params -- node )
\ #alien-assembly new-alien-node ; #alien-assembly new-alien-node ;
TUPLE: #alien-callback < node params child ; TUPLE: #alien-callback < node params child ;
: <#alien-callback> ( params child -- node ) : <#alien-callback> ( params child -- node )
\ #alien-callback new #alien-callback new
swap >>child swap >>child
swap >>params ; swap >>params ;