%
% (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}
import StgSyn ( StgOp )
import TyCon ( TyCon )
import BitSet -- for liveness masks
-import Maybes ( Maybe012(..) )
import FastTypes
import Outputable
-- 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
isDynamicTarget, isCasmTarget, defaultCCallConv )
import StgSyn ( StgOp(..) )
import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
-import Maybes ( Maybe012(..) )
import Outputable
import Panic ( panic )
import FastTypes
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
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
= 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
-- (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
= 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
]
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
]
(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
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
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
-- 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
#include "HsVersions.h"
import PrimRep ( PrimRep(..) )
-import Maybes ( Maybe012(..) )
import Outputable
| 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
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"
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"
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])
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(..) )
import Outputable
import GlaExts
import Util ( nOfThem, lengthExceeds, listLengthCmp )
-import Maybe ( isNothing )
+import Maybe ( isNothing, maybeToList )
import ST
-- 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
| 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
| 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 $$
$$ 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,
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 '-'
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 "^"
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
staticClosureNeedsLink
)
import Literal ( Literal(..), word2IntLit )
-import Maybes ( Maybe012(..), maybeToBool )
+import Maybes ( maybeToBool )
import StgSyn ( StgOp(..) )
import MachOp ( MachOp(..), resultRepsOfMachOp )
import PrimRep ( isFloatingRep, is64BitRep,
-- 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
: 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
: 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.
(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
#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(..),
| 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
StReg _ -> t
_ -> pprPanic "derefDLL: unhandled case"
(pprStixExpr t)
-
-assignMachOp :: Maybe012 StixVReg -> MachOp -> [StixExpr]
- -> NatM InstrBlock
\end{code}
%************************************************************************
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
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
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 -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 -}
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
| 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
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.
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
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
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
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
-- 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
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
-> 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)
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
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
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
-----------------------------------------------------------------------
--- $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
--
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
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
\begin{code}
module Maybes (
- Maybe012(..), maybe012ToList,
MaybeErr(..),
orElse,
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}
/* -----------------------------------------------------------------------------
- * $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
*
* 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,
* 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
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]; \
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.
*/
#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
uncheckedIShiftRLzh
addIntCzh
subIntCzh
- mulIntCzh
+ mulIntMayOflozh
Wordzh
gtWordzh
% ------------------------------------------------------------------------------
-% $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
%
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
projects / ghc-hetmet.git / commitdiff