[project @ 2001-12-18 15:23:15 by sewardj]

Fix various bugs in the implementation of subIntC and mulMayOflo.

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 9112cdf..aeb8d30 100644 (file)
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -802,10 +802,10 @@ dscCOpStmt [res_r,res_c] IntSubCOp [aa,bb] vols
    = mkTemps [IntRep,IntRep,IntRep]            `thenFlt` \ [t1,t2,t3] ->
      getBitsPerWordMinus1                      `thenFlt` \ (bpw1_code,bpw1_t) ->
      (returnFlt . CSequential) [
-        CMachOpStmt (Just res_r) MO_Nat_Add [aa,bb] Nothing,
+        CMachOpStmt (Just res_r) MO_Nat_Sub [aa,bb] Nothing,
         CMachOpStmt (Just t1) MO_Nat_Xor [aa,bb] Nothing,
         CMachOpStmt (Just t2) MO_Nat_Xor [aa,res_r] Nothing,
-        CMachOpStmt (Just t3) MO_Nat_And [t2,t3] Nothing,
+        CMachOpStmt (Just t3) MO_Nat_And [t1,t2] Nothing,
         bpw1_code,
         CMachOpStmt (Just res_c) MO_Nat_Shr [t3, bpw1_t] Nothing
      ]

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 41a2ac2..249ebc8 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -1013,7 +1013,8 @@ getRegister (StMachOp mop [x, y]) -- dyadic MachOps
              code2 = registerCode reg2 t2
              src1  = registerName reg1 t1
              src2  = registerName reg2 t2
-             code dst = toOL [
+             code dst = code1 `appOL` code2 `appOL`
+                        toOL [
                            MOV L (OpReg src1) (OpReg res_hi),
                            MOV L (OpReg src2) (OpReg res_lo),
                            IMUL64 res_hi res_lo,               -- result in res_hi:res_lo
@@ -1406,7 +1407,8 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps
              code2 = registerCode reg2 t2
              src1  = registerName reg1 t1
              src2  = registerName reg2 t2
-             code dst = toOL [
+             code dst = code1 `appOL` code2 `appOL`
+                        toOL [
                            SMUL False src1 (RIReg src2) res_lo,
                            RDY res_hi,
                            SRA res_lo (RIImm (ImmInt 31)) res_lo,

diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp
index 40b737c..6f231bf 100644 (file)
--- a/ghc/compiler/prelude/primops.txt.pp
+++ b/ghc/compiler/prelude/primops.txt.pp
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.14 2001/12/14 15:26:16 sewardj Exp $
+-- $Id: primops.txt.pp,v 1.15 2001/12/18 15:23:16 sewardj Exp $
 --
 -- Primitive Operations
 --
@@ -184,14 +184,15 @@ primop   IntMulOp    "*#"
    with commutable = True
 
 primop   IntMulMayOfloOp  "mulIntMayOflo#" 
-   GenPrimOp   Int# -> Int# -> Bool
-   {Return True if there is any possibility that the upper word of a
+   Dyadic   Int# -> Int# -> Int#
+   {Return non-zero if there is any possibility that the upper word of a
     signed integer multiply might contain useful information.  Return
-    False only if you are completely sure that no overflow can occur.
+    zero only if you are completely sure that no overflow can occur.
     On a 32-bit platform, the recommmended implementation is to do a 
-    32 x 32 -> 64 signed multiply, and compare result[63:32] with 
-    (result[31] >>signed 31).  If they are identical, meaning that the 
-    upper word is merely a sign extension of the lower one, return 0, else 1.
+    32 x 32 -> 64 signed multiply, and subtract result[63:32] from
+    (result[31] >>signed 31).  If this is zero, meaning that the 
+    upper word is merely a sign extension of the lower one, no
+    overflow can occur.
 
     On a 64-bit platform it is not always possible to 
     acquire the top 64 bits of the result.  Therefore, a recommended 

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index f7191da..e6eeaf4 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.89 2001/12/14 15:26:16 sewardj Exp $
+ * $Id: PrimOps.h,v 1.90 2001/12/18 15:23:16 sewardj Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -39,6 +39,10 @@
  * we use a crude approximation, testing whether either operand is
  * larger than 32-bits; if neither is, then we go ahead with the
  * multiplication.
+ *
+ * Return non-zero if there is any possibility that the signed multiply
+ * of a and b might overflow.  Return zero only if you are absolutely sure
+ * that it won't overflow.  If in doubt, return non-zero.
  */
 
 #if SIZEOF_VOID_P == 4

diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs
index 6447471..157a423 100644 (file)
--- a/ghc/lib/std/PrelNum.lhs
+++ b/ghc/lib/std/PrelNum.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelNum.lhs,v 1.44 2001/12/14 15:26:16 sewardj Exp $
+% $Id: PrelNum.lhs,v 1.45 2001/12/18 15:23:16 sewardj Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -352,8 +352,9 @@ minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2
 minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2
 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 
-timesInteger i1@(S# i) i2@(S# j)   = if mulIntMayOflo# i j then toBig i1 * toBig i2 
-                                                           else S# (i *# j)
+timesInteger i1@(S# i) i2@(S# j)   = if   mulIntMayOflo# i j ==# 0#
+                                     then S# (i *# j)
+                                     else toBig i1 * toBig i2 
 timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2
 timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2
 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d