compiler.*: Remove the scrubbing part of the GC maps

Instead of generating GC maps which describe which stack locations that
are uninitialized, we emit ##clear instructions for those locations in
front of ##call-gc instructions. This makes the context root scanning
much simpler because the GC can assume that all stack slots are
initialized. It also removes the compiler.cfg.stacks.vacant pass and
seem to reduce the image size slightly because many fewer GC maps needs
to be emitted.

basis/compiler/cfg/finalization/finalization.factor

@@ -3,7 +3,7 @@
 USING: compiler.cfg.build-stack-frame compiler.cfg.gc-checks
 compiler.cfg.linear-scan compiler.cfg.representations
 compiler.cfg.save-contexts compiler.cfg.ssa.destruction
-compiler.cfg.stacks.clearing compiler.cfg.stacks.vacant compiler.cfg.utilities
+compiler.cfg.stacks.clearing compiler.cfg.utilities
 compiler.cfg.write-barrier ;
 IN: compiler.cfg.finalization
 
@@ -13,7 +13,6 @@ IN: compiler.cfg.finalization
         insert-gc-checks
         eliminate-write-barriers
         clear-uninitialized
-        fill-gc-maps
         insert-save-contexts
         destruct-ssa
         linear-scan

basis/compiler/cfg/instructions/instructions-docs.factor

@@ -399,7 +399,7 @@ HELP: gc-map
   }
   "The 'gc-roots' and 'derived-roots' slots are initially vreg integers referencing objects that are live during the gc call and needs to be spilled so that they can be traced. In the " { $link emit-gc-map-insn } " word in " { $vocab-link "compiler.cfg.linear-scan.assignment" } " they are converted to spill slots which the collector is able to trace."
 }
-{ $see-also emit-gc-info-bitmaps fill-gc-map } ;
+{ $see-also emit-gc-info-bitmap fill-gc-map } ;
 
 ARTICLE: "compiler.cfg.instructions" "Basic block instructions"
 "The " { $vocab-link "compiler.cfg.instructions" } " vocab contains all instruction classes used for generating CFG:s (Call Flow Graphs)."

basis/compiler/cfg/instructions/instructions.factor

@@ -851,7 +851,7 @@ UNION: gc-map-insn
 
 M: gc-map-insn clone call-next-method [ clone ] change-gc-map ;
 
-TUPLE: gc-map scrub-d scrub-r gc-roots derived-roots ;
+TUPLE: gc-map gc-roots derived-roots ;
 
 : <gc-map> ( -- gc-map ) gc-map new ;
 

basis/compiler/cfg/save-contexts/save-contexts-tests.factor

