compiler.codegen.gc-maps: simplies largest-spill-slot and refactors serialize-gc-maps

basis/compiler/codegen/gc-maps/gc-maps-docs.factor

@@ -1,32 +1,13 @@
-USING: bit-arrays byte-arrays compiler.cfg.instructions help.markup help.syntax
+USING: bit-arrays byte-arrays compiler.cfg compiler.cfg.instructions
-kernel math ;
+compiler.cfg.stack-frame help.markup help.syntax kernel math sequences ;
 IN: compiler.codegen.gc-maps
 
-ARTICLE: "compiler.codegen.gc-maps" "GC maps"
-"The " { $vocab-link "compiler.codegen.gc-maps" } " handles generating code for keeping track of garbage collection maps. Every code block either ends with:"
-{ $list "uint 0" }
-"or"
-{ $list
-  {
-      "bitmap, byte aligned, five subsequences:"
-      { $list
-        "scrubbed data stack locations"
-        "scrubbed retain stack locations"
-        "GC root spill slots"
-      }
-  }
-  "uint[] base pointers"
-  "uint[] return addresses"
-  "uint largest scrubbed data stack location"
-  "uint largest scrubbed retain stack location"
-  "uint largest GC root spill slot"
-  "uint largest derived root spill slot"
-  "int number of return addresses"
-} ;
-
 HELP: emit-gc-info-bitmaps
-{ $values { "counts" "counts of the three different types of gc checks" } }
+{ $values
-{ $description "Emits the scrub location data in all gc-maps registered in the " { $link gc-maps } " variable to the make sequence being created. The result is a concatenation of all datastack scrub locations, retainstack scrub locations and gc root locations converted into a byte-array. Given that byte-array and knowledge of the number of scrub locations, the original gc-map can be reconstructed."  } ;
+  { "gc-maps" sequence }
+  { "counts" "counts of the three different types of gc checks" }
+}
+{ $description "Emits the scrub location data in the 'gc-maps' to the make sequence being created. The result is a concatenation of all datastack scrub locations, retainstack scrub locations and gc root locations converted into a byte-array. Given that byte-array and knowledge of the number of scrub locations, the original gc-map can be reconstructed."  } ;
 
 HELP: emit-scrub
 { $values
@@ -55,13 +36,20 @@ HELP: emit-uint
   }
 } ;
 
+HELP: emit-gc-maps
+{ $description "GC maps are emitted so that the end is aligned to a 16-byte boundary." } ;
+
 HELP: gc-maps
-{ $var-description "Variable that holds a sequence of " { $link gc-map } " tuples." } ;
+{ $var-description "Variable that holds a sequence of " { $link gc-map } " tuples. Gc maps are added to the sequence by " { $link gc-map-here } "." } ;
 
 HELP: gc-map-needed?
 { $values { "gc-map/f" { $maybe gc-map } } { "?" boolean } }
 { $description "If all slots in the gc-map are empty, then it doesn't need to be emitted." } ;
 
+HELP: gc-root-offsets
+{ $values { "gc-map" gc-map } { "offsets" sequence } }
+{ $description "Gets the offets of all roots in a gc-map. The " { $link stack-frame } " variable must have been setup first." } ;
+
 HELP: serialize-gc-maps
 { $values { "byte-array" byte-array } }
 { $description "Serializes the gc-maps that have been registered in the " { $link gc-maps } " variable into a byte-array." } ;
@@ -70,4 +58,30 @@ HELP: gc-map-here
 { $values { "gc-map" gc-map } }
 { $description "Registers the gc map in the " { $link gc-maps } " dynamic variable at the current compiled offset." } ;
 
+ARTICLE: "compiler.codegen.gc-maps" "GC maps"
+"The " { $vocab-link "compiler.codegen.gc-maps" } " handles generating code for keeping track of garbage collection maps. Every code block either ends with:"
+{ $list "uint 0" }
+"or"
+{ $list
+  {
+      "bitmap, byte aligned, five subsequences:"
+      { $list
+        "scrubbed data stack locations"
+        "scrubbed retain stack locations"
+        "GC root spill slots"
+      }
+  }
+  "uint[] base pointers"
+  "uint[] return addresses"
+  "uint largest scrubbed data stack location"
+  "uint largest scrubbed retain stack location"
+  "uint largest GC root spill slot"
+  "uint largest derived root spill slot"
+  "int number of return addresses"
+}
+"The " { $link gc-map } " tuples of the " { $link cfg } " are serialized to the above format and placed directly after the generated code."
+$nl
+"Main entry point:"
+{ $subsections emit-gc-maps } ;
+
 ABOUT: "compiler.codegen.gc-maps"

basis/compiler/codegen/gc-maps/gc-maps-tests.factor

@@ -112,7 +112,7 @@ cpu x86.64? [
                    T{ spill-slot { n 0 } }
                    T{ spill-slot { n 24 } }
                } }
