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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-06-28 16:43:45 -05:00
parent 3b0954f63e d4de1d38b9
commit 1fab8efeee
2 changed files with 37 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/compiler/cfg/stack-analysis/merge/merge.factor
View File

@ -42,20 +42,20 @@ IN: compiler.cfg.stack-analysis.merge
[ [ keys ] map concat prune ] keep [ [ keys ] map concat prune ] keep
'[ dup _ [ at ] with map ] H{ } map>assoc ; '[ dup _ [ at ] with map ] H{ } map>assoc ;
: insert-peek ( predecessor state loc -- vreg ) : insert-peek ( predecessor loc -- vreg )
'[ _ _ swap translate-loc ^^peek ] add-instructions ; '[ _ ^^peek ] add-instructions ;
: merge-loc ( predecessors states vregs loc -- vreg ) : merge-loc ( predecessors vregs loc -- vreg )
! Insert a ##phi in the current block where the input ! Insert a ##phi in the current block where the input
! is the vreg storing loc from each predecessor block ! is the vreg storing loc from each predecessor block
'[ dup [ 2nip ] [ drop _ insert-peek ] if ] 3map '[ [ ] [ _ insert-peek ] ?if ] 2map
dup all-equal? [ first ] [ ^^phi ] if ; dup all-equal? [ first ] [ ^^phi ] if ;
:: merge-locs ( state predecessors states -- state ) :: merge-locs ( state predecessors states -- state )
states [ locs>vregs>> ] map states collect-locs states [ locs>vregs>> ] map states collect-locs
[| key value | [| key value |
key key
predecessors states value key merge-loc predecessors value key merge-loc
] assoc-map ] assoc-map
state translate-locs state translate-locs
state (>>locs>vregs) state (>>locs>vregs)

49
basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
View File

@ -8,26 +8,11 @@ sets namespaces arrays cpu.architecture ;
IN: compiler.cfg.stack-analysis.tests IN: compiler.cfg.stack-analysis.tests
! Fundamental invariant: a basic block should not load or store a value more than once ! Fundamental invariant: a basic block should not load or store a value more than once
: check-for-redundant-ops ( cfg -- )
[
instructions>>
[
[ ##peek? ] filter [ loc>> ] map duplicates empty?
[ "Redundant peeks" throw ] unless
] [
[ ##replace? ] filter [ loc>> ] map duplicates empty?
[ "Redundant replaces" throw ] unless
] bi
] each-basic-block ;
: test-stack-analysis ( quot -- cfg ) : test-stack-analysis ( quot -- cfg )
dup cfg? [ test-cfg first ] unless dup cfg? [ test-cfg first ] unless
compute-predecessors compute-predecessors
delete-useless-blocks
delete-useless-conditionals
stack-analysis stack-analysis
dup check-cfg dup check-cfg ;
dup check-for-redundant-ops ;
: linearize ( cfg -- mr ) : linearize ( cfg -- mr )
flatten-cfg instructions>> ; flatten-cfg instructions>> ;
@ -116,7 +101,7 @@ local-only? off
! Correct height tracking ! Correct height tracking
[ t ] [ [ t ] [
[ pick [ <array> ] [ drop ] if swap ] test-stack-analysis eliminate-dead-code [ pick [ <array> ] [ drop ] if swap ] test-stack-analysis eliminate-dead-code
reverse-post-order 2 swap nth reverse-post-order 3 swap nth
instructions>> [ ##peek? ] filter first2 [ loc>> ] [ loc>> ] bi* instructions>> [ ##peek? ] filter first2 [ loc>> ] [ loc>> ] bi*
2array { D 1 D 0 } set= 2array { D 1 D 0 } set=
] unit-test ] unit-test
@ -145,3 +130,33 @@ local-only? off
3 get instructions>> second loc>> 3 get instructions>> second loc>>
] unit-test ] unit-test
! Do inserted ##peeks reference the correct stack location if
! an ##inc-d/r was also inserted?
[ D 0 ] [
V{ T{ ##branch } } 0 test-bb
V{ T{ ##branch } } 1 test-bb
V{
T{ ##peek f V int-regs 1 D 0 }
T{ ##branch }
} 2 test-bb
V{
T{ ##call f \ + -1 }
T{ ##inc-d f 1 }
T{ ##branch }
} 3 test-bb
V{ T{ ##return } } 4 test-bb
test-diamond
cfg new 0 get >>entry
compute-predecessors
stack-analysis
drop
3 get instructions>> [ ##peek? ] find nip loc>>
] unit-test