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

   1 USING: accessors alien.c-types assocs bit-arrays.private
   2 classes.struct fry grouping io io.encodings.binary
   3 io.streams.byte-array kernel math sequences tools.image-analyzer.utils
   4 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 : read-struct-safe ( struct -- instance/f )
  15     dup heap-size read [ swap memory>struct ] [ drop f ] if* ;
  16
  17 ! Real stuff
  18 : return-addresses ( gc-info -- seq )
  19     return-address-count>> read-ints ;
  20
  21 : base-pointers ( gc-info -- seq )
  22     [ return-address-count>> ] keep derived-root-count>>
  23     '[ _ read-ints ] replicate <reversed> ;
  24
  25 : (read-scrub-bits) ( gc-info -- seq )
  26     [ gc-root-count>> ] [ return-address-count>> ] bi * read-bits ;
  27
  28 : scrub-bits ( gc-info -- seq )
  29     [ (read-scrub-bits) ] [ gc-root-count>> ] bi
  30     [ drop { } ] [ group ] if-zero ;
  31
  32 : byte-array>gc-maps ( byte-array -- gc-maps )
  33     binary <byte-reader> <backwards-reader> [
  34         gc-info read-struct-safe [
  35             [ return-addresses ] [ base-pointers ] [ scrub-bits ] tri
  36             swap zip zip
  37         ] [ { } ] if*
  38     ] with-input-stream ;
  39
  40 : word>gc-maps ( word -- gc-maps )
  41     word>byte-array byte-array>gc-maps ;