compiler.cfg.representations: simplify a little

db4
Slava Pestov 2010-04-25 16:07:08 -04:00
parent ed8c32989f
commit 458fd007be
2 changed files with 26 additions and 35 deletions

View File

@ -15,57 +15,52 @@ cpu.architecture ;
FROM: namespaces => set ; FROM: namespaces => set ;
IN: compiler.cfg.representations.selection IN: compiler.cfg.representations.selection
SYMBOL: scc-infos ! vregs which must be tagged at the definition site because
! there is at least one usage that is not int-rep. If all usages
! are int-rep it is safe to untag at the definition site.
SYMBOL: tagged-vregs
TUPLE: scc-info reps all-uses-untagged? ; SYMBOL: vreg-reps
: <scc-info> ( -- reps )
V{ } clone t \ scc-info boa ;
: scc-info ( vreg -- info )
vreg>scc scc-infos get [ drop <scc-info> ] cache ;
: handle-def ( vreg rep -- ) : handle-def ( vreg rep -- )
swap scc-info reps>> push ; swap vreg>scc vreg-reps get
[ [ intersect ] when* ] change-at ;
: handle-use ( vreg rep -- ) : handle-use ( vreg rep -- )
int-rep eq? [ scc-info f >>all-uses-untagged? ] unless drop ; int-rep eq? [ drop ] [ vreg>scc tagged-vregs get adjoin ] if ;
GENERIC: collect-scc-info ( insn -- ) GENERIC: (collect-vreg-reps) ( insn -- )
M: ##load-reference collect-scc-info M: ##load-reference (collect-vreg-reps)
[ dst>> ] [ obj>> ] bi { [ dst>> ] [ obj>> ] bi {
{ [ dup float? ] [ drop { float-rep double-rep } ] } { [ dup float? ] [ drop { float-rep double-rep } ] }
{ [ dup byte-array? ] [ drop vector-reps ] } { [ dup byte-array? ] [ drop vector-reps ] }
[ drop { } ] [ drop { } ]
} cond handle-def ; } cond handle-def ;
M: vreg-insn collect-scc-info M: vreg-insn (collect-vreg-reps)
[ [ handle-use ] each-use-rep ] [ [ handle-use ] each-use-rep ]
[ [ 1array handle-def ] each-def-rep ] [ [ 1array handle-def ] each-def-rep ]
[ [ 1array handle-def ] each-temp-rep ] [ [ 1array handle-def ] each-temp-rep ]
tri ; tri ;
M: insn collect-scc-info drop ; M: insn (collect-vreg-reps) drop ;
: collect-scc-infos ( cfg -- ) : collect-vreg-reps ( cfg -- )
H{ } clone scc-infos set H{ } clone vreg-reps set
[ [ collect-scc-info ] each-non-phi ] each-basic-block ; HS{ } clone tagged-vregs set
[ [ (collect-vreg-reps) ] each-non-phi ] each-basic-block ;
SYMBOL: possibilities SYMBOL: possibilities
: permitted-reps ( scc-info -- seq ) : possible-reps ( vreg reps -- vreg reps )
reps>> [ ] [ intersect ] map-reduce { tagged-rep } union
tagged-rep over member-eq? [ tagged-rep suffix ] unless ; 2dup [ tagged-vregs get in? not ] [ { tagged-rep } = ] bi* and
[ drop { tagged-rep int-rep } ] [ ] if ;
: scc-reps ( scc-info -- seq )
dup permitted-reps
2dup [ all-uses-untagged?>> ] [ { tagged-rep } = ] bi* and
[ 2drop { tagged-rep int-rep } ] [ nip ] if ;
: compute-possibilities ( cfg -- ) : compute-possibilities ( cfg -- )
collect-scc-infos collect-vreg-reps
scc-infos get [ scc-reps ] assoc-map possibilities set ; vreg-reps get [ possible-reps ] assoc-map possibilities set ;
! For every vreg, compute the cost of keeping it in every possible ! For every vreg, compute the cost of keeping it in every possible
! representation. ! representation.
@ -86,12 +81,9 @@ SYMBOL: costs
[ costs get at 2dup key? ] dip [ costs get at 2dup key? ] dip
'[ [ current-loop-nesting 10^ _ * + ] change-at ] [ 2drop ] if ; '[ [ current-loop-nesting 10^ _ * + ] change-at ] [ 2drop ] if ;
: possible-reps ( scc -- reps )
possibilities get at ;
:: increase-costs ( vreg preferred factor -- ) :: increase-costs ( vreg preferred factor -- )
vreg vreg>scc :> scc vreg vreg>scc :> scc
scc possible-reps [ scc possibilities get at [
dup preferred eq? [ drop ] [ scc factor increase-cost ] if dup preferred eq? [ drop ] [ scc factor increase-cost ] if
] each ; inline ] each ; inline

View File

@ -1,4 +1,4 @@
! Copyright (C) 2009 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 assocs kernel locals fry sequences USING: accessors assocs kernel locals fry sequences
cpu.architecture cpu.architecture
@ -6,8 +6,7 @@ compiler.cfg.rpo
compiler.cfg.def-use compiler.cfg.def-use
compiler.cfg.utilities compiler.cfg.utilities
compiler.cfg.registers compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.instructions ;
compiler.cfg.representations.conversion ;
IN: compiler.cfg.ssa.cssa IN: compiler.cfg.ssa.cssa
! Convert SSA to conventional SSA. This pass runs after representation ! Convert SSA to conventional SSA. This pass runs after representation
@ -24,7 +23,7 @@ IN: compiler.cfg.ssa.cssa
:: insert-copy ( bb src rep -- bb dst ) :: insert-copy ( bb src rep -- bb dst )
bb src insert-copy? [ bb src insert-copy? [
rep next-vreg-rep :> dst rep next-vreg-rep :> dst
bb [ dst src rep src rep-of emit-conversion ] add-instructions bb [ dst src rep ##copy ] add-instructions
bb dst bb dst
] [ bb src ] if ; ] [ bb src ] if ;