compiler.cfg.ssa.cssa: correctly handle overflowing fixnum instructions

basis/compiler/cfg/ssa/cssa/cssa.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel locals fry
+USING: accessors assocs kernel locals fry sequences
 cpu.architecture
 compiler.cfg.rpo
+compiler.cfg.def-use
 compiler.cfg.utilities
 compiler.cfg.registers
 compiler.cfg.instructions
@@ -13,10 +14,19 @@ IN: compiler.cfg.ssa.cssa
 ! selection, so it must keep track of representations when introducing
 ! new values.
 
+: insert-copy? ( bb vreg -- ? )
+    ! If the last instruction defines a value (which means it is
+    ! ##fixnum-add, ##fixnum-sub or ##fixnum-mul) then we don't
+    ! need to insert a copy since in fact doing so will result
+    ! in incorrect code.
+    [ instructions>> last defs-vreg ] dip eq? not ;
+
 :: insert-copy ( bb src rep -- bb dst )
-    rep next-vreg-rep :> dst
-    bb [ dst src rep src rep-of emit-conversion ] add-instructions
-    bb dst ;
+    bb src insert-copy? [
+        rep next-vreg-rep :> dst
+        bb [ dst src rep src rep-of emit-conversion ] add-instructions
+        bb dst
+    ] [ bb src ] if ;
 
 : convert-phi ( ##phi -- )
     dup dst>> rep-of '[ [ _ insert-copy ] assoc-map ] change-inputs drop ;

basis/compiler/tests/codegen.factor

@@ -3,7 +3,7 @@ math hashtables.private math.private namespaces sequences tools.test
 namespaces.private slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make alien.c-types combinators.short-circuit
-math.order math.libm math.parser ;
+math.order math.libm math.parser alien.c-types ;
 FROM: math => float ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
@@ -431,3 +431,21 @@ cell 4 = [
         ] curry each-integer
     ] compile-call
 ] unit-test
+
+TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-only } ;
+
+[ 2 ] [
+    little-endian?
+    T{ myseq f B{ 1 0 0 0 } B{ 1 0 0 0 } }
+    T{ myseq f B{ 0 0 0 1 } B{ 0 0 0 1 } } ?
+    [
+        { myseq } declare
+        [ 0 2 ] dip dup
+        [
+            [
+                over 1 < [ underlying1>> ] [ [ 1 - ] dip underlying2>> ] if
+                swap 4 * >fixnum alien-signed-4
+            ] bi-curry@ bi * +
+        ] 2curry each-integer
+    ] compile-call
+] unit-test