compiler.cfg.liveness: refactoring so that words that doesn't modify

the live-set doesnt return it

e.g it's clearer when the effect is ( live-set insn -- ) than ( live-set insn -- live-set ) that the live-set is modified in place
db4
Björn Lindqvist 2015-04-16 08:56:23 +02:00 committed by John Benediktsson
parent c876d79b9d
commit a17e943e88
2 changed files with 41 additions and 25 deletions

View File

@ -54,13 +54,12 @@ IN: compiler.cfg.liveness.tests
] unit-test
! fill-gc-map
{ H{ } } [
{ } [
f representations set
H{ } clone T{ gc-map } fill-gc-map
] unit-test
{
H{ { 48 48 } }
T{ gc-map { gc-roots { 48 } } { derived-roots V{ } } }
} [
H{ { 48 tagged-rep } } representations set
@ -70,16 +69,12 @@ IN: compiler.cfg.liveness.tests
! kill-defs
{ H{ } } [
H{ } T{ ##peek f 37 D 0 0 } kill-defs
H{ } dup T{ ##peek f 37 D 0 0 } kill-defs
] unit-test
{ H{ { 3 3 } } } [
H{ { 37 99 } { 99 99 } { 2 99 } } leader-map set
H{ { 37 37 } { 3 3 } } T{ ##peek f 2 D 0 0 } kill-defs
] unit-test
{ t } [
H{ { 123 123 } } clone T{ ##peek f 7 D 0 } dupd kill-defs eq?
H{ { 37 37 } { 3 3 } } dup T{ ##peek f 2 D 0 0 } kill-defs
] unit-test
! lookup-base-pointer
@ -97,6 +92,14 @@ IN: compiler.cfg.liveness.tests
456 T{ ##peek f 123 D 0 } lookup-base-pointer*
] unit-test
! transfer-liveness
{
H{ { 37 37 } }
} [
H{ } clone dup { T{ ##replace f 37 D 1 6 } T{ ##peek f 37 D 0 0 } }
transfer-liveness
] unit-test
! visit-gc-root
{ V{ } HS{ 48 } } [
H{ { 48 tagged-rep } } representations set
@ -112,12 +115,24 @@ IN: compiler.cfg.liveness.tests
! visit-insn
{ H{ } } [
H{ } clone T{ ##peek f 0 D 0 } visit-insn
H{ } clone [ T{ ##peek f 0 D 0 } visit-insn ] keep
] unit-test
{ H{ { 48 48 } { 37 37 } } } [
H{ { 48 tagged-rep } } representations set
H{ { 48 48 } } clone T{ ##replace f 37 D 1 6 } visit-insn
H{ { 48 48 } } clone [ T{ ##replace f 37 D 1 6 } visit-insn ] keep
] unit-test
{
T{ ##call-gc
{ gc-map
T{ gc-map { gc-roots { 93 } } { derived-roots V{ } } }
}
}
} [
H{ { 93 tagged-rep } } representations set
H{ { 93 93 } } clone T{ ##call-gc f T{ gc-map } }
[ visit-insn ] keep
] unit-test
: test-liveness ( -- )

View File

@ -26,17 +26,18 @@ SYMBOL: edge-live-ins
SYMBOL: base-pointers
GENERIC: visit-insn ( live-set insn -- live-set )
GENERIC: visit-insn ( live-set insn -- )
: kill-defs ( live-set insn -- live-set )
! This would be much better if live-set was a real set
: kill-defs ( live-set insn -- )
defs-vregs [ ?leader ] map
'[ drop ?leader _ in? not ] assoc-filter! ; inline
'[ drop ?leader _ in? not ] assoc-filter! drop ; inline
: gen-uses ( live-set insn -- live-set )
uses-vregs [ over conjoin ] each ; inline
: gen-uses ( live-set insn -- )
uses-vregs [ swap conjoin ] with each ; inline
M: vreg-insn visit-insn ( live-set insn -- live-set )
[ kill-defs ] [ gen-uses ] bi ;
M: vreg-insn visit-insn ( live-set insn -- )
[ kill-defs ] [ gen-uses ] 2bi ;
DEFER: lookup-base-pointer
@ -96,19 +97,19 @@ M: vreg-insn lookup-base-pointer* 2drop f ;
[ '[ drop _ _ visit-gc-root ] assoc-each ] 2keep
members ;
: fill-gc-map ( live-set gc-map -- live-set )
[ representations get [ dup gc-roots ] [ f f ] if ] dip
: fill-gc-map ( live-set gc-map -- )
[ representations get [ gc-roots ] [ drop f f ] if ] dip
[ gc-roots<< ] [ derived-roots<< ] bi ;
M: gc-map-insn visit-insn ( live-set insn -- live-set )
[ kill-defs ] [ gc-map>> fill-gc-map ] [ gen-uses ] tri ;
M: gc-map-insn visit-insn ( live-set insn -- )
[ kill-defs ] [ gc-map>> fill-gc-map ] [ gen-uses ] 2tri ;
M: ##phi visit-insn kill-defs ;
M: insn visit-insn drop ;
M: insn visit-insn 2drop ;
: transfer-liveness ( live-set instructions -- live-set' )
[ clone ] [ <reversed> ] bi* [ visit-insn ] each ;
: transfer-liveness ( live-set insns -- )
<reversed> [ visit-insn ] with each ;
SYMBOL: work-list
@ -116,7 +117,7 @@ SYMBOL: work-list
work-list get push-all-front ;
: compute-live-in ( basic-block -- live-in )
[ live-out ] keep instructions>> transfer-liveness ;
[ live-out clone dup ] keep instructions>> transfer-liveness ;
: compute-edge-live-in ( basic-block -- edge-live-in )
H{ } clone [