From c3d81cefe9742698f23ac0e9d4a514dac9579445 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 1 Oct 2009 19:41:23 -0500
Subject: [PATCH] compiler.cfg: don't unbox the same value more than once per
 basic block

---
 basis/compiler/cfg/builder/builder-tests.factor    | 13 +++++++++----
 .../cfg/representations/representations.factor     | 14 ++++++++++++--
 2 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 9a77ee4017..d303cc597f 100644
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -159,9 +159,12 @@ IN: compiler.cfg.builder.tests
     { pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
 ] each
 
-: contains-insn? ( quot insn-check -- ? )
+: count-insns ( quot insn-check -- ? )
     [ test-mr [ instructions>> ] map ] dip
-    '[ _ any? ] any? ; inline
+    '[ _ count ] sigma ; inline
+
+: contains-insn? ( quot insn-check -- ? )
+    count-insns 0 > ; inline
 
 [ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
 
@@ -197,14 +200,16 @@ IN: compiler.cfg.builder.tests
     [ f t ] [
         [ { byte-array fixnum } declare alien-cell 4 alien-float ]
         [ [ ##box-alien? ] contains-insn? ]
-        [ [ ##box-float? ] contains-insn? ] bi
+        [ [ ##allot? ] contains-insn? ] bi
     ] unit-test
 
     [ f t ] [
         [ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
         [ [ ##box-alien? ] contains-insn? ]
-        [ [ ##box-float? ] contains-insn? ] bi
+        [ [ ##allot? ] contains-insn? ] bi
     ] unit-test
+    
+    [ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test
 ] when
 
 ! Regression. Make sure everything is inlined correctly
diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor
index f31184cecf..a2311ca964 100644
--- a/basis/compiler/cfg/representations/representations.factor
+++ b/basis/compiler/cfg/representations/representations.factor
@@ -51,7 +51,7 @@ M:: vector-rep emit-box ( dst src rep -- )
     dst byte-array-offset src rep ##set-alien-vector ;
 
 M: vector-rep emit-unbox
-    byte-array-offset ##alien-vector ;
+    [ byte-array-offset ] dip ##alien-vector ;
 
 M:: scalar-rep emit-box ( dst src rep -- )
     int-rep next-vreg-rep :> temp
@@ -152,6 +152,9 @@ SYMBOL: costs
 ! Insert conversions. This introduces new temporaries, so we need
 ! to rename opearands too.
 
+! Mapping from vreg,rep pairs to vregs
+SYMBOL: alternatives
+
 :: emit-def-conversion ( dst preferred required -- new-dst' )
     ! If an instruction defines a register with representation 'required',
     ! but the register has preferred representation 'preferred', then
@@ -164,7 +167,13 @@ SYMBOL: costs
     ! but the register has preferred representation 'preferred', then
     ! we rename the instruction's input to a new register, which
     ! becomes the output of a conversion instruction.
-    required next-vreg-rep [ src required preferred emit-conversion ] keep ;
+    preferred required eq? [ src ] [
+        src required alternatives get [
+            required next-vreg-rep :> new-src
+            [ new-src ] 2dip preferred emit-conversion
+            new-src
+        ] 2cache
+    ] if ;
 
 SYMBOLS: renaming-set needs-renaming? ;
 
@@ -245,6 +254,7 @@ M: insn conversions-for-insn , ;
     dup kill-block? [ drop ] [
         [
             [
+                H{ } clone alternatives set
                 [ conversions-for-insn ] each
             ] V{ } make
         ] change-instructions drop