From c0d89b061e574b2adc6a6b2eff9460b3116be2e0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 19 Oct 2008 01:10:21 -0500
Subject: [PATCH] Fixing register allocator prspilling
---
basis/compiler/cfg/builder/builder.factor | 3 +-
basis/compiler/cfg/cfg.factor | 4 +-
basis/compiler/cfg/debugger/debugger.factor | 4 +-
.../cfg/instructions/instructions.factor | 14 +-
.../linear-scan/allocation/allocation.factor | 103 ++++----
.../linear-scan/assignment/assignment.factor | 18 +-
.../cfg/linear-scan/linear-scan-tests.factor | 222 ++++++++++++++++--
.../cfg/linear-scan/linear-scan.factor | 11 +-
.../live-intervals/live-intervals.factor | 21 +-
.../cfg/stack-frame/stack-frame.factor | 29 +--
.../expressions/expressions.factor | 23 ++
.../cfg/value-numbering/graph/graph.factor | 32 +++
.../value-numbering/liveness/liveness.factor | 38 +++
.../propagate/propagate.factor | 58 +++++
.../value-numbering/value-numbering.factor | 46 ++++
basis/compiler/codegen/codegen.factor | 20 +-
basis/compiler/compiler.factor | 24 +-
17 files changed, 519 insertions(+), 151 deletions(-)
create mode 100644 basis/compiler/cfg/value-numbering/expressions/expressions.factor
create mode 100644 basis/compiler/cfg/value-numbering/graph/graph.factor
create mode 100644 basis/compiler/cfg/value-numbering/liveness/liveness.factor
create mode 100644 basis/compiler/cfg/value-numbering/propagate/propagate.factor
create mode 100644 basis/compiler/cfg/value-numbering/value-numbering.factor
diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 8b5202dd63..e5f91d19df 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -329,8 +329,7 @@ M: #terminate emit-node
stack-frame new
swap
[ return>> return-size >>return ]
- [ alien-parameters parameter-sizes drop >>params ] bi
- dup [ params>> ] [ return>> ] bi + >>size ;
+ [ alien-parameters parameter-sizes drop >>params ] bi ;
: alien-stack-frame ( params -- )
<alien-stack-frame> ##stack-frame ;
diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor
index e32ad47890..8ce3260153 100644
--- a/basis/compiler/cfg/cfg.factor
+++ b/basis/compiler/cfg/cfg.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces assocs sequences sets fry ;
+USING: kernel arrays accessors namespaces assocs sequences sets fry ;
IN: compiler.cfg
TUPLE: cfg entry word label ;
@@ -19,7 +19,7 @@ successors ;
V{ } clone >>instructions
V{ } clone >>successors ;
-TUPLE: mr instructions word label ;
+TUPLE: mr { instructions array } word label spill-counts ;
: <mr> ( instructions word label -- mr )
mr new
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index f7591ba105..a04670ddab 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -4,7 +4,7 @@ USING: kernel words sequences quotations namespaces io
accessors prettyprint prettyprint.config
compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.linearization
-compiler.cfg.stack-frame ;
+compiler.cfg.stack-frame compiler.cfg.linear-scan ;
IN: compiler.cfg.debugger
GENERIC: test-cfg ( quot -- cfgs )
@@ -16,7 +16,7 @@ M: word test-cfg
[ build-tree-from-word nip optimize-tree ] keep build-cfg ;
: test-mr ( quot -- mrs )
- test-cfg [ build-mr build-stack-frame ] map ;
+ test-cfg [ build-mr ] map ;
: mr. ( mrs -- )
[
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 1335a082bf..689650f0a4 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -19,10 +19,10 @@ INSN: ##inc-r { n integer } ;
! Subroutine calls
TUPLE: stack-frame
-{ size integer }
{ params integer }
{ return integer }
-{ total-size integer } ;
+{ total-size integer }
+spill-counts ;
INSN: ##stack-frame stack-frame ;
: ##simple-stack-frame ( -- ) T{ stack-frame } ##stack-frame ;
@@ -125,8 +125,8 @@ M: _cond-branch uses-vregs src>> 1array ;
M: _if-intrinsic defs-vregs intrinsic-defs-vregs ;
M: _if-intrinsic uses-vregs intrinsic-uses-vregs ;
-INSN: _spill-integer { src vreg } n ;
-INSN: _reload-integer { dst vreg } n ;
-
-INSN: _spill-float { src vreg } n ;
-INSN: _reload-float { dst vreg } n ;
+! These instructions operate on machine registers and not
+! virtual registers
+INSN: _spill src class n ;
+INSN: _reload dst class n ;
+INSN: _spill-counts counts ;
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 5433908768..1b49609387 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces sequences math math.order kernel assocs
-accessors vectors fry heaps cpu.architecture
+accessors vectors fry heaps cpu.architecture combinators
compiler.cfg.registers
compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation
@@ -24,25 +24,11 @@ SYMBOL: active-intervals
: delete-active ( live-interval -- )
active-intervals get delete ;
-: expired-interval? ( n interval -- ? )
- [ end>> ] [ start>> ] bi or > ;
-
: expire-old-intervals ( n -- )
active-intervals get
- [ expired-interval? ] with partition
+ [ end>> > ] with partition
[ [ deallocate-register ] each ] [ active-intervals set ] bi* ;
-: expire-old-uses ( n -- )
- active-intervals get
- swap '[
- uses>> [
- dup peek _ < [ pop* ] [ drop ] if
- ] unless-empty
- ] each ;
-
-: update-state ( live-interval -- )
- start>> [ expire-old-intervals ] [ expire-old-uses ] bi ;
-
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
@@ -64,8 +50,25 @@ SYMBOL: progress
[ [ start>> ] keep ] { } map>assoc
unhandled-intervals get heap-push-all ;
-: assign-free-register ( live-interval registers -- )
- pop >>reg add-active ;
+! Splitting
+: find-use ( live-interval n quot -- i elt )
+ [ uses>> ] 2dip curry find ; inline
+
+: split-before ( live-interval i -- before )
+ [ clone dup uses>> ] dip
+ [ head >>uses ] [ 1- swap nth >>end ] 2bi ;
+
+: split-after ( live-interval i -- after )
+ [ clone dup uses>> ] dip
+ [ tail >>uses ] [ swap nth >>start ] 2bi
+ f >>reg ;
+
+: split-interval ( live-interval n -- before after )
+ [ drop ] [ [ > ] find-use drop ] 2bi
+ [ split-before ] [ split-after ] 2bi ;
+
+: record-split ( live-interval before after -- )
+ [ >>split-before ] [ >>split-after ] bi* drop ;
! Spilling
SYMBOL: spill-counts
@@ -73,37 +76,20 @@ SYMBOL: spill-counts
: next-spill-location ( reg-class -- n )
spill-counts get [ dup 1+ ] change-at ;
-: interval-to-spill ( -- live-interval )
+: interval-to-spill ( active-intervals current -- live-interval )
#! We spill the interval with the most distant use location.
- active-intervals get
- [ uses>> empty? not ] filter
- unclip-slice [
- [ [ uses>> peek ] bi@ > ] most
- ] reduce ;
-
-: check-split ( live-interval -- )
- [ start>> ] [ end>> ] bi = [ "Cannot split any further" throw ] when ;
-
-: split-interval ( live-interval -- before after )
- #! Split the live interval at the location of its first use.
- #! 'Before' now starts and ends on the same instruction.
- [ check-split ]
- [ clone [ uses>> delete-all ] [ dup start>> >>end ] bi ]
- [ clone f >>reg dup uses>> peek >>start ]
- tri ;
-
-: record-split ( live-interval before after -- )
- [ >>split-before ] [ >>split-after ] bi* drop ;
+ start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
+ unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ;
: assign-spill ( before after -- before after )
#! If it has been spilled already, reuse spill location.
- USE: cpu.architecture ! XXX
over reload-from>>
- [ int-regs next-spill-location ] unless*
+ [ over vreg>> reg-class>> next-spill-location ] unless*
tuck [ >>spill-to ] [ >>reload-from ] 2bi* ;
-: split-and-spill ( live-interval -- before after )
- dup split-interval [ record-split ] [ assign-spill ] 2bi ;
+: split-and-spill ( new existing -- before after )
+ dup rot start>> split-interval
+ [ record-split ] [ assign-spill ] 2bi ;
: reuse-register ( new existing -- )
reg>> >>reg add-active ;
@@ -114,30 +100,30 @@ SYMBOL: spill-counts
#! interval, then process the new interval and the tail end
#! of the existing interval again.
[ reuse-register ]
- [ delete-active ]
- [ split-and-spill [ drop ] [ add-unhandled ] bi* ] tri ;
+ [ nip delete-active ]
+ [ split-and-spill [ drop ] [ add-unhandled ] bi* ] 2tri ;
: spill-new ( new existing -- )
#! Our new interval will be used after the active interval
#! with the most distant use location. Split the new
#! interval, then process both parts of the new interval
#! again.
- [ split-and-spill add-unhandled ] dip spill-existing ;
+ [ dup split-and-spill add-unhandled ] dip spill-existing ;
: spill-existing? ( new existing -- ? )
- over uses>> empty? [ 2drop t ] [ [ uses>> peek ] bi@ < ] if ;
+ #! Test if 'new' will be used before 'existing'.
+ over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
-: assign-blocked-register ( live-interval -- )
- interval-to-spill
- 2dup spill-existing?
- [ spill-existing ] [ spill-new ] if ;
+: assign-blocked-register ( new -- )
+ [ active-intervals get ] keep interval-to-spill
+ 2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
-: assign-register ( live-interval -- )
- dup vreg>> free-registers-for [
- assign-blocked-register
- ] [
- assign-free-register
- ] if-empty ;
+: assign-free-register ( new registers -- )
+ pop >>reg add-active ;
+
+: assign-register ( new -- )
+ dup vreg>> free-registers-for
+ [ assign-blocked-register ] [ assign-free-register ] if-empty ;
! Main loop
: init-allocator ( registers -- )
@@ -148,7 +134,10 @@ SYMBOL: spill-counts
-1 progress set ;
: handle-interval ( live-interval -- )
- [ start>> progress set ] [ update-state ] [ assign-register ] tri ;
+ [ start>> progress set ]
+ [ start>> expire-old-intervals ]
+ [ assign-register ]
+ tri ;
: (allocate-registers) ( -- )
unhandled-intervals get [ handle-interval ] slurp-heap ;
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 541ab606a2..876bb6ba6c 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -35,13 +35,8 @@ SYMBOL: unhandled-intervals
[ add-unhandled ] each ;
: insert-spill ( live-interval -- )
- [ reg>> ] [ spill-to>> ] [ vreg>> reg-class>> ] tri
- over [
- {
- { int-regs [ _spill-integer ] }
- { double-float-regs [ _spill-float ] }
- } case
- ] [ 3drop ] if ;
+ [ reg>> ] [ vreg>> reg-class>> ] [ spill-to>> ] tri
+ dup [ _spill ] [ 3drop ] if ;
: expire-old-intervals ( n -- )
active-intervals get
@@ -50,13 +45,8 @@ SYMBOL: unhandled-intervals
[ insert-spill ] each ;
: insert-reload ( live-interval -- )
- [ reg>> ] [ reload-from>> ] [ vreg>> reg-class>> ] tri
- over [
- {
- { int-regs [ _reload-integer ] }
- { double-float-regs [ _reload-float ] }
- } case
- ] [ 3drop ] if ;
+ [ reg>> ] [ vreg>> reg-class>> ] [ reload-from>> ] tri
+ dup [ _reload ] [ 3drop ] if ;
: activate-new-intervals ( n -- )
#! Any live intervals which start on the current instruction
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 1784886154..88d7bcdbcf 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -7,49 +7,209 @@ compiler.cfg.instructions
compiler.cfg.registers
compiler.cfg.linear-scan
compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.debugger ;
+[ 7 ] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+ { start 0 }
+ { end 10 }
+ { uses V{ 0 1 3 7 10 } }
+ }
+ 4 [ >= ] find-use nip
+] unit-test
+
+[ 4 ] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+ { start 0 }
+ { end 10 }
+ { uses V{ 0 1 3 4 10 } }
+ }
+ 4 [ >= ] find-use nip
+] unit-test
+
+[ f ] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+ { start 0 }
+ { end 10 }
+ { uses V{ 0 1 3 4 10 } }
+ }
+ 100 [ >= ] find-use nip
+] unit-test
+
+[
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 1 }
+ { uses V{ 0 1 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 5 }
+ { end 5 }
+ { uses V{ 5 } }
+ }
+] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 5 }
+ { uses V{ 0 1 5 } }
+ } 2 split-interval
+] unit-test
+
+[
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 0 }
+ { uses V{ 0 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 1 }
+ { end 5 }
+ { uses V{ 1 5 } }
+ }
+] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 5 }
+ { uses V{ 0 1 5 } }
+ } 0 split-interval
+] unit-test
+
+[
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 3 }
+ { end 10 }
+ { uses V{ 3 10 } }
+ }
+] [
+ {
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 1 }
+ { end 15 }
+ { uses V{ 1 3 7 10 15 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 3 }
+ { end 8 }
+ { uses V{ 3 4 8 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 3 }
+ { end 10 }
+ { uses V{ 3 10 } }
+ }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 5 }
+ { end 5 }
+ { uses V{ 5 } }
+ }
+ interval-to-spill
+] unit-test
+
+[ t ] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 5 }
+ { end 15 }
+ { uses V{ 5 10 15 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 1 }
+ { end 20 }
+ { uses V{ 1 20 } }
+ }
+ spill-existing?
+] unit-test
+
+[ f ] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 5 }
+ { end 15 }
+ { uses V{ 5 10 15 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 1 }
+ { end 20 }
+ { uses V{ 1 7 20 } }
+ }
+ spill-existing?
+] unit-test
+
+[ t ] [
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 5 }
+ { end 5 }
+ { uses V{ 5 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 1 }
+ { end 20 }
+ { uses V{ 1 7 20 } }
+ }
+ spill-existing?
+] unit-test
+
[ ] [
{
- T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
+ T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
}
- H{ { f { "A" } } }
+ H{ { int-regs { "A" } } }
check-linear-scan
] unit-test
[ ] [
{
- T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 10 } { uses V{ 10 } } }
- T{ live-interval { vreg T{ vreg { n 2 } } } { start 11 } { end 20 } { uses V{ 20 } } }
+ T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 10 } { uses V{ 0 10 } } }
+ T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 11 } { end 20 } { uses V{ 11 20 } } }
}
- H{ { f { "A" } } }
+ H{ { int-regs { "A" } } }
check-linear-scan
] unit-test
[ ] [
{
- T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
- T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 60 } { uses V{ 60 } } }
+ T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
+ T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 60 } { uses V{ 30 60 } } }
}
- H{ { f { "A" } } }
+ H{ { int-regs { "A" } } }
check-linear-scan
] unit-test
[ ] [
{
- T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
- T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 200 } { uses V{ 200 } } }
+ T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
+ T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 200 } { uses V{ 30 200 } } }
}
- H{ { f { "A" } } }
+ H{ { int-regs { "A" } } }
check-linear-scan
] unit-test
[
{
- T{ live-interval { vreg T{ vreg { n 1 } } } { start 0 } { end 100 } { uses V{ 100 } } }
- T{ live-interval { vreg T{ vreg { n 2 } } } { start 30 } { end 100 } { uses V{ 100 } } }
+ T{ live-interval { vreg T{ vreg { n 1 } { reg-class int-regs } } } { start 0 } { end 100 } { uses V{ 0 100 } } }
+ T{ live-interval { vreg T{ vreg { n 2 } { reg-class int-regs } } } { start 30 } { end 100 } { uses V{ 30 100 } } }
}
- H{ { f { "A" } } }
+ H{ { int-regs { "A" } } }
check-linear-scan
] must-fail
@@ -81,15 +241,15 @@ SYMBOL: max-uses
max-insns get [ dup ] H{ } map>assoc available set
[
live-interval new
- swap f swap vreg boa >>vreg
+ swap int-regs swap vreg boa >>vreg
max-uses get random 2 max [ not-taken ] replicate natural-sort
- unclip [ >vector >>uses ] [ >>start ] bi*
- dup uses>> first >>end
+ [ >>uses ] [ first >>start ] bi
+ dup uses>> peek >>end
] map
] with-scope ;
: random-test ( num-intervals max-uses max-registers max-insns -- )
- over >r random-live-intervals r> f associate check-linear-scan ;
+ over >r random-live-intervals r> int-regs associate check-linear-scan ;
[ ] [ 30 2 1 60 random-test ] unit-test
[ ] [ 60 2 2 60 random-test ] unit-test
@@ -118,3 +278,29 @@ USING: math.private compiler.cfg.debugger ;
} clone
1array (linear-scan) first regs>> values all-equal?
] unit-test
+
+[ 0 1 ] [
+ {
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+ { start 0 }
+ { end 5 }
+ { uses V{ 0 1 5 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 2 } } }
+ { start 3 }
+ { end 4 }
+ { uses V{ 3 4 } }
+ }
+ T{ live-interval
+ { vreg T{ vreg { reg-class int-regs } { n 3 } } }
+ { start 2 }
+ { end 6 }
+ { uses V{ 2 4 6 } }
+ }
+ } [ clone ] map
+ H{ { int-regs { "A" "B" } } }
+ allocate-registers
+ first split-before>> [ start>> ] [ end>> ] bi
+] unit-test
diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index 4628728299..855f2a6648 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -1,8 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces
+USING: kernel accessors namespaces make
cpu.architecture
compiler.cfg
+compiler.cfg.instructions
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation
compiler.cfg.linear-scan.assignment ;
@@ -28,6 +29,10 @@ IN: compiler.cfg.linear-scan
: linear-scan ( mr -- mr' )
[
- [ (linear-scan) ] change-instructions
- ! spill-counts get >>spill-counts
+ [
+ [
+ (linear-scan) %
+ spill-counts get _spill-counts
+ ] { } make
+ ] change-instructions
] with-scope ;
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 a0699b80bd..3ab7e03783 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -4,16 +4,20 @@ USING: namespaces kernel assocs accessors sequences math fry
compiler.cfg.instructions compiler.cfg.registers ;
IN: compiler.cfg.linear-scan.live-intervals
-TUPLE: live-interval < identity-tuple
+TUPLE: live-interval
vreg
reg spill-to reload-from split-before split-after
start end uses ;
+: add-use ( n live-interval -- )
+ [ (>>end) ] [ uses>> push ] 2bi ;
+
: <live-interval> ( start vreg -- live-interval )
live-interval new
+ V{ } clone >>uses
swap >>vreg
- swap >>start
- V{ } clone >>uses ;
+ over >>start
+ [ add-use ] keep ;
M: live-interval hashcode*
nip [ start>> ] [ end>> 1000 * ] bi + ;
@@ -24,25 +28,18 @@ M: live-interval clone
! Mapping from vreg to live-interval
SYMBOL: live-intervals
-: add-use ( n vreg live-intervals -- )
- at [ (>>end) ] [ uses>> push ] 2bi ;
-
: new-live-interval ( n vreg live-intervals -- )
2dup key? [ "Multiple defs" throw ] when
[ [ <live-interval> ] keep ] dip set-at ;
: compute-live-intervals* ( insn n -- )
live-intervals get
- [ [ uses-vregs ] 2dip '[ _ swap _ add-use ] each ]
+ [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ]
[ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
3bi ;
-: finalize-live-intervals ( assoc -- seq' )
- #! Reverse uses lists so that we can pop values off.
- values dup [ uses>> reverse-here ] each ;
-
: compute-live-intervals ( instructions -- live-intervals )
H{ } clone [
live-intervals set
[ compute-live-intervals* ] each-index
- ] keep finalize-live-intervals ;
+ ] keep values ;
diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index 7a419779a3..4443ea64f7 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces accessors math.order assocs kernel sequences
-combinators make compiler.cfg.instructions
+combinators make cpu.architecture compiler.cfg.instructions
compiler.cfg.instructions.syntax compiler.cfg.registers ;
IN: compiler.cfg.stack-frame
@@ -9,35 +9,31 @@ SYMBOL: frame-required?
SYMBOL: spill-counts
-: init-stack-frame-builder ( -- )
- frame-required? off
- T{ stack-frame } clone stack-frame set ;
-
GENERIC: compute-stack-frame* ( insn -- )
: max-stack-frame ( frame1 frame2 -- frame3 )
- {
- [ [ size>> ] bi@ max ]
- [ [ params>> ] bi@ max ]
- [ [ return>> ] bi@ max ]
- [ [ total-size>> ] bi@ max ]
- } 2cleave
- stack-frame boa ;
+ [ stack-frame new ] 2dip
+ [ [ params>> ] bi@ max >>params ]
+ [ [ return>> ] bi@ max >>return ]
+ 2bi ;
M: ##stack-frame compute-stack-frame*
frame-required? on
stack-frame>> stack-frame [ max-stack-frame ] change ;
-M: _spill-integer compute-stack-frame*
+M: _spill compute-stack-frame*
drop frame-required? on ;
-M: _spill-float compute-stack-frame*
- drop frame-required? on ;
+M: _spill-counts compute-stack-frame*
+ counts>> stack-frame get (>>spill-counts) ;
M: insn compute-stack-frame* drop ;
: compute-stack-frame ( insns -- )
- [ compute-stack-frame* ] each ;
+ frame-required? off
+ T{ stack-frame } clone stack-frame set
+ [ compute-stack-frame* ] each
+ stack-frame get dup stack-frame-size >>total-size drop ;
GENERIC: insert-pro/epilogues* ( insn -- )
@@ -56,7 +52,6 @@ M: insn insert-pro/epilogues* , ;
: build-stack-frame ( mr -- mr )
[
- init-stack-frame-builder
[
[ compute-stack-frame ]
[ insert-pro/epilogues ]
diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
new file mode 100644
index 0000000000..f8fb0aab29
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.expressions
+
+! Referentially-transparent expressions.
+
+TUPLE: expr op ;
+
+! op is always %peek
+TUPLE: peek-expr < expr loc ;
+TUPLE: unary-expr < expr in ;
+TUPLE: load-literal-expr < expr obj ;
+
+GENERIC: >expr ( insn -- expr )
+
+M: ##peek >expr
+ [ class ] [ loc>> ] bi peek-expr boa ;
+
+M: ##load-literal >expr
+ [ class ] [ obj>> ] bi load-literal-expr boa ;
+
+M: ##unary >expr
+ [ class ] [ src>> vreg>vn ] bi unary-expr boa ;
diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor
new file mode 100644
index 0000000000..b0ae044fb7
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/graph/graph.factor
@@ -0,0 +1,32 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.graph
+
+SYMBOL: vn-counter
+
+: next-vn ( -- vn ) vn-counter [ dup 1 + ] change ;
+
+! biassoc mapping expressions to value numbers
+SYMBOL: exprs>vns
+
+: expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ;
+
+: vn>expr ( vn -- expr ) exprs>vns get value-at ;
+
+! biassoc mapping vregs to value numbers
+SYMBOL: vregs>vns
+
+: vreg>vn ( vreg -- vn ) vregs>vns get at ;
+
+: vn>vreg ( vn -- vreg ) vregs>vns get value-at ;
+
+: set-vn ( vn vreg -- ) vregs>vns get set-at ;
+
+: init-value-graph ( -- )
+ 0 vn-counter set
+ <bihash> exprs>vns set
+ <bihash> vregs>vns set ;
+
+: reset-value-graph ( -- )
+ exprs>vns get clear-assoc
+ vregs>vns get clear-assoc ;
diff --git a/basis/compiler/cfg/value-numbering/liveness/liveness.factor b/basis/compiler/cfg/value-numbering/liveness/liveness.factor
new file mode 100644
index 0000000000..c445c0835d
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/liveness/liveness.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.liveness
+
+! A set of VNs which are (transitively) used by side-effecting
+! instructions.
+SYMBOL: live-vns
+
+GENERIC: live-expr ( expr -- )
+
+: live-vn ( vn -- )
+ #! Mark a VN and all VNs used in its computation as live.
+ dup live-vns get key? [ drop ] [
+ [ live-vns get conjoin ] [ vn>expr live-expr ] bi
+ ] if ;
+
+M: peek-expr live-expr drop ;
+M: unary-expr live-expr in>> live-vn ;
+M: load-literal-expr live-expr in>> live-vn ;
+
+: live-vreg ( vreg -- ) vreg>vn live-vn ;
+
+: live? ( vreg -- ? )
+ dup vreg>vn tuck vn>vreg =
+ [ live-vns get key? ] [ drop f ] if ;
+
+: init-liveness ( -- )
+ H{ } clone live-vns set ;
+
+GENERIC: eliminate ( insn -- insn/f )
+
+: (eliminate) ( insn -- insn/f )
+ dup dst>> >vreg live? [ drop f ] unless ;
+
+M: ##peek eliminate (eliminate) ;
+M: ##unary eliminate (eliminate) ;
+M: ##load-literal eliminate (eliminate) ;
+M: insn eliminate ;
diff --git a/basis/compiler/cfg/value-numbering/propagate/propagate.factor b/basis/compiler/cfg/value-numbering/propagate/propagate.factor
new file mode 100644
index 0000000000..758d3f95e6
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/propagate/propagate.factor
@@ -0,0 +1,58 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering.propagate
+
+! If two vregs compute the same value, replace references to
+! the latter with the former.
+
+: resolve ( vreg -- vreg' ) vreg>vn vn>vreg ;
+
+GENERIC: propogate ( insn -- insn )
+
+M: ##cond-branch propagate [ resolve ] change-src ;
+
+M: ##unary propogate [ resolve ] change-src ;
+
+M: ##nullary propagate ;
+
+M: ##replace propagate [ resolve ] change-src ;
+
+M: ##inc-d propagate ;
+
+M: ##inc-r propagate ;
+
+M: ##stack-frame propagate ;
+
+M: ##call propagate ;
+
+M: ##jump propagate ;
+
+M: ##return propagate ;
+
+M: ##intrinsic propagate
+ [ [ resolve ] assoc-map ] change-defs-vregs
+ [ [ resolve ] assoc-map ] change-uses-vregs ;
+
+M: ##dispatch propagate [ resolve ] change-src ;
+
+M: ##dispatch-label propagate ;
+
+M: ##write-barrier propagate [ resolve ] change-src ;
+
+M: ##alien-invoke propagate ;
+
+M: ##alien-indirect propagate ;
+
+M: ##alien-callback propagate ;
+
+M: ##callback-return propagate ;
+
+M: ##prologue propagate ;
+
+M: ##epilogue propagate ;
+
+M: ##branch propagate ;
+
+M: ##if-intrinsic propagate
+ [ [ resolve ] assoc-map ] change-defs-vregs
+ [ [ resolve ] assoc-map ] change-uses-vregs ;
diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor
new file mode 100644
index 0000000000..81e8c40afd
--- /dev/null
+++ b/basis/compiler/cfg/value-numbering/value-numbering.factor
@@ -0,0 +1,46 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.cfg.value-numbering
+
+: insn>vn ( insn -- vn ) >expr simplify ; inline
+
+GENERIC: make-value-node ( insn -- )
+
+M: ##cond-branch make-value-node src>> live-vreg ;
+M: ##unary make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
+M: ##nullary make-value-node drop ;
+M: ##load-literal make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
+M: ##peek make-value-node [ insn>vn ] [ dst>> ] bi set-vn ;
+M: ##replace make-value-node reset-value-graph ;
+M: ##inc-d make-value-node reset-value-graph ;
+M: ##inc-r make-value-node reset-value-graph ;
+M: ##stack-frame make-value-node reset-value-graph ;
+M: ##call make-value-node reset-value-graph ;
+M: ##jump make-value-node reset-value-graph ;
+M: ##return make-value-node reset-value-graph ;
+M: ##intrinsic make-value-node uses-vregs [ live-vreg ] each ;
+M: ##dispatch make-value-node reset-value-graph ;
+M: ##dispatch-label make-value-node reset-value-graph ;
+M: ##allot make-value-node drop ;
+M: ##write-barrier make-value-node drop ;
+M: ##gc make-value-node reset-value-graph ;
+M: ##replace make-value-node reset-value-graph ;
+M: ##alien-invoke make-value-node reset-value-graph ;
+M: ##alien-indirect make-value-node reset-value-graph ;
+M: ##alien-callback make-value-node reset-value-graph ;
+M: ##callback-return make-value-node reset-value-graph ;
+M: ##prologue make-value-node reset-value-graph ;
+M: ##epilogue make-value-node reset-value-graph ;
+M: ##branch make-value-node reset-value-graph ;
+M: ##if-intrinsic make-value-node uses-vregs [ live-vreg ] each ;
+
+: init-value-numbering ( -- )
+ init-value-graph
+ init-expressions
+ init-liveness ;
+
+: value-numbering ( instructions -- instructions )
+ init-value-numbering
+ [ [ make-value-node ] [ propagate ] bi ] map
+ [ eliminate ] map
+ sift ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 44e2fd6bac..6c83c38355 100644
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -72,11 +72,7 @@ M: _label generate-insn
id>> lookup-label , ;
M: _prologue generate-insn
- stack-frame>>
- [ stack-frame set ]
- [ dup size>> stack-frame-size >>total-size drop ]
- [ total-size>> %prologue ]
- tri ;
+ stack-frame>> [ stack-frame set ] [ total-size>> %prologue ] bi ;
M: _epilogue generate-insn
stack-frame>> total-size>> %epilogue ;
@@ -439,3 +435,17 @@ M: ##alien-callback generate-insn
[ wrap-callback-quot %alien-callback ]
[ alien-return [ %unnest-stacks ] [ %callback-value ] if-void ]
tri ;
+
+M: _spill generate-insn
+ [ src>> ] [ n>> ] [ class>> ] tri {
+ { int-regs [ %spill-integer ] }
+ { double-float-regs [ %spill-float ] }
+ } case ;
+
+M: _reload generate-insn
+ [ dst>> ] [ n>> ] [ class>> ] tri {
+ { int-regs [ %reload-integer ] }
+ { double-float-regs [ %reload-float ] }
+ } case ;
+
+M: _spill-counts generate-insn drop ;
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index c94252e7ac..c02c1e8fda 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -61,18 +61,6 @@ SYMBOL: +failed+
: frontend ( word -- effect nodes )
[ build-tree-from-word ] [ fail ] recover optimize-tree ;
-: finish ( effect word -- )
- [ swap save-effect ]
- [ compiled-unxref ]
- [
- dup crossref?
- [
- dependencies get >alist
- generic-dependencies get >alist
- compiled-xref
- ] [ drop ] if
- ] tri ;
-
! Only switch this off for debugging.
SYMBOL: compile-dependencies?
@@ -92,6 +80,18 @@ t compile-dependencies? set-global
save-asm
] each ;
+: finish ( effect word -- )
+ [ swap save-effect ]
+ [ compiled-unxref ]
+ [
+ dup crossref?
+ [
+ dependencies get >alist
+ generic-dependencies get >alist
+ compiled-xref
+ ] [ drop ] if
+ ] tri ;
+
: (compile) ( word -- )
'[
_ {