WIP
Slava Pestov
Doug Coleman
parent
ae276ec225
commit
07227f22f9
basis/compiler
cfg
def-use
instructions
linear-scan
allocation/state
parallel-copy
renaming/functor
ssa
cssa
destruction
tests
|
|
@ -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
|
||||
<PRIVATE
|
||||
|
||||
: slot-array-quot ( slots -- quot )
|
||||
|
|
@ -45,33 +94,6 @@ M: insn uses-vregs drop { } ;
|
|||
|
||||
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
|
||||
[ 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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
<spill-slot> ;
|
||||
|
|
|
|||
|
|
@ -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 ] [
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 <location> ] cache ;
|
||||
|
||||
: init-resolve ( -- )
|
||||
H{ } clone temp-spills set
|
||||
H{ } clone temp-locations set ;
|
||||
|
||||
: add-mapping ( from to rep -- )
|
||||
'[ _ <location> ] 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 ;
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ IN: compiler.cfg.parallel-copy
|
|||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOLS: temp locs preds to-do ready ;
|
||||
SYMBOLS: locs preds to-do ready ;
|
||||
|
||||
: init-to-do ( bs -- )
|
||||
to-do get push-all-back ;
|
||||
|
|
@ -19,43 +19,59 @@ SYMBOLS: temp locs preds to-do ready ;
|
|||
: init-ready ( bs -- )
|
||||
locs get '[ _ key? not ] filter ready get push-all-front ;
|
||||
|
||||
: init ( mapping temp -- )
|
||||
temp set
|
||||
: init ( mapping -- )
|
||||
<dlist> to-do set
|
||||
<dlist> 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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: temp-vregs
|
||||
|
||||
: temp-vreg ( rep -- vreg )
|
||||
temp-vregs get [ next-vreg-rep ] cache ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: 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 ;
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue