extra/tools/image-analyzer/gc-info/gc-info.factor

   1 USING: accessors alien.c-types alien.data arrays assocs
   2 bit-arrays.private classes.struct fry grouping io io.encodings.binary
   3 io.streams.byte-array kernel math math.statistics sequences
   4 sequences.repeating splitting tools.image-analyzer.utils vm ;
   5 IN: tools.image-analyzer.gc-info
   6
   7 ! Utils
   8 : read-ints ( count -- seq )
   9     int read-array ;
  10
  11 : read-bits ( bit-count -- bit-array )
  12     [ bits>bytes read byte-array>bit-array ] keep head ;
  13
  14 : (cut-points) ( counts times -- seq )
  15     <repeats> cum-sum but-last ;
  16
  17 : reshape-sequence ( seq counts times -- seqs )
  18     [ (cut-points) split-indices ] keep <groups> flip ;
  19
  20 : read-struct-safe ( struct -- instance/f )
  21     dup heap-size read [ swap memory>struct ] [ drop f ] if* ;
  22
  23 ! Real stuff
  24 : return-addresses ( gc-info -- seq )
  25     return-address-count>> read-ints ;
  26
  27 : base-pointers ( gc-info -- seq )
  28     [ return-address-count>> ] keep derived-root-count>>
  29     '[ _ read-ints ] replicate ;
  30
  31 : bit-counts ( gc-info -- counts )
  32     struct-slot-values 3 head ;
  33
  34 : (read-scrub-bits) ( gc-info -- seq )
  35     [ bit-counts sum ] [ return-address-count>> ] bi * read-bits ;
  36
  37 : scrub-bits ( gc-info -- seq )
  38     [ (read-scrub-bits) ] [ bit-counts ] [ return-address-count>> ] tri
  39     [ 2drop { } ] [ reshape-sequence ] if-zero ;
  40
  41 : byte-array>gc-maps ( byte-array -- gc-maps )
  42     binary <byte-reader> <backwards-reader> [
  43         gc-info read-struct-safe [
  44             [ return-addresses ] [ base-pointers ] [ scrub-bits ] tri
  45             swap zip zip
  46         ] [ { } ] if*
  47     ] with-input-stream ;