From: sewardj Date: Tue, 18 Dec 2001 15:23:16 +0000 (+0000) Subject: [project @ 2001-12-18 15:23:15 by sewardj] X-Git-Tag: Approximately_9120_patches~368 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f5c974ce53f3670fd344c1f0f604e7e429e3c5da;hp=7f2a1860ed988629e8c48e74e392aadf83dcf2e2;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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