compiler: preliminary implementation of tracking derived pointers in GC maps
Slava Pestov
Slava Pestov
parent
53aed0805a
commit
6b5fffc026
|
|
@ -830,13 +830,16 @@ UNION: conditional-branch-insn
|
|||
UNION: ##read ##slot ##slot-imm ##vm-field ##alien-global ;
|
||||
UNION: ##write ##set-slot ##set-slot-imm ##set-vm-field ;
|
||||
|
||||
! Instructions that contain subroutine calls to functions which
|
||||
! can callback arbitrary Factor code
|
||||
UNION: factor-call-insn
|
||||
UNION: alien-call-insn
|
||||
##alien-invoke
|
||||
##alien-indirect
|
||||
##alien-assembly ;
|
||||
|
||||
! Instructions that contain subroutine calls to functions which
|
||||
! can callback arbitrary Factor code
|
||||
UNION: factor-call-insn
|
||||
alien-call-insn ;
|
||||
|
||||
! Instructions that contain subroutine calls to functions which
|
||||
! allocate memory
|
||||
UNION: gc-map-insn
|
||||
|
|
@ -848,15 +851,10 @@ factor-call-insn ;
|
|||
M: gc-map-insn clone call-next-method [ clone ] change-gc-map ;
|
||||
|
||||
! Each one has a gc-map slot
|
||||
TUPLE: gc-map scrub-d scrub-r gc-roots ;
|
||||
TUPLE: gc-map scrub-d scrub-r gc-roots derived-roots ;
|
||||
|
||||
: <gc-map> ( -- gc-map ) gc-map new ;
|
||||
|
||||
UNION: alien-call-insn
|
||||
##alien-invoke
|
||||
##alien-indirect
|
||||
##alien-assembly ;
|
||||
|
||||
! Instructions that clobber registers. They receive inputs and
|
||||
! produce outputs in spill slots.
|
||||
UNION: hairy-clobber-insn
|
||||
|
|
|
|||
|
|
@ -146,9 +146,15 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
|
|||
M: vreg-insn assign-registers-in-insn
|
||||
[ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;
|
||||
|
||||
: assign-gc-roots ( gc-map -- )
|
||||
[ [ vreg>spill-slot ] map ] change-gc-roots drop ;
|
||||
|
||||
: assign-derived-roots ( gc-map -- )
|
||||
[ [ [ vreg>spill-slot ] bi@ ] assoc-map ] change-derived-roots drop ;
|
||||
|
||||
M: gc-map-insn assign-registers-in-insn
|
||||
[ [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ]
|
||||
[ gc-map>> [ [ vreg>spill-slot ] map ] change-gc-roots drop ]
|
||||
[ gc-map>> [ assign-gc-roots ] [ assign-derived-roots ] bi ]
|
||||
bi ;
|
||||
|
||||
M: insn assign-registers-in-insn drop ;
|
||||
|
|
|
|||
|
|
@ -205,4 +205,43 @@ V{
|
|||
|
||||
[ H{ { 0 0 } } ] [ 2 get 4 get edge-live-in ] unit-test
|
||||
|
||||
[ H{ { 1 1 } } ] [ 3 get 4 get edge-live-in ] unit-test
|
||||
[ H{ { 1 1 } } ] [ 3 get 4 get edge-live-in ] unit-test
|
||||
|
||||
|
||||
V{
|
||||
T{ ##prologue }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek f 0 D 0 }
|
||||
T{ ##tagged>integer f 1 0 }
|
||||
T{ ##call-gc f T{ gc-map } }
|
||||
T{ ##replace f 0 D 0 }
|
||||
T{ ##call-gc f T{ gc-map } }
|
||||
T{ ##replace f 1 D 0 }
|
||||
T{ ##branch }
|
||||
} 1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
} 2 test-bb
|
||||
|
||||
0 1 edge
|
||||
1 2 edge
|
||||
|
||||
H{
|
||||
{ 0 tagged-rep }
|
||||
{ 1 int-rep }
|
||||
} representations set
|
||||
|
||||
[ ] [ cfg new 0 get >>entry dup cfg set compute-live-sets ] unit-test
|
||||
|
||||
[ V{ { 1 0 } } ] [ 1 get instructions>> 2 swap nth gc-map>> derived-roots>> ] unit-test
|
||||
|
||||
[ { 0 } ] [ 1 get instructions>> 2 swap nth gc-map>> gc-roots>> ] unit-test
|
||||
|
||||
[ V{ { 1 0 } } ] [ 1 get instructions>> 4 swap nth gc-map>> derived-roots>> ] unit-test
|
||||
|
||||
[ { 0 } ] [ 1 get instructions>> 4 swap nth gc-map>> gc-roots>> ] unit-test
|
||||
|
|
@ -1,15 +1,28 @@
|
|||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors assocs fry deques dlists namespaces
|
||||
sequences sets compiler.cfg compiler.cfg.def-use
|
||||
compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.utilities compiler.cfg.predecessors
|
||||
compiler.cfg.rpo cpu.architecture ;
|
||||
USING: arrays kernel accessors assocs fry locals combinators
|
||||
deques dlists namespaces sequences sets compiler.cfg
|
||||
compiler.cfg.def-use compiler.cfg.instructions
|
||||
compiler.cfg.registers compiler.cfg.utilities
|
||||
compiler.cfg.predecessors compiler.cfg.rpo cpu.architecture ;
|
||||
FROM: namespaces => set ;
|
||||
IN: compiler.cfg.liveness
|
||||
|
||||
! See http://en.wikipedia.org/wiki/Liveness_analysis
|
||||
! Similar to http://en.wikipedia.org/wiki/Liveness_analysis,
|
||||
! with three additions:
|
||||
|
||||
! 1) With SSA, it is not sufficient to have a single live-in set
|
||||
! per block. There is also there is an edge-live-in set per
|
||||
! edge, consisting of phi inputs from each predecessor.
|
||||
! 2) Liveness analysis annotates call sites with GC maps
|
||||
! indicating the spill slots in the stack frame that contain
|
||||
! tagged pointers, and thus have to be visited if a GC occurs
|
||||
! inside the call.
|
||||
! 3) GC maps can contain derived pointers. A derived pointer is
|
||||
! a pointer into the middle of a data heap object. Each derived
|
||||
! pointer has a base pointer, to keep it up to date when objects
|
||||
! are moved by the garbage collector. This extends live
|
||||
! intervals and inserts new ##phi instructions.
|
||||
SYMBOL: live-ins
|
||||
|
||||
: live-in ( bb -- set )
|
||||
|
|
@ -27,6 +40,8 @@ SYMBOL: edge-live-ins
|
|||
: edge-live-in ( predecessor basic-block -- set )
|
||||
edge-live-ins get at at ;
|
||||
|
||||
SYMBOL: base-pointers
|
||||
|
||||
GENERIC: visit-insn ( live-set insn -- live-set )
|
||||
|
||||
: kill-defs ( live-set insn -- live-set )
|
||||
|
|
@ -35,20 +50,64 @@ GENERIC: visit-insn ( live-set insn -- live-set )
|
|||
: gen-uses ( live-set insn -- live-set )
|
||||
uses-vregs [ over conjoin ] each ; inline
|
||||
|
||||
M: vreg-insn visit-insn [ kill-defs ] [ gen-uses ] bi ;
|
||||
M: vreg-insn visit-insn
|
||||
[ kill-defs ] [ gen-uses ] bi ;
|
||||
|
||||
! Our liveness analysis annotates call sites with GC maps
|
||||
! indicating the spill slots in the stack frame that contain
|
||||
! tagged pointers, and thus have to be visited if a GC occurs
|
||||
! inside the call.
|
||||
DEFER: lookup-base-pointer
|
||||
|
||||
GENERIC: lookup-base-pointer* ( insn -- vreg/f )
|
||||
|
||||
M: ##tagged>integer lookup-base-pointer* src>> ;
|
||||
|
||||
M: ##unbox-any-c-ptr lookup-base-pointer*
|
||||
! If the input to unbox-any-c-ptr was an alien and not a
|
||||
! byte array, then the derived pointer will be outside of
|
||||
! the data heap. The GC has to handle this case and ignore
|
||||
! it.
|
||||
src>> ;
|
||||
|
||||
M: ##copy lookup-base-pointer* src>> lookup-base-pointer ;
|
||||
|
||||
M: ##add-imm lookup-base-pointer* src1>> lookup-base-pointer ;
|
||||
|
||||
M: ##sub-imm lookup-base-pointer* src1>> lookup-base-pointer ;
|
||||
|
||||
M: ##add lookup-base-pointer*
|
||||
! If both operands have a base pointer, then the user better
|
||||
! not be doing memory reads and writes on the object, since
|
||||
! we don't give it a base pointer in that case at all.
|
||||
[ src1>> ] [ src2>> ] bi [ lookup-base-pointer ] bi@ xor ;
|
||||
|
||||
M: ##sub lookup-base-pointer*
|
||||
src1>> lookup-base-pointer ;
|
||||
|
||||
M: vreg-insn lookup-base-pointer* drop f ;
|
||||
|
||||
: lookup-base-pointer ( vreg -- vreg/f )
|
||||
base-pointers get [ insn-of lookup-base-pointer* ] cache ;
|
||||
|
||||
:: visit-derived-root ( vreg derived-roots gc-roots -- )
|
||||
vreg lookup-base-pointer :> base
|
||||
base [
|
||||
{ vreg base } derived-roots push
|
||||
base gc-roots adjoin
|
||||
] when ;
|
||||
|
||||
: visit-gc-root ( vreg derived-roots gc-roots -- )
|
||||
pick rep-of {
|
||||
{ tagged-rep [ nip adjoin ] }
|
||||
{ int-rep [ visit-derived-root ] }
|
||||
[ 2drop 2drop ]
|
||||
} case ;
|
||||
|
||||
: gc-roots ( live-set -- derived-roots gc-roots )
|
||||
V{ } clone HS{ } clone
|
||||
[ '[ drop _ _ visit-gc-root ] assoc-each ] 2keep
|
||||
members ;
|
||||
|
||||
: fill-gc-map ( live-set insn -- live-set )
|
||||
representations get [
|
||||
gc-map>> over keys
|
||||
[ rep-of tagged-rep? ] filter
|
||||
>>gc-roots
|
||||
] when
|
||||
drop ;
|
||||
[ representations get [ dup gc-roots ] [ f f ] if ] dip
|
||||
gc-map>> [ gc-roots<< ] [ derived-roots<< ] bi ;
|
||||
|
||||
M: gc-map-insn visit-insn
|
||||
[ kill-defs ] [ fill-gc-map ] [ gen-uses ] tri ;
|
||||
|
|
@ -60,9 +119,6 @@ M: insn visit-insn drop ;
|
|||
: transfer-liveness ( live-set instructions -- live-set' )
|
||||
[ clone ] [ <reversed> ] bi* [ visit-insn ] each ;
|
||||
|
||||
: local-live-in ( instructions -- live-set )
|
||||
[ H{ } ] dip transfer-liveness keys ;
|
||||
|
||||
SYMBOL: work-list
|
||||
|
||||
: add-to-work-list ( basic-blocks -- )
|
||||
|
|
@ -98,11 +154,13 @@ SYMBOL: work-list
|
|||
|
||||
: compute-live-sets ( cfg -- )
|
||||
needs-predecessors
|
||||
dup compute-insns
|
||||
|
||||
<hashed-dlist> work-list set
|
||||
H{ } clone live-ins set
|
||||
H{ } clone edge-live-ins set
|
||||
H{ } clone live-outs set
|
||||
H{ } clone base-pointers set
|
||||
post-order add-to-work-list
|
||||
work-list get [ liveness-step ] slurp-deque ;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,13 +9,14 @@ STRUCT: gc-info
|
|||
{ scrub-d-count uint }
|
||||
{ scrub-r-count uint }
|
||||
{ gc-root-count uint }
|
||||
{ derived-root-count uint }
|
||||
{ return-address-count uint } ;
|
||||
|
||||
SINGLETON: fake-cpu
|
||||
|
||||
fake-cpu \ cpu set
|
||||
|
||||
M: fake-cpu gc-root-offsets ;
|
||||
M: fake-cpu gc-root-offset ;
|
||||
|
||||
[ ] [
|
||||
[
|
||||
|
|
@ -27,7 +28,7 @@ M: fake-cpu gc-root-offsets ;
|
|||
|
||||
50 <byte-array> %
|
||||
|
||||
T{ gc-map f B{ 0 1 1 1 0 } B{ 1 0 } V{ 1 3 } } gc-map-here
|
||||
T{ gc-map f B{ 0 1 1 1 0 } B{ 1 0 } V{ 1 3 } V{ { 2 4 } } } gc-map-here
|
||||
|
||||
emit-gc-info
|
||||
] B{ } make
|
||||
|
|
@ -54,7 +55,10 @@ M: fake-cpu gc-root-offsets ;
|
|||
f t f t
|
||||
} underlying>> %
|
||||
|
||||
! Return addresses - 4 bytes
|
||||
! Derived pointers
|
||||
uint-array{ -1 -1 4 } underlying>> %
|
||||
|
||||
! Return addresses
|
||||
uint-array{ 100 } underlying>> %
|
||||
|
||||
! GC info footer - 16 bytes
|
||||
|
|
@ -62,6 +66,7 @@ M: fake-cpu gc-root-offsets ;
|
|||
{ scrub-d-count 5 }
|
||||
{ scrub-r-count 2 }
|
||||
{ gc-root-count 4 }
|
||||
{ derived-root-count 3 }
|
||||
{ return-address-count 1 }
|
||||
} (underlying)>> %
|
||||
] B{ } make
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays bit-arrays byte-arrays byte-vectors generic assocs
|
||||
hashtables io.binary kernel kernel.private math namespaces make
|
||||
sequences words quotations strings alien.accessors alien.strings
|
||||
layouts system combinators math.bitwise math.order
|
||||
sequences words quotations strings sorting alien.accessors
|
||||
alien.strings layouts system combinators math.bitwise math.order
|
||||
combinators.short-circuit combinators.smart accessors growable
|
||||
fry memoize compiler.constants compiler.cfg.instructions
|
||||
cpu.architecture ;
|
||||
|
|
@ -144,12 +144,14 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ;
|
|||
! - <scrubbed data stack locations>
|
||||
! - <scrubbed retain stack locations>
|
||||
! - <GC root spill slots>
|
||||
! uint[] <base pointers>
|
||||
! uint[] <return addresses>
|
||||
! uint <largest scrubbed data stack location>
|
||||
! uint <largest scrubbed retain stack location>
|
||||
! uint <largest GC root spill slot>
|
||||
! uint <number of return addresses>
|
||||
|
||||
! uint <largest derived root spill slot>
|
||||
! int <number of return addresses>
|
||||
!
|
||||
SYMBOLS: return-addresses gc-maps ;
|
||||
|
||||
: gc-map-needed? ( gc-map -- ? )
|
||||
|
|
@ -160,6 +162,7 @@ SYMBOLS: return-addresses gc-maps ;
|
|||
[ scrub-d>> empty? ]
|
||||
[ scrub-r>> empty? ]
|
||||
[ gc-roots>> empty? ]
|
||||
[ derived-roots>> empty? ]
|
||||
} 1&& not
|
||||
] when ;
|
||||
|
||||
|
|
@ -169,33 +172,64 @@ SYMBOLS: return-addresses gc-maps ;
|
|||
compiled-offset return-addresses get push
|
||||
] [ drop ] if ;
|
||||
|
||||
: longest ( seqs -- n )
|
||||
[ length ] [ max ] map-reduce ;
|
||||
|
||||
: emit-scrub ( seqs -- n )
|
||||
! seqs is a sequence of sequences of 0/1
|
||||
dup [ length ] [ max ] map-reduce
|
||||
dup longest
|
||||
[ '[ [ 0 = ] ?{ } map-as _ f pad-tail % ] each ] keep ;
|
||||
|
||||
: integers>bits ( seq n -- bit-array )
|
||||
<bit-array> [ '[ [ t ] dip _ set-nth ] each ] keep ;
|
||||
|
||||
: largest-spill-slot ( seqs -- n )
|
||||
[ [ 0 ] [ supremum 1 + ] if-empty ] [ max ] map-reduce ;
|
||||
|
||||
: emit-gc-roots ( seqs -- n )
|
||||
! seqs is a sequence of sequences of integers 0..n-1
|
||||
dup [ [ 0 ] [ supremum 1 + ] if-empty ] [ max ] map-reduce
|
||||
dup largest-spill-slot
|
||||
[ '[ _ integers>bits % ] each ] keep ;
|
||||
|
||||
: emit-uint ( n -- )
|
||||
building get push-uint ;
|
||||
|
||||
: emit-uints ( n -- )
|
||||
[ emit-uint ] each ;
|
||||
|
||||
: gc-root-offsets ( gc-map -- offsets )
|
||||
gc-roots>> [ gc-root-offset ] map ;
|
||||
|
||||
: emit-gc-info-bitmaps ( -- scrub-d-count scrub-r-count gc-root-count )
|
||||
[
|
||||
gc-maps get {
|
||||
[ [ scrub-d>> ] map emit-scrub ]
|
||||
[ [ scrub-r>> ] map emit-scrub ]
|
||||
[ [ gc-root-offsets ] map emit-gc-roots ]
|
||||
} cleave
|
||||
] ?{ } make underlying>> % ;
|
||||
|
||||
: emit-base-table ( alist longest -- )
|
||||
-1 <array> <enum> swap assoc-union! seq>> emit-uints ;
|
||||
|
||||
: derived-root-offsets ( gc-map -- offsets )
|
||||
derived-roots>> [ [ gc-root-offset ] bi@ ] assoc-map ;
|
||||
|
||||
: emit-base-tables ( -- count )
|
||||
gc-maps get [ derived-root-offsets ] map
|
||||
dup [ keys ] map largest-spill-slot
|
||||
[ '[ _ emit-base-table ] each ] keep ;
|
||||
|
||||
: emit-return-addresses ( -- )
|
||||
return-addresses get emit-uints ;
|
||||
|
||||
: gc-info ( -- byte-array )
|
||||
[
|
||||
return-addresses get empty? [ 0 emit-uint ] [
|
||||
gc-maps get
|
||||
[
|
||||
[ [ scrub-d>> ] map emit-scrub ]
|
||||
[ [ scrub-r>> ] map emit-scrub ]
|
||||
[ [ gc-roots>> gc-root-offsets ] map emit-gc-roots ] tri
|
||||
] ?{ } make underlying>> %
|
||||
return-addresses get [ emit-uint ] each
|
||||
[ emit-uint ] tri@
|
||||
emit-gc-info-bitmaps
|
||||
emit-base-tables
|
||||
emit-return-addresses
|
||||
4array emit-uints
|
||||
return-addresses get length emit-uint
|
||||
] if
|
||||
] B{ } make ;
|
||||
|
|
|
|||
|
|
@ -823,25 +823,3 @@ TUPLE: some-tuple x ;
|
|||
aa-indirect-1 >>x
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
! Write barrier elimination was being done before scheduling and
|
||||
! GC check insertion, and didn't take subroutine calls into
|
||||
! account. Oops...
|
||||
: write-barrier-elim-in-wrong-place ( -- obj )
|
||||
! A callback used below
|
||||
void { } cdecl [ compact-gc ] alien-callback
|
||||
! Allocate an object A in the nursery
|
||||
1 f <array>
|
||||
! Subroutine call promotes the object to tenured
|
||||
swap void { } cdecl alien-indirect
|
||||
! Allocate another object B in the nursery, store it into
|
||||
! the first
|
||||
1 f <array> over set-first
|
||||
! Now object A's card should be marked and minor GC should
|
||||
! promote B to aging
|
||||
minor-gc
|
||||
! Do stuff
|
||||
[ 100 [ ] times ] infer.
|
||||
;
|
||||
|
||||
[ { { f } } ] [ write-barrier-elim-in-wrong-place ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@ sequences tools.test namespaces.private slots.private
|
|||
sequences.private byte-arrays alien alien.accessors layouts
|
||||
words definitions compiler.units io combinators vectors grouping
|
||||
make alien.c-types combinators.short-circuit math.order
|
||||
math.libm math.parser math.functions alien.syntax ;
|
||||
math.libm math.parser math.functions alien.syntax memory
|
||||
stack-checker ;
|
||||
FROM: math => float ;
|
||||
QUALIFIED: namespaces.private
|
||||
IN: compiler.tests.codegen
|
||||
|
|
@ -463,6 +464,13 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
|
|||
[ [ HEX: f bitand ] bi@ [ shift ] [ drop -3 shift ] 2bi ] compile-call
|
||||
] unit-test
|
||||
|
||||
! Alias analysis bug
|
||||
[ t ] [
|
||||
[
|
||||
10 10 <byte-array> [ <displaced-alien> underlying>> ] keep eq?
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
! GC root offsets were computed wrong on x86
|
||||
: gc-root-messup ( a -- b )
|
||||
dup [
|
||||
|
|
@ -473,9 +481,45 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
|
|||
|
||||
[ ] [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test
|
||||
|
||||
! Alias analysis bug
|
||||
[ t ] [
|
||||
[
|
||||
10 10 <byte-array> [ <displaced-alien> underlying>> ] keep eq?
|
||||
] compile-call
|
||||
] unit-test
|
||||
! Write barrier elimination was being done before scheduling and
|
||||
! GC check insertion, and didn't take subroutine calls into
|
||||
! account. Oops...
|
||||
: write-barrier-elim-in-wrong-place ( -- obj )
|
||||
! A callback used below
|
||||
void { } cdecl [ compact-gc ] alien-callback
|
||||
! Allocate an object A in the nursery
|
||||
1 f <array>
|
||||
! Subroutine call promotes the object to tenured
|
||||
swap void { } cdecl alien-indirect
|
||||
! Allocate another object B in the nursery, store it into
|
||||
! the first
|
||||
1 f <array> over set-first
|
||||
! Now object A's card should be marked and minor GC should
|
||||
! promote B to aging
|
||||
minor-gc
|
||||
! Do stuff
|
||||
[ 100 [ ] times ] infer.
|
||||
;
|
||||
|
||||
[ { { f } } ] [ write-barrier-elim-in-wrong-place ] unit-test
|
||||
|
||||
! GC maps must support derived pointers
|
||||
: (derived-pointer-test-1) ( -- byte-array )
|
||||
2 <byte-array> ;
|
||||
|
||||
: derived-pointer-test-1 ( -- byte-array )
|
||||
! A callback used below
|
||||
void { } cdecl [ compact-gc ] alien-callback
|
||||
! Put the construction in a word since instruction selection
|
||||
! eliminates the untagged pointer entirely if the value is a
|
||||
! byte array
|
||||
(derived-pointer-test-1) { c-ptr } declare
|
||||
! Store into an array, an untagged pointer to the payload
|
||||
! is now an available expression
|
||||
123 over 0 set-alien-unsigned-1
|
||||
! GC, moving the array and derived pointer
|
||||
swap void { } cdecl alien-indirect
|
||||
! Store into the array again
|
||||
231 over 1 set-alien-unsigned-1 ;
|
||||
|
||||
[ B{ 123 231 } ] [ derived-pointer-test-1 ] unit-test
|
||||
|
|
|
|||
|
|
@ -225,7 +225,7 @@ M: object vm-stack-space 0 ;
|
|||
! %store-memory work
|
||||
HOOK: complex-addressing? cpu ( -- ? )
|
||||
|
||||
HOOK: gc-root-offsets cpu ( seq -- seq' )
|
||||
HOOK: gc-root-offset cpu ( spill-slot -- n )
|
||||
|
||||
HOOK: %load-immediate cpu ( reg val -- )
|
||||
HOOK: %load-reference cpu ( reg obj -- )
|
||||
|
|
|
|||
|
|
@ -503,8 +503,8 @@ M:: x86 %check-nursery-branch ( label size cc temp1 temp2 -- )
|
|||
{ cc/<= [ label JG ] }
|
||||
} case ;
|
||||
|
||||
M: x86 gc-root-offsets
|
||||
[ n>> spill-offset special-offset cell + cell /i ] map f like ;
|
||||
M: x86 gc-root-offset
|
||||
n>> spill-offset special-offset cell + cell /i ;
|
||||
|
||||
M: x86 %call-gc ( gc-map -- )
|
||||
\ minor-gc %call
|
||||
|
|
|
|||
|
|
@ -60,9 +60,9 @@ void context::scrub_stacks(gc_info *info, cell index)
|
|||
u8 *bitmap = info->gc_info_bitmap();
|
||||
|
||||
{
|
||||
cell base = info->scrub_d_base(index);
|
||||
cell base = info->callsite_scrub_d(index);
|
||||
|
||||
for(int loc = 0; loc < info->scrub_d_count; loc++)
|
||||
for(cell loc = 0; loc < info->scrub_d_count; loc++)
|
||||
{
|
||||
if(bitmap_p(bitmap,base + loc))
|
||||
{
|
||||
|
|
@ -75,7 +75,7 @@ void context::scrub_stacks(gc_info *info, cell index)
|
|||
}
|
||||
|
||||
{
|
||||
cell base = info->scrub_r_base(index);
|
||||
cell base = info->callsite_scrub_r(index);
|
||||
|
||||
for(int loc = 0; loc < info->scrub_r_count; loc++)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -3,17 +3,17 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
int gc_info::return_address_index(cell return_address)
|
||||
cell gc_info::return_address_index(cell return_address)
|
||||
{
|
||||
u32 *return_address_array = return_addresses();
|
||||
|
||||
for(int i = 0; i < return_address_count; i++)
|
||||
for(cell i = 0; i < return_address_count; i++)
|
||||
{
|
||||
if(return_address == return_address_array[i])
|
||||
return i;
|
||||
}
|
||||
|
||||
return -1;
|
||||
return gc_info_missing_value;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,15 +1,23 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
const u32 gc_info_missing_value = (u32)-1;
|
||||
|
||||
struct gc_info {
|
||||
int scrub_d_count;
|
||||
int scrub_r_count;
|
||||
int gc_root_count;
|
||||
int return_address_count;
|
||||
u32 scrub_d_count;
|
||||
u32 scrub_r_count;
|
||||
u32 gc_root_count;
|
||||
u32 derived_root_count;
|
||||
u32 return_address_count;
|
||||
|
||||
cell callsite_bitmap_size()
|
||||
{
|
||||
return scrub_d_count + scrub_r_count + gc_root_count;
|
||||
}
|
||||
|
||||
cell total_bitmap_size()
|
||||
{
|
||||
return return_address_count * (scrub_d_count + scrub_r_count + gc_root_count);
|
||||
return return_address_count * callsite_bitmap_size();
|
||||
}
|
||||
|
||||
cell total_bitmap_bytes()
|
||||
|
|
@ -19,33 +27,43 @@ struct gc_info {
|
|||
|
||||
u32 *return_addresses()
|
||||
{
|
||||
return (u32 *)((u8 *)this - return_address_count * sizeof(u32));
|
||||
return (u32 *)this - return_address_count;
|
||||
}
|
||||
|
||||
u32 *base_pointer_map()
|
||||
{
|
||||
return return_addresses() - return_address_count * derived_root_count;
|
||||
}
|
||||
|
||||
u8 *gc_info_bitmap()
|
||||
{
|
||||
return (u8 *)return_addresses() - total_bitmap_bytes();
|
||||
return (u8 *)base_pointer_map() - total_bitmap_bytes();
|
||||
}
|
||||
|
||||
cell scrub_d_base(cell index)
|
||||
cell callsite_scrub_d(cell index)
|
||||
{
|
||||
return index * scrub_d_count;
|
||||
}
|
||||
|
||||
cell scrub_r_base(cell index)
|
||||
cell callsite_scrub_r(cell index)
|
||||
{
|
||||
return return_address_count * scrub_d_count +
|
||||
index * scrub_r_count;
|
||||
}
|
||||
|
||||
cell spill_slot_base(cell index)
|
||||
cell callsite_gc_roots(cell index)
|
||||
{
|
||||
return return_address_count * scrub_d_count
|
||||
+ return_address_count * scrub_r_count
|
||||
+ index * gc_root_count;
|
||||
}
|
||||
|
||||
int return_address_index(cell return_address);
|
||||
cell lookup_base_pointer(cell index, cell derived_root)
|
||||
{
|
||||
return base_pointer_map()[index * derived_root_count + derived_root];
|
||||
}
|
||||
|
||||
cell return_address_index(cell return_address);
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -292,27 +292,52 @@ struct call_frame_slot_visitor {
|
|||
gc_info *info = compiled->block_gc_info();
|
||||
|
||||
assert(return_address < compiled->size());
|
||||
int index = info->return_address_index(return_address);
|
||||
if(index == -1)
|
||||
u32 callsite = info->return_address_index(return_address);
|
||||
if(callsite == gc_info_missing_value)
|
||||
return;
|
||||
|
||||
#ifdef DEBUG_GC_MAPS
|
||||
std::cout << "call frame code block " << compiled << " with offset " << return_address << std::endl;
|
||||
#endif
|
||||
u8 *bitmap = info->gc_info_bitmap();
|
||||
cell base = info->spill_slot_base(index);
|
||||
cell *stack_pointer = (cell *)(parent->frame_successor(frame) + 1);
|
||||
u8 *bitmap = info->gc_info_bitmap();
|
||||
|
||||
for(int spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++)
|
||||
/* Subtract old value of base pointer from every derived pointer. */
|
||||
for(cell spill_slot = 0; spill_slot < info->derived_root_count; spill_slot++)
|
||||
{
|
||||
if(bitmap_p(bitmap,base + spill_slot))
|
||||
cell base_pointer = info->lookup_base_pointer(callsite, spill_slot);
|
||||
if(base_pointer != gc_info_missing_value)
|
||||
{
|
||||
#ifdef DEBUG_GC_MAPS
|
||||
std::cout << "visiting spill slot " << spill_slot << std::endl;
|
||||
std::cout << "visiting derived root " << spill_slot
|
||||
<< " with base pointer " << base_pointer
|
||||
<< std::endl;
|
||||
#endif
|
||||
stack_pointer[spill_slot] -= stack_pointer[base_pointer];
|
||||
}
|
||||
}
|
||||
|
||||
/* Update all GC roots, including base pointers. */
|
||||
cell callsite_gc_roots = info->callsite_gc_roots(callsite);
|
||||
|
||||
for(cell spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++)
|
||||
{
|
||||
if(bitmap_p(bitmap,callsite_gc_roots + spill_slot))
|
||||
{
|
||||
#ifdef DEBUG_GC_MAPS
|
||||
std::cout << "visiting GC root " << spill_slot << std::endl;
|
||||
#endif
|
||||
visitor->visit_handle(stack_pointer + spill_slot);
|
||||
}
|
||||
}
|
||||
|
||||
/* Add the base pointers to obtain new derived pointer values. */
|
||||
for(cell spill_slot = 0; spill_slot < info->derived_root_count; spill_slot++)
|
||||
{
|
||||
cell base_pointer = info->lookup_base_pointer(callsite, spill_slot);
|
||||
if(base_pointer != gc_info_missing_value)
|
||||
stack_pointer[spill_slot] += stack_pointer[base_pointer];
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
|
|
|
|||
10
vm/vm.hpp
10
vm/vm.hpp
|
|
@ -329,14 +329,16 @@ struct factor_vm
|
|||
return (Type *)allot_object(Type::type_number,size);
|
||||
}
|
||||
|
||||
inline bool in_data_heap_p(cell pointer)
|
||||
{
|
||||
return (pointer >= data->seg->start && pointer < data->seg->end);
|
||||
}
|
||||
|
||||
inline void check_data_pointer(object *pointer)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!(current_gc && current_gc->op == collect_growing_heap_op))
|
||||
{
|
||||
assert((cell)pointer >= data->seg->start
|
||||
&& (cell)pointer < data->seg->end);
|
||||
}
|
||||
assert(in_data_heap_p((cell)pointer));
|
||||
#endif
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue