From c55a6bb385f829cf2b7a7baa6ab507443be62317 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 28 Apr 2010 02:53:01 -0400
Subject: [PATCH] compiler.cfg.gc-checks: move phi instructions into GC check
 block, to ensure correct behavior

---
 .../cfg/gc-checks/gc-checks-tests.factor      | 56 ++++++++++++++++---
 basis/compiler/cfg/gc-checks/gc-checks.factor | 32 ++++++++---
 2 files changed, 70 insertions(+), 18 deletions(-)

diff --git a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
index 7a148bc201..de5e35aaa4 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
@@ -44,13 +44,12 @@ V{
         [ first ##check-nursery-branch? ]
     } 1&& ;
 
-[ t ] [ 100 <gc-check> gc-check? ] unit-test
+[ t ] [ V{ } 100 <gc-check> gc-check? ] unit-test
 
-2 \ vreg-counter set-global
+4 \ vreg-counter set-global
 
 [
     V{
-        T{ ##save-context f 3 4 }
         T{ ##load-tagged f 5 0 }
         T{ ##replace f 5 D 0 }
         T{ ##replace f 5 R 3 }
@@ -93,7 +92,7 @@ V{
 
 [ ] [ cfg get needs-predecessors drop ] unit-test
 
-[ ] [ 31337 { D 1 R 2 } { 10 20 } 3 get (insert-gc-check) ] unit-test
+[ ] [ { D 1 R 2 } { 10 20 } V{ } 31337 3 get (insert-gc-check) ] unit-test
 
 [ t ] [ 1 get successors>> first gc-check? ] unit-test
 
@@ -157,11 +156,10 @@ H{
 
 [
     V{
-        T{ ##save-context f 33 34 }
-        T{ ##load-tagged f 35 0 }
-        T{ ##replace f 35 D 0 }
-        T{ ##replace f 35 D 1 }
-        T{ ##replace f 35 D 2 }
+        T{ ##load-tagged f 31 0 }
+        T{ ##replace f 31 D 0 }
+        T{ ##replace f 31 D 1 }
+        T{ ##replace f 31 D 2 }
         T{ ##call-gc f { 2 } }
         T{ ##branch }
     }
@@ -169,3 +167,43 @@ H{
 
 ! Don't forget to invalidate RPO after inserting basic blocks!
 [ 8 ] [ cfg get reverse-post-order length ] unit-test
+
+! Do the right thing with ##phi instructions
+V{
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##load-reference f 1 "hi" }
+    T{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##load-reference f 2 "bye" }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##phi f 3 }
+    T{ ##allot f 1 64 byte-array }
+    T{ ##branch }
+} 3 test-bb
+
+1 get 1 2array
+2 get 2 2array 2array 3 get instructions>> first (>>inputs)
+
+0 { 1 2 } edges
+1 3 edge
+2 3 edge
+
+[ ] [ test-gc-checks ] unit-test
+
+H{
+    { 1 tagged-rep }
+    { 2 tagged-rep }
+    { 3 tagged-rep }
+} representations set
+
+[ ] [ cfg get insert-gc-checks drop ] unit-test
+[ t ] [ 2 get successors>> first instructions>> first ##phi? ] unit-test
+[ 2 ] [ 3 get instructions>> length ] unit-test
diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 737e956933..4d71bbe556 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -36,11 +36,17 @@ IN: compiler.cfg.gc-checks
 !   \      /
 !      bb
 
-: <gc-check> ( size -- bb )
-    [ <basic-block> ] dip
+! Any ##phi instructions at the start of bb are transplanted
+! into the gc-check block.
+
+: <gc-check> ( phis size -- bb )
+    [ <basic-block> ] 2dip
     [
-        cc<= int-rep next-vreg-rep int-rep next-vreg-rep
-        ##check-nursery-branch
+        [ % ]
+        [
+            cc<= int-rep next-vreg-rep int-rep next-vreg-rep
+            ##check-nursery-branch
+        ] bi*
     ] V{ } make >>instructions ;
 
 : wipe-locs ( uninitialized-locs -- )
@@ -55,7 +61,7 @@ IN: compiler.cfg.gc-checks
     [ [ wipe-locs ] [ ##call-gc ] bi* ##branch ] V{ } make
     >>instructions t >>unlikely? ;
 
-:: insert-guard ( check body bb -- )
+:: insert-guard ( body check bb -- )
     bb predecessors>> check (>>predecessors)
     V{ bb body }      check (>>successors)
 
@@ -66,8 +72,8 @@ IN: compiler.cfg.gc-checks
 
     check predecessors>> [ bb check update-successors ] each ;
 
-: (insert-gc-check) ( size uninitialized-locs gc-roots bb -- )
-    [ [ <gc-check> ] 2dip <gc-call> ] dip insert-guard ;
+: (insert-gc-check) ( uninitialized-locs gc-roots phis size bb -- )
+    [ [ <gc-call> ] 2dip <gc-check> ] dip insert-guard ;
 
 GENERIC: allocation-size* ( insn -- n )
 
@@ -82,14 +88,22 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
     [ ##allocation? ] filter
     [ allocation-size* data-alignment get align ] map-sum ;
 
+: gc-live-in ( bb -- vregs )
+    [ live-in keys ] [ instructions>> [ ##phi? ] filter [ dst>> ] map ] bi
+    append ;
+
 : live-tagged ( bb -- vregs )
-    live-in keys [ rep-of tagged-rep? ] filter ;
+    gc-live-in [ rep-of tagged-rep? ] filter ;
+
+: remove-phis ( bb -- phis )
+    [ [ ##phi? ] partition ] change-instructions drop ;
 
 : insert-gc-check ( bb -- )
     {
-        [ allocation-size ]
         [ uninitialized-locs ]
         [ live-tagged ]
+        [ remove-phis ]
+        [ allocation-size ]
         [ ]
     } cleave
     (insert-gc-check) ;