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 placedb4
parent
c876d79b9d
commit
a17e943e88
|
@ -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 ( -- )
|
||||
|
|
|
@ -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 [
|
||||
|
|
Loading…
Reference in New Issue