60 lines
1.9 KiB
Factor
60 lines
1.9 KiB
Factor
USING: accessors alien alien.c-types alien.data arrays assocs bit-arrays
|
|
bit-arrays.private classes.struct fry grouping kernel math math.statistics
|
|
sequences sequences.repeating splitting vm words ;
|
|
IN: tools.gc-decode
|
|
|
|
! Utils
|
|
: byte-array>bit-array ( byte-array -- bit-array )
|
|
[ integer>bit-array 8 f pad-tail ] { } map-as concat ;
|
|
|
|
: (cut-points) ( counts times -- seq )
|
|
<repeats> cum-sum but-last ;
|
|
|
|
: reshape-sequence ( seq counts times -- seqs )
|
|
[ (cut-points) split-indices ] keep <groups> flip ;
|
|
|
|
: end-address>direct-array ( obj count type -- seq )
|
|
[ heap-size * [ >c-ptr alien-address ] dip - <alien> ] 2keep
|
|
c-direct-array-constructor execute( alien len -- seq ) ;
|
|
|
|
: bit-counts ( gc-info -- counts )
|
|
struct-slot-values 5 head ;
|
|
|
|
: total-bitmap-bits ( gc-info -- n )
|
|
[ bit-counts sum ] [ return-address-count>> ] bi * ;
|
|
|
|
: return-addresses ( gc-info -- seq )
|
|
dup return-address-count>> uint end-address>direct-array ;
|
|
|
|
: base-pointers ( gc-info -- seq )
|
|
[ return-addresses ]
|
|
[ return-address-count>> ]
|
|
[ derived-root-count>> ] tri *
|
|
int end-address>direct-array ;
|
|
|
|
: base-pointer-groups ( gc-info -- seqs )
|
|
dup base-pointers
|
|
[ return-address-count>> { } <array> ]
|
|
[ swap derived-root-count>> <groups> [ >array ] map ] if-empty ;
|
|
|
|
: scrub-bytes ( gc-info -- seq )
|
|
[ base-pointers ] [ total-bitmap-bits bits>bytes ] bi
|
|
uchar end-address>direct-array ;
|
|
|
|
: scrub-bits ( gc-info -- seq )
|
|
[ scrub-bytes byte-array>bit-array ] keep total-bitmap-bits head ;
|
|
|
|
: scrub-bit-groups ( gc-info -- scrub-groups )
|
|
[ scrub-bits ] [ bit-counts ] [ return-address-count>> ] tri
|
|
[ 2drop { } ] [ reshape-sequence ] if-zero ;
|
|
|
|
: read-gc-maps ( gc-info -- assoc )
|
|
[ return-addresses ] [ scrub-bit-groups ] [ base-pointer-groups ] tri
|
|
zip zip ;
|
|
|
|
: word>gc-info ( word -- gc-info )
|
|
word-code nip gc-info struct-size - <alien> gc-info memory>struct ;
|
|
|
|
: decode-gc-maps ( word -- assoc )
|
|
word>gc-info read-gc-maps ;
|