-            } 1array gc-maps set
+            } 1array
             [ emit-gc-info-bitmaps ] B{ } make drop
         ] with-variable
     ] unit-test
@@ -125,7 +125,7 @@ cpu x86.64? [
                    T{ spill-slot { n 0 } }
                    T{ spill-slot { n 24 } }
                } }
-            } 1array gc-maps set
+            } 1array
             [ emit-gc-info-bitmaps ] B{ } make drop
         ] with-variable
     ] unit-test
@@ -133,6 +133,16 @@ cpu x86.64? [
     fake-cpu \ cpu set
 ] when
 
+! largest-spill-slot
+{
+    5 0 4 1
+} [
+    { { 4 } } largest-spill-slot
+    { { } } largest-spill-slot
+    { { 2 3 } { 0 } } largest-spill-slot
+    { { 0 } } largest-spill-slot
+] unit-test
+
 ! gc-map-needed?
 { t t } [
     T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
@@ -149,7 +159,7 @@ cpu x86.64? [
     { 4 2 0 }
     V{ 1 }
 } [
-    { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } } gc-maps set
+    { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } }
     [ emit-gc-info-bitmaps ] V{ } make
 ] unit-test
 
@@ -157,7 +167,7 @@ cpu x86.64? [
     { 1 0 0 }
     V{ 1 }
 } [
-    { T{ gc-map { scrub-d { 0 } } } } gc-maps set
+    { T{ gc-map { scrub-d { 0 } } } }
     [ emit-gc-info-bitmaps ] V{ } make
 ] unit-test
 
@@ -174,7 +184,7 @@ USING: present prettyprint ;
 {
     3 B{ 255 255 255 255 255 255 255 255 4 0 0 0 }
 } [
-    { T{ gc-map { derived-roots V{ { 2 4 } } } } } gc-maps set
+    { T{ gc-map { derived-roots V{ { 2 4 } } } } }
     [ emit-base-tables ] B{ } make
 ] unit-test
 

basis/compiler/codegen/gc-maps/gc-maps.factor

@@ -25,7 +25,7 @@ SYMBOLS: return-addresses gc-maps ;
     <bit-array> [ '[ [ t ] dip _ set-nth ] each ] keep ;
 
 : largest-spill-slot ( seqs -- n )
-    [ [ 0 ] [ supremum 1 + ] if-empty ] [ max ] map-reduce ;
+    concat [ 0 ] [ supremum 1 + ] if-empty ;
 
 : emit-gc-roots ( seqs -- n )
     ! seqs is a sequence of sequences of integers 0..n-1
@@ -40,9 +40,8 @@ SYMBOLS: return-addresses gc-maps ;
 : gc-root-offsets ( gc-map -- offsets )
     gc-roots>> [ gc-root-offset ] map ;
 
-: emit-gc-info-bitmaps ( -- counts )
+: emit-gc-info-bitmaps ( gc-maps -- counts )
     [
-        gc-maps get
         [ [ scrub-d>> ] map emit-scrub ]
         [ [ scrub-r>> ] map emit-scrub ]
         [ [ gc-root-offsets ] map emit-gc-roots ] tri 3array
@@ -54,23 +53,19 @@ SYMBOLS: return-addresses gc-maps ;
 : derived-root-offsets ( gc-map -- offsets )
     derived-roots>> [ [ gc-root-offset ] bi@ ] assoc-map ;
 
-: emit-base-tables ( -- count )
+: emit-base-tables ( gc-maps -- count )
-    gc-maps get [ derived-root-offsets ] map
+    [ derived-root-offsets ] map
     dup [ keys ] map largest-spill-slot
     [ '[ _ emit-base-table ] each ] keep ;
 
-: emit-return-addresses ( -- )
-    return-addresses get emit-uints ;
-
 : serialize-gc-maps ( -- byte-array )
     [
-        return-addresses get empty? [ 0 emit-uint ] [
+        return-addresses get empty? [ { } ] [
-            emit-gc-info-bitmaps
+            gc-maps get [ emit-gc-info-bitmaps ] [ emit-base-tables ] bi suffix
-            emit-base-tables suffix
-            emit-return-addresses
-            emit-uints
-            return-addresses get length emit-uint
         ] if
+        return-addresses get emit-uints
+        emit-uints
+        return-addresses get length emit-uint
     ] B{ } make ;
 
 : init-gc-maps ( -- )
@@ -78,8 +73,6 @@ SYMBOLS: return-addresses gc-maps ;
     V{ } clone gc-maps set ;
 
 : emit-gc-maps ( -- )
-    ! We want to place the GC maps so that the end is aligned
-    ! on a 16-byte boundary.
     serialize-gc-maps [
         length compiled-offset +
         [ data-alignment get align ] keep -