compiler.cfg: now that kill-blocks cannot contain instructions that define vregs we can skip them all

db4
Slava Pestov 2010-07-27 12:40:31 -04:00
parent 7f4b7d66a3
commit 355d89e8e8
9 changed files with 55 additions and 49 deletions

View File

@ -53,8 +53,8 @@ M: insn visit-insn drop ;
: (collect-copies) ( cfg -- ) : (collect-copies) ( cfg -- )
[ [
phis get clear-assoc phis get clear-assoc
instructions>> [ visit-insn ] each [ visit-insn ] each
] each-basic-block ; ] simple-analysis ;
: collect-copies ( cfg -- ) : collect-copies ( cfg -- )
H{ } clone copies set H{ } clone copies set

View File

@ -4,7 +4,7 @@ USING: accessors assocs arrays classes combinators
compiler.units fry generalizations sequences.generalizations compiler.units fry generalizations sequences.generalizations
generic kernel locals namespaces quotations sequences sets slots generic kernel locals namespaces quotations sequences sets slots
words compiler.cfg.instructions compiler.cfg.instructions.syntax words compiler.cfg.instructions compiler.cfg.instructions.syntax
compiler.cfg.rpo ; compiler.cfg.rpo compiler.cfg ;
FROM: namespaces => set ; FROM: namespaces => set ;
FROM: sets => members ; FROM: sets => members ;
IN: compiler.cfg.def-use IN: compiler.cfg.def-use
@ -91,17 +91,17 @@ SYMBOLS: defs insns ;
: compute-defs ( cfg -- ) : compute-defs ( cfg -- )
H{ } clone [ H{ } clone [
'[ '[
dup instructions>> [ [ basic-block get ] dip [
_ set-def-of _ set-def-of
] with each ] with each
] each-basic-block ] simple-analysis
] keep defs set ; ] keep defs set ;
: compute-insns ( cfg -- ) : compute-insns ( cfg -- )
H{ } clone [ H{ } clone [
'[ '[
instructions>> [ [
dup _ set-def-of dup _ set-def-of
] each ] each
] each-basic-block ] simple-analysis
] keep insns set ; ] keep insns set ;

View File

@ -158,6 +158,7 @@ M: insn assign-registers-in-insn drop ;
} cleave ; } cleave ;
:: assign-registers-in-block ( bb -- ) :: assign-registers-in-block ( bb -- )
bb kill-block?>> [
bb [ bb [
[ [
bb begin-block bb begin-block
@ -171,7 +172,8 @@ M: insn assign-registers-in-insn drop ;
] each ] each
bb compute-live-out bb compute-live-out
] V{ } make ] V{ } make
] change-instructions drop ; ] change-instructions drop
] unless ;
: assign-registers ( live-intervals cfg -- ) : assign-registers ( live-intervals cfg -- )
[ init-assignment ] dip [ init-assignment ] dip

View File

@ -171,6 +171,7 @@ M: clobber-insn compute-sync-points*
M: insn compute-sync-points* drop ; M: insn compute-sync-points* drop ;
: compute-live-intervals-step ( bb -- ) : compute-live-intervals-step ( bb -- )
dup kill-block?>> [ drop ] [
{ {
[ block-from from set ] [ block-from from set ]
[ block-to to set ] [ block-to to set ]
@ -182,7 +183,8 @@ M: insn compute-sync-points* drop ;
bi bi
] each ] each
] ]
} cleave ; } cleave
] if ;
: init-live-intervals ( -- ) : init-live-intervals ( -- )
H{ } clone live-intervals set H{ } clone live-intervals set

View File

@ -99,7 +99,9 @@ SYMBOL: temp
2dup compute-mappings perform-mappings ; 2dup compute-mappings perform-mappings ;
: resolve-block-data-flow ( bb -- ) : resolve-block-data-flow ( bb -- )
dup successors>> [ resolve-edge-data-flow ] with each ; dup kill-block?>> [ drop ] [
dup successors>> [ resolve-edge-data-flow ] with each
] if ;
: resolve-data-flow ( cfg -- ) : resolve-data-flow ( cfg -- )
needs-predecessors needs-predecessors

