From 14d8696f40c20b2d7107eddedf879a2881b6da1e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 19 Oct 2008 03:34:42 -0500
Subject: [PATCH] Oops, don't mix register classes in active set
---
basis/compiler/cfg/debugger/debugger.factor | 2 +-
.../linear-scan/allocation/allocation.factor | 24 +++--
basis/compiler/tests/templates.factor | 91 ++++++++++++++++++-
.../cpu/x86/architecture/architecture.factor | 18 +++-
4 files changed, 121 insertions(+), 14 deletions(-)
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index a04670ddab..6665564c91 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -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 ] map ;
+ test-cfg [ build-mr linear-scan build-stack-frame ] map ;
: mr. ( mrs -- )
[
diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index 1b49609387..9402e4d841 100644
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -18,16 +18,22 @@ SYMBOL: free-registers
! Vector of active live intervals
SYMBOL: active-intervals
+: active-intervals-for ( vreg -- seq )
+ reg-class>> active-intervals get at ;
+
: add-active ( live-interval -- )
- active-intervals get push ;
+ dup vreg>> active-intervals-for push ;
: delete-active ( live-interval -- )
- active-intervals get delete ;
+ dup vreg>> active-intervals-for delq ;
: expire-old-intervals ( n -- )
- active-intervals get
- [ end>> > ] with partition
- [ [ deallocate-register ] each ] [ active-intervals set ] bi* ;
+ active-intervals swap '[
+ [
+ [ end>> _ < ] partition
+ [ [ deallocate-register ] each ] dip
+ ] assoc-map
+ ] change ;
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
@@ -115,7 +121,7 @@ SYMBOL: spill-counts
over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ;
: assign-blocked-register ( new -- )
- [ active-intervals get ] keep interval-to-spill
+ [ dup vreg>> active-intervals-for ] keep interval-to-spill
2dup spill-existing? [ spill-existing ] [ spill-new ] if ;
: assign-free-register ( new registers -- )
@@ -126,11 +132,13 @@ SYMBOL: spill-counts
[ assign-blocked-register ] [ assign-free-register ] if-empty ;
! Main loop
+: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline
+
: init-allocator ( registers -- )
- V{ } clone active-intervals set
<min-heap> unhandled-intervals set
[ reverse >vector ] assoc-map free-registers set
- H{ { int-regs 0 } { double-float-regs 0 } } clone spill-counts set
+ reg-classes [ 0 ] { } map>assoc spill-counts set
+ reg-classes [ V{ } clone ] { } map>assoc active-intervals set
-1 progress set ;
: handle-interval ( live-interval -- )
diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor
index c8baaea164..a979a19e83 100644
--- a/basis/compiler/tests/templates.factor
+++ b/basis/compiler/tests/templates.factor
@@ -101,7 +101,6 @@ unit-test
] [ define-temp ] with-compilation-unit drop
] unit-test
-
! Test how dispatch handles the end of a basic block
: try-breaking-dispatch ( n a b -- a b str )
float+ swap { [ "hey" ] [ "bye" ] } dispatch ;
@@ -189,7 +188,7 @@ TUPLE: my-tuple ;
] unit-test
! Regression
-: a-dummy ( -- ) drop "hi" print ;
+: a-dummy ( a -- ) drop "hi" print ;
[ ] [
1 [
@@ -245,8 +244,96 @@ TUPLE: my-tuple ;
[ dup float+ ]
} cleave ;
+[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
+[ 1.0 float-spill-bug ] unit-test
+
[ t ] [ \ float-spill-bug compiled>> ] unit-test
+: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
+ {
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ [ dup float+ ]
+ [ float>fixnum dup fixnum+fast ]
+ } cleave ;
+
+[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
+[ 1.0 float-fixnum-spill-bug ] unit-test
+
+[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
+
! Regression
: dispatch-alignment-regression ( -- c )
{ tuple vector } 3 slot { word } declare
diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor
index bfcb79d41d..3b48610fe7 100644
--- a/basis/cpu/x86/architecture/architecture.factor
+++ b/basis/cpu/x86/architecture/architecture.factor
@@ -15,12 +15,24 @@ HOOK: stack-reg cpu ( -- reg )
: stack@ ( n -- op ) stack-reg swap [+] ;
+: spill-integer-base ( stack-frame -- n )
+ [ params>> ] [ return>> ] bi + ;
+
: spill-integer@ ( n -- op )
- cells stack-frame get [ params>> ] [ return>> ] bi + + stack@ ;
+ cells
+ stack-frame get spill-integer-base
+ + stack@ ;
+
+: spill-float-base ( stack-frame -- n )
+ [ spill-counts>> int-regs swap at int-regs reg-size * ]
+ [ params>> ]
+ [ return>> ]
+ tri + + ;
: spill-float@ ( n -- op )
- #! XXX
- cells stack-frame get [ params>> ] [ return>> ] bi + + stack@ ;
+ double-float-regs reg-size *
+ stack-frame get spill-float-base
+ + stack@ ;
: next-stack@ ( n -- operand )
#! nth parameter from the next stack frame. Used to box