compiler.cfg: clean up GC check generation to use spill-slot data type
parent
d07c0429fc
commit
8d3a45dee2
|
@ -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' )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue