From 70e9834f2f8d05dbaa7ddbc6aa837ff8947a1b6e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Fri, 22 Apr 2016 18:35:10 +0200
Subject: [PATCH] compiler.cfg.*: new system for emitting spill/reloads for gc
 calls (#1471)

GC calls were treated as sync points so all registers were spilled
around them. But if the gc call isn't triggered, it is unnecessary to
spill. This commit fixes that by handling ##call-gc specially and
putting ##spill and ##reloads in the same block as the gc call itself.
---
 .../cfg/instructions/instructions-docs.factor |  7 +-
 .../assignment/assignment-docs.factor         | 44 +++++++----
 .../assignment/assignment-tests.factor        | 23 +++---
 .../linear-scan/assignment/assignment.factor  | 76 ++++++++++++-------
 .../live-intervals/live-intervals-docs.factor |  7 +-
 .../live-intervals-tests.factor               | 11 ++-
 .../live-intervals/live-intervals.factor      |  1 -
 .../cfg/utilities/utilities-docs.factor       | 18 ++++-
 basis/compiler/cfg/utilities/utilities.factor |  9 ++-
 9 files changed, 129 insertions(+), 67 deletions(-)

diff --git a/basis/compiler/cfg/instructions/instructions-docs.factor b/basis/compiler/cfg/instructions/instructions-docs.factor
index 9df48d8989..fc19684ed6 100644
--- a/basis/compiler/cfg/instructions/instructions-docs.factor
+++ b/basis/compiler/cfg/instructions/instructions-docs.factor
@@ -357,10 +357,13 @@ HELP: gc-map
   { $table
     {
         { $slot "gc-roots" }
-        { "First a " { $link sequence } " of vregs that will be spilled during a gc. It is assigned in the " { $vocab-link "compiler.cfg.liveness" } " compiler pass. Then it is converted to a sequence of " { $link spill-slot } "s in " { $link assign-registers } "." }
+        { { $link sequence } " of vregs or spill-slots" }
     }
-    { { $slot "derived-roots" } { "An " { $link assoc } " of pairs of spill slots." } }
+    {
+        { $slot "derived-roots" }
+        { "An " { $link assoc } " of pairs of vregs or spill slots." } }
   }
+  "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 } ;
 
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor b/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor
index 1858fc806d..b88965a0d5 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor
@@ -1,22 +1,15 @@
 USING: assocs compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.allocation
-compiler.cfg.linear-scan.allocation.state compiler.cfg.liveness
-compiler.cfg.registers heaps help.markup help.syntax math sequences ;
+compiler.cfg.linear-scan.allocation
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness
+compiler.cfg.registers heaps help.markup help.syntax math quotations
+sequences ;
 IN: compiler.cfg.linear-scan.assignment
 
 HELP: add-pending
 { $values { "live-interval" live-interval-state } }
 { $description "Adds a live interval to the pending interval set." } ;
 
-HELP: assign-derived-roots
-{ $values { "gc-map" gc-map } }
-{ $description "Assigns pairs of spill slots for all derived roots in a gc map." } ;
-{ assign-gc-roots assign-derived-roots } related-words
-
-HELP: assign-gc-roots
-{ $values { "gc-map" gc-map } }
-{ $description "Assigns spill slots for all gc roots in a gc map." } ;
-
 HELP: assign-registers-in-block
 { $values { "bb" basic-block } }
 { $description "Assigns registers to vregs and also inserts " { $link ##reload } " and " { $link ##spill } " instructions." } ;
@@ -29,14 +22,22 @@ HELP: assign-all-registers
 { $values { "insn" insn } }
 { $description "Assigns physical registers for the virtual registers used and defined by the instruction." } ;
 
+HELP: change-insn-gc-roots
+{ $values { "gc-map-insn" gc-map-insn } { "quot" quotation } }
+{ $description "Applies the quotation to all vregs in the instructions " { $link gc-map } "." } ;
+
 HELP: compute-live-in
 { $values { "bb" basic-block } }
 { $description "Computes the live in registers for a basic block." }
 { $see-also machine-live-ins } ;
 
+HELP: emit-##call-gc
+{ $values { "insn" ##call-gc } }
+{ $description "Emits a " { $link ##call-gc } " instruction and the " { $link ##reload } " and " { $link ##spill } " instructions it requires. ##call-gc aren't counted as sync points, so the instruction requires special handling." } ;
+
 HELP: expire-old-intervals
 { $values { "n" integer } { "pending-heap" min-heap } }
-{ $description "Expires all intervals older than the cutoff point." } ;
+{ $description "Expires all intervals older than the cutoff point. First they are removed from the 'pending-heap' and " { $link pending-interval-assoc } ". Then " { $link ##spill } " instructions are inserted for each interval that was removed." } ;
 
 HELP: insert-reload
 { $values { "live-interval" live-interval-state } }
@@ -74,15 +75,28 @@ HELP: vreg>spill-slot
 { $description "Converts a vreg number to a spill slot." } ;
 
 ARTICLE: "compiler.cfg.linear-scan.assignment" "Assigning registers to live intervals"
-"The " { $vocab-link "compiler.cfg.linear-scan.assignment" } " assigns registers to live intervals." $nl
+"The " { $vocab-link "compiler.cfg.linear-scan.assignment" } " assigns registers to live intervals. Before this compiler pass, all values in the " { $link cfg } " were represented as simple integers called \"virtual registers\" or vregs. In this pass, using the live interval data computed in the register allocation pass (" { $vocab-link "compiler.cfg.linear-scan.allocation" } "), those vregs are translated into physical registers."
+$nl
+"Since there is an infinite number of vregs but the number of physical registers is limited, some values must be spilled. So this pass also handles spilling decisions and inserts " { $link ##spill } " and " { $link ##reload } " instructions where needed."
+$nl
+"GC maps:"
+{ $subsections
+  change-insn-gc-roots
+  emit-##call-gc
+}
 "Pending intervals:"
 { $subsections
   activate-interval
   add-pending
   pending-interval-assoc
+  expire-old-intervals
   remove-pending
 }
 "Vreg transformations:"
-{ $subsections vreg>reg vreg>spill-slot vregs>regs } ;
+{ $subsections
+  vreg>reg
+  vreg>spill-slot
+  vregs>regs
+} ;
 
 ABOUT: "compiler.cfg.linear-scan.assignment"
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor b/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor
index 7cc7757c18..54eca98614 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor
@@ -1,9 +1,10 @@
-USING: accessors arrays compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.assignment
+USING: accessors arrays compiler.cfg.instructions
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.assignment
 compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
-compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities cpu.architecture
-cpu.x86.assembler.operands grouping heaps kernel make namespaces random
-sequences sorting tools.test ;
+compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities
+cpu.architecture cpu.x86.assembler.operands heaps kernel make
+namespaces sequences sorting tools.test ;
 IN: compiler.cfg.linear-scan.assignment.tests
 
 : cherry-pick ( seq indices -- seq' )
@@ -49,14 +50,6 @@ IN: compiler.cfg.linear-scan.assignment.tests
     } live-intervals>min-heap [ activate-new-intervals ] { } make
 ] unit-test
 
-! assign-gc-roots
-{
-    T{ gc-map { gc-roots { T{ spill-slot { n 7 } } } } }
-} [
-    { { 23 int-rep 23 T{ spill-slot { n 7 } } } } setup-vreg-spills
-    <gc-map> 23 1array >>gc-roots [ assign-gc-roots ] keep
-] unit-test
-
 ! assign-insn-defs
 {
     T{ ##peek { dst RAX } { loc T{ ds-loc } } { insn# 0 } }
@@ -97,9 +90,11 @@ IN: compiler.cfg.linear-scan.assignment.tests
 ] unit-test
 
 ! expire-old-intervals
-{ 3 } [
+{ 3 H{ } } [
+    H{ { 25 RBX } } clone pending-interval-assoc set
     90 { 50 90 95 120 } [ 25 <live-interval> 2array ] map >min-heap
     [ expire-old-intervals ] keep heap-size
+    pending-interval-assoc get
 ] unit-test
 
 ! insert-reload
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 9143a0b056..3225b583b8 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -1,22 +1,26 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators compiler.cfg
+USING: accessors arrays assocs combinators compiler.cfg
 compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.live-intervals compiler.cfg.linearization
 compiler.cfg.liveness compiler.cfg.registers
-compiler.cfg.renaming.functor compiler.cfg.ssa.destruction.leaders fry
-heaps kernel make math namespaces sequences ;
+compiler.cfg.renaming.functor compiler.cfg.ssa.destruction.leaders
+compiler.cfg.utilities fry heaps kernel make math namespaces sequences
+;
 IN: compiler.cfg.linear-scan.assignment
-
-: heap-pop-while ( heap quot: ( key -- ? ) -- values )
-    '[ dup heap-empty? [ f f ] [ dup heap-peek @ ] if ]
-    [ over heap-pop* ] produce 2nip ; inline
+QUALIFIED: sets
 
 ! This contains both active and inactive intervals; any interval
 ! such that start <= insn# <= end is in this set.
 SYMBOL: pending-interval-heap
 SYMBOL: pending-interval-assoc
 
+: insert-spill ( live-interval -- )
+    [ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri ##spill, ;
+
+: handle-spill ( live-interval -- )
+    dup spill-to>> [ insert-spill ] [ drop ] if ;
+
 : add-pending ( live-interval -- )
     [ dup live-interval-end pending-interval-heap get heap-push ]
     [ [ reg>> ] [ vreg>> ] bi pending-interval-assoc get set-at ]
@@ -25,16 +29,13 @@ SYMBOL: pending-interval-assoc
 : remove-pending ( live-interval -- )
     vreg>> pending-interval-assoc get delete-at ;
 
+: vreg>spill-slot ( vreg -- slot )
+    dup rep-of lookup-spill-slot ;
+
 : vreg>reg ( vreg -- reg/spill-slot )
     dup leader dup pending-interval-assoc get at
     [ 2nip ] [ swap rep-of lookup-spill-slot ] if* ;
 
-ERROR: not-spilled-error vreg ;
-
-: vreg>spill-slot ( vreg -- spill-slot )
-    dup vreg>reg dup spill-slot?
-    [ nip ] [ drop leader not-spilled-error ] if ;
-
 : vregs>regs ( assoc -- assoc' )
     [ vreg>reg ] assoc-map ;
 
@@ -65,12 +66,6 @@ SYMBOL: machine-live-outs
 : compute-live-out ( bb -- )
     [ live-out vregs>regs ] keep machine-live-outs get set-at ;
 
-: insert-spill ( live-interval -- )
-    [ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri ##spill, ;
-
-: handle-spill ( live-interval -- )
-    dup spill-to>> [ insert-spill ] [ drop ] if ;
-
 : expire-interval ( live-interval -- )
     [ remove-pending ] [ handle-spill ] bi ;
 
@@ -98,12 +93,6 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
 : assign-all-registers ( insn -- )
     [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;
 
-: assign-gc-roots ( gc-map -- )
-    gc-roots>> [ vreg>spill-slot ] map! drop ;
-
-: assign-derived-roots ( gc-map -- )
-    [ [ [ vreg>spill-slot ] bi@ ] assoc-map ] change-derived-roots drop ;
-
 : begin-block ( bb -- )
     {
         [ basic-block namespaces:set ]
@@ -112,8 +101,39 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
         [ compute-live-in ]
     } cleave ;
 
-: handle-gc-map-insn ( insn -- )
-    dup , gc-map>> [ assign-gc-roots ] [ assign-derived-roots ] bi ;
+: change-insn-gc-roots ( gc-map-insn quot: ( x -- x ) -- )
+    [ gc-map>> ] dip [ swap gc-roots>> swap map! drop ]
+    [ '[ [ [ @ ] bi@ ] assoc-map ] change-derived-roots drop ] 2bi ; inline
+
+: spill-required? ( live-interval root-leaders n -- ? )
+    [ [ vreg>> ] dip sets:in? ] [ swap covers? ] bi-curry* bi or ;
+
+: spill-intervals ( root-leaders n -- live-intervals )
+    [ pending-interval-heap get heap-members ] 2dip
+    '[ _ _ spill-required? ] filter ;
+
+: spill/reload ( interval -- {reg,rep,slot} )
+    [ reg>> ] [ vreg>> dup rep-of dup swapd assign-spill-slot ] bi 3array ;
+
+: spill/reloads ( intervals -- spill/reloads )
+    [ spill/reload ] map ;
+
+: spill/reloads-for-call-gc ( ##call-gc -- spill-seq )
+    [ gc-map>> gc-roots>> ] [ insn#>> ] bi spill-intervals spill/reloads ;
+
+: emit-##call-gc ( insn -- )
+    dup spill/reloads-for-call-gc
+    dup [ first3 ##spill, ] each
+    swap ,
+    [ first3 ##reload, ] each ;
+
+: emit-gc-map-insn ( gc-map-insn -- )
+    [ [ leader ] change-insn-gc-roots ]
+    [ dup ##call-gc? [ emit-##call-gc ] [ , ] if ]
+    [ [ vreg>spill-slot ] change-insn-gc-roots ] tri ;
+
+: emit-insn ( insn -- )
+    dup gc-map-insn? [ emit-gc-map-insn ] [ , ] if ;
 
 : assign-registers-in-block ( bb -- )
     dup begin-block
@@ -122,7 +142,7 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
             [
                 [ insn#>> prepare-insn ]
                 [ assign-all-registers ]
-                [ dup gc-map-insn? [ handle-gc-map-insn ] [ , ] if ] tri
+                [ emit-insn ] tri
             ] each
         ] V{ } make
     ] change-instructions compute-live-out ;
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-docs.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-docs.factor
index fe486c7cf1..34d58eb78d 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-docs.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-docs.factor
@@ -25,7 +25,7 @@ HELP: cfg>sync-points
 { $see-also sync-point } ;
 
 HELP: clobber-insn
-{ $class-description "Instructions that clobber registers but are allowed to produce outputs in registers. Inputs are in spill slots, except for inputs coalesced with the output, in which case that input will be in a register." } ;
+{ $class-description "Instructions that clobber registers but are allowed to produce outputs in registers. Inputs are in spill slots, except for inputs coalesced with the output, in which case that input will be in a register. Each instruction that is a member of the clobber-insn class requires a " { $link sync-point } "." } ;
 
 HELP: compute-live-intervals
 { $values { "cfg" cfg } { "intervals/sync-points" sequence } }
@@ -48,7 +48,8 @@ HELP: from
 { $var-description "An integer representing a sequence number one lower than all numbers in the currently processed block." } ;
 
 HELP: hairy-clobber-insn
-{ $class-description "Instructions that clobber registers. They receive inputs and produce outputs in spill slots." } ;
+{ $class-description "Instructions that clobber registers. They receive inputs and produce outputs in spill slots." }
+{ $notes "The " { $link ##call-gc } " instruction is not included in the class even though it clobbers registers because it is handled specially." } ;
 
 HELP: insn>sync-point
 { $values { "insn" insn } { "sync-point/f" { $maybe sync-point } } }
@@ -135,6 +136,8 @@ $nl
 "Sync point handling:"
 { $subsections
   cfg>sync-points
+  clobber-insn
+  hairy-clobber-insn
   insn>sync-point
 } ;
 
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
index 4d6b57955b..4760b1fec7 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals-tests.factor
@@ -11,9 +11,14 @@ IN: compiler.cfg.linear-scan.live-intervals.tests
 
 ! cfg>sync-points
 {
-    V{ T{ sync-point { n 0 } } }
+    V{
+        T{ sync-point { n 2 } }
+    }
 } [
-    V{ T{ ##call-gc } } insns>cfg
+    V{
+        T{ ##call-gc }
+        T{ ##callback-inputs }
+    } insns>cfg
     [ number-instructions ] [ cfg>sync-points ] bi
 ] unit-test
 
@@ -35,7 +40,7 @@ IN: compiler.cfg.linear-scan.live-intervals.tests
 
 ! insn>sync-point
 { f f t } [
-    T{ ##call-gc } insn>sync-point keep-dst?>>
+    T{ ##call-gc } insn>sync-point
     T{ ##callback-outputs } insn>sync-point keep-dst?>>
     T{ ##unbox } insn>sync-point keep-dst?>>
 ] unit-test
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index c0fe254eca..ead47fbcc8 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -87,7 +87,6 @@ M: insn compute-live-intervals* drop ;
     ] [ uses-vregs ] if ;
 
 UNION: hairy-clobber-insn
-    ##call-gc
     alien-call-insn
     ##callback-inputs
     ##callback-outputs
diff --git a/basis/compiler/cfg/utilities/utilities-docs.factor b/basis/compiler/cfg/utilities/utilities-docs.factor
index 1925a90a49..c3a830f635 100644
--- a/basis/compiler/cfg/utilities/utilities-docs.factor
+++ b/basis/compiler/cfg/utilities/utilities-docs.factor
@@ -1,4 +1,5 @@
-USING: compiler.cfg help.markup help.syntax sequences ;
+USING: assocs compiler.cfg hashtables help.markup help.syntax
+sequences ;
 IN: compiler.cfg.utilities
 
 HELP: connect-Nto1-bbs
@@ -8,3 +9,18 @@ HELP: connect-Nto1-bbs
 HELP: insert-basic-block
 { $values { "from" basic-block } { "to" basic-block } { "insns" sequence } }
 { $description "Insert basic block on the edge between 'from' and 'to'." } ;
+
+ARTICLE: "compiler.cfg.utilities" "Utility words used by CFG optimization"
+"Various utilities."
+$nl
+"For " { $vocab-link "heaps" } ":"
+{ $subsections
+  heap-members
+  heap-pop-while
+}
+"For " { $vocab-link "deques" } ":"
+{ $subsections
+  slurp/replenish-deque
+} ;
+
+ABOUT: "compiler.cfg.utilities"
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index f177b11112..5b246fac38 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators.short-circuit compiler.cfg
 compiler.cfg.instructions compiler.cfg.rpo cpu.architecture deques fry
-kernel locals make math namespaces sequences sets ;
+heaps kernel locals math sequences sets ;
 IN: compiler.cfg.utilities
 
 : block>cfg ( bb -- cfg )
@@ -92,3 +92,10 @@ IN: compiler.cfg.utilities
 
 : slurp/replenish-deque ( ... deque quot: ( ... obj -- ... seq ) -- ... )
       over '[ @ _ push-all-front ] slurp-deque ; inline
+
+: heap-members ( heap -- seq )
+    data>> [ value>> ] map ;
+
+: heap-pop-while ( heap quot: ( key -- ? ) -- values )
+    '[ dup heap-empty? [ f f ] [ dup heap-peek @ ] if ]
+    [ over heap-pop* ] produce 2nip ; inline