From 7dee9e10796acdc3af04f222ef06808ad3d1b611 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 14 Dec 2001 15:26:16 +0000 Subject: [PATCH] [project @ 2001-12-14 15:26:14 by sewardj] Get rid of multiple-result MachOps (MO_NatS_AddC, MO_NatS_SubC, MO_NatS_MulC) which implement {add,sub,mul}IntC#. Supporting gunk in the NCG disappears as a result. Instead: * {add,sub}IntC# are translated out during abstract C simplification, turning into the xor-xor-invert-and-shift sequence previously defined in PrimOps.h. * mulIntC# is more difficult to get rid of portably. Instead we have a new single-result PrimOp, mulIntMayOflo, with corresponding MachOp MO_NatS_MulMayOflo. This tells you whether a W x W -> W signed multiply might overflow, where W is the word size. When W=32, is implemented by computing a 2W-long result. When W=64, we use the previous approximation. PrelNum.lhs' implementation of timesInteger changes slightly, to use the new PrimOp. --- ghc/compiler/absCSyn/AbsCSyn.lhs | 5 +- ghc/compiler/absCSyn/AbsCUtils.lhs | 364 +++++++++++++++++++------------ ghc/compiler/absCSyn/MachOp.hs | 272 +++++++++++------------ ghc/compiler/absCSyn/PprAbsC.lhs | 29 +-- ghc/compiler/nativeGen/AbsCStixGen.lhs | 42 +--- ghc/compiler/nativeGen/AsmCodeGen.lhs | 2 - ghc/compiler/nativeGen/MachCode.lhs | 105 +++------ ghc/compiler/nativeGen/MachMisc.lhs | 2 + ghc/compiler/nativeGen/PprMach.lhs | 21 ++ ghc/compiler/nativeGen/RegAllocInfo.lhs | 2 + ghc/compiler/nativeGen/Stix.lhs | 37 +--- ghc/compiler/prelude/primops.txt.pp | 35 ++- ghc/compiler/utils/Maybes.lhs | 17 -- ghc/includes/PrimOps.h | 65 ++---- ghc/lib/std/PrelGHC.hi-boot.pp | 2 +- ghc/lib/std/PrelNum.lhs | 7 +- 16 files changed, 480 insertions(+), 527 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 9b410ef..04e1367 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: AbsCSyn.lhs,v 1.42 2001/12/06 11:50:07 sewardj Exp $ +% $Id: AbsCSyn.lhs,v 1.43 2001/12/14 15:26:14 sewardj Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -52,7 +52,6 @@ import Unique ( Unique ) import StgSyn ( StgOp ) import TyCon ( TyCon ) import BitSet -- for liveness masks -import Maybes ( Maybe012(..) ) import FastTypes import Outputable @@ -123,7 +122,7 @@ stored in a mixed type location.) -- NEW CASES FOR EXPANDED PRIMOPS | CMachOpStmt -- Machine-level operation - (Maybe012 CAddrMode) -- 0, 1 or 2 results + (Maybe CAddrMode) -- 0 or 1 results MachOp [CAddrMode] -- Arguments (Maybe [MagicId]) -- list of regs which need to be preserved diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index ab1a649..eb5869f 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -34,7 +34,6 @@ import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety(..) isDynamicTarget, isCasmTarget, defaultCCallConv ) import StgSyn ( StgOp(..) ) import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize ) -import Maybes ( Maybe012(..) ) import Outputable import Panic ( panic ) import FastTypes @@ -609,22 +608,22 @@ mkHalfWord_HIADDR res arg mkTemp WordRep `thenFlt` \ t_hw_mask1 -> mkTemp WordRep `thenFlt` \ t_hw_mask2 -> let a_hw_shift - = CMachOpStmt (Just1 t_hw_shift) + = CMachOpStmt (Just t_hw_shift) MO_Nat_Shl [CBytesPerWord, CLit (mkMachInt 2)] Nothing a_hw_mask1 - = CMachOpStmt (Just1 t_hw_mask1) + = CMachOpStmt (Just t_hw_mask1) MO_Nat_Shl [CLit (mkMachWord 1), t_hw_shift] Nothing a_hw_mask2 - = CMachOpStmt (Just1 t_hw_mask2) + = CMachOpStmt (Just t_hw_mask2) MO_Nat_Sub [t_hw_mask1, CLit (mkMachWord 1)] Nothing final # if WORDS_BIGENDIAN = CSequential [ a_hw_shift, a_hw_mask1, a_hw_mask2, - CMachOpStmt (Just1 res) MO_Nat_And [arg, t_hw_mask2] Nothing + CMachOpStmt (Just res) MO_Nat_And [arg, t_hw_mask2] Nothing ] # else = CSequential [ a_hw_shift, - CMachOpStmt (Just1 res) MO_Nat_Shr [arg, t_hw_shift] Nothing + CMachOpStmt (Just res) MO_Nat_Shr [arg, t_hw_shift] Nothing ] # endif in @@ -657,19 +656,19 @@ non_void_amode amode k -> True doIndexOffForeignObjOp rep res addr idx - = Just (Just1 res, MO_ReadOSBI fixedHdrSize rep, [addr,idx]) + = Just (Just res, MO_ReadOSBI fixedHdrSize rep, [addr,idx]) doIndexOffAddrOp rep res addr idx - = Just (Just1 res, MO_ReadOSBI 0 rep, [addr,idx]) + = Just (Just res, MO_ReadOSBI 0 rep, [addr,idx]) doIndexByteArrayOp rep res addr idx - = Just (Just1 res, MO_ReadOSBI arrWordsHdrSize rep, [addr,idx]) + = Just (Just res, MO_ReadOSBI arrWordsHdrSize rep, [addr,idx]) doWriteOffAddrOp rep addr idx val - = Just (Just0, MO_WriteOSBI 0 rep, [addr,idx,val]) + = Just (Nothing, MO_WriteOSBI 0 rep, [addr,idx,val]) doWriteByteArrayOp rep addr idx val - = Just (Just0, MO_WriteOSBI arrWordsHdrSize rep, [addr,idx,val]) + = Just (Nothing, MO_WriteOSBI arrWordsHdrSize rep, [addr,idx,val]) -- Simple dyadic op but one for which we need to cast first arg to -- be sure of correctness @@ -677,10 +676,23 @@ translateOp_dyadic_cast1 mop res cast_arg1_to arg1 arg2 vols = mkTemp cast_arg1_to `thenFlt` \ arg1casted -> (returnFlt . CSequential) [ CAssign arg1casted arg1, - CMachOpStmt (Just1 res) mop [arg1casted,arg2] + CMachOpStmt (Just res) mop [arg1casted,arg2] (if isDefinitelyInlineMachOp mop then Nothing else Just vols) ] +getBitsPerWordMinus1 :: FlatM (AbstractC, CAddrMode) +getBitsPerWordMinus1 + = mkTemps [IntRep, IntRep] `thenFlt` \ [t1,t2] -> + returnFlt ( + CSequential [ + CMachOpStmt (Just t1) MO_Nat_Shl + [CBytesPerWord, CLit (mkMachInt 3)] Nothing, + CMachOpStmt (Just t2) MO_Nat_Sub + [t1, CLit (mkMachInt 1)] Nothing + ], + t2 + ) + ------------------------------------------------------------------------------ dscCOpStmt :: [CAddrMode] -- Results @@ -690,6 +702,74 @@ dscCOpStmt :: [CAddrMode] -- Results -- (to save/restore around the op) -> FlatM AbstractC + +dscCOpStmt [res_r,res_c] IntAddCOp [aa,bb] vols +{- + With some bit-twiddling, we can define int{Add,Sub}Czh portably in + C, and without needing any comparisons. This may not be the + fastest way to do it - if you have better code, please send it! --SDM + + Return : r = a + b, c = 0 if no overflow, 1 on overflow. + + We currently don't make use of the r value if c is != 0 (i.e. + overflow), we just convert to big integers and try again. This + could be improved by making r and c the correct values for + plugging into a new J#. + + { r = ((I_)(a)) + ((I_)(b)); \ + c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ + >> (BITS_IN (I_) - 1); \ + } + Wading through the mass of bracketry, it seems to reduce to: + c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1) + + SSA-form: + t1 = a^b + t2 = ~t1 + t3 = a^r + t4 = t2 & t3 + c = t4 >>unsigned BITS_IN(I_)-1 +-} + = mkTemps [IntRep,IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3,t4] -> + getBitsPerWordMinus1 `thenFlt` \ (bpw1_code,bpw1_t) -> + (returnFlt . CSequential) [ + CMachOpStmt (Just res_r) MO_Nat_Add [aa,bb] Nothing, + CMachOpStmt (Just t1) MO_Nat_Xor [aa,bb] Nothing, + CMachOpStmt (Just t2) MO_Nat_Not [t1] Nothing, + CMachOpStmt (Just t3) MO_Nat_Xor [aa,res_r] Nothing, + CMachOpStmt (Just t4) MO_Nat_And [t2,t3] Nothing, + bpw1_code, + CMachOpStmt (Just res_c) MO_Nat_Shr [t4, bpw1_t] Nothing + ] + + +dscCOpStmt [res_r,res_c] IntSubCOp [aa,bb] vols +{- Similarly: + #define subIntCzh(r,c,a,b) \ + { r = ((I_)(a)) - ((I_)(b)); \ + c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ + >> (BITS_IN (I_) - 1); \ + } + + c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1) + + t1 = a^b + t2 = a^r + t3 = t1 & t2 + c = t3 >>unsigned BITS_IN(I_)-1 +-} + = 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 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, + bpw1_code, + CMachOpStmt (Just res_c) MO_Nat_Shr [t3, bpw1_t] Nothing + ] + + -- #define parzh(r,node) r = 1 dscCOpStmt [res] ParOp [arg] vols = returnFlt @@ -725,7 +805,7 @@ dscCOpStmt [res] SizeofByteArrayOp [arg] vols = mkTemp WordRep `thenFlt` \ w -> (returnFlt . CSequential) [ CAssign w (mkDerefOff WordRep arg fixedHdrSize), - CMachOpStmt (Just1 w) + CMachOpStmt (Just w) MO_NatU_Mul [w, CBytesPerWord] (Just vols), CAssign res w ] @@ -744,7 +824,7 @@ dscCOpStmt [] TouchOp [arg] vols dscCOpStmt [res] ByteArrayContents_Char [arg] vols = mkTemp PtrRep `thenFlt` \ ptr -> (returnFlt . CSequential) [ - CMachOpStmt (Just1 ptr) MO_NatU_to_NatP [arg] Nothing, + CMachOpStmt (Just ptr) MO_NatU_to_NatP [arg] Nothing, CAssign ptr (mkNoDerefOff WordRep ptr arrWordsHdrSize), CAssign res ptr ] @@ -761,7 +841,7 @@ dscCOpStmt [res] EqStableNameOp [arg1,arg2] vols (returnFlt . CSequential) [ CAssign sn1 (mkDerefOff WordRep arg1 fixedHdrSize), CAssign sn2 (mkDerefOff WordRep arg2 fixedHdrSize), - CMachOpStmt (Just1 res) MO_Nat_Eq [sn1,sn2] Nothing + CMachOpStmt (Just res) MO_Nat_Eq [sn1,sn2] Nothing ] -- #define addrToHValuezh(r,a) r=(P_)a @@ -806,8 +886,8 @@ dscCOpStmt [res] UnsafeFreezeByteArrayOp [arg] vols dscCOpStmt [r] AddrRemOp [a1,a2] vols = mkTemp WordRep `thenFlt` \ a1casted -> (returnFlt . CSequential) [ - CMachOpStmt (Just1 a1casted) MO_NatP_to_NatU [a1] Nothing, - CMachOpStmt (Just1 r) MO_NatU_Rem [a1casted,a2] Nothing + CMachOpStmt (Just a1casted) MO_NatP_to_NatU [a1] Nothing, + CMachOpStmt (Just r) MO_NatU_Rem [a1casted,a2] Nothing ] -- not handled by translateOp because they need casts @@ -838,11 +918,11 @@ dscCOpStmt ress op args vols translateOp [r] ReadArrayOp [obj,ix] - = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) + = Just (Just r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) translateOp [r] IndexArrayOp [obj,ix] - = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) + = Just (Just r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) translateOp [] WriteArrayOp [obj,ix,v] - = Just (Just0, MO_WriteOSBI arrPtrsHdrSize PtrRep, [obj,ix,v]) + = Just (Nothing, MO_WriteOSBI arrPtrsHdrSize PtrRep, [obj,ix,v]) -- IndexXXXoffForeignObj @@ -994,158 +1074,158 @@ translateOp [] WriteByteArrayOp_Word64 [a,i,x] = doWriteByteArrayOp Word64Rep a -- Native word signless ops -translateOp [r] IntAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2]) -translateOp [r] IntSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2]) -translateOp [r] WordAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2]) -translateOp [r] WordSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2]) -translateOp [r] AddrAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2]) -translateOp [r] AddrSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2]) - -translateOp [r] IntEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] IntNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2]) -translateOp [r] WordEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] WordNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2]) -translateOp [r] AddrEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] AddrNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2]) - -translateOp [r] AndOp [a1,a2] = Just (Just1 r, MO_Nat_And, [a1,a2]) -translateOp [r] OrOp [a1,a2] = Just (Just1 r, MO_Nat_Or, [a1,a2]) -translateOp [r] XorOp [a1,a2] = Just (Just1 r, MO_Nat_Xor, [a1,a2]) -translateOp [r] NotOp [a1] = Just (Just1 r, MO_Nat_Not, [a1]) +translateOp [r] IntAddOp [a1,a2] = Just (Just r, MO_Nat_Add, [a1,a2]) +translateOp [r] IntSubOp [a1,a2] = Just (Just r, MO_Nat_Sub, [a1,a2]) +translateOp [r] WordAddOp [a1,a2] = Just (Just r, MO_Nat_Add, [a1,a2]) +translateOp [r] WordSubOp [a1,a2] = Just (Just r, MO_Nat_Sub, [a1,a2]) +translateOp [r] AddrAddOp [a1,a2] = Just (Just r, MO_Nat_Add, [a1,a2]) +translateOp [r] AddrSubOp [a1,a2] = Just (Just r, MO_Nat_Sub, [a1,a2]) + +translateOp [r] IntEqOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] IntNeOp [a1,a2] = Just (Just r, MO_Nat_Ne, [a1,a2]) +translateOp [r] WordEqOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] WordNeOp [a1,a2] = Just (Just r, MO_Nat_Ne, [a1,a2]) +translateOp [r] AddrEqOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] AddrNeOp [a1,a2] = Just (Just r, MO_Nat_Ne, [a1,a2]) + +translateOp [r] AndOp [a1,a2] = Just (Just r, MO_Nat_And, [a1,a2]) +translateOp [r] OrOp [a1,a2] = Just (Just r, MO_Nat_Or, [a1,a2]) +translateOp [r] XorOp [a1,a2] = Just (Just r, MO_Nat_Xor, [a1,a2]) +translateOp [r] NotOp [a1] = Just (Just r, MO_Nat_Not, [a1]) -- Native word signed ops -translateOp [r] IntMulOp [a1,a2] = Just (Just1 r, MO_NatS_Mul, [a1,a2]) -translateOp [r] IntQuotOp [a1,a2] = Just (Just1 r, MO_NatS_Quot, [a1,a2]) -translateOp [r] IntRemOp [a1,a2] = Just (Just1 r, MO_NatS_Rem, [a1,a2]) -translateOp [r] IntNegOp [a1] = Just (Just1 r, MO_NatS_Neg, [a1]) +translateOp [r] IntMulOp [a1,a2] = Just (Just r, MO_NatS_Mul, [a1,a2]) +translateOp [r] IntMulMayOfloOp [a1,a2] = Just (Just r, MO_NatS_MulMayOflo, [a1,a2]) +translateOp [r] IntQuotOp [a1,a2] = Just (Just r, MO_NatS_Quot, [a1,a2]) +translateOp [r] IntRemOp [a1,a2] = Just (Just r, MO_NatS_Rem, [a1,a2]) +translateOp [r] IntNegOp [a1] = Just (Just r, MO_NatS_Neg, [a1]) -translateOp [r,c] IntAddCOp [a1,a2] = Just (Just2 r c, MO_NatS_AddC, [a1,a2]) -translateOp [r,c] IntSubCOp [a1,a2] = Just (Just2 r c, MO_NatS_SubC, [a1,a2]) -translateOp [r,c] IntMulCOp [a1,a2] = Just (Just2 r c, MO_NatS_MulC, [a1,a2]) +translateOp [r] IntGeOp [a1,a2] = Just (Just r, MO_NatS_Ge, [a1,a2]) +translateOp [r] IntLeOp [a1,a2] = Just (Just r, MO_NatS_Le, [a1,a2]) +translateOp [r] IntGtOp [a1,a2] = Just (Just r, MO_NatS_Gt, [a1,a2]) +translateOp [r] IntLtOp [a1,a2] = Just (Just r, MO_NatS_Lt, [a1,a2]) -translateOp [r] IntGeOp [a1,a2] = Just (Just1 r, MO_NatS_Ge, [a1,a2]) -translateOp [r] IntLeOp [a1,a2] = Just (Just1 r, MO_NatS_Le, [a1,a2]) -translateOp [r] IntGtOp [a1,a2] = Just (Just1 r, MO_NatS_Gt, [a1,a2]) -translateOp [r] IntLtOp [a1,a2] = Just (Just1 r, MO_NatS_Lt, [a1,a2]) -- Native word unsigned ops -translateOp [r] WordGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2]) -translateOp [r] WordLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2]) -translateOp [r] WordGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2]) -translateOp [r] WordLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2]) +translateOp [r] WordGeOp [a1,a2] = Just (Just r, MO_NatU_Ge, [a1,a2]) +translateOp [r] WordLeOp [a1,a2] = Just (Just r, MO_NatU_Le, [a1,a2]) +translateOp [r] WordGtOp [a1,a2] = Just (Just r, MO_NatU_Gt, [a1,a2]) +translateOp [r] WordLtOp [a1,a2] = Just (Just r, MO_NatU_Lt, [a1,a2]) -translateOp [r] WordMulOp [a1,a2] = Just (Just1 r, MO_NatU_Mul, [a1,a2]) -translateOp [r] WordQuotOp [a1,a2] = Just (Just1 r, MO_NatU_Quot, [a1,a2]) -translateOp [r] WordRemOp [a1,a2] = Just (Just1 r, MO_NatU_Rem, [a1,a2]) +translateOp [r] WordMulOp [a1,a2] = Just (Just r, MO_NatU_Mul, [a1,a2]) +translateOp [r] WordQuotOp [a1,a2] = Just (Just r, MO_NatU_Quot, [a1,a2]) +translateOp [r] WordRemOp [a1,a2] = Just (Just r, MO_NatU_Rem, [a1,a2]) -translateOp [r] AddrGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2]) -translateOp [r] AddrLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2]) -translateOp [r] AddrGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2]) -translateOp [r] AddrLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2]) +translateOp [r] AddrGeOp [a1,a2] = Just (Just r, MO_NatU_Ge, [a1,a2]) +translateOp [r] AddrLeOp [a1,a2] = Just (Just r, MO_NatU_Le, [a1,a2]) +translateOp [r] AddrGtOp [a1,a2] = Just (Just r, MO_NatU_Gt, [a1,a2]) +translateOp [r] AddrLtOp [a1,a2] = Just (Just r, MO_NatU_Lt, [a1,a2]) -- 32-bit unsigned ops -translateOp [r] CharEqOp [a1,a2] = Just (Just1 r, MO_32U_Eq, [a1,a2]) -translateOp [r] CharNeOp [a1,a2] = Just (Just1 r, MO_32U_Ne, [a1,a2]) -translateOp [r] CharGeOp [a1,a2] = Just (Just1 r, MO_32U_Ge, [a1,a2]) -translateOp [r] CharLeOp [a1,a2] = Just (Just1 r, MO_32U_Le, [a1,a2]) -translateOp [r] CharGtOp [a1,a2] = Just (Just1 r, MO_32U_Gt, [a1,a2]) -translateOp [r] CharLtOp [a1,a2] = Just (Just1 r, MO_32U_Lt, [a1,a2]) +translateOp [r] CharEqOp [a1,a2] = Just (Just r, MO_32U_Eq, [a1,a2]) +translateOp [r] CharNeOp [a1,a2] = Just (Just r, MO_32U_Ne, [a1,a2]) +translateOp [r] CharGeOp [a1,a2] = Just (Just r, MO_32U_Ge, [a1,a2]) +translateOp [r] CharLeOp [a1,a2] = Just (Just r, MO_32U_Le, [a1,a2]) +translateOp [r] CharGtOp [a1,a2] = Just (Just r, MO_32U_Gt, [a1,a2]) +translateOp [r] CharLtOp [a1,a2] = Just (Just r, MO_32U_Lt, [a1,a2]) -- Double ops -translateOp [r] DoubleEqOp [a1,a2] = Just (Just1 r, MO_Dbl_Eq, [a1,a2]) -translateOp [r] DoubleNeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ne, [a1,a2]) -translateOp [r] DoubleGeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ge, [a1,a2]) -translateOp [r] DoubleLeOp [a1,a2] = Just (Just1 r, MO_Dbl_Le, [a1,a2]) -translateOp [r] DoubleGtOp [a1,a2] = Just (Just1 r, MO_Dbl_Gt, [a1,a2]) -translateOp [r] DoubleLtOp [a1,a2] = Just (Just1 r, MO_Dbl_Lt, [a1,a2]) - -translateOp [r] DoubleAddOp [a1,a2] = Just (Just1 r, MO_Dbl_Add, [a1,a2]) -translateOp [r] DoubleSubOp [a1,a2] = Just (Just1 r, MO_Dbl_Sub, [a1,a2]) -translateOp [r] DoubleMulOp [a1,a2] = Just (Just1 r, MO_Dbl_Mul, [a1,a2]) -translateOp [r] DoubleDivOp [a1,a2] = Just (Just1 r, MO_Dbl_Div, [a1,a2]) -translateOp [r] DoublePowerOp [a1,a2] = Just (Just1 r, MO_Dbl_Pwr, [a1,a2]) - -translateOp [r] DoubleSinOp [a1] = Just (Just1 r, MO_Dbl_Sin, [a1]) -translateOp [r] DoubleCosOp [a1] = Just (Just1 r, MO_Dbl_Cos, [a1]) -translateOp [r] DoubleTanOp [a1] = Just (Just1 r, MO_Dbl_Tan, [a1]) -translateOp [r] DoubleSinhOp [a1] = Just (Just1 r, MO_Dbl_Sinh, [a1]) -translateOp [r] DoubleCoshOp [a1] = Just (Just1 r, MO_Dbl_Cosh, [a1]) -translateOp [r] DoubleTanhOp [a1] = Just (Just1 r, MO_Dbl_Tanh, [a1]) -translateOp [r] DoubleAsinOp [a1] = Just (Just1 r, MO_Dbl_Asin, [a1]) -translateOp [r] DoubleAcosOp [a1] = Just (Just1 r, MO_Dbl_Acos, [a1]) -translateOp [r] DoubleAtanOp [a1] = Just (Just1 r, MO_Dbl_Atan, [a1]) -translateOp [r] DoubleLogOp [a1] = Just (Just1 r, MO_Dbl_Log, [a1]) -translateOp [r] DoubleExpOp [a1] = Just (Just1 r, MO_Dbl_Exp, [a1]) -translateOp [r] DoubleSqrtOp [a1] = Just (Just1 r, MO_Dbl_Sqrt, [a1]) -translateOp [r] DoubleNegOp [a1] = Just (Just1 r, MO_Dbl_Neg, [a1]) +translateOp [r] DoubleEqOp [a1,a2] = Just (Just r, MO_Dbl_Eq, [a1,a2]) +translateOp [r] DoubleNeOp [a1,a2] = Just (Just r, MO_Dbl_Ne, [a1,a2]) +translateOp [r] DoubleGeOp [a1,a2] = Just (Just r, MO_Dbl_Ge, [a1,a2]) +translateOp [r] DoubleLeOp [a1,a2] = Just (Just r, MO_Dbl_Le, [a1,a2]) +translateOp [r] DoubleGtOp [a1,a2] = Just (Just r, MO_Dbl_Gt, [a1,a2]) +translateOp [r] DoubleLtOp [a1,a2] = Just (Just r, MO_Dbl_Lt, [a1,a2]) + +translateOp [r] DoubleAddOp [a1,a2] = Just (Just r, MO_Dbl_Add, [a1,a2]) +translateOp [r] DoubleSubOp [a1,a2] = Just (Just r, MO_Dbl_Sub, [a1,a2]) +translateOp [r] DoubleMulOp [a1,a2] = Just (Just r, MO_Dbl_Mul, [a1,a2]) +translateOp [r] DoubleDivOp [a1,a2] = Just (Just r, MO_Dbl_Div, [a1,a2]) +translateOp [r] DoublePowerOp [a1,a2] = Just (Just r, MO_Dbl_Pwr, [a1,a2]) + +translateOp [r] DoubleSinOp [a1] = Just (Just r, MO_Dbl_Sin, [a1]) +translateOp [r] DoubleCosOp [a1] = Just (Just r, MO_Dbl_Cos, [a1]) +translateOp [r] DoubleTanOp [a1] = Just (Just r, MO_Dbl_Tan, [a1]) +translateOp [r] DoubleSinhOp [a1] = Just (Just r, MO_Dbl_Sinh, [a1]) +translateOp [r] DoubleCoshOp [a1] = Just (Just r, MO_Dbl_Cosh, [a1]) +translateOp [r] DoubleTanhOp [a1] = Just (Just r, MO_Dbl_Tanh, [a1]) +translateOp [r] DoubleAsinOp [a1] = Just (Just r, MO_Dbl_Asin, [a1]) +translateOp [r] DoubleAcosOp [a1] = Just (Just r, MO_Dbl_Acos, [a1]) +translateOp [r] DoubleAtanOp [a1] = Just (Just r, MO_Dbl_Atan, [a1]) +translateOp [r] DoubleLogOp [a1] = Just (Just r, MO_Dbl_Log, [a1]) +translateOp [r] DoubleExpOp [a1] = Just (Just r, MO_Dbl_Exp, [a1]) +translateOp [r] DoubleSqrtOp [a1] = Just (Just r, MO_Dbl_Sqrt, [a1]) +translateOp [r] DoubleNegOp [a1] = Just (Just r, MO_Dbl_Neg, [a1]) -- Float ops -translateOp [r] FloatEqOp [a1,a2] = Just (Just1 r, MO_Flt_Eq, [a1,a2]) -translateOp [r] FloatNeOp [a1,a2] = Just (Just1 r, MO_Flt_Ne, [a1,a2]) -translateOp [r] FloatGeOp [a1,a2] = Just (Just1 r, MO_Flt_Ge, [a1,a2]) -translateOp [r] FloatLeOp [a1,a2] = Just (Just1 r, MO_Flt_Le, [a1,a2]) -translateOp [r] FloatGtOp [a1,a2] = Just (Just1 r, MO_Flt_Gt, [a1,a2]) -translateOp [r] FloatLtOp [a1,a2] = Just (Just1 r, MO_Flt_Lt, [a1,a2]) - -translateOp [r] FloatAddOp [a1,a2] = Just (Just1 r, MO_Flt_Add, [a1,a2]) -translateOp [r] FloatSubOp [a1,a2] = Just (Just1 r, MO_Flt_Sub, [a1,a2]) -translateOp [r] FloatMulOp [a1,a2] = Just (Just1 r, MO_Flt_Mul, [a1,a2]) -translateOp [r] FloatDivOp [a1,a2] = Just (Just1 r, MO_Flt_Div, [a1,a2]) -translateOp [r] FloatPowerOp [a1,a2] = Just (Just1 r, MO_Flt_Pwr, [a1,a2]) - -translateOp [r] FloatSinOp [a1] = Just (Just1 r, MO_Flt_Sin, [a1]) -translateOp [r] FloatCosOp [a1] = Just (Just1 r, MO_Flt_Cos, [a1]) -translateOp [r] FloatTanOp [a1] = Just (Just1 r, MO_Flt_Tan, [a1]) -translateOp [r] FloatSinhOp [a1] = Just (Just1 r, MO_Flt_Sinh, [a1]) -translateOp [r] FloatCoshOp [a1] = Just (Just1 r, MO_Flt_Cosh, [a1]) -translateOp [r] FloatTanhOp [a1] = Just (Just1 r, MO_Flt_Tanh, [a1]) -translateOp [r] FloatAsinOp [a1] = Just (Just1 r, MO_Flt_Asin, [a1]) -translateOp [r] FloatAcosOp [a1] = Just (Just1 r, MO_Flt_Acos, [a1]) -translateOp [r] FloatAtanOp [a1] = Just (Just1 r, MO_Flt_Atan, [a1]) -translateOp [r] FloatLogOp [a1] = Just (Just1 r, MO_Flt_Log, [a1]) -translateOp [r] FloatExpOp [a1] = Just (Just1 r, MO_Flt_Exp, [a1]) -translateOp [r] FloatSqrtOp [a1] = Just (Just1 r, MO_Flt_Sqrt, [a1]) -translateOp [r] FloatNegOp [a1] = Just (Just1 r, MO_Flt_Neg, [a1]) +translateOp [r] FloatEqOp [a1,a2] = Just (Just r, MO_Flt_Eq, [a1,a2]) +translateOp [r] FloatNeOp [a1,a2] = Just (Just r, MO_Flt_Ne, [a1,a2]) +translateOp [r] FloatGeOp [a1,a2] = Just (Just r, MO_Flt_Ge, [a1,a2]) +translateOp [r] FloatLeOp [a1,a2] = Just (Just r, MO_Flt_Le, [a1,a2]) +translateOp [r] FloatGtOp [a1,a2] = Just (Just r, MO_Flt_Gt, [a1,a2]) +translateOp [r] FloatLtOp [a1,a2] = Just (Just r, MO_Flt_Lt, [a1,a2]) + +translateOp [r] FloatAddOp [a1,a2] = Just (Just r, MO_Flt_Add, [a1,a2]) +translateOp [r] FloatSubOp [a1,a2] = Just (Just r, MO_Flt_Sub, [a1,a2]) +translateOp [r] FloatMulOp [a1,a2] = Just (Just r, MO_Flt_Mul, [a1,a2]) +translateOp [r] FloatDivOp [a1,a2] = Just (Just r, MO_Flt_Div, [a1,a2]) +translateOp [r] FloatPowerOp [a1,a2] = Just (Just r, MO_Flt_Pwr, [a1,a2]) + +translateOp [r] FloatSinOp [a1] = Just (Just r, MO_Flt_Sin, [a1]) +translateOp [r] FloatCosOp [a1] = Just (Just r, MO_Flt_Cos, [a1]) +translateOp [r] FloatTanOp [a1] = Just (Just r, MO_Flt_Tan, [a1]) +translateOp [r] FloatSinhOp [a1] = Just (Just r, MO_Flt_Sinh, [a1]) +translateOp [r] FloatCoshOp [a1] = Just (Just r, MO_Flt_Cosh, [a1]) +translateOp [r] FloatTanhOp [a1] = Just (Just r, MO_Flt_Tanh, [a1]) +translateOp [r] FloatAsinOp [a1] = Just (Just r, MO_Flt_Asin, [a1]) +translateOp [r] FloatAcosOp [a1] = Just (Just r, MO_Flt_Acos, [a1]) +translateOp [r] FloatAtanOp [a1] = Just (Just r, MO_Flt_Atan, [a1]) +translateOp [r] FloatLogOp [a1] = Just (Just r, MO_Flt_Log, [a1]) +translateOp [r] FloatExpOp [a1] = Just (Just r, MO_Flt_Exp, [a1]) +translateOp [r] FloatSqrtOp [a1] = Just (Just r, MO_Flt_Sqrt, [a1]) +translateOp [r] FloatNegOp [a1] = Just (Just r, MO_Flt_Neg, [a1]) -- Conversions -translateOp [r] Int2DoubleOp [a1] = Just (Just1 r, MO_NatS_to_Dbl, [a1]) -translateOp [r] Double2IntOp [a1] = Just (Just1 r, MO_Dbl_to_NatS, [a1]) +translateOp [r] Int2DoubleOp [a1] = Just (Just r, MO_NatS_to_Dbl, [a1]) +translateOp [r] Double2IntOp [a1] = Just (Just r, MO_Dbl_to_NatS, [a1]) + +translateOp [r] Int2FloatOp [a1] = Just (Just r, MO_NatS_to_Flt, [a1]) +translateOp [r] Float2IntOp [a1] = Just (Just r, MO_Flt_to_NatS, [a1]) -translateOp [r] Int2FloatOp [a1] = Just (Just1 r, MO_NatS_to_Flt, [a1]) -translateOp [r] Float2IntOp [a1] = Just (Just1 r, MO_Flt_to_NatS, [a1]) +translateOp [r] Float2DoubleOp [a1] = Just (Just r, MO_Flt_to_Dbl, [a1]) +translateOp [r] Double2FloatOp [a1] = Just (Just r, MO_Dbl_to_Flt, [a1]) -translateOp [r] Float2DoubleOp [a1] = Just (Just1 r, MO_Flt_to_Dbl, [a1]) -translateOp [r] Double2FloatOp [a1] = Just (Just1 r, MO_Dbl_to_Flt, [a1]) +translateOp [r] Int2WordOp [a1] = Just (Just r, MO_NatS_to_NatU, [a1]) +translateOp [r] Word2IntOp [a1] = Just (Just r, MO_NatU_to_NatS, [a1]) -translateOp [r] Int2WordOp [a1] = Just (Just1 r, MO_NatS_to_NatU, [a1]) -translateOp [r] Word2IntOp [a1] = Just (Just1 r, MO_NatU_to_NatS, [a1]) +translateOp [r] Int2AddrOp [a1] = Just (Just r, MO_NatS_to_NatP, [a1]) +translateOp [r] Addr2IntOp [a1] = Just (Just r, MO_NatP_to_NatS, [a1]) -translateOp [r] Int2AddrOp [a1] = Just (Just1 r, MO_NatS_to_NatP, [a1]) -translateOp [r] Addr2IntOp [a1] = Just (Just1 r, MO_NatP_to_NatS, [a1]) +translateOp [r] OrdOp [a1] = Just (Just r, MO_32U_to_NatS, [a1]) +translateOp [r] ChrOp [a1] = Just (Just r, MO_NatS_to_32U, [a1]) -translateOp [r] OrdOp [a1] = Just (Just1 r, MO_32U_to_NatS, [a1]) -translateOp [r] ChrOp [a1] = Just (Just1 r, MO_NatS_to_32U, [a1]) +translateOp [r] Narrow8IntOp [a1] = Just (Just r, MO_8S_to_NatS, [a1]) +translateOp [r] Narrow16IntOp [a1] = Just (Just r, MO_16S_to_NatS, [a1]) +translateOp [r] Narrow32IntOp [a1] = Just (Just r, MO_32S_to_NatS, [a1]) -translateOp [r] Narrow8IntOp [a1] = Just (Just1 r, MO_8S_to_NatS, [a1]) -translateOp [r] Narrow16IntOp [a1] = Just (Just1 r, MO_16S_to_NatS, [a1]) -translateOp [r] Narrow32IntOp [a1] = Just (Just1 r, MO_32S_to_NatS, [a1]) +translateOp [r] Narrow8WordOp [a1] = Just (Just r, MO_8U_to_NatU, [a1]) +translateOp [r] Narrow16WordOp [a1] = Just (Just r, MO_16U_to_NatU, [a1]) +translateOp [r] Narrow32WordOp [a1] = Just (Just r, MO_32U_to_NatU, [a1]) -translateOp [r] Narrow8WordOp [a1] = Just (Just1 r, MO_8U_to_NatU, [a1]) -translateOp [r] Narrow16WordOp [a1] = Just (Just1 r, MO_16U_to_NatU, [a1]) -translateOp [r] Narrow32WordOp [a1] = Just (Just1 r, MO_32U_to_NatU, [a1]) +-- Word comparisons masquerading as more exotic things. -translateOp [r] SameMutVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] SameMVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] SameMutableArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] EqForeignObj [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] EqStablePtrOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMutVarOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMVarOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMutableArrayOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] EqForeignObj [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) +translateOp [r] EqStablePtrOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2]) translateOp _ _ _ = Nothing diff --git a/ghc/compiler/absCSyn/MachOp.hs b/ghc/compiler/absCSyn/MachOp.hs index e17cde4..75994bc 100644 --- a/ghc/compiler/absCSyn/MachOp.hs +++ b/ghc/compiler/absCSyn/MachOp.hs @@ -10,7 +10,6 @@ where #include "HsVersions.h" import PrimRep ( PrimRep(..) ) -import Maybes ( Maybe012(..) ) import Outputable @@ -49,19 +48,16 @@ data MachOp | MO_NatU_Gt | MO_NatU_Lt - | MO_NatS_Mul -- signed * + | MO_NatS_Mul -- low word of signed * + | MO_NatS_MulMayOflo -- nonzero if high word of signed * might contain useful info | MO_NatS_Quot -- signed / (same semantics as IntQuotOp) | MO_NatS_Rem -- signed % (same semantics as IntRemOp) | MO_NatS_Neg -- unary - - | MO_NatU_Mul -- unsigned * + | MO_NatU_Mul -- low word of unsigned * | MO_NatU_Quot -- unsigned / (same semantics as WordQuotOp) | MO_NatU_Rem -- unsigned % (same semantics as WordRemOp) - | MO_NatS_AddC -- signed +, first result sum, second result carry - | MO_NatS_SubC -- signed -, first result sum, second result borrow - | MO_NatS_MulC -- signed *, first result sum, second result carry - | MO_Nat_And | MO_Nat_Or | MO_Nat_Xor @@ -192,6 +188,7 @@ pprMachOp MO_NatU_Gt = text "MO_NatU_Gt" pprMachOp MO_NatU_Lt = text "MO_NatU_Lt" pprMachOp MO_NatS_Mul = text "MO_NatS_Mul" +pprMachOp MO_NatS_MulMayOflo = text "MO_NatS_MulMayOflo" pprMachOp MO_NatS_Quot = text "MO_NatS_Quot" pprMachOp MO_NatS_Rem = text "MO_NatS_Rem" pprMachOp MO_NatS_Neg = text "MO_NatS_Neg" @@ -200,10 +197,6 @@ pprMachOp MO_NatU_Mul = text "MO_NatU_Mul" pprMachOp MO_NatU_Quot = text "MO_NatU_Quot" pprMachOp MO_NatU_Rem = text "MO_NatU_Rem" -pprMachOp MO_NatS_AddC = text "MO_NatS_AddC" -pprMachOp MO_NatS_SubC = text "MO_NatS_SubC" -pprMachOp MO_NatS_MulC = text "MO_NatS_MulC" - pprMachOp MO_Nat_And = text "MO_Nat_And" pprMachOp MO_Nat_Or = text "MO_Nat_Or" pprMachOp MO_Nat_Xor = text "MO_Nat_Xor" @@ -340,139 +333,136 @@ isComparisonMachOp :: MachOp -> Bool isComparisonMachOp mop = comp `elem` snd (machOpProps mop) -- Find the PrimReps for the returned value(s) of the MachOp. -resultRepsOfMachOp :: MachOp -> Maybe012 PrimRep +resultRepsOfMachOp :: MachOp -> Maybe PrimRep resultRepsOfMachOp mop = fst (machOpProps mop) -- This bit does the real work. -machOpProps :: MachOp -> (Maybe012 PrimRep, [MO_Prop]) - -machOpProps MO_Nat_Add = (Just1 IntRep, [inline, comm]) -machOpProps MO_Nat_Sub = (Just1 IntRep, [inline]) -machOpProps MO_Nat_Eq = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_Nat_Ne = (Just1 IntRep, [inline, comp, comm]) - -machOpProps MO_NatS_Ge = (Just1 IntRep, [inline, comp]) -machOpProps MO_NatS_Le = (Just1 IntRep, [inline, comp]) -machOpProps MO_NatS_Gt = (Just1 IntRep, [inline, comp]) -machOpProps MO_NatS_Lt = (Just1 IntRep, [inline, comp]) - -machOpProps MO_NatU_Ge = (Just1 IntRep, [inline, comp]) -machOpProps MO_NatU_Le = (Just1 IntRep, [inline, comp]) -machOpProps MO_NatU_Gt = (Just1 IntRep, [inline, comp]) -machOpProps MO_NatU_Lt = (Just1 IntRep, [inline, comp]) - -machOpProps MO_NatS_Mul = (Just1 IntRep, [inline, comm]) -machOpProps MO_NatS_Quot = (Just1 IntRep, [inline]) -machOpProps MO_NatS_Rem = (Just1 IntRep, [inline]) -machOpProps MO_NatS_Neg = (Just1 IntRep, [inline]) - -machOpProps MO_NatU_Mul = (Just1 WordRep, [inline, comm]) -machOpProps MO_NatU_Quot = (Just1 WordRep, [inline]) -machOpProps MO_NatU_Rem = (Just1 WordRep, [inline]) - -machOpProps MO_NatS_AddC = (Just2 IntRep IntRep, []) -machOpProps MO_NatS_SubC = (Just2 IntRep IntRep, []) -machOpProps MO_NatS_MulC = (Just2 IntRep IntRep, []) - -machOpProps MO_Nat_And = (Just1 IntRep, [inline, comm]) -machOpProps MO_Nat_Or = (Just1 IntRep, [inline, comm]) -machOpProps MO_Nat_Xor = (Just1 IntRep, [inline, comm]) -machOpProps MO_Nat_Not = (Just1 IntRep, [inline]) -machOpProps MO_Nat_Shl = (Just1 IntRep, [inline]) -machOpProps MO_Nat_Shr = (Just1 IntRep, [inline]) -machOpProps MO_Nat_Sar = (Just1 IntRep, [inline]) - -machOpProps MO_32U_Eq = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_32U_Ne = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_32U_Ge = (Just1 IntRep, [inline, comp]) -machOpProps MO_32U_Le = (Just1 IntRep, [inline, comp]) -machOpProps MO_32U_Gt = (Just1 IntRep, [inline, comp]) -machOpProps MO_32U_Lt = (Just1 IntRep, [inline, comp]) - -machOpProps MO_Dbl_Eq = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_Dbl_Ne = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_Dbl_Ge = (Just1 IntRep, [inline, comp]) -machOpProps MO_Dbl_Le = (Just1 IntRep, [inline, comp]) -machOpProps MO_Dbl_Gt = (Just1 IntRep, [inline, comp]) -machOpProps MO_Dbl_Lt = (Just1 IntRep, [inline, comp]) - -machOpProps MO_Dbl_Add = (Just1 DoubleRep, [inline, comm]) -machOpProps MO_Dbl_Sub = (Just1 DoubleRep, [inline]) -machOpProps MO_Dbl_Mul = (Just1 DoubleRep, [inline, comm]) -machOpProps MO_Dbl_Div = (Just1 DoubleRep, [inline]) -machOpProps MO_Dbl_Pwr = (Just1 DoubleRep, []) - -machOpProps MO_Dbl_Sin = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Cos = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Tan = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Sinh = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Cosh = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Tanh = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Asin = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Acos = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Atan = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Log = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Exp = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Sqrt = (Just1 DoubleRep, []) -machOpProps MO_Dbl_Neg = (Just1 DoubleRep, [inline]) - -machOpProps MO_Flt_Add = (Just1 FloatRep, [inline, comm]) -machOpProps MO_Flt_Sub = (Just1 FloatRep, [inline]) -machOpProps MO_Flt_Mul = (Just1 FloatRep, [inline, comm]) -machOpProps MO_Flt_Div = (Just1 FloatRep, [inline]) -machOpProps MO_Flt_Pwr = (Just1 FloatRep, []) - -machOpProps MO_Flt_Eq = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_Flt_Ne = (Just1 IntRep, [inline, comp, comm]) -machOpProps MO_Flt_Ge = (Just1 IntRep, [inline, comp]) -machOpProps MO_Flt_Le = (Just1 IntRep, [inline, comp]) -machOpProps MO_Flt_Gt = (Just1 IntRep, [inline, comp]) -machOpProps MO_Flt_Lt = (Just1 IntRep, [inline, comp]) - -machOpProps MO_Flt_Sin = (Just1 FloatRep, []) -machOpProps MO_Flt_Cos = (Just1 FloatRep, []) -machOpProps MO_Flt_Tan = (Just1 FloatRep, []) -machOpProps MO_Flt_Sinh = (Just1 FloatRep, []) -machOpProps MO_Flt_Cosh = (Just1 FloatRep, []) -machOpProps MO_Flt_Tanh = (Just1 FloatRep, []) -machOpProps MO_Flt_Asin = (Just1 FloatRep, []) -machOpProps MO_Flt_Acos = (Just1 FloatRep, []) -machOpProps MO_Flt_Atan = (Just1 FloatRep, []) -machOpProps MO_Flt_Log = (Just1 FloatRep, []) -machOpProps MO_Flt_Exp = (Just1 FloatRep, []) -machOpProps MO_Flt_Sqrt = (Just1 FloatRep, []) -machOpProps MO_Flt_Neg = (Just1 FloatRep, [inline]) - -machOpProps MO_32U_to_NatS = (Just1 IntRep, [inline]) -machOpProps MO_NatS_to_32U = (Just1 WordRep, [inline]) - -machOpProps MO_NatS_to_Dbl = (Just1 DoubleRep, [inline]) -machOpProps MO_Dbl_to_NatS = (Just1 IntRep, [inline]) - -machOpProps MO_NatS_to_Flt = (Just1 FloatRep, [inline]) -machOpProps MO_Flt_to_NatS = (Just1 IntRep, [inline]) - -machOpProps MO_NatS_to_NatU = (Just1 WordRep, [inline]) -machOpProps MO_NatU_to_NatS = (Just1 IntRep, [inline]) - -machOpProps MO_NatS_to_NatP = (Just1 PtrRep, [inline]) -machOpProps MO_NatP_to_NatS = (Just1 IntRep, [inline]) -machOpProps MO_NatU_to_NatP = (Just1 PtrRep, [inline]) -machOpProps MO_NatP_to_NatU = (Just1 WordRep, [inline]) - -machOpProps MO_Dbl_to_Flt = (Just1 FloatRep, [inline]) -machOpProps MO_Flt_to_Dbl = (Just1 DoubleRep, [inline]) - -machOpProps MO_8S_to_NatS = (Just1 IntRep, [inline]) -machOpProps MO_16S_to_NatS = (Just1 IntRep, [inline]) -machOpProps MO_32S_to_NatS = (Just1 IntRep, [inline]) - -machOpProps MO_8U_to_NatU = (Just1 WordRep, [inline]) -machOpProps MO_16U_to_NatU = (Just1 WordRep, [inline]) -machOpProps MO_32U_to_NatU = (Just1 WordRep, [inline]) - -machOpProps (MO_ReadOSBI offset rep) = (Just1 rep, [inline]) -machOpProps (MO_WriteOSBI offset rep) = (Just0, [inline]) +machOpProps :: MachOp -> (Maybe PrimRep, [MO_Prop]) + +machOpProps MO_Nat_Add = (Just IntRep, [inline, comm]) +machOpProps MO_Nat_Sub = (Just IntRep, [inline]) +machOpProps MO_Nat_Eq = (Just IntRep, [inline, comp, comm]) +machOpProps MO_Nat_Ne = (Just IntRep, [inline, comp, comm]) + +machOpProps MO_NatS_Ge = (Just IntRep, [inline, comp]) +machOpProps MO_NatS_Le = (Just IntRep, [inline, comp]) +machOpProps MO_NatS_Gt = (Just IntRep, [inline, comp]) +machOpProps MO_NatS_Lt = (Just IntRep, [inline, comp]) + +machOpProps MO_NatU_Ge = (Just IntRep, [inline, comp]) +machOpProps MO_NatU_Le = (Just IntRep, [inline, comp]) +machOpProps MO_NatU_Gt = (Just IntRep, [inline, comp]) +machOpProps MO_NatU_Lt = (Just IntRep, [inline, comp]) + +machOpProps MO_NatS_Mul = (Just IntRep, [inline, comm]) +machOpProps MO_NatS_MulMayOflo = (Just IntRep, [inline, comm]) +machOpProps MO_NatS_Quot = (Just IntRep, [inline]) +machOpProps MO_NatS_Rem = (Just IntRep, [inline]) +machOpProps MO_NatS_Neg = (Just IntRep, [inline]) + +machOpProps MO_NatU_Mul = (Just WordRep, [inline, comm]) +machOpProps MO_NatU_Quot = (Just WordRep, [inline]) +machOpProps MO_NatU_Rem = (Just WordRep, [inline]) + +machOpProps MO_Nat_And = (Just IntRep, [inline, comm]) +machOpProps MO_Nat_Or = (Just IntRep, [inline, comm]) +machOpProps MO_Nat_Xor = (Just IntRep, [inline, comm]) +machOpProps MO_Nat_Not = (Just IntRep, [inline]) +machOpProps MO_Nat_Shl = (Just IntRep, [inline]) +machOpProps MO_Nat_Shr = (Just IntRep, [inline]) +machOpProps MO_Nat_Sar = (Just IntRep, [inline]) + +machOpProps MO_32U_Eq = (Just IntRep, [inline, comp, comm]) +machOpProps MO_32U_Ne = (Just IntRep, [inline, comp, comm]) +machOpProps MO_32U_Ge = (Just IntRep, [inline, comp]) +machOpProps MO_32U_Le = (Just IntRep, [inline, comp]) +machOpProps MO_32U_Gt = (Just IntRep, [inline, comp]) +machOpProps MO_32U_Lt = (Just IntRep, [inline, comp]) + +machOpProps MO_Dbl_Eq = (Just IntRep, [inline, comp, comm]) +machOpProps MO_Dbl_Ne = (Just IntRep, [inline, comp, comm]) +machOpProps MO_Dbl_Ge = (Just IntRep, [inline, comp]) +machOpProps MO_Dbl_Le = (Just IntRep, [inline, comp]) +machOpProps MO_Dbl_Gt = (Just IntRep, [inline, comp]) +machOpProps MO_Dbl_Lt = (Just IntRep, [inline, comp]) + +machOpProps MO_Dbl_Add = (Just DoubleRep, [inline, comm]) +machOpProps MO_Dbl_Sub = (Just DoubleRep, [inline]) +machOpProps MO_Dbl_Mul = (Just DoubleRep, [inline, comm]) +machOpProps MO_Dbl_Div = (Just DoubleRep, [inline]) +machOpProps MO_Dbl_Pwr = (Just DoubleRep, []) + +machOpProps MO_Dbl_Sin = (Just DoubleRep, []) +machOpProps MO_Dbl_Cos = (Just DoubleRep, []) +machOpProps MO_Dbl_Tan = (Just DoubleRep, []) +machOpProps MO_Dbl_Sinh = (Just DoubleRep, []) +machOpProps MO_Dbl_Cosh = (Just DoubleRep, []) +machOpProps MO_Dbl_Tanh = (Just DoubleRep, []) +machOpProps MO_Dbl_Asin = (Just DoubleRep, []) +machOpProps MO_Dbl_Acos = (Just DoubleRep, []) +machOpProps MO_Dbl_Atan = (Just DoubleRep, []) +machOpProps MO_Dbl_Log = (Just DoubleRep, []) +machOpProps MO_Dbl_Exp = (Just DoubleRep, []) +machOpProps MO_Dbl_Sqrt = (Just DoubleRep, []) +machOpProps MO_Dbl_Neg = (Just DoubleRep, [inline]) + +machOpProps MO_Flt_Add = (Just FloatRep, [inline, comm]) +machOpProps MO_Flt_Sub = (Just FloatRep, [inline]) +machOpProps MO_Flt_Mul = (Just FloatRep, [inline, comm]) +machOpProps MO_Flt_Div = (Just FloatRep, [inline]) +machOpProps MO_Flt_Pwr = (Just FloatRep, []) + +machOpProps MO_Flt_Eq = (Just IntRep, [inline, comp, comm]) +machOpProps MO_Flt_Ne = (Just IntRep, [inline, comp, comm]) +machOpProps MO_Flt_Ge = (Just IntRep, [inline, comp]) +machOpProps MO_Flt_Le = (Just IntRep, [inline, comp]) +machOpProps MO_Flt_Gt = (Just IntRep, [inline, comp]) +machOpProps MO_Flt_Lt = (Just IntRep, [inline, comp]) + +machOpProps MO_Flt_Sin = (Just FloatRep, []) +machOpProps MO_Flt_Cos = (Just FloatRep, []) +machOpProps MO_Flt_Tan = (Just FloatRep, []) +machOpProps MO_Flt_Sinh = (Just FloatRep, []) +machOpProps MO_Flt_Cosh = (Just FloatRep, []) +machOpProps MO_Flt_Tanh = (Just FloatRep, []) +machOpProps MO_Flt_Asin = (Just FloatRep, []) +machOpProps MO_Flt_Acos = (Just FloatRep, []) +machOpProps MO_Flt_Atan = (Just FloatRep, []) +machOpProps MO_Flt_Log = (Just FloatRep, []) +machOpProps MO_Flt_Exp = (Just FloatRep, []) +machOpProps MO_Flt_Sqrt = (Just FloatRep, []) +machOpProps MO_Flt_Neg = (Just FloatRep, [inline]) + +machOpProps MO_32U_to_NatS = (Just IntRep, [inline]) +machOpProps MO_NatS_to_32U = (Just WordRep, [inline]) + +machOpProps MO_NatS_to_Dbl = (Just DoubleRep, [inline]) +machOpProps MO_Dbl_to_NatS = (Just IntRep, [inline]) + +machOpProps MO_NatS_to_Flt = (Just FloatRep, [inline]) +machOpProps MO_Flt_to_NatS = (Just IntRep, [inline]) + +machOpProps MO_NatS_to_NatU = (Just WordRep, [inline]) +machOpProps MO_NatU_to_NatS = (Just IntRep, [inline]) + +machOpProps MO_NatS_to_NatP = (Just PtrRep, [inline]) +machOpProps MO_NatP_to_NatS = (Just IntRep, [inline]) +machOpProps MO_NatU_to_NatP = (Just PtrRep, [inline]) +machOpProps MO_NatP_to_NatU = (Just WordRep, [inline]) + +machOpProps MO_Dbl_to_Flt = (Just FloatRep, [inline]) +machOpProps MO_Flt_to_Dbl = (Just DoubleRep, [inline]) + +machOpProps MO_8S_to_NatS = (Just IntRep, [inline]) +machOpProps MO_16S_to_NatS = (Just IntRep, [inline]) +machOpProps MO_32S_to_NatS = (Just IntRep, [inline]) + +machOpProps MO_8U_to_NatU = (Just WordRep, [inline]) +machOpProps MO_16U_to_NatU = (Just WordRep, [inline]) +machOpProps MO_32U_to_NatU = (Just WordRep, [inline]) + +machOpProps (MO_ReadOSBI offset rep) = (Just rep, [inline]) +machOpProps (MO_WriteOSBI offset rep) = (Nothing, [inline]) diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 0cd8d85..fd7daf8 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -45,7 +45,7 @@ import Literal ( Literal(..) ) import TyCon ( tyConDataCons ) import Name ( NamedThing(..) ) import DataCon ( dataConWrapId ) -import Maybes ( Maybe012(..), maybe012ToList, maybeToBool, catMaybes ) +import Maybes ( maybeToBool, catMaybes ) import PrimOp ( primOpNeedsWrapper ) import MachOp ( MachOp(..) ) import ForeignCall ( ForeignCall(..) ) @@ -60,7 +60,7 @@ import BitSet ( BitSet, intBS ) import Outputable import GlaExts import Util ( nOfThem, lengthExceeds, listLengthCmp ) -import Maybe ( isNothing ) +import Maybe ( isNothing, maybeToList ) import ST @@ -255,7 +255,7 @@ pprAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs) _ -- NEW CASES FOR EXPANDED PRIMOPS -- We have to deal with some of these specially -pprAbsC (CMachOpStmt (Just1 res) (MO_ReadOSBI offw scaleRep) +pprAbsC (CMachOpStmt (Just res) (MO_ReadOSBI offw scaleRep) [baseAmode, indexAmode] maybe_vols) _ | isNothing maybe_vols @@ -266,7 +266,7 @@ pprAbsC (CMachOpStmt (Just1 res) (MO_ReadOSBI offw scaleRep) | otherwise = panic "pprAbsC:MO_ReadOSBI -- out-of-line array indexing ?!?!" -pprAbsC (CMachOpStmt Just0 (MO_WriteOSBI offw scaleRep) +pprAbsC (CMachOpStmt Nothing (MO_WriteOSBI offw scaleRep) [baseAmode, indexAmode, vAmode] maybe_vols) _ | isNothing maybe_vols @@ -277,18 +277,10 @@ pprAbsC (CMachOpStmt Just0 (MO_WriteOSBI offw scaleRep) | otherwise = panic "pprAbsC:MO_WriteOSBI -- out-of-line array indexing ?!?!" -pprAbsC (CMachOpStmt (Just2 res carry) mop [arg1,arg2] maybe_vols) _ - | mop `elem` [MO_NatS_AddC, MO_NatS_SubC, MO_NatS_MulC] - = hcat [ pprMachOp_for_C mop, - lparen, - ppr_amode res, comma, ppr_amode carry, comma, - pprAmode arg1, comma, pprAmode arg2, - rparen, semi ] - -- The rest generically. -pprAbsC stmt@(CMachOpStmt (Just1 res) mop [arg1,arg2] maybe_vols) _ - = let prefix_fn = mop `elem` [MO_Dbl_Pwr, MO_Flt_Pwr] +pprAbsC stmt@(CMachOpStmt (Just res) mop [arg1,arg2] maybe_vols) _ + = let prefix_fn = mop `elem` [MO_Dbl_Pwr, MO_Flt_Pwr, MO_NatS_MulMayOflo] in case ppr_maybe_vol_regs maybe_vols of {(saves,restores) -> saves $$ @@ -302,7 +294,7 @@ pprAbsC stmt@(CMachOpStmt (Just1 res) mop [arg1,arg2] maybe_vols) _ $$ restores } -pprAbsC stmt@(CMachOpStmt (Just1 res) mop [arg1] maybe_vols) _ +pprAbsC stmt@(CMachOpStmt (Just res) mop [arg1] maybe_vols) _ = case ppr_maybe_vol_regs maybe_vols of {(saves,restores) -> saves $$ hcat [ppr_amode res, equals, @@ -664,6 +656,7 @@ pprMachOp_for_C MO_NatU_Gt = text ">" pprMachOp_for_C MO_NatU_Lt = text "<" pprMachOp_for_C MO_NatS_Mul = char '*' +pprMachOp_for_C MO_NatS_MulMayOflo = text "mulIntMayOflo" pprMachOp_for_C MO_NatS_Quot = char '/' pprMachOp_for_C MO_NatS_Rem = char '%' pprMachOp_for_C MO_NatS_Neg = char '-' @@ -672,10 +665,6 @@ pprMachOp_for_C MO_NatU_Mul = char '*' pprMachOp_for_C MO_NatU_Quot = char '/' pprMachOp_for_C MO_NatU_Rem = char '%' -pprMachOp_for_C MO_NatS_AddC = text "addIntCzh" -pprMachOp_for_C MO_NatS_SubC = text "subIntCzh" -pprMachOp_for_C MO_NatS_MulC = text "mulIntCzh" - pprMachOp_for_C MO_Nat_And = text "&" pprMachOp_for_C MO_Nat_Or = text "|" pprMachOp_for_C MO_Nat_Xor = text "^" @@ -1718,7 +1707,7 @@ ppr_decls_AbsC (CInitHdr cl_info reg_rel cost_centre _) where info_lbl = infoTableLabelFromCI cl_info -ppr_decls_AbsC (CMachOpStmt res _ args _) = ppr_decls_Amodes (maybe012ToList res ++ args) +ppr_decls_AbsC (CMachOpStmt res _ args _) = ppr_decls_Amodes (maybeToList res ++ args) ppr_decls_AbsC (COpStmt results _ args _) = ppr_decls_Amodes (results ++ args) ppr_decls_AbsC (CSimultaneous abc) = ppr_decls_AbsC abc diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs index 90d2868..2445f57 100644 --- a/ghc/compiler/nativeGen/AbsCStixGen.lhs +++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs @@ -30,7 +30,7 @@ import ClosureInfo ( infoTableLabelFromCI, entryLabelFromCI, staticClosureNeedsLink ) import Literal ( Literal(..), word2IntLit ) -import Maybes ( Maybe012(..), maybeToBool ) +import Maybes ( maybeToBool ) import StgSyn ( StgOp(..) ) import MachOp ( MachOp(..), resultRepsOfMachOp ) import PrimRep ( isFloatingRep, is64BitRep, @@ -414,7 +414,7 @@ Now the PrimOps, some of which may need caller-saves register wrappers. -- Translate out array indexing primops right here, so that -- individual targets don't have to deal with them - gencode (CMachOpStmt (Just1 r1) (MO_ReadOSBI off_w rep) [base,index] vols) + gencode (CMachOpStmt (Just r1) (MO_ReadOSBI off_w rep) [base,index] vols) = returnUs (\xs -> mkStAssign rep @@ -425,7 +425,8 @@ Now the PrimOps, some of which may need caller-saves register wrappers. : xs ) - gencode (CMachOpStmt Just0 (MO_WriteOSBI off_w rep) [base,index,val] vols) + -- Ordinary MachOps are passed through unchanged. + gencode (CMachOpStmt Nothing (MO_WriteOSBI off_w rep) [base,index,val] vols) = returnUs (\xs -> StAssignMem rep @@ -436,33 +437,14 @@ Now the PrimOps, some of which may need caller-saves register wrappers. : xs ) - -- Gruesome cases for multiple-result primops - gencode (CMachOpStmt (Just2 r1 r2) mop [arg1, arg2] vols) - | mop `elem` [MO_NatS_AddC, MO_NatS_SubC, MO_NatS_MulC] - = getUniqueUs `thenUs` \ u1 -> - getUniqueUs `thenUs` \ u2 -> - let vr1 = StixVReg u1 IntRep - vr2 = StixVReg u2 IntRep - r1s = a2stix r1 - r2s = a2stix r2 - in - returnUs (\xs -> - StAssignMachOp (Just2 vr1 vr2) mop [a2stix arg1, a2stix arg2] - : mkStAssign IntRep r1s (StReg (StixTemp vr1)) - : mkStAssign IntRep r2s (StReg (StixTemp vr2)) - : xs - ) - - -- Ordinary MachOps are passed through unchanged. - - gencode (CMachOpStmt (Just1 r1) mop args vols) - = let (Just1 rep) = resultRepsOfMachOp mop - in - returnUs (\xs -> - mkStAssign rep (a2stix r1) - (StMachOp mop (map a2stix args)) - : xs - ) + gencode (CMachOpStmt (Just r1) mop args vols) + = case resultRepsOfMachOp mop of + Just rep + -> returnUs (\xs -> + mkStAssign rep (a2stix r1) + (StMachOp mop (map a2stix args)) + : xs + ) \end{code} Now the dreaded conditional jump. diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs index 8ec5901..da1dde4 100644 --- a/ghc/compiler/nativeGen/AsmCodeGen.lhs +++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs @@ -237,8 +237,6 @@ stixStmt_ConFold stmt (StAssignMem pk baseRegAddr src) StAssignMem pk addr src -> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src) - StAssignMachOp lhss mop args - -> StAssignMachOp lhss mop (map stixExpr_ConFold args) StVoidable expr -> StVoidable (stixExpr_ConFold expr) StJump dsts addr diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 8e90d29..ff2800e 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -27,7 +27,7 @@ import CLabel ( CLabel, labelDynamic ) #if sparc_TARGET_ARCH || alpha_TARGET_ARCH import CLabel ( isAsmTemp ) #endif -import Maybes ( maybeToBool, Maybe012(..) ) +import Maybes ( maybeToBool ) import PrimRep ( isFloatingRep, is64BitRep, PrimRep(..), getPrimRepArrayElemSize ) import Stix ( getNatLabelNCG, StixStmt(..), StixExpr(..), @@ -103,8 +103,6 @@ stmtToInstrs stmt = case stmt of | ncg_target_is_32bit && is64BitRep pk -> assignReg_I64Code reg (derefDLL src) | otherwise -> assignReg_IntCode pk reg (derefDLL src) - StAssignMachOp lhss mop rhss - -> assignMachOp lhss mop rhss StFallThrough lbl -- When falling through on the Alpha, we still have to load pv @@ -165,9 +163,6 @@ derefDLL tree StReg _ -> t _ -> pprPanic "derefDLL: unhandled case" (pprStixExpr t) - -assignMachOp :: Maybe012 StixVReg -> MachOp -> [StixExpr] - -> NatM InstrBlock \end{code} %************************************************************************ @@ -968,6 +963,7 @@ getRegister (StMachOp mop [x, y]) -- dyadic MachOps MO_NatU_Rem -> trivialCode (REM L) Nothing x y MO_NatS_Mul -> let op = IMUL L in trivialCode op (Just op) x y MO_NatU_Mul -> let op = MUL L in trivialCode op (Just op) x y + MO_NatS_MulMayOflo -> imulMayOflo x y MO_Flt_Add -> trivialFCode FloatRep GADD x y MO_Flt_Sub -> trivialFCode FloatRep GSUB x y @@ -1003,6 +999,31 @@ getRegister (StMachOp mop [x, y]) -- dyadic MachOps demote x = StMachOp MO_Dbl_to_Flt [x] -------------------- + imulMayOflo :: StixExpr -> StixExpr -> NatM Register + imulMayOflo a1 a2 + = getNewRegNCG IntRep `thenNat` \ t1 -> + getNewRegNCG IntRep `thenNat` \ t2 -> + getNewRegNCG IntRep `thenNat` \ res_lo -> + getNewRegNCG IntRep `thenNat` \ res_hi -> + getRegister a1 `thenNat` \ reg1 -> + getRegister a2 `thenNat` \ reg2 -> + let code1 = registerCode reg1 t1 + code2 = registerCode reg2 t2 + src1 = registerName reg1 t1 + src2 = registerName reg2 t2 + code dst = 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 + SAR L (ImmInt 31) (OpReg res_lo), -- sign extend lower part + SUB L (OpReg res_hi) (OpReg res_lo), -- compare against upper + MOV L (OpReg res_lo) (OpReg dst) + -- dst==0 if high part == sign extended low part + ] + in + returnNat (Any IntRep code) + + -------------------- shift_code :: (Imm -> Operand -> Instr) -> StixExpr -> StixExpr @@ -1173,41 +1194,6 @@ getRegister leaf imm = maybeImm leaf imm__2 = case imm of Just x -> x - - -assignMachOp (Just2 sv_rr sv_cc) mop [aa,bb] - | mop `elem` [MO_NatS_AddC, MO_NatS_SubC, MO_NatS_MulC] - = getRegister aa `thenNat` \ registeraa -> - getRegister bb `thenNat` \ registerbb -> - getNewRegNCG IntRep `thenNat` \ tmp -> - getNewRegNCG IntRep `thenNat` \ tmpaa -> - getNewRegNCG IntRep `thenNat` \ tmpbb -> - let stixVReg_to_VReg (StixVReg u rep) = mkVReg u rep - rr = stixVReg_to_VReg sv_rr - cc = stixVReg_to_VReg sv_cc - codeaa = registerCode registeraa tmpaa - srcaa = registerName registeraa tmpaa - codebb = registerCode registerbb tmpbb - srcbb = registerName registerbb tmpbb - - insn = case mop of MO_NatS_AddC -> ADD; MO_NatS_SubC -> SUB - MO_NatS_MulC -> IMUL - cond = if mop == MO_NatS_MulC then OFLO else CARRY - str = showSDoc (pprMachOp mop) - - code = toOL [ - COMMENT (_PK_ ("begin " ++ str)), - MOV L (OpReg srcbb) (OpReg tmp), - insn L (OpReg srcaa) (OpReg tmp), - MOV L (OpReg tmp) (OpReg rr), - MOV L (OpImm (ImmInt 0)) (OpReg eax), - SETCC cond (OpReg eax), - MOV L (OpReg eax) (OpReg cc), - COMMENT (_PK_ ("end " ++ str)) - ] - in - returnNat (codeaa `appOL` codebb `appOL` code) - #endif {- i386_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1436,43 +1422,6 @@ getRegister leaf imm = maybeImm leaf imm__2 = case imm of Just x -> x - - -assignMachOp (Just2 sv_rr sv_cc) mop [aa,bb] - = panic "assignMachOp(sparc)" -{- - | mop `elem` [MO_NatS_AddC, MO_NatS_SubC, MO_NatS_MulC] - = getRegister aa `thenNat` \ registeraa -> - getRegister bb `thenNat` \ registerbb -> - getNewRegNCG IntRep `thenNat` \ tmp -> - getNewRegNCG IntRep `thenNat` \ tmpaa -> - getNewRegNCG IntRep `thenNat` \ tmpbb -> - let stixVReg_to_VReg (StixVReg u rep) = mkVReg u rep - rr = stixVReg_to_VReg sv_rr - cc = stixVReg_to_VReg sv_cc - codeaa = registerCode registeraa tmpaa - srcaa = registerName registeraa tmpaa - codebb = registerCode registerbb tmpbb - srcbb = registerName registerbb tmpbb - - insn = case mop of MO_NatS_AddC -> ADD; MO_NatS_SubC -> SUB - MO_NatS_MulC -> IMUL - cond = if mop == MO_NatS_MulC then OFLO else CARRY - str = showSDoc (pprMachOp mop) - - code = toOL [ - COMMENT (_PK_ ("begin " ++ str)), - MOV L (OpReg srcbb) (OpReg tmp), - insn L (OpReg srcaa) (OpReg tmp), - MOV L (OpReg tmp) (OpReg rr), - MOV L (OpImm (ImmInt 0)) (OpReg eax), - SETCC cond (OpReg eax), - MOV L (OpReg eax) (OpReg cc), - COMMENT (_PK_ ("end " ++ str)) - ] - in - returnNat (codeaa `appOL` codebb `appOL` code) --} #endif {- sparc_TARGET_ARCH -} -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 6b2c181..f7f4b8f 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -493,6 +493,8 @@ but we don't care, since it doesn't get used much. We hope. | SUB Size Operand Operand | IMUL Size Operand Operand -- signed int mul | MUL Size Operand Operand -- unsigned int mul + | IMUL64 Reg Reg -- 32 x 32 -> 64 signed mul + -- operand1:operand2 := (operand1[31:0] *signed operand2[31:0]) -- Quotient and remainder. SEE comment above -- these are not -- real x86 insns; instead they are expanded when printed diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index fd11258..e643e75 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -989,6 +989,9 @@ pprInstr (IREM sz src dst) = pprInstr_quotRem True False sz src dst pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst pprInstr (REM sz src dst) = pprInstr_quotRem False False sz src dst +pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo + + -- Simulating a flat register set on the x86 FP stack is tricky. -- you have to free %st(7) before pushing anything on the FP reg stack -- so as to preclude the possibility of a FP stack overflow exception. @@ -1143,6 +1146,24 @@ pprInstr_quotRem signed isQuot sz src dst fakeInsn = text opStr <+> pprOperand sz src <> char ',' <+> pprOperand sz dst +-- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg +pprInstr_imul64 hi_reg lo_reg + = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg + pp_hi_reg = pprReg L hi_reg + pp_lo_reg = pprReg L lo_reg + in + vcat [ + text "\t# BEGIN " <> fakeInsn, + text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg, + text "\tpushl %eax ; pushl %edx", + text "\tmovl 12(%esp), %eax ; imull 8(%esp)", + text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)", + text "\tpopl %edx ; popl %eax", + text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg, + text "\t# END " <> fakeInsn + ] + + -------------------------- -- coerce %st(0) to the specified size diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 8d82ae3..5d8f73b 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -236,6 +236,7 @@ regUsage instr = case instr of ADD sz src dst -> usageRM src dst SUB sz src dst -> usageRM src dst IMUL sz src dst -> usageRM src dst + IMUL64 sd1 sd2 -> mkRU [sd1,sd2] [sd1,sd2] MUL sz src dst -> usageRM src dst IQUOT sz src dst -> usageRM src dst IREM sz src dst -> usageRM src dst @@ -627,6 +628,7 @@ patchRegs instr env = case instr of ADD sz src dst -> patch2 (ADD sz) src dst SUB sz src dst -> patch2 (SUB sz) src dst IMUL sz src dst -> patch2 (IMUL sz) src dst + IMUL64 sd1 sd2 -> IMUL64 (env sd1) (env sd2) MUL sz src dst -> patch2 (MUL sz) src dst IQUOT sz src dst -> patch2 (IQUOT sz) src dst IREM sz src dst -> patch2 (IREM sz) src dst diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index 4af4982..573496c 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -46,7 +46,6 @@ import Unique ( Unique ) import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize ) import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply, UniqSM, thenUs, returnUs, getUniqueUs ) -import Maybes ( Maybe012(..), maybe012ToList ) import Constants ( wORD_SIZE ) import Outputable import FastTypes @@ -73,10 +72,6 @@ data StixStmt -- assigned to, so there is an implicit dereference here. | StAssignMem PrimRep StixExpr StixExpr -- dst, src - -- Do a machine op which generates multiple values, and assign - -- the results to the lvalues stated here. - | StAssignMachOp (Maybe012 StixVReg) MachOp [StixExpr] - -- A simple assembly label that we might jump to. | StLabel CLabel @@ -171,8 +166,8 @@ repOfStixExpr (StInd rep _) = rep repOfStixExpr (StCall target conv retrep args) = retrep repOfStixExpr (StMachOp mop args) = case resultRepsOfMachOp mop of - Just1 rep -> rep - other -> pprPanic "repOfStixExpr:StMachOp" (pprMachOp mop) + Just rep -> rep + Nothing -> pprPanic "repOfStixExpr:StMachOp" (pprMachOp mop) -- used by insnFuture in RegAllocInfo.lhs @@ -228,13 +223,6 @@ pprStixStmt t -> ppr pr <> char '[' <> pprStixExpr addr <> char ']' <> text " :=" <> ppr pr <> text " " <> pprStixExpr rhs - StAssignMachOp lhss mop args - -> parens (hcat (punctuate comma ( - map pprStixVReg (maybe012ToList lhss) - ))) - <> text " := " - <> pprMachOp mop - <> parens (hsep (punctuate comma (map pprStixExpr args))) StLabel ll -> pprCLabel ll <+> char ':' StFunBegin ll -> char ' ' $$ parens (text "FunBegin" <+> pprCLabel ll) StFunEnd ll -> parens (text "FunEnd" <+> pprCLabel ll) @@ -372,8 +360,6 @@ stixStmt_CountTempUses u t StJump dsts t1 -> qe t1 StCondJump lbl t1 -> qe t1 StData pk ts -> sum (map qe ts) - StAssignMachOp lhss mop args - -> sum (map qv (maybe012ToList lhss)) + sum (map qe args) StVoidable expr -> qe expr StSegment _ -> 0 StFunBegin _ -> 0 @@ -430,21 +416,6 @@ stixStmt_MapUniques f t qs = stixStmt_MapUniques f qr = stixReg_MapUniques f qv = stixVReg_MapUniques f - - doMopLhss Just0 = Just0 - doMopLhss (Just1 r1) - = case qv r1 of - Nothing -> Just1 r1 - other -> doMopLhss_panic - doMopLhss (Just2 r1 r2) - = case (qv r1, qv r2) of - (Nothing, Nothing) -> Just2 r1 r2 - other -> doMopLhss_panic - -- Because the StixRegs processed by doMopLhss are lvalues, they - -- absolutely shouldn't be mapped to a StixExpr; - -- hence we panic if they do. Same deal for StAssignReg below. - doMopLhss_panic - = panic "stixStmt_MapUniques:doMopLhss" in case t of StAssignReg pk reg rhs @@ -455,9 +426,7 @@ stixStmt_MapUniques f t StJump dsts t1 -> StJump dsts (qe t1) StCondJump lbl t1 -> StCondJump lbl (qe t1) StData pk ts -> StData pk (map qe ts) - StVoidable expr -> StVoidable (qe expr) - StAssignMachOp lhss mop args - -> StAssignMachOp (doMopLhss lhss) mop (map qe args) + StVoidable expr -> StVoidable (qe expr) StSegment _ -> t StLabel _ -> t StFunBegin _ -> t diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp index 2bdd64c..40b737c 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.13 2001/12/13 10:47:28 sewardj Exp $ +-- $Id: primops.txt.pp,v 1.14 2001/12/14 15:26:16 sewardj Exp $ -- -- Primitive Operations -- @@ -180,6 +180,30 @@ primop IntSubOp "-#" Dyadic Int# -> Int# -> Int# primop IntMulOp "*#" Dyadic Int# -> Int# -> Int# + {Low word of signed integer multiply.} + with commutable = True + +primop IntMulMayOfloOp "mulIntMayOflo#" + GenPrimOp Int# -> Int# -> Bool + {Return True 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. + 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. + + On a 64-bit platform it is not always possible to + acquire the top 64 bits of the result. Therefore, a recommended + implementation is to take the absolute value of both operands, and + return 0 iff bits[63:31] of them are zero, since that means that their + magnitudes fit within 31 bits, so the magnitude of the product must fit + into 62 bits. + + If in doubt, return non-zero, but do make an effort to create the + correct answer for small args, since otherwise the performance of + (*) :: Integer -> Integer -> Integer will be poor. + } with commutable = True primop IntQuotOp "quotInt#" Dyadic @@ -197,11 +221,12 @@ primop IntGcdOp "gcdInt#" Dyadic Int# -> Int# -> Int# primop IntNegOp "negateInt#" Monadic Int# -> Int# primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Add with carry. First member of result is (wrapped) sum; second member is 0 iff no overflow occured.} + {Add with carry. First member of result is (wrapped) sum; + second member is 0 iff no overflow occured.} primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Subtract with carry. First member of result is (wrapped) difference; second member is 0 iff no overflow occured.} -primop IntMulCOp "mulIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Multiply with carry. First member of result is (wrapped) product; second member is 0 iff no overflow occured.} + {Subtract with carry. First member of result is (wrapped) difference; + second member is 0 iff no overflow occured.} + primop IntGtOp ">#" Compare Int# -> Int# -> Bool primop IntGeOp ">=#" Compare Int# -> Int# -> Bool diff --git a/ghc/compiler/utils/Maybes.lhs b/ghc/compiler/utils/Maybes.lhs index 1cb6aee..353c3b5 100644 --- a/ghc/compiler/utils/Maybes.lhs +++ b/ghc/compiler/utils/Maybes.lhs @@ -5,7 +5,6 @@ \begin{code} module Maybes ( - Maybe012(..), maybe012ToList, MaybeErr(..), orElse, @@ -29,22 +28,6 @@ import Maybe( catMaybes, mapMaybe ) infixr 4 `orElse` \end{code} - -%************************************************************************ -%* * -\subsection[Maybe012 type]{The @Maybe012@ type} -%* * -%************************************************************************ - -\begin{code} -data Maybe012 a = Just0 | Just1 a | Just2 a a deriving (Eq,Show) - -maybe012ToList Just0 = [] -maybe012ToList (Just1 x) = [x] -maybe012ToList (Just2 x y) = [x, y] -\end{code} - - %************************************************************************ %* * \subsection[Maybe type]{The @Maybe@ type} diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 3af5f88..f7191da 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.88 2001/12/11 18:25:15 sof Exp $ + * $Id: PrimOps.h,v 1.89 2001/12/14 15:26:16 sewardj Exp $ * * (c) The GHC Team, 1998-2000 * @@ -28,38 +28,11 @@ * Int operations with carry. * -------------------------------------------------------------------------- */ -/* With some bit-twiddling, we can define int{Add,Sub}Czh portably in - * C, and without needing any comparisons. This may not be the - * fastest way to do it - if you have better code, please send it! --SDM - * - * Return : r = a + b, c = 0 if no overflow, 1 on overflow. - * - * We currently don't make use of the r value if c is != 0 (i.e. - * overflow), we just convert to big integers and try again. This - * could be improved by making r and c the correct values for - * plugging into a new J#. - */ -#define addIntCzh(r,c,a,b) \ -{ r = ((I_)(a)) + ((I_)(b)); \ - c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ - >> (BITS_IN (I_) - 1); \ -} - - -#define subIntCzh(r,c,a,b) \ -{ r = ((I_)(a)) - ((I_)(b)); \ - c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ - >> (BITS_IN (I_) - 1); \ -} - /* Multiply with overflow checking. * - * This is slightly more tricky - the usual sign rules for add/subtract - * don't apply. + * This is tricky - the usual sign rules for add/subtract don't apply. * - * On x86 hardware we use a hand-crafted assembly fragment to do the job. - * - * On other 32-bit machines we use gcc's 'long long' types, finding + * On 32-bit machines we use gcc's 'long long' types, finding * overflow with some careful bit-twiddling. * * On 64-bit machines where gcc's 'long long' type is also 64-bits, @@ -68,19 +41,7 @@ * multiplication. */ -#if i386_TARGET_ARCH - -#define mulIntCzh(r,c,a,b) \ -{ \ - __asm__("xorl %1,%1\n\t \ - imull %2,%3\n\t \ - jno 1f\n\t \ - movl $1,%1\n\t \ - 1:" \ - : "=r" (r), "=&r" (c) : "r" (a), "0" (b)); \ -} - -#elif SIZEOF_VOID_P == 4 +#if SIZEOF_VOID_P == 4 #ifdef WORDS_BIGENDIAN #define C 0 @@ -95,8 +56,9 @@ typedef union { StgInt32 i[2]; } long_long_u ; -#define mulIntCzh(r,c,a,b) \ -{ \ +#define mulIntMayOflo(a,b) \ +({ \ + StgInt32 r, c; \ long_long_u z; \ z.l = (StgInt64)a * (StgInt64)b; \ r = z.i[R]; \ @@ -105,7 +67,9 @@ typedef union { c = ((StgWord)((a^b) ^ r)) \ >> (BITS_IN (I_) - 1); \ } \ -} + c; \ +}) + /* Careful: the carry calculation above is extremely delicate. Make sure * you test it thoroughly after changing it. */ @@ -116,16 +80,17 @@ typedef union { #define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a))) -#define mulIntCzh(r,c,a,b) \ -{ \ +#define mulIntMayOflo(a,b) \ +({ \ + I_ c; \ if (stg_abs(a) >= HALF_INT || \ stg_abs(b) >= HALF_INT) { \ c = 1; \ } else { \ - r = ((I_)(a)) * ((I_)(b)); \ c = 0; \ } \ -} + c; \ +}) #endif diff --git a/ghc/lib/std/PrelGHC.hi-boot.pp b/ghc/lib/std/PrelGHC.hi-boot.pp index 2a8953a..1223735 100644 --- a/ghc/lib/std/PrelGHC.hi-boot.pp +++ b/ghc/lib/std/PrelGHC.hi-boot.pp @@ -95,7 +95,7 @@ __export PrelGHC uncheckedIShiftRLzh addIntCzh subIntCzh - mulIntCzh + mulIntMayOflozh Wordzh gtWordzh diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs index e2cf190..6447471 100644 --- a/ghc/lib/std/PrelNum.lhs +++ b/ghc/lib/std/PrelNum.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelNum.lhs,v 1.43 2001/12/13 10:48:29 simonpj Exp $ +% $Id: PrelNum.lhs,v 1.44 2001/12/14 15:26:16 sewardj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -352,9 +352,8 @@ 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) = case mulIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 * toBig i2 } +timesInteger i1@(S# i) i2@(S# j) = if mulIntMayOflo# i j then toBig i1 * toBig i2 + else S# (i *# j) 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 -- 1.7.10.4