View File

@ -11,10 +11,10 @@ SYMBOL: components
: init-components ( cfg components -- ) : init-components ( cfg components -- )
'[ '[
instructions>> [ [
defs-vregs [ _ add-atom ] each defs-vregs [ _ add-atom ] each
] each ] each
] each-basic-block ; ] simple-analysis ;
GENERIC# visit-insn 1 ( insn disjoint-set -- ) GENERIC# visit-insn 1 ( insn disjoint-set -- )
@ -28,10 +28,10 @@ M: insn visit-insn 2drop ;
: merge-components ( cfg components -- ) : merge-components ( cfg components -- )
'[ '[
instructions>> [ [
_ visit-insn _ visit-insn
] each ] each
] each-basic-block ; ] simple-analysis ;
: compute-components ( cfg -- ) : compute-components ( cfg -- )
<disjoint-set> <disjoint-set>

View File

@ -1,7 +1,8 @@
! Copyright (C) 2009, 2010 Slava Pestov. ! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors compiler.cfg.instructions compiler.cfg.registers USING: accessors compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.rpo cpu.architecture kernel sequences vectors ; compiler.cfg.rpo cpu.architecture kernel sequences vectors
combinators.short-circuit ;
IN: compiler.cfg.save-contexts IN: compiler.cfg.save-contexts
! Insert context saves. ! Insert context saves.
@ -14,7 +15,10 @@ M: gc-map-insn needs-save-context? drop t ;
M: insn needs-save-context? drop f ; M: insn needs-save-context? drop f ;
: bb-needs-save-context? ( insn -- ? ) : bb-needs-save-context? ( insn -- ? )
instructions>> [ needs-save-context? ] any? ; {
[ kill-block?>> not ]
[ instructions>> [ needs-save-context? ] any? ]
} 1&& ;
GENERIC: modifies-context? ( insn -- ? ) GENERIC: modifies-context? ( insn -- ? )

View File

@ -103,12 +103,9 @@ M: ##phi prepare-insn
[ dst>> ] [ inputs>> values ] bi [ dst>> ] [ inputs>> values ] bi
[ maybe-eliminate-copy ] with each ; [ maybe-eliminate-copy ] with each ;
: prepare-block ( bb -- )
instructions>> [ prepare-insn ] each ;
: prepare-coalescing ( cfg -- ) : prepare-coalescing ( cfg -- )
init-coalescing init-coalescing
[ prepare-block ] each-basic-block ; [ [ prepare-insn ] each ] simple-analysis ;
: process-copies ( -- ) : process-copies ( -- )
copies get [ maybe-eliminate-copy ] assoc-each ; copies get [ maybe-eliminate-copy ] assoc-each ;

View File

@ -38,13 +38,12 @@ M: insn record-insn
SYMBOLS: def-indices kill-indices ; SYMBOLS: def-indices kill-indices ;
: compute-local-live-ranges ( bb -- ) : compute-local-live-ranges ( insns -- )
H{ } clone local-def-indices set H{ } clone local-def-indices set
H{ } clone local-kill-indices set H{ } clone local-kill-indices set
[ instructions>> [ swap record-insn ] each-index ] [ swap record-insn ] each-index
[ [ local-def-indices get ] dip def-indices get set-at ] local-def-indices get basic-block get def-indices get set-at
[ [ local-kill-indices get ] dip kill-indices get set-at ] local-kill-indices get basic-block get kill-indices get set-at ;
tri ;
PRIVATE> PRIVATE>
@ -53,7 +52,7 @@ PRIVATE>
H{ } clone def-indices set H{ } clone def-indices set
H{ } clone kill-indices set H{ } clone kill-indices set
[ compute-local-live-ranges ] each-basic-block ; [ compute-local-live-ranges ] simple-analysis ;
: def-index ( vreg bb -- n ) : def-index ( vreg bb -- n )
def-indices get at at ; def-indices get at at ;