From 88168656dd3ebf5487d4d35b8ea0bbffda31d909 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 1 Oct 2007 06:56:45 -0400
Subject: [PATCH] Another compiler fix

---
 core/compiler/test/templates-early.factor | 30 +++++++++++++++++++++++
 core/compiler/test/templates.factor       |  5 ++++
 core/generator/registers/registers.factor | 16 ++++++------
 3 files changed, 44 insertions(+), 7 deletions(-)

diff --git a/core/compiler/test/templates-early.factor b/core/compiler/test/templates-early.factor
index f79d4a2631..ae7cf12502 100644
--- a/core/compiler/test/templates-early.factor
+++ b/core/compiler/test/templates-early.factor
@@ -157,3 +157,33 @@ SYMBOL: template-chosen
     ! This is empty since we didn't change the stack
     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 ] with-scope
+
+! Regression
+[
+    [ ] [ init-templates ] unit-test
+
+    [ ] [ { object object } set-operand-classes ] unit-test
+
+    ! 2dup
+    [ ] [
+        T{ effect f { "x" "y" } { "x" "y" "x" "y" } }
+        phantom-shuffle
+    ] unit-test
+
+    [ ] [
+        2 phantom-d get phantom-input
+        [ { { f "a" } { f "b" } } lazy-load ] { } make drop
+    ] unit-test
+    
+    [ t ] [
+        phantom-d get [ cached? ] all?
+    ] unit-test
+
+    ! >r
+    [ ] [
+        1 phantom->r
+    ] unit-test
+
+    ! This should not fail
+    [ ] [ [ end-basic-block ] { } make drop ] unit-test
+] with-scope
diff --git a/core/compiler/test/templates.factor b/core/compiler/test/templates.factor
index 635618a3b8..aa2690da7b 100644
--- a/core/compiler/test/templates.factor
+++ b/core/compiler/test/templates.factor
@@ -213,3 +213,8 @@ TUPLE: my-tuple ;
         0 alien-cell type
     ] compile-1 alien type-number =
 ] unit-test
+
+[ 2 1 ] [
+    2 1
+    [ 2dup fixnum< [ >r die r> ] when ] compile-1
+] unit-test
diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor
index 4ad360d0db..79873b8fbd 100644
--- a/core/generator/registers/registers.factor
+++ b/core/generator/registers/registers.factor
@@ -116,8 +116,8 @@ M: cached live-vregs* cached-vreg live-vregs* ;
 M: cached live-loc? cached-loc live-loc? ;
 M: cached (lazy-load) >r cached-vreg r> (lazy-load) ;
 M: cached lazy-store
-    2dup cached-loc =
-    [ 2drop ] [ "live-locs" get at %move ] if ;
+    2dup cached-loc live-loc?
+    [ "live-locs" get at %move ] [ 2drop ] if ;
 M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ;
 
 INSTANCE: cached value
@@ -433,17 +433,19 @@ M: loc lazy-store
     #! We don't have enough free registers to load all shuffle
     #! inputs, so we use a single temporary register, together
     #! with the area of the data stack above the stack pointer
-    find-tmp-loc slow-shuffle-mapping
-    [
-        [ swap dup cached? [ cached-vreg ] when %move ] assoc-each
-    ] keep
-    >hashtable do-shuffle ;
+    find-tmp-loc slow-shuffle-mapping [
+        [
+            swap dup cached? [ cached-vreg ] when %move
+        ] assoc-each
+    ] keep >hashtable do-shuffle ;
 
 : fast-shuffle? ( live-locs -- ? )
     #! Test if we have enough free registers to load all
     #! shuffle inputs at once.
     T{ int-regs } free-vregs [ length ] 2apply <= ;
 
+USING: io prettyprint ;
+
 : finalize-locs ( -- )
     #! Perform any deferred stack shuffling.
     [