From c53aca6016316583b790171c7ad9a690de77c3fa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Jun 2009 21:32:51 -0500
Subject: [PATCH] compiler.cfg.linear-scan: fix coalescing to take lifetime
 holes into account

---
 .../linear-scan/allocation/allocation.factor  | 39 ++++++-------------
 .../allocation/coalescing/coalescing.factor   | 14 ++++++-
 .../live-intervals/live-intervals.factor      | 22 +++++++++++
 3 files changed, 45 insertions(+), 30 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 3dcc925d7c..4425050d4b 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -2,44 +2,27 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs heaps kernel namespaces sequences fry math
 combinators arrays sorting compiler.utilities
+compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation.coalescing
 compiler.cfg.linear-scan.allocation.spilling
 compiler.cfg.linear-scan.allocation.splitting
 compiler.cfg.linear-scan.allocation.state ;
 IN: compiler.cfg.linear-scan.allocation
 
-: relevant-ranges ( new inactive -- new' inactive' )
-    ! Slice off all ranges of 'inactive' that precede the start of 'new'
-    [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
+: free-positions ( new -- assoc )
+    vreg>> reg-class>> registers get at [ 1/0. ] H{ } map>assoc ;
 
-: intersect-live-range ( range1 range2 -- n/f )
-    2dup [ from>> ] bi@ > [ swap ] when
-    2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
+: active-positions ( new -- assoc )
+    vreg>> active-intervals-for [ reg>> 0 ] H{ } map>assoc ;
 
-: intersect-live-ranges ( ranges1 ranges2 -- n )
-    {
-        { [ over empty? ] [ 2drop 1/0. ] }
-        { [ dup empty? ] [ 2drop 1/0. ] }
-        [
-            2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
-                drop
-                2dup [ first from>> ] bi@ <
-                [ [ rest-slice ] dip ] [ rest-slice ] if
-                intersect-live-ranges
-            ] if
-        ]
-    } cond ;
-
-: intersect-inactive ( new inactive -- n )
-    relevant-ranges intersect-live-ranges ;
+: inactive-positions ( new -- assoc )
+    dup vreg>> inactive-intervals-for
+    [ [ reg>> swap ] keep relevant-ranges intersect-live-ranges ]
+    with H{ } map>assoc ;
 
 : compute-free-pos ( new -- free-pos )
-    dup vreg>>
-    [ nip reg-class>> registers get at [ 1/0. ] H{ } map>assoc ]
-    [ inactive-intervals-for [ [ reg>> swap ] keep intersect-inactive ] with H{ } map>assoc ]
-    [ nip active-intervals-for [ reg>> 0 ] H{ } map>assoc ]
-    2tri 3array assoc-combine
-    >alist alist-max ;
+    [ free-positions ] [ inactive-positions ] [ active-positions ] tri
+    3array assoc-combine >alist alist-max ;
 
 : no-free-registers? ( result -- ? )
     second 0 = ; inline
diff --git a/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor b/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
index 99ed75dcbc..b2b9202204 100644
--- a/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/coalescing/coalescing.factor
@@ -1,18 +1,28 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences
+combinators.short-circuit
+compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation.state ;
 IN: compiler.cfg.linear-scan.allocation.coalescing
 
 : active-interval ( vreg -- live-interval )
     dup [ dup active-intervals-for [ vreg>> = ] with find nip ] when ;
 
+: intersects-inactive-intervals? ( live-interval -- ? )
+    dup vreg>> inactive-intervals-for
+    [ relevant-ranges intersect-live-ranges 1/0. = ] with all? ;
+
 : coalesce? ( live-interval -- ? )
-    [ start>> ] [ copy-from>> active-interval ] bi
-    dup [ end>> = ] [ 2drop f ] if ;
+    {
+        [ copy-from>> active-interval ]
+        [ [ start>> ] [ copy-from>> active-interval end>> ] bi = ]
+        [ intersects-inactive-intervals? ]
+    } 1&& ;
 
 : coalesce ( live-interval -- )
     dup copy-from>> active-interval
     [ [ add-active ] [ [ delete-active ] [ add-handled ] bi ] bi* ]
     [ reg>> >>reg drop ]
     2bi ;
+ 
\ No newline at end of file
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 c88f7fd21b..c67a7bb021 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -144,3 +144,25 @@ M: ##copy-float compute-live-intervals*
         live-intervals set
         <reversed> [ compute-live-intervals-step ] each
     ] keep values dup finish-live-intervals ;
+
+: relevant-ranges ( new inactive -- new' inactive' )
+    ! Slice off all ranges of 'inactive' that precede the start of 'new'
+    [ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
+
+: intersect-live-range ( range1 range2 -- n/f )
+    2dup [ from>> ] bi@ > [ swap ] when
+    2dup [ to>> ] [ from>> ] bi* >= [ nip from>> ] [ 2drop f ] if ;
+
+: intersect-live-ranges ( ranges1 ranges2 -- n )
+    {
+        { [ over empty? ] [ 2drop 1/0. ] }
+        { [ dup empty? ] [ 2drop 1/0. ] }
+        [
+            2dup [ first ] bi@ intersect-live-range dup [ 2nip ] [
+                drop
+                2dup [ first from>> ] bi@ <
+                [ [ rest-slice ] dip ] [ rest-slice ] if
+                intersect-live-ranges
+            ] if
+        ]
+    } cond ;