diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index 04443db45d..36e6bdd46e 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2010 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2008, 2011 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs arrays classes combinators compiler.units fry generalizations sequences.generalizations @@ -9,6 +9,9 @@ FROM: namespaces => set ; FROM: sets => members ; IN: compiler.cfg.def-use +! Utilities for iterating over instruction operands + +! Def-use protocol GENERIC: defs-vregs ( insn -- seq ) GENERIC: temp-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq ) @@ -17,6 +20,52 @@ M: insn defs-vregs drop { } ; M: insn temp-vregs drop { } ; M: insn uses-vregs drop { } ; +! Instructions with unusual operands, also see these passes +! for special behavior: +! - compiler.cfg.renaming.functor +! - compiler.cfg.representations.preferred +CONSTANT: special-vreg-insns { + ##parallel-copy + ##phi + ##alien-invoke + ##alien-indirect + ##alien-assembly + ##callback-inputs + ##callback-outputs +} + +! Special defs-vregs methods +M: ##parallel-copy defs-vregs values>> [ first ] map ; + +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 { } ; + +! Special uses-vregs methods +M: ##parallel-copy uses-vregs values>> [ second ] map ; + +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 ; + +! Generate defs-vregs, uses-vregs and temp-vregs for everything +! else -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 [ special-vreg-insns diff [ define-defs-vregs-method ] each ] @@ -80,6 +102,7 @@ M: ##callback-outputs uses-vregs tri ] with-compilation-unit +! Computing vreg -> insn -> bb mapping SYMBOLS: defs insns ; : def-of ( vreg -- node ) defs get at ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 91c1488750..0fc8763a01 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2010 Slava Pestov. +! Copyright (C) 2008, 2011 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors arrays kernel sequences namespaces words math math.order layouts classes.union compiler.units alien @@ -119,6 +119,10 @@ def: dst use: src literal: rep ; +! Only used by compiler.cfg.cssa +FLUSHABLE-INSN: ##parallel-copy +literal: values ; + FOLDABLE-INSN: ##tagged>integer def: dst/int-rep use: src/tagged-rep ; diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor index 7f98e53688..476e0d307f 100644 --- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor +++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor @@ -119,7 +119,7 @@ SYMBOL: unhandled-intervals : reg-class-assoc ( quot -- assoc ) [ reg-classes ] dip { } map>assoc ; inline -: next-spill-slot ( size -- n ) +: next-spill-slot ( size -- spill-slot ) cfg get [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ; diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor index 7aff066e0b..22f9cfbeeb 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor @@ -107,7 +107,7 @@ IN: compiler.cfg.linear-scan.resolve.tests ] unit-test cfg new 8 >>spill-area-size cfg set -H{ } clone spill-temps set +init-resolve [ t ] [ { diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index 68c43dfc87..3af803f90e 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009, 2010 Slava Pestov. +! Copyright (C) 2009, 2011 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit fry kernel locals namespaces @@ -33,10 +33,21 @@ M: location equal? M: location hashcode* reg>> hashcode* ; -SYMBOL: spill-temps +SYMBOL: temp-spills -: spill-temp ( rep -- n ) - rep-size spill-temps get [ next-spill-slot ] cache ; +: temp-spill ( rep -- spill-slot ) + rep-size temp-spills get + [ next-spill-slot ] cache ; + +SYMBOL: temp-locations + +: temp-location ( loc -- temp ) + rep>> temp-locations get + [ [ temp-spill ] keep ] cache ; + +: init-resolve ( -- ) + H{ } clone temp-spills set + H{ } clone temp-locations set ; : add-mapping ( from to rep -- ) '[ _ ] bi@ 2array , ; @@ -74,20 +85,18 @@ SYMBOL: spill-temps : register->register ( from to -- ) swap [ reg>> ] [ [ reg>> ] [ rep>> ] bi ] bi* ##copy, ; -SYMBOL: temp - : >insn ( from to -- ) { - { [ over temp eq? ] [ temp->register ] } - { [ dup temp eq? ] [ register->temp ] } { [ over reg>> spill-slot? ] [ memory->register ] } { [ dup reg>> spill-slot? ] [ register->memory ] } [ register->register ] } cond ; : mapping-instructions ( alist -- insns ) - [ swap ] H{ } assoc-map-as - [ temp [ swap >insn ] parallel-mapping ##branch, ] { } make ; + [ swap ] H{ } assoc-map-as [ + [ temp-location ] [ swap >insn ] parallel-mapping + ##branch + ] { } make ; : perform-mappings ( bb to mappings -- ) dup empty? [ 3drop ] [ @@ -105,6 +114,5 @@ SYMBOL: temp : resolve-data-flow ( cfg -- ) needs-predecessors - - H{ } clone spill-temps set + init-resolve [ resolve-block-data-flow ] each-basic-block ; diff --git a/basis/compiler/cfg/parallel-copy/parallel-copy.factor b/basis/compiler/cfg/parallel-copy/parallel-copy.factor index 4e8320d3d6..e006c620b0 100644 --- a/basis/compiler/cfg/parallel-copy/parallel-copy.factor +++ b/basis/compiler/cfg/parallel-copy/parallel-copy.factor @@ -11,7 +11,7 @@ IN: compiler.cfg.parallel-copy to-do set ready set [ preds set ] [ [ nip dup ] H{ } assoc-map-as locs set ] [ keys [ init-to-do ] [ init-ready ] bi ] tri ; -:: process-ready ( b quot -- ) +:: process-ready ( b quot: ( dst src -- ) -- ) b preds get at :> a a locs get at :> c b c quot call b a locs get set-at a c = a preds get at and [ a ready get push-front ] when ; inline -:: process-to-do ( b quot -- ) +:: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- ) ! Note that we check if b = loc(b), not b = loc(pred(b)) as the ! paper suggests. Confirmed by one of the authors at ! http://www.reddit.com/comments/93253/some_lecture_notes_on_ssa_form/c0bco4f b locs get at b = [ - temp get b quot call - temp get b locs get set-at + b temp call :> temp + temp b quot call + temp b locs get set-at b ready get push-front ] when ; inline PRIVATE> -:: parallel-mapping ( mapping temp quot -- ) +:: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- ) + ! mapping is a list of { dst src } pairs [ - mapping temp init + mapping init to-do get [ ready get [ quot process-ready ] slurp-deque - quot process-to-do + temp quot process-to-do ] slurp-deque ] with-scope ; inline : parallel-copy ( mapping -- ) - next-vreg [ any-rep ##copy, ] parallel-mapping ; + ! mapping is a list of { dst src } pairs + next-vreg '[ drop _ ] [ any-rep ##copy ] parallel-mapping ; + + + +: parallel-copy-rep ( mapping -- ) + ! mapping is a list of { dst src } pairs + H{ } clone temp-vregs set + [ rep-of temp-vreg ] [ dup rep-of ##copy ] parallel-mapping ; diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor index 0e1cf5311d..32b52f4321 100644 --- a/basis/compiler/cfg/renaming/functor/functor.factor +++ b/basis/compiler/cfg/renaming/functor/functor.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009, 2010 Slava Pestov. +! Copyright (C) 2009, 2011 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 @@ -6,6 +6,8 @@ compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.instructions.syntax ; IN: compiler.cfg.renaming.functor +! Like compiler.cfg.def-use, but for changing operands + : slot-change-quot ( slots quot -- quot' ) '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join [ drop ] append ; @@ -19,34 +21,36 @@ rename-insn-temps DEFINES ${NAME}-insn-temps WHERE GENERIC: rename-insn-defs ( insn -- ) +GENERIC: rename-insn-uses ( insn -- ) +GENERIC: rename-insn-temps ( insn -- ) M: insn rename-insn-defs drop ; +M: insn rename-insn-uses drop ; +M: insn rename-insn-temps drop ; -insn-classes get special-vreg-insns diff [ insn-def-slots empty? not ] filter [ - [ \ rename-insn-defs create-method-in ] - [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi - define -] each +! Instructions with unusual operands + +! Special rename-insn-defs methods +M: ##parallel-copy rename-insn-defs + [ [ first2 [ DEF-QUOT ] dip 2array ] map ] change-values ; 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 ; + [ [ 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 -- ) +! Special rename-insn-uses methods +M: ##parallel-copy rename-insn-uses + [ [ first2 USE-QUOT 2array ] map ] change-values ; -M: insn rename-insn-uses drop ; - -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: ##phi rename-insn-uses + [ USE-QUOT assoc-map ] change-inputs drop ; M: alien-call-insn rename-insn-uses [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs @@ -57,14 +61,21 @@ 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 ; + [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs + drop ; -M: ##phi rename-insn-uses - [ USE-QUOT assoc-map ] change-inputs drop ; +! Generate methods for everything else +insn-classes get special-vreg-insns diff [ insn-def-slots empty? not ] filter [ + [ \ rename-insn-defs create-method-in ] + [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi + define +] each -GENERIC: rename-insn-temps ( insn -- ) - -M: insn rename-insn-temps drop ; +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 insn-classes get [ insn-temp-slots empty? not ] filter [ [ \ rename-insn-temps create-method-in ] diff --git a/basis/compiler/cfg/ssa/cssa/cssa.factor b/basis/compiler/cfg/ssa/cssa/cssa.factor index 57ec9af42d..96ef723168 100644 --- a/basis/compiler/cfg/ssa/cssa/cssa.factor +++ b/basis/compiler/cfg/ssa/cssa/cssa.factor @@ -1,34 +1,54 @@ -! Copyright (C) 2009, 2010 Slava Pestov. +! Copyright (C) 2009, 2011 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs kernel locals fry sequences sets -cpu.architecture +USING: accessors assocs kernel locals fry make namespaces +sequences cpu.architecture +compiler.cfg compiler.cfg.rpo -compiler.cfg.def-use compiler.cfg.utilities +compiler.cfg.predecessors compiler.cfg.registers compiler.cfg.instructions ; +FROM: assocs => change-at ; IN: compiler.cfg.ssa.cssa ! Convert SSA to conventional SSA. This pass runs after representation ! selection, so it must keep track of representations when introducing ! new values. -: insert-copy? ( bb vreg -- ? ) - ! If the last instruction defines a value (which means it is - ! ##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-vregs ] dip swap in? not ; +SYMBOL: copies -:: insert-copy ( bb src rep -- bb dst ) - bb src insert-copy? [ - rep next-vreg-rep :> dst - bb [ dst src rep ##copy, ] add-instructions - bb dst - ] [ bb src ] if ; +: init-copies ( bb -- ) + predecessors>> [ V{ } clone ] H{ } map>assoc copies set ; -: convert-phi ( ##phi -- ) - dup dst>> rep-of '[ [ _ insert-copy ] assoc-map ] change-inputs drop ; +:: convert-operand ( src pred rep -- dst ) + rep next-vreg-rep :> dst + { dst src } pred copies get at push + dst ; + +:: convert-phi ( insn preds -- ) + insn dst>> rep-of :> rep + insn inputs>> :> inputs + preds [| pred | + pred inputs [ pred rep convert-operand ] change-at + ] each ; + +: insert-edge-copies ( from to copies -- ) + [ ##parallel-copy ##branch ] { } make insert-basic-block ; + +: insert-copies ( bb -- ) + [ copies get ] dip '[ + [ drop ] [ [ _ ] dip insert-edge-copies ] if-empty + ] assoc-each ; + +: convert-phis ( bb -- ) + [ init-copies ] + [ dup predecessors>> '[ _ convert-phi ] each-phi ] + [ insert-copies ] + tri ; : construct-cssa ( cfg -- ) - [ [ convert-phi ] each-phi ] each-basic-block ; + needs-predecessors + + dup [ convert-phis ] each-basic-block + + cfg-changed drop ; diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor index 981ce42363..4da2e1db28 100644 --- a/basis/compiler/cfg/ssa/destruction/destruction.factor +++ b/basis/compiler/cfg/ssa/destruction/destruction.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2009, 2010 Slava Pestov. +! Copyright (C) 2009, 2011 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs fry locals kernel namespaces -sequences sequences.deep +USING: accessors arrays assocs fry locals kernel make +namespaces sequences sequences.deep sets vectors cpu.architecture compiler.cfg.rpo @@ -13,6 +13,7 @@ compiler.cfg.liveness compiler.cfg.ssa.cssa compiler.cfg.ssa.interference compiler.cfg.ssa.interference.live-ranges +compiler.cfg.parallel-copy compiler.cfg.utilities compiler.utilities ; FROM: namespaces => set ; @@ -66,15 +67,6 @@ SYMBOL: copies : coalesce-vregs ( merged leader1 leader2 -- ) [ coalesce-leaders ] [ coalesce-elements ] 2bi ; -:: maybe-eliminate-copy ( vreg1 vreg2 -- ) - ! Eliminate a copy of possible. - vreg1 leader :> vreg1 - vreg2 leader :> vreg2 - vreg1 vreg2 eq? [ - vreg1 class-elements vreg2 class-elements sets-interfere? - [ drop ] [ vreg1 vreg2 coalesce-vregs ] if - ] unless ; - GENERIC: prepare-insn ( insn -- ) : maybe-eliminate-copy-later ( dst src -- ) @@ -96,35 +88,69 @@ M: vreg-insn prepare-insn M: ##copy prepare-insn [ dst>> ] [ src>> ] bi maybe-eliminate-copy-later ; +M: ##parallel-copy prepare-insn + values>> [ first2 maybe-eliminate-copy-later ] each ; + +: leaders ( vreg1 vreg2 -- vreg1' vreg2' ) + [ leader ] bi@ ; + +: vregs-interfere? ( vreg1 vreg2 -- merged/f ? ) + [ class-elements ] bi@ sets-interfere? ; + +ERROR: vregs-shouldn't-interfere vreg1 vreg2 ; + +:: must-eliminate-copy ( vreg1 vreg2 -- ) + ! Eliminate a copy. + vreg1 vreg2 eq? [ + vreg1 vreg2 vregs-interfere? + [ vreg1 vreg2 vregs-shouldn't-interfere ] + [ vreg1 vreg2 coalesce-vregs ] + if + ] unless ; + M: ##tagged>integer prepare-insn - [ dst>> ] [ src>> ] bi maybe-eliminate-copy ; + [ dst>> ] [ src>> ] bi leaders must-eliminate-copy ; M: ##phi prepare-insn [ dst>> ] [ inputs>> values ] bi - [ maybe-eliminate-copy ] with each ; + [ leaders must-eliminate-copy ] with each ; : prepare-coalescing ( cfg -- ) init-coalescing [ [ prepare-insn ] each ] simple-analysis ; -: process-copies ( -- ) - copies get [ maybe-eliminate-copy ] assoc-each ; +:: maybe-eliminate-copy ( vreg1 vreg2 -- ) + ! Eliminate a copy if possible. + vreg1 vreg2 eq? [ + vreg1 vreg2 vregs-interfere? + [ drop ] [ vreg1 vreg2 coalesce-vregs ] if + ] unless ; -GENERIC: useful-insn? ( insn -- ? ) +: process-copies ( -- ) + copies get [ leaders maybe-eliminate-copy ] assoc-each ; + +GENERIC: cleanup-insn ( insn -- ) : useful-copy? ( insn -- ? ) - [ dst>> leader ] [ src>> leader ] bi eq? not ; inline + [ dst>> ] [ src>> ] bi leaders eq? not ; inline -M: ##copy useful-insn? useful-copy? ; +M: ##copy cleanup-insn + dup useful-copy? [ , ] [ drop ] if ; -M: ##tagged>integer useful-insn? useful-copy? ; +M: ##parallel-copy cleanup-insn + values>> + [ first2 leaders 2array ] map [ first2 eq? not ] filter + [ parallel-copy-rep ] unless-empty ; -M: ##phi useful-insn? drop f ; +M: ##tagged>integer cleanup-insn + dup useful-copy? [ , ] [ drop ] if ; -M: insn useful-insn? drop t ; +M: ##phi cleanup-insn drop ; + +M: insn cleanup-insn , ; : cleanup-cfg ( cfg -- ) - [ [ useful-insn? ] filter! ] simple-optimization ; + [ [ [ cleanup-insn ] each ] V{ } make ] simple-optimization ; PRIVATE> @@ -138,4 +164,5 @@ PRIVATE> dup compute-live-ranges dup prepare-coalescing process-copies - dup cleanup-cfg ; + dup cleanup-cfg + dup compute-live-sets ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index a7dbd01f4a..d564f9e307 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -524,3 +524,16 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read- 231 over 1 set-alien-unsigned-1 ; [ B{ 123 231 } ] [ derived-pointer-test-1 ] unit-test + +: fib-count2 ( -- x y ) 0 1 [ dup 4000000 <= ] [ [ + ] keep swap ] while ; + +[ 3524578 5702887 ] [ fib-count2 ] unit-test + +! Stupid repro +USE: compiler.cfg.registers + +0 vreg-counter set-global + +{ fib-count2 } compile + +[ 3524578 5702887 ] [ fib-count2 ] unit-test