1 USING: accessors alien alien.c-types alien.data arrays assocs bit-arrays
2 bit-arrays.private classes.struct fry grouping kernel math math.statistics
3 sequences sequences.repeating splitting vm words ;
7 : byte-array>bit-array ( byte-array -- bit-array )
8 [ integer>bit-array 8 f pad-tail ] { } map-as concat ;
10 : (cut-points) ( counts times -- seq )
11 <repeats> cum-sum but-last ;
13 : reshape-sequence ( seq counts times -- seqs )
14 [ (cut-points) split-indices ] keep <groups> flip ;
16 : end-address>direct-array ( obj count type -- seq )
17 [ heap-size * [ >c-ptr alien-address ] dip - <alien> ] 2keep
18 c-direct-array-constructor execute( alien len -- seq ) ;
20 : bit-counts ( gc-info -- counts )
21 struct-slot-values 3 head ;
23 : total-bitmap-bits ( gc-info -- n )
24 [ bit-counts sum ] [ return-address-count>> ] bi * ;
26 : return-addresses ( gc-info -- seq )
27 dup return-address-count>> uint end-address>direct-array ;
29 : base-pointers ( gc-info -- seq )
31 [ return-address-count>> ]
32 [ derived-root-count>> ] tri *
33 int end-address>direct-array ;
35 : base-pointer-groups ( gc-info -- seqs )
37 [ return-address-count>> { } <array> ]
38 [ swap derived-root-count>> <groups> [ >array ] map ] if-empty ;
40 : scrub-bytes ( gc-info -- seq )
41 [ base-pointers ] [ total-bitmap-bits bits>bytes ] bi
42 uchar end-address>direct-array ;
44 : scrub-bits ( gc-info -- seq )
45 [ scrub-bytes byte-array>bit-array ] keep total-bitmap-bits head ;
47 : scrub-bit-groups ( gc-info -- scrub-groups )
48 [ scrub-bits ] [ bit-counts ] [ return-address-count>> ] tri
49 [ 2drop { } ] [ reshape-sequence ] if-zero ;
51 : read-gc-maps ( gc-info -- assoc )
52 [ return-addresses ] [ scrub-bit-groups ] [ base-pointer-groups ] tri
55 : word>gc-info ( word -- gc-info )
56 word-code nip gc-info struct-size - <alien> gc-info memory>struct ;
58 : decode-gc-maps ( word -- assoc )
59 word>gc-info read-gc-maps ;