@@ -38,7 +38,7 @@ V{
 V{
     T{ ##inc f D: 3 }
     T{ ##box f 4 3 "from_signed_4" int-rep
-        T{ gc-map { scrub-d B{ 0 0 0 } } { scrub-r B{ } } { gc-roots { } } }
+       T{ gc-map { gc-roots { } } }
     }
 } 0 test-bb
 
@@ -49,7 +49,7 @@ V{
         T{ ##inc f D: 3 }
         T{ ##save-context f 5 6 }
         T{ ##box f 4 3 "from_signed_4" int-rep
-            T{ gc-map { scrub-d B{ 0 0 0 } } { scrub-r B{ } } { gc-roots { } } }
+            T{ gc-map { gc-roots { } } }
         }
     }
 } [

basis/compiler/cfg/ssa/destruction/destruction-tests.factor

@@ -51,10 +51,10 @@ IN: compiler.cfg.ssa.destruction.tests
            { stack-size 0 }
            { symbols "g_quark_to_string" }
            { dll DLL" libglib-2.0.so" }
-           { gc-map T{ gc-map { scrub-d { } } { scrub-r { } } } }
+           { gc-map T{ gc-map } }
            { insn# 14 }
         }
-        T{ ##call-gc { gc-map T{ gc-map { scrub-d { } } { scrub-r { } } } } }
+        T{ ##call-gc { gc-map T{ gc-map } } }
         T{ ##box-alien
            { dst 37 }
            { src 36 }

basis/compiler/cfg/stacks/clearing/clearing-docs.factor

@@ -3,22 +3,34 @@ help.syntax kernel sequences strings ;
 IN: compiler.cfg.stacks.clearing
 
 ARTICLE: "compiler.cfg.stacks.clearing" "Uninitialized stack location clearing"
-"A compiler pass that inserts " { $link ##replace-imm } " instructions front of unsafe " { $link ##peek } " instructions in the " { $link cfg } ". Consider the following sequence of instructions."
+"A compiler pass that inserts " { $link ##clear } " instructions front of instructions which requires the whole stack to be initialized. Consider the following sequence of instructions:"
+{ $code
+  "##inc D: 2"
+  "..."
+  "##allot"
+  "##replace ... D: 0"
+  "##replace ... D: 1"
+}
+"The GC check runs before stack locations 0 and 1 have been initialized, so they need to be cleared as they can contain garbage data which could crash Factor if it tries to trace them. This is achieved by computing uninitialized locations with a dataflow analysis (see " { $vocab-link "compiler.cfg.stacks.padding" } ") and then inserting clears so that the instruction sequence becomes:"
+{ $code
+  "##inc D: 2"
+  "..."
+  "##clear D: 0"
+  "##clear D: 1"
+  "##allot"
+  "##replace ... D: 0"
+  "##replace ... D: 1"
+}
+"Similar dangerous stack 'holes' needs to be padded in the same way to guard unsafe " { $link ##peek } " instructions. E.g:"
 { $code
   "##inc D: 2"
   "##peek RCX D: 2"
 }
-"The ##peek can cause a stack underflow and then there will be two uninitialized locations on the data stack that can't be traced. To counteract that, this pass modifies the instruction sequence so that it becomes:"
+"Here the ##peek can cause a stack underflow and then there will be two uninitialized locations on the captured data stack that can't be traced. As in the previous example, ##clears are inserted on locations D: 0 and D: 1." ;
-{ $code
-  "##inc D: 2"
-  "##replace-imm 17 D: 0"
-  "##replace-imm 17 D: 1"
-  "##peek RCX D: 2"
-} ;
 
 HELP: dangerous-insn?
 { $values { "state" "a stack state" } { "insn" insn } { "?" boolean } }
-{ $description "Checks if the instruction is dangerous (can cause a stack underflow). " }
+{ $description "Checks if the instruction is dangerous, meaning that the holes in the stack must be filled before it is executed." }
 { $examples
   { $example
     "USING: compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks.clearing prettyprint ;"
@@ -30,6 +42,11 @@ HELP: dangerous-insn?
     "{ { 0 { } } { 2 { } } } T{ ##peek { loc R: 0 } } dangerous-insn? ."
     "f"
   }
+  { $example
+    "USING: compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks.clearing prettyprint ;"
+    "{ { 0 { } } { 3 { } } } T{ ##call-gc } dangerous-insn?"
+    "t"
+  }
 } ;
 
 

basis/compiler/cfg/stacks/clearing/clearing-tests.factor

@@ -18,11 +18,12 @@ IN: compiler.cfg.stacks.clearing.tests
 
 ! dangerous-insn?
 {
-    t f t
+    t f t t
 } [
     { { 0 { } } { 0 { } } } T{ ##peek { loc D: 0 } } dangerous-insn?
     { { 1 { } } { 0 { } } } T{ ##peek { loc D: 0 } } dangerous-insn?
     { { 2 { 0 1 } } { 0 { } } } T{ ##peek { loc D: 2 } } dangerous-insn?
+    { { 0 { } } { 3 { } } } T{ ##call-gc } dangerous-insn?
 ] unit-test
 
 ! state>clears

basis/compiler/cfg/stacks/clearing/clearing.factor

@@ -8,7 +8,8 @@ IN: compiler.cfg.stacks.clearing
     [ f ##clear boa ] map ;
 
 : dangerous-insn? ( state insn -- ? )
-    { [ nip ##peek? ] [ underflowable-peek? ] } 2&& ;
+    [ { [ nip ##peek? ] [ underflowable-peek? ] } 2&& ]
+    [ gc-map-insn? ] bi or ;
 
 : clearing-insns ( assoc insn -- insns' )
     [ insn#>> of ] keep 2dup dangerous-insn? [

basis/compiler/cfg/stacks/padding/padding-tests.factor

@@ -237,7 +237,7 @@ IN: compiler.cfg.stacks.padding.tests
             10 V{
                 T{ ##inc f D: -3 }
                 T{ ##peek { dst 0 } { loc D: 0 } }
-                T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
+                T{ ##alien-invoke { gc-map T{ gc-map } } }
             }
         }
     } [ over insns>block ] assoc-map dup
@@ -660,7 +660,7 @@ IN: compiler.cfg.stacks.padding.tests
 [
     V{
         T{ ##inc f D: 1 }
-        T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } }
+        T{ ##alien-invoke { gc-map T{ gc-map } } }
         T{ ##peek { loc D: 0 } }
     } following-stack-state
 ] [ vacant-peek? ] must-fail-with

basis/compiler/cfg/stacks/vacant/vacant-docs.factor

@@ -1,38 +0,0 @@
-USING: compiler.cfg compiler.cfg.instructions compiler.cfg.stacks.padding
-help.markup help.syntax sequences strings ;
-IN: compiler.cfg.stacks.vacant
-
-ARTICLE: "compiler.cfg.stacks.vacant" "Uninitialized/overinitialized stack location analysis"
-"Consider the following sequence of instructions:"
-{ $code
-  "##inc D: 2"
-  "..."
-  "##allot"
-  "##replace ... D: 0"
-  "##replace ... D: 1"
-}
-"The GC check runs before stack locations 0 and 1 have been initialized, and so the GC needs to scrub them so that they don't get traced. This is achieved by computing uninitialized locations with a dataflow analysis, and recording the information in GC maps. The call_frame_slot_visitor object in vm/slot_visitor.hpp reads this information from GC maps and performs the scrubbing." ;
-
-HELP: fill-gc-maps
-{ $values { "cfg" cfg } }
-{ $description "Populates the scrub-d, check-d, scrub-r and check-r slots of all gc maps in the cfg." } ;
-
-HELP: state>gc-data
-{ $values { "state" sequence } { "gc-data" sequence } }
-{ $description "Takes a stack state on the format given by " { $link trace-stack-state } " and emits an array containing two bit-patterns with locations on the data and retain stacks to scrub." } ;
-
-HELP: vacant>bits
-{ $values
-  { "vacant" "sequence of uninitialized stack locations" }
-  { "bits" "sequence of 1:s and 0:s" }
-}
-{ $description "Converts a sequence of uninitialized stack locations to the pattern of 1:s and 0:s that can be put in the " { $slot "scrub-d" } " and " { $slot "scrub-r" } " slots of a " { $link gc-map } ". 0:s are uninitialized locations and 1:s are initialized." }
-{ $examples
-  { $example
-    "USING: compiler.cfg.stacks.vacant prettyprint ;"
-    "{ 0 1 3 } vacant>bits ."
-    "{ 0 0 1 0 }"
-  }
-} ;
-
-ABOUT: "compiler.cfg.stacks.vacant"

basis/compiler/cfg/stacks/vacant/vacant-tests.factor

@@ -1,28 +0,0 @@
-USING: accessors arrays assocs compiler.cfg
-compiler.cfg.dataflow-analysis.private compiler.cfg.instructions
-compiler.cfg.linearization compiler.cfg.registers
-compiler.cfg.utilities compiler.cfg.stacks.vacant kernel math sequences sorting
-tools.test vectors ;
-IN: compiler.cfg.stacks.vacant.tests
-
-! state>gc-data
-{
-    { { } { } }
-} [
-    { { 3 { } } { 3 { } } } state>gc-data
-] unit-test
-
-{
-    { { 0 1 0 } { } }
-    { { 1 0 0 } { 0 } }
-} [
-    { { 3 { 0 2 } } { 3 { } } } state>gc-data
-    { { 3 { 1 2 } } { 3 { 0 } } } state>gc-data
-] unit-test
-
-! visit-insn should set the gc info.
-{ { 0 0 } { } } [
-    { { 2 { 0 1 } } { 0 { } } }
-    T{ ##alien-invoke { gc-map T{ gc-map } } }
-    [ gc-map>> set-gc-map ] keep gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi
-] unit-test

basis/compiler/cfg/stacks/vacant/vacant.factor

@@ -1,20 +0,0 @@
-USING: accessors arrays assocs compiler.cfg.instructions
-compiler.cfg.linearization compiler.cfg.stacks.padding fry kernel math
-sequences ;
-IN: compiler.cfg.stacks.vacant
-
-: vacant>bits ( vacant --  bits )
-    [ { } ] [
-        dup supremum 1 + 1 <array>
-        [ '[ _ 0 -rot set-nth ] each ] keep
-    ] if-empty ;
-
-: state>gc-data ( state -- gc-data )
-    [ second vacant>bits ] map ;
-
-: set-gc-map ( state gc-map -- )
-    swap state>gc-data first2 -rot >>scrub-d swap >>scrub-r drop ;
-
-: fill-gc-maps ( cfg -- )
-    [ trace-stack-state ] [ cfg>insns [ gc-map-insn? ] filter ] bi
-    [ [ insn#>> of ] [ gc-map>> ] bi set-gc-map ] with each ;

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

@@ -2,28 +2,18 @@ USING: bit-arrays byte-arrays compiler.cfg compiler.cfg.instructions
 compiler.cfg.stack-frame help.markup help.syntax kernel math sequences ;
 IN: compiler.codegen.gc-maps
 
-HELP: emit-gc-info-bitmaps
+HELP: emit-gc-info-bitmap
 { $values
   { "gc-maps" sequence }
-  { "counts" "counts of the three different types of gc checks" }
+  { "spill-count" "maximum number of spill slots" }
 }
-{ $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."  } ;
+{ $description "Emits a bitmap of live locations of spill slots in the 'gc-maps' to the current make sequence." } ;
 
-HELP: emit-scrub
+HELP: emit-gc-roots
 { $values
-  { "seqs" "a sequence of sequences of 0/1" }
+  { "seqs" "a sequence of sequences" }
-  { "n" "length of the longest sequence" }
+  { "n" "maximum number of spill slots" }
-}
+} { $description "Emits the sequences of spill slots as a sequence of " { $link t } " and " { $link f } " values to the current make sequence." } ;
-{ $description "Emits a space-efficient " { $link bit-array } " to the make sequence being created. The outputted array will be of length n times the number of sequences given. Each group of n elements in the array contains true values if the stack location should be scrubbed, and false if it shouldn't." }
-{ $examples
-  { $example
-    "USING: bit-arrays byte-arrays compiler.codegen.gc-maps make prettyprint ;"
-    "[ { B{ 0 } B{ 0 } B{ 1 1 1 0 } } emit-scrub ] ?{ } make . ."
-    "?{ t f f f t f f f f f f t }\n4"
-  }
-} ;
-
-{ emit-gc-info-bitmaps emit-scrub } related-words
 
 HELP: emit-uint
 { $values { "n" integer } }
@@ -59,27 +49,22 @@ HELP: gc-map-here
 { $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:"
+"The " { $vocab-link "compiler.codegen.gc-maps" } " vocab serializes a compiled words gc maps into a space-efficient format which is appended to the end of the code block."
+$nl
+"Every code block generated either ends with:"
 { $list "uint 0" }
 "or"
 { $list
   {
-      "bitmap, byte aligned, five subsequences:"
+      "a bitmap representing the indices of the spill slots that contain roots in each gc map"
-      { $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"
+  "int number of return addresses/gc maps"
 }
-"The " { $link gc-map } " tuples of the " { $link cfg } " are serialized to the above format and placed directly after the generated code."
+"For example, if there are three gc maps and each contain four roots, then bit 0-3 in the bitmap would indicate liveness of the first gc maps roots, 4-7 of the second and 8-11 of the third."
 $nl
 "Main entry point:"
 { $subsections emit-gc-maps } ;

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

@@ -1,7 +1,8 @@
-USING: accessors alien.c-types arrays bit-arrays classes.struct compiler.cfg
+USING: accessors alien.c-types arrays bit-arrays byte-arrays
-compiler.cfg.instructions compiler.cfg.stack-frame compiler.cfg.utilities
+classes.struct compiler.cfg compiler.cfg.instructions
+compiler.cfg.stack-frame compiler.cfg.utilities
 compiler.codegen.gc-maps compiler.codegen.relocation cpu.architecture
-cpu.x86 byte-arrays make namespaces kernel layouts math sequences
+cpu.x86 kernel layouts make math namespaces sequences
 specialized-arrays system tools.test ;
 QUALIFIED: vm
 SPECIALIZED-ARRAY: uint
@@ -25,8 +26,6 @@ M: fake-cpu gc-root-offset ;
     50 <byte-array> %
 
     T{ gc-map
-       { scrub-d { 0 1 1 1 0 } }
-       { scrub-r { 1 0 } }
        { gc-roots V{ 1 3 } }
        { derived-roots V{ { 2 4 } } }
     } gc-map-here
@@ -39,30 +38,24 @@ M: fake-cpu gc-root-offset ;
 [
     100 <byte-array> %
 
-    ! The below data is 38 bytes -- 6 bytes padding needed to
+    ! The below data is 29 bytes -- 15 bytes padding needed to
     ! align
-    6 <byte-array> %
+    15 <byte-array> %
 
-    ! Bitmap - 2 bytes
+    ! Bitmap - 1 byte
     ?{
-        ! scrub-d
-        t f f f t
-        ! scrub-r
-        f t
         ! gc-roots
         f t f t
     } underlying>> %
 
-    ! Derived pointers
+    ! Derived pointers - 12 bytes
     uint-array{ -1 -1 4 } underlying>> %
 
-    ! Return addresses
+    ! Return addresses - 4 bytes
     uint-array{ 100 } underlying>> %
 
-    ! GC info footer - 20 bytes
+    ! GC info footer - 12 bytes
     S{ vm:gc-info
-       { scrub-d-count 5 }
-       { scrub-r-count 2 }
        { gc-root-count 4 }
        { derived-root-count 3 }
        { return-address-count 1 }
@@ -83,55 +76,40 @@ M: linux-x86.64 gc-root-offset
     stack-frame new swap >>spill-area-base
     { } insns>cfg swap >>stack-frame ;
 
+: array>spill-slots ( seq -- spills )
+    [ spill-slot boa ] map ;
+
+: <gc-map/spills> ( spills -- gc-map )
+    array>spill-slots { } gc-map boa ;
+
 cpu x86.64? [
     linux-x86.64 \ cpu set
 
     ! gc-root-offsets
     { { 1 3 } } [
         0 cfg-w-spill-area-base cfg [
-            T{ gc-map
+            { 0 16 } <gc-map/spills> gc-root-offsets
-               { gc-roots {
-                   T{ spill-slot { n 0 } }
-                   T{ spill-slot { n 16 } }
-               } }
-            } gc-root-offsets
         ] with-variable
     ] unit-test
 
     { { 6 10 } } [
         32 cfg-w-spill-area-base cfg [
-            T{ gc-map
+            { 8 40 } <gc-map/spills> gc-root-offsets
-               { gc-roots {
-                   T{ spill-slot { n 8 } }
-                   T{ spill-slot { n 40 } }
-               } }
-            } gc-root-offsets
         ] with-variable
     ] unit-test
 
-    ! scrub-d scrub-r gc-roots
+    { 5 B{ 18 } } [
-    { { 0 0 5 } } [
         0 cfg-w-spill-area-base cfg [
-            T{ gc-map
+            { 0 24 } <gc-map/spills> 1array
-               { gc-roots {
+            [ emit-gc-info-bitmap ] B{ } make
-                   T{ spill-slot { n 0 } }
-                   T{ spill-slot { n 24 } }
-               } }
-            } 1array
-            [ emit-gc-info-bitmaps ] B{ } make drop
         ] with-variable
     ] unit-test
 
     ! scrub-d scrub-r gc-roots
-    { { 0 0 9 } } [
+    { 9 B{ 32 1 } } [
         32 cfg-w-spill-area-base cfg [
-            T{ gc-map
+            { 0 24 } <gc-map/spills> 1array
-               { gc-roots {
+            [ emit-gc-info-bitmap ] B{ } make
-                   T{ spill-slot { n 0 } }
-                   T{ spill-slot { n 24 } }
-               } }
-            } 1array
-            [ emit-gc-info-bitmaps ] B{ } make drop
         ] with-variable
     ] unit-test
 
@@ -149,35 +127,18 @@ cpu x86.64? [
 ] unit-test
 
 ! gc-map-needed?
-{ t t } [
+{ f } [
-    T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
+    T{ gc-map } gc-map-needed?
-    T{ gc-map { scrub-d { 0 1 1 1 } } } gc-map-needed?
 ] unit-test
 
-! emit-scrub
+! emit-gc-info-bitmap
-{ 3 V{ t t t f f f } } [
-    [ { { 0 0 0 } { 1 1 1 } } emit-scrub ] V{ } make
-] unit-test
-
-! emit-gc-info-bitmaps
 {
-    { 4 2 0 }
+    0 V{ }
-    V{ 1 }
 } [
-    { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } }
+    { T{ gc-map } } [ emit-gc-info-bitmap ] V{ } make
-    [ emit-gc-info-bitmaps ] V{ } make
 ] unit-test
 
-{
+! ! derived-root-offsets
-    { 1 0 0 }
-    V{ 1 }
-} [
-    { T{ gc-map { scrub-d { 0 } } } }
-    [ emit-gc-info-bitmaps ] V{ } make
-] unit-test
-
-! derived-root-offsets
-USING: present prettyprint ;
 {
     V{ { 2 4 } }
 } [
@@ -201,19 +162,17 @@ USING: present prettyprint ;
 ] unit-test
 
 {
-    B{ 17 123 0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 }
+    B{ 123 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 }
 } [
     { 123 } return-addresses set
-    { T{ gc-map { scrub-d { 0 1 1 1 0 } } } } gc-maps set
+    { T{ gc-map } } gc-maps set
     serialize-gc-maps
 ] unit-test
 
 ! gc-info + ret-addr + 9bits (5+2+2) = 20 + 4 + 2 = 26
-{ 26 } [
+{ 17 } [
     {
         T{ gc-map
-           { scrub-d { 0 1 1 1 0 } }
-           { scrub-r { 1 0 } }
            { gc-roots V{ 1 3 } }
         }
     } gc-maps set
@@ -222,11 +181,9 @@ USING: present prettyprint ;
 ] unit-test
 
 ! gc-info + ret-addr + 3 base-pointers + 9bits = 20 + 4 + 12 + 2 = 38
-{ 38 } [
+{ 29 } [
     {
         T{ gc-map
-           { scrub-d { 0 1 1 1 0 } }
-           { scrub-r { 1 0 } }
            { gc-roots V{ 1 3 } }
            { derived-roots V{ { 2 4 } } }
         }

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

@@ -16,11 +16,6 @@ SYMBOLS: return-addresses gc-maps ;
         compiled-offset return-addresses get push
     ] [ drop ] if ;
 
-: emit-scrub ( seqs -- n )
-    ! seqs is a sequence of sequences of 0/1
-    dup longest length
-    [ '[ [ 0 = ] ?{ } map-as _ f pad-tail % ] each ] keep ;
-
 : integers>bits ( seq n -- bit-array )
     <bit-array> [ '[ [ t ] dip _ set-nth ] each ] keep ;
 
@@ -40,12 +35,9 @@ SYMBOLS: return-addresses gc-maps ;
 : gc-root-offsets ( gc-map -- offsets )
     gc-roots>> [ gc-root-offset ] map ;
 
-: emit-gc-info-bitmaps ( gc-maps -- counts )
+: emit-gc-info-bitmap ( gc-maps -- spill-count )
-    [
+    [ gc-root-offsets ] map
-        [ [ scrub-d>> ] map emit-scrub ]
+    [ emit-gc-roots ] ?{ } make underlying>> % ;
-        [ [ scrub-r>> ] map emit-scrub ]
-        [ [ gc-root-offsets ] map emit-gc-roots ] tri 3array
-    ] ?{ } make underlying>> % ;
 
 : emit-base-table ( alist longest -- )
     -1 <array> <enum> swap assoc-union! seq>> emit-uints ;
@@ -61,7 +53,7 @@ SYMBOLS: return-addresses gc-maps ;
 : serialize-gc-maps ( -- byte-array )
     [
         return-addresses get empty? [ { } ] [
-            gc-maps get [ emit-gc-info-bitmaps ] [ emit-base-tables ] bi suffix
+            gc-maps get [ emit-gc-info-bitmap ] [ emit-base-tables ] bi 2array
         ] if
         return-addresses get emit-uints
         emit-uints

basis/cpu/x86/x86-tests.factor

@@ -41,20 +41,22 @@ cpu x86.64? [
 ! %alien-invoke
 { 1 } [
     [
-        f { } { } { } { } 0 0 { } "dll" T{ gc-map { scrub-d V{ 0 } } } %alien-invoke
+        f { } { } { } { } 0 0 { } "dll"
+        T{ gc-map { gc-roots V{ T{ spill-slot { n 0 } } } } }
+        %alien-invoke
     ] with-fixup drop gc-maps get length
 ] unit-test
 
 ! %call-gc
 { V{ } } [
     [
-        T{ gc-map { scrub-d V{ } } } %call-gc
+        T{ gc-map } %call-gc
     ] with-fixup drop gc-maps get
 ] unit-test
 
 { 1 } [
     [
-        T{ gc-map { scrub-d V{ 0 0 } } } %call-gc
+        T{ gc-map { gc-roots V{ T{ spill-slot { n 0 } } } } } %call-gc
     ] with-fixup drop gc-maps get length
 ] unit-test
 

basis/vm/vm.factor

@@ -102,8 +102,6 @@ STRUCT: gc-event
 ! gc-info should be kept in sync with:
 !   vm/gc_info.hpp
 STRUCT: gc-info
-    { scrub-d-count uint read-only }
-    { scrub-r-count uint read-only }
     { gc-root-count uint read-only }
     { derived-root-count uint read-only }
     { return-address-count uint read-only } ;

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

@@ -27,13 +27,9 @@ QUALIFIED: opencl
 
 : tally-gc-maps ( gc-maps -- seq/f )
     [ f ] [
-        {
+        [ [ gc-root-offsets ] map largest-spill-slot ]
-            [ [ scrub-d>> length ] map supremum ]
+        [ [ derived-root-offsets ] map [ keys ] map largest-spill-slot ]
-            [ [ scrub-r>> length ] map supremum ]
+        [ length ] tri 3array
-            [ [ gc-root-offsets ] map largest-spill-slot ]
-            [ [ derived-root-offsets ] map [ keys ] map largest-spill-slot ]
-            [ length ]
-        } cleave 5 narray
     ] if-empty ;
 
 ! Like word>gc-info but uses the compiler

vm/gc_info.hpp

@@ -4,14 +4,12 @@ namespace factor {
 //   basis/compiler/codegen/gc-maps/gc-maps.factor
 //   basis/vm/vm.factor
 struct gc_info {
-  uint32_t scrub_d_count;
-  uint32_t scrub_r_count;
   uint32_t gc_root_count;
   uint32_t derived_root_count;
   uint32_t return_address_count;
 
   cell callsite_bitmap_size() {
-    return scrub_d_count + scrub_r_count + gc_root_count;
+    return gc_root_count;
   }
 
   cell total_bitmap_size() {
@@ -32,21 +30,9 @@ struct gc_info {
     return (uint8_t*)base_pointer_map() - total_bitmap_bytes();
   }
 
-  cell callsite_scrub_d(cell index) {
-    cell base = 0;
-    return base + index * scrub_d_count;
-  }
-
-  cell callsite_scrub_r(cell index) {
-    cell base = return_address_count * scrub_d_count;
-    return base + index * scrub_r_count;
-  }
 
   cell callsite_gc_roots(cell index) {
-    cell base =
+    return index * gc_root_count;
-        return_address_count * scrub_d_count +
-        return_address_count * scrub_r_count;
-    return base + index * gc_root_count;
   }
 
   uint32_t lookup_base_pointer(cell index, cell derived_root) {

vm/slot_visitor.hpp

@@ -223,31 +223,16 @@ template <typename Fixup> void slot_visitor<Fixup>::visit_all_roots() {
 }
 
 // primitive_minor_gc() is invoked by inline GC checks, and it needs to
-// fill in uninitialized stack locations before actually calling the GC.
+// visit spill slots which references objects in the heap.
-// See the documentation in compiler.cfg.stacks.vacant for details.
 
 // So for each call frame:
-//  - scrub some uninitialized locations
 //  - trace roots in spill slots
 
 template <typename Fixup> struct call_frame_slot_visitor {
   slot_visitor<Fixup>* visitor;
-  // NULL in case we're a visitor for a callstack object.
-  context* ctx;
 
-  void scrub_stack(cell stack, uint8_t* bitmap, cell base, uint32_t count) {
+  call_frame_slot_visitor(slot_visitor<Fixup>* visitor)
-    for (cell loc = 0; loc < count; loc++) {
+      : visitor(visitor) {}
-      if (bitmap_p(bitmap, base + loc)) {
-#ifdef DEBUG_GC_MAPS
-        FACTOR_PRINT("scrubbing stack location " << loc);
-#endif
-        *((cell*)stack - loc) = 0;
-      }
-    }
-  }
-
-  call_frame_slot_visitor(slot_visitor<Fixup>* visitor, context* ctx)
-      : visitor(visitor), ctx(ctx) {}
 
   // frame top -> [return address]
   //              [spill area]
@@ -275,18 +260,6 @@ template <typename Fixup> struct call_frame_slot_visitor {
     cell* stack_pointer = (cell*)frame_top;
     uint8_t* bitmap = info->gc_info_bitmap();
 
-    if (ctx) {
-      // Scrub vacant stack locations.
-      scrub_stack(ctx->datastack,
-                  bitmap,
-                  info->callsite_scrub_d(callsite),
-                  info->scrub_d_count);
-      scrub_stack(ctx->retainstack,
-                  bitmap,
-                  info->callsite_scrub_r(callsite),
-                  info->scrub_r_count);
-    }
-
     // Subtract old value of base pointer from every derived pointer.
     for (cell spill_slot = 0; spill_slot < info->derived_root_count;
          spill_slot++) {
@@ -305,9 +278,9 @@ template <typename Fixup> struct call_frame_slot_visitor {
 
     for (cell spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++) {
       if (bitmap_p(bitmap, callsite_gc_roots + spill_slot)) {
-#ifdef DEBUG_GC_MAPS
+        #ifdef DEBUG_GC_MAPS
         FACTOR_PRINT("visiting GC root " << spill_slot);
-#endif
+        #endif
         visitor->visit_handle(stack_pointer + spill_slot);
       }
     }
@@ -324,13 +297,13 @@ template <typename Fixup> struct call_frame_slot_visitor {
 
 template <typename Fixup>
 void slot_visitor<Fixup>::visit_callstack_object(callstack* stack) {
-  call_frame_slot_visitor<Fixup> call_frame_visitor(this, NULL);
+  call_frame_slot_visitor<Fixup> call_frame_visitor(this);
   parent->iterate_callstack_object(stack, call_frame_visitor, fixup);
 }
 
 template <typename Fixup>
 void slot_visitor<Fixup>::visit_callstack(context* ctx) {
-  call_frame_slot_visitor<Fixup> call_frame_visitor(this, ctx);
+  call_frame_slot_visitor<Fixup> call_frame_visitor(this);
   parent->iterate_callstack(ctx, call_frame_visitor, fixup);
 }