compiler.cfg: clean up GC check generation to use spill-slot data type

db4
Slava Pestov 2009-07-03 23:11:23 -05:00
parent d07c0429fc
commit 8d3a45dee2
5 changed files with 32 additions and 39 deletions

View File

@ -10,7 +10,7 @@ IN: compiler.cfg.gc-checks
: insert-gc-check ( basic-block -- )
dup gc? [
[ i i f f \ ##gc new-insn prefix ] change-instructions drop
[ i i f \ ##gc new-insn prefix ] change-instructions drop
] [ drop ] if ;
: insert-gc-checks ( cfg -- cfg' )

View File

@ -220,7 +220,7 @@ INSN: ##compare-imm < ##binary-imm cc temp ;
INSN: ##compare-float-branch < ##conditional-branch ;
INSN: ##compare-float < ##binary cc temp ;
INSN: ##gc { temp1 vreg } { temp2 vreg } live-registers live-spill-slots ;
INSN: ##gc { temp1 vreg } { temp2 vreg } live-values ;
! Instructions used by machine IR only.
INSN: _prologue stack-frame ;

View File

@ -105,7 +105,7 @@ ERROR: already-reloaded ;
GENERIC: assign-registers-in-insn ( insn -- )
: register-mapping ( live-intervals -- alist )
[ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
[ [ vreg>> ] [ reg>> ] bi ] H{ } map>assoc ;
: all-vregs ( insn -- vregs )
[ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
@ -130,19 +130,22 @@ M: vreg-insn assign-registers-in-insn
register-mapping
>>regs drop ;
: compute-live-registers ( insn -- regs )
: compute-live-registers ( insn -- assoc )
[ active-intervals ] [ temp-vregs ] bi
'[ vreg>> _ memq? not ] filter
register-mapping ;
: compute-live-spill-slots ( -- spill-slots )
: compute-live-spill-slots ( -- assocs )
spill-slots get values
[ [ vreg>> swap ] { } assoc-map-as ] map concat ;
[ [ vreg>> swap <spill-slot> ] H{ } assoc-map-as ] map ;
: compute-live-values ( insn -- assoc )
[ compute-live-spill-slots ] dip compute-live-registers suffix
assoc-combine ;
M: ##gc assign-registers-in-insn
dup call-next-method
dup compute-live-registers >>live-registers
compute-live-spill-slots >>live-spill-slots
dup compute-live-values >>live-values
drop ;
M: insn assign-registers-in-insn drop ;

View File

@ -57,41 +57,31 @@ M: ##dispatch linearize-insn
[ successors>> [ number>> _dispatch-label ] each ]
bi* ;
: gc-root-registers ( n live-registers -- n )
: (compute-gc-roots) ( n live-values -- n )
[
[ second 2array , ]
[ first reg-class>> reg-size + ]
2bi
] each ;
[ nip 2array , ]
[ drop reg-class>> reg-size + ]
3bi
] assoc-each ;
: gc-root-spill-slots ( n live-spill-slots -- n )
: oop-values ( regs -- regs' )
[ drop reg-class>> int-regs eq? ] assoc-filter ;
: data-values ( regs -- regs' )
[ drop reg-class>> double-float-regs eq? ] assoc-filter ;
: compute-gc-roots ( live-values -- alist )
[
dup first reg-class>> int-regs eq? [
[ second <spill-slot> 2array , ]
[ first reg-class>> reg-size + ]
2bi
] [ drop ] if
] each ;
: oop-registers ( regs -- regs' )
[ first reg-class>> int-regs eq? ] filter ;
: data-registers ( regs -- regs' )
[ first reg-class>> double-float-regs eq? ] filter ;
:: compute-gc-roots ( live-registers live-spill-slots -- alist )
[
0
[ 0 ] dip
! we put float registers last; the GC doesn't actually scan them
live-registers oop-registers gc-root-registers
live-spill-slots gc-root-spill-slots
live-registers data-registers gc-root-registers
[ oop-values (compute-gc-roots) ]
[ data-values (compute-gc-roots) ] bi
drop
] { } make ;
: count-gc-roots ( live-registers live-spill-slots -- n )
: count-gc-roots ( live-values -- n )
! Size of GC root area, minus the float registers
[ oop-registers length ] bi@ + ;
oop-values assoc-size ;
M: ##gc linearize-insn
nip
@ -99,11 +89,11 @@ M: ##gc linearize-insn
[ temp1>> ]
[ temp2>> ]
[
[ live-registers>> ] [ live-spill-slots>> ] bi
live-values>>
[ compute-gc-roots ]
[ count-gc-roots ]
[ gc-roots-size ]
2tri
tri
] tri
_gc
] with-regs ;

View File

@ -34,8 +34,8 @@ spill-counts ;
: gc-root-offset ( n -- n' ) gc-root-base + ;
: gc-roots-size ( live-registers live-spill-slots -- n )
[ keys [ reg-class>> reg-size ] sigma ] bi@ + ;
: gc-roots-size ( live-values -- n )
keys [ reg-class>> reg-size ] sigma ;
: (stack-frame-size) ( stack-frame -- n )
[