From 387f6df9e5068a981dd4c5f40f4fff6f175fba3c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Jun 2009 00:24:51 -0500
Subject: [PATCH] compiler.cfg.linear-scan: Debugging resolve pass
---
.../cfg/linear-scan/debugger/debugger.factor | 9 ++-
.../cfg/linear-scan/linear-scan-tests.factor | 7 +--
.../linear-scan/resolve/resolve-tests.factor | 61 ++++++++++++++++++-
.../cfg/linear-scan/resolve/resolve.factor | 30 ++++++---
4 files changed, 89 insertions(+), 18 deletions(-)
diff --git a/basis/compiler/cfg/linear-scan/debugger/debugger.factor b/basis/compiler/cfg/linear-scan/debugger/debugger.factor
index dad87b62ae..401241722f 100644
--- a/basis/compiler/cfg/linear-scan/debugger/debugger.factor
+++ b/basis/compiler/cfg/linear-scan/debugger/debugger.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences sets arrays math strings fry
-prettyprint compiler.cfg.linear-scan.live-intervals
-compiler.cfg.linear-scan.allocation ;
+namespaces prettyprint compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.allocation compiler.cfg ;
IN: compiler.cfg.linear-scan.debugger
: check-assigned ( live-intervals -- )
@@ -34,3 +34,6 @@ IN: compiler.cfg.linear-scan.debugger
: live-intervals. ( seq -- )
[ interval-picture ] map simple-table. ;
+
+: test-bb ( insns n -- )
+ [ <basic-block> swap >>number swap >>instructions ] keep set ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index b4f6302049..1f8112a893 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1417,9 +1417,6 @@ USING: math.private ;
intersect-inactive
] unit-test
-: test-bb ( insns n -- )
- [ <basic-block> swap >>number swap >>instructions ] keep set ;
-
! Bug in live spill slots calculation
V{ T{ ##prologue } T{ ##branch } } 0 test-bb
@@ -1489,7 +1486,9 @@ SYMBOL: linear-scan-result
flatten-cfg 1array mr.
] unit-test ;
-{ 1 2 } test-linear-scan-on-cfg
+! This test has a critical edge -- do we care about these?
+
+! { 1 2 } test-linear-scan-on-cfg
! Bug in inactive interval handling
! [ rot dup [ -rot ] when ]
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
index 475e8ea167..3e98d6c9f0 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
@@ -1,6 +1,65 @@
+USING: accessors arrays compiler.cfg compiler.cfg.instructions
+compiler.cfg.linear-scan.debugger
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.numbering
+compiler.cfg.linear-scan.resolve compiler.cfg.predecessors
+compiler.cfg.registers compiler.cfg.rpo cpu.architecture kernel
+namespaces tools.test vectors ;
IN: compiler.cfg.linear-scan.resolve.tests
-USING: compiler.cfg.linear-scan.resolve tools.test arrays kernel ;
[ { 1 2 3 4 5 6 } ] [
{ 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
+] unit-test
+
+V{
+ T{ ##peek f V int-regs 0 D 0 }
+ T{ ##branch }
+} 0 test-bb
+
+V{
+ T{ ##replace f V int-regs 0 D 1 }
+ T{ ##return }
+} 1 test-bb
+
+1 get 1vector 0 get (>>successors)
+
+cfg new 0 get >>entry
+compute-predecessors
+dup reverse-post-order number-instructions
+drop
+
+CONSTANT: test-live-interval-1
+T{ live-interval
+ { start 0 }
+ { end 6 }
+ { uses V{ 0 6 } }
+ { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
+ { spill-to 0 }
+ { vreg V int-regs 0 }
+}
+
+[ f ] [
+ 0 get test-live-interval-1 spill-to
+] unit-test
+
+[ 0 ] [
+ 1 get test-live-interval-1 spill-to
+] unit-test
+
+CONSTANT: test-live-interval-2
+T{ live-interval
+ { start 0 }
+ { end 6 }
+ { uses V{ 0 6 } }
+ { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
+ { reload-from 0 }
+ { vreg V int-regs 0 }
+}
+
+[ 0 ] [
+ 0 get test-live-interval-2 reload-from
+] unit-test
+
+[ f ] [
+ 1 get test-live-interval-2 reload-from
] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index 002914cd7b..55a2eab41b 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences
classes.tuple classes.parser parser fry words make arrays
-combinators compiler.cfg.linear-scan.live-intervals
+locals combinators compiler.cfg.linear-scan.live-intervals
compiler.cfg.liveness compiler.cfg.instructions ;
IN: compiler.cfg.linear-scan.resolve
@@ -24,23 +24,36 @@ SYNTAX: OPERATION:
>>
+: reload-from ( bb live-interval -- n/f )
+ 2dup [ block-from ] [ start>> ] bi* =
+ [ nip reload-from>> ] [ 2drop f ] if ;
+
+: spill-to ( bb live-interval -- n/f )
+ 2dup [ block-to ] [ end>> ] bi* =
+ [ nip spill-to>> ] [ 2drop f ] if ;
+
OPERATION: memory->memory spill-to>> reload-from>>
OPERATION: register->memory reg>> reload-from>>
OPERATION: memory->register spill-to>> reg>>
OPERATION: register->register reg>> reg>>
-: add-mapping ( from to -- )
- dup reload-from>> [
- over spill-to>> [ memory->memory ] [ register->memory ] if
+:: add-mapping ( bb1 bb2 li1 li2 -- )
+ bb2 li2 reload-from [
+ bb1 li1 spill-to
+ [ li1 li2 memory->memory ]
+ [ li1 li2 register->memory ] if
] [
- over spill-to>> [ memory->register ] [ register->register ] if
+ bb1 li1 spill-to
+ [ li1 li2 memory->register ]
+ [ li1 li2 register->register ] if
] if ;
: resolve-value-data-flow ( bb to vreg -- )
+ [ 2dup ] dip
live-intervals get at
[ [ block-to ] dip child-interval-at ]
[ [ block-from ] dip child-interval-at ]
- bi-curry bi* 2dup eq? [ 2drop ] [ add-mapping ] if ;
+ bi-curry bi* 2dup eq? [ 2drop 2drop ] [ add-mapping ] if ;
: compute-mappings ( bb to -- mappings )
[
@@ -50,9 +63,6 @@ OPERATION: register->register reg>> reg>>
GENERIC: >insn ( operation -- )
-: >operation< ( operation -- from to reg-class )
- [ from>> ] [ to>> ] [ reg-class>> ] tri ; inline
-
M: memory->memory >insn
[ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
@@ -80,7 +90,7 @@ M: register->register >insn
[ predecessors>> length 1 >= ] bi* and ; inline
: insert-position/join ( from to -- before after )
- drop instructions>> { } ;
+ drop instructions>> dup pop 1array ;
: insert-position ( bb to -- before after )
{