tools.image-analyzer.gc-info: updating vocab to work with new gc system

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

@@ -8,11 +8,11 @@ HELP: word>gc-maps
 { $values { "word" word } { "gc-maps" assoc } }
 { $description "Main word of the vocab. Decodes the gc maps for a word into an assoc with the following format:"
   { $list
-    "Each key is the return addess of a gc callsite (delta relative to the start of the code block)."
+    "Each key is the return addess of a gc callsite (as an offset relative to the blocks entry point)."
     {
         "Each value is a two-tuple where:"
         { $list
-          "The first element is a three-tuple containing the scrub patterns for the datastack, retainstack and gc roots."
+          "The first element contains the scrub patterns for the gc roots."
           "The second element is a sequence of derived roots for the callsite."
         }
     }
@@ -22,7 +22,7 @@ HELP: word>gc-maps
   { $unchecked-example
     "USING: effects prettyprint ;"
     "\\ <effect> word>gc-maps ."
-    "{ { 153 { { ?{ t } ?{ t t t } ?{ f t t t t } } { } } } }"
+    "{ { 155 { ?{ f t t t t } { } } } }"
   }
 } ;
 

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

@@ -1,11 +1,10 @@
 USING: accessors alien.c-types alien.syntax arrays assocs bit-arrays
-classes.struct combinators combinators.short-circuit compiler compiler.cfg
+classes.struct combinators.short-circuit compiler compiler.cfg
-compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.linearization
+compiler.cfg.debugger compiler.cfg.instructions
-compiler.cfg.stack-frame compiler.codegen.gc-maps compiler.units fry generic
+compiler.cfg.linearization compiler.codegen.gc-maps compiler.units fry
-grouping io io.encodings.binary io.streams.byte-array kernel math namespaces
+generic grouping io io.encodings.binary io.streams.byte-array kernel
-random sequences sequences.generalizations
+math namespaces random sequences system tools.image-analyzer.gc-info
-tools.image-analyzer.gc-info tools.image-analyzer.utils tools.test vm
+tools.image-analyzer.utils tools.test vm vocabs words ;
-vocabs words ;
 IN: tools.image-analyzer.gc-info.tests
 QUALIFIED: cpu.x86.features.private
 QUALIFIED: crypto.aes.utils
@@ -71,6 +70,14 @@ QUALIFIED: opencl
     \ effects:<effect> word>gc-maps empty?
 ] unit-test
 
+cpu x86.64? [
+    {
+        { { 155 { ?{ f t t t t } { } } } }
+    } [
+        \ effects:<effect> word>gc-maps
+    ] unit-test
+] when
+
 { f } [
     \ + word>gc-maps empty?
 ] unit-test
@@ -103,7 +110,6 @@ FUNCTION: void LLVMDisposeTypeHandle ( LLVMTypeHandleRef TypeHandle )
     [ base-pointer-groups-expected ] [ base-pointer-groups-decoded ] bi =
 ] unit-test
 
-
 ! Tough words #1227
 { t } [
     \ resolve-types

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

@@ -1,7 +1,7 @@
-USING: accessors alien.c-types alien.data arrays assocs
+USING: accessors alien.c-types assocs bit-arrays.private
-bit-arrays.private classes.struct fry grouping io io.encodings.binary
+classes.struct fry grouping io io.encodings.binary
-io.streams.byte-array kernel math math.statistics sequences
+io.streams.byte-array kernel math sequences tools.image-analyzer.utils
-sequences.repeating splitting tools.image-analyzer.utils vm ;
+vm ;
 IN: tools.image-analyzer.gc-info
 
 ! Utils
@@ -11,12 +11,6 @@ IN: tools.image-analyzer.gc-info
 : read-bits ( bit-count -- bit-array )
     [ bits>bytes read byte-array>bit-array ] keep head ;
 
-: (cut-points) ( counts times -- seq )
-    <repeats> cum-sum but-last ;
-
-: reshape-sequence ( seq counts times -- seqs )
-    [ (cut-points) split-indices ] keep <groups> flip ;
-
 : read-struct-safe ( struct -- instance/f )
     dup heap-size read [ swap memory>struct ] [ drop f ] if* ;
 
@@ -28,15 +22,12 @@ IN: tools.image-analyzer.gc-info
     [ return-address-count>> ] keep derived-root-count>>
     '[ _ read-ints ] replicate <reversed> ;
 
-: bit-counts ( gc-info -- counts )
-    struct-slot-values 3 head ;
-
 : (read-scrub-bits) ( gc-info -- seq )
-    [ bit-counts sum ] [ return-address-count>> ] bi * read-bits ;
+    [ gc-root-count>> ] [ return-address-count>> ] bi * read-bits ;
 
 : scrub-bits ( gc-info -- seq )
-    [ (read-scrub-bits) ] [ bit-counts ] [ return-address-count>> ] tri
+    [ (read-scrub-bits) ] [ gc-root-count>> ] bi
-    [ 2drop { } ] [ reshape-sequence ] if-zero ;
+    [ drop { } ] [ group ] if-zero ;
 
 : byte-array>gc-maps ( byte-array -- gc-maps )
     binary <byte-reader> <backwards-reader> [