ghc/compiler/codeGen/CgPrimOp.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Code generation for PrimOps.
   4 --
   5 -- (c) The University of Glasgow 2004
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CgPrimOp (
  10    cgPrimOp
  11  ) where
  12
  13 import StgSyn           ( StgLiveVars, StgArg )
  14 import CgBindery        ( getVolatileRegs, getArgAmodes )
  15 import CgMonad
  16 import CgInfoTbls       ( getConstrTag )
  17 import CgUtils          ( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
  18 import Cmm
  19 import CLabel           ( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel )
  20 import CmmUtils
  21 import MachOp
  22 import SMRep
  23 import PrimOp           ( PrimOp(..) )
  24 import SMRep            ( tablesNextToCode )
  25 import Constants        ( wORD_SIZE, wORD_SIZE_IN_BITS )
  26 import Outputable
  27
  28 -- ---------------------------------------------------------------------------
  29 -- Code generation for PrimOps
  30
  31 cgPrimOp   :: [CmmReg]          -- where to put the results
  32            -> PrimOp            -- the op
  33            -> [StgArg]          -- arguments
  34            -> StgLiveVars       -- live vars, in case we need to save them
  35            -> Code
  36
  37 cgPrimOp results op args live
  38   = do arg_exprs <- getArgAmodes args
  39        let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
  40        emitPrimOp results op non_void_args live
  41
  42
  43 emitPrimOp :: [CmmReg]          -- where to put the results
  44            -> PrimOp            -- the op
  45            -> [CmmExpr]         -- arguments
  46            -> StgLiveVars       -- live vars, in case we need to save them
  47            -> Code
  48
  49 --  First we handle various awkward cases specially.  The remaining
  50 -- easy cases are then handled by translateOp, defined below.
  51
  52 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] live
  53 {-
  54    With some bit-twiddling, we can define int{Add,Sub}Czh portably in
  55    C, and without needing any comparisons.  This may not be the
  56    fastest way to do it - if you have better code, please send it! --SDM
  57
  58    Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
  59
  60    We currently don't make use of the r value if c is != 0 (i.e.
  61    overflow), we just convert to big integers and try again.  This
  62    could be improved by making r and c the correct values for
  63    plugging into a new J#.
  64
  65    { r = ((I_)(a)) + ((I_)(b));                                 \
  66      c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
  67          >> (BITS_IN (I_) - 1);                                 \
  68    }
  69    Wading through the mass of bracketry, it seems to reduce to:
  70    c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
  71
  72 -}
  73    = stmtsC [
  74         CmmAssign res_r (CmmMachOp mo_wordAdd [aa,bb]),
  75         CmmAssign res_c $
  76           CmmMachOp mo_wordUShr [
  77                 CmmMachOp mo_wordAnd [
  78                     CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
  79                     CmmMachOp mo_wordXor [aa, CmmReg res_r]
  80                 ],
  81                 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
  82           ]
  83      ]
  84
  85
  86 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
  87 {- Similarly:
  88    #define subIntCzh(r,c,a,b)                                   \
  89    { r = ((I_)(a)) - ((I_)(b));                                 \
  90      c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
  91          >> (BITS_IN (I_) - 1);                                 \
  92    }
  93
  94    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
  95 -}
  96    = stmtsC [
  97         CmmAssign res_r (CmmMachOp mo_wordSub [aa,bb]),
  98         CmmAssign res_c $
  99           CmmMachOp mo_wordUShr [
 100                 CmmMachOp mo_wordAnd [
 101                     CmmMachOp mo_wordXor [aa,bb],
 102                     CmmMachOp mo_wordXor [aa, CmmReg res_r]
 103                 ],
 104                 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
 105           ]
 106      ]
 107
 108
 109 emitPrimOp [res] ParOp [arg] live
 110    = stmtC (CmmAssign res (CmmLit (mkIntCLit 1)))
 111
 112 emitPrimOp [res] ReadMutVarOp [mutv] live
 113    = stmtC (CmmAssign res (cmmLoadIndexW mutv fixedHdrSize))
 114
 115 emitPrimOp [] WriteMutVarOp [mutv,var] live
 116    = stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
 117
 118 --  #define sizzeofByteArrayzh(r,a) \
 119 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
 120 emitPrimOp [res] SizeofByteArrayOp [arg] live
 121    = stmtC $
 122         CmmAssign res (CmmMachOp mo_wordMul [
 123                           cmmLoadIndexW arg fixedHdrSize,
 124                           CmmLit (mkIntCLit wORD_SIZE)
 125                         ])
 126
 127 --  #define sizzeofMutableByteArrayzh(r,a) \
 128 --      r = (((StgArrWords *)(a))->words * sizeof(W_))
 129 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
 130    = emitPrimOp [res] SizeofByteArrayOp [arg] live
 131
 132
 133 --  #define touchzh(o)                  /* nothing */
 134 emitPrimOp [] TouchOp [arg] live
 135    = nopC
 136
 137 --  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
 138 emitPrimOp [res] ByteArrayContents_Char [arg] live
 139    = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize))
 140
 141 --  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
 142 emitPrimOp [res] StableNameToIntOp [arg] live
 143    = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize))
 144
 145 --  #define eqStableNamezh(r,sn1,sn2)                                   \
 146 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 147 emitPrimOp [res] EqStableNameOp [arg1,arg2] live
 148    = stmtC (CmmAssign res (CmmMachOp mo_wordEq [
 149                                 cmmLoadIndexW arg1 fixedHdrSize,
 150                                 cmmLoadIndexW arg2 fixedHdrSize
 151                          ]))
 152
 153
 154 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
 155    = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2]))
 156
 157 --  #define addrToHValuezh(r,a) r=(P_)a
 158 emitPrimOp [res] AddrToHValueOp [arg] live
 159    = stmtC (CmmAssign res arg)
 160
 161 --  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
 162 emitPrimOp [res] DataToTagOp [arg] live
 163    = stmtC (CmmAssign res (getConstrTag arg))
 164
 165 {- Freezing arrays-of-ptrs requires changing an info table, for the
 166    benefit of the generational collector.  It needs to scavenge mutable
 167    objects, even if they are in old space.  When they become immutable,
 168    they can be removed from this scavenge list.  -}
 169
 170 --  #define unsafeFreezzeArrayzh(r,a)
 171 --      {
 172 --        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
 173 --        r = a;
 174 --      }
 175 emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
 176    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
 177              CmmAssign res arg ]
 178
 179 --  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
 180 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
 181    = stmtC (CmmAssign res arg)
 182
 183 -- Reading/writing pointer arrays
 184
 185 emitPrimOp [r] ReadArrayOp  [obj,ix]   live  = doReadPtrArrayOp r obj ix
 186 emitPrimOp [r] IndexArrayOp [obj,ix]   live  = doReadPtrArrayOp r obj ix
 187 emitPrimOp []  WriteArrayOp [obj,ix,v] live  = doWritePtrArrayOp obj ix v
 188
 189 -- IndexXXXoffAddr
 190
 191 emitPrimOp res IndexOffAddrOp_Char      args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
 192 emitPrimOp res IndexOffAddrOp_WideChar  args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
 193 emitPrimOp res IndexOffAddrOp_Int       args live = doIndexOffAddrOp Nothing wordRep res args
 194 emitPrimOp res IndexOffAddrOp_Word      args live = doIndexOffAddrOp Nothing wordRep res args
 195 emitPrimOp res IndexOffAddrOp_Addr      args live = doIndexOffAddrOp Nothing wordRep res args
 196 emitPrimOp res IndexOffAddrOp_Float     args live = doIndexOffAddrOp Nothing F32 res args
 197 emitPrimOp res IndexOffAddrOp_Double    args live = doIndexOffAddrOp Nothing F64 res args
 198 emitPrimOp res IndexOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
 199 emitPrimOp res IndexOffAddrOp_Int8      args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8  res args
 200 emitPrimOp res IndexOffAddrOp_Int16     args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
 201 emitPrimOp res IndexOffAddrOp_Int32     args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
 202 emitPrimOp res IndexOffAddrOp_Int64     args live = doIndexOffAddrOp Nothing I64 res args
 203 emitPrimOp res IndexOffAddrOp_Word8     args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8  res args
 204 emitPrimOp res IndexOffAddrOp_Word16    args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
 205 emitPrimOp res IndexOffAddrOp_Word32    args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
 206 emitPrimOp res IndexOffAddrOp_Word64    args live = doIndexOffAddrOp Nothing I64 res args
 207
 208 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
 209
 210 emitPrimOp res ReadOffAddrOp_Char      args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
 211 emitPrimOp res ReadOffAddrOp_WideChar  args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
 212 emitPrimOp res ReadOffAddrOp_Int       args live = doIndexOffAddrOp Nothing wordRep res args
 213 emitPrimOp res ReadOffAddrOp_Word      args live = doIndexOffAddrOp Nothing wordRep res args
 214 emitPrimOp res ReadOffAddrOp_Addr      args live = doIndexOffAddrOp Nothing wordRep res args
 215 emitPrimOp res ReadOffAddrOp_Float     args live = doIndexOffAddrOp Nothing F32 res args
 216 emitPrimOp res ReadOffAddrOp_Double    args live = doIndexOffAddrOp Nothing F64 res args
 217 emitPrimOp res ReadOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
 218 emitPrimOp res ReadOffAddrOp_Int8      args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8  res args
 219 emitPrimOp res ReadOffAddrOp_Int16     args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
 220 emitPrimOp res ReadOffAddrOp_Int32     args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
 221 emitPrimOp res ReadOffAddrOp_Int64     args live = doIndexOffAddrOp Nothing I64 res args
 222 emitPrimOp res ReadOffAddrOp_Word8     args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8  res args
 223 emitPrimOp res ReadOffAddrOp_Word16    args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
 224 emitPrimOp res ReadOffAddrOp_Word32    args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
 225 emitPrimOp res ReadOffAddrOp_Word64    args live = doIndexOffAddrOp Nothing I64 res args
 226
 227 -- IndexXXXArray
 228
 229 emitPrimOp res IndexByteArrayOp_Char      args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
 230 emitPrimOp res IndexByteArrayOp_WideChar  args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
 231 emitPrimOp res IndexByteArrayOp_Int       args live = doIndexByteArrayOp Nothing wordRep res args
 232 emitPrimOp res IndexByteArrayOp_Word      args live = doIndexByteArrayOp Nothing wordRep res args
 233 emitPrimOp res IndexByteArrayOp_Addr      args live = doIndexByteArrayOp Nothing wordRep res args
 234 emitPrimOp res IndexByteArrayOp_Float     args live = doIndexByteArrayOp Nothing F32 res args
 235 emitPrimOp res IndexByteArrayOp_Double    args live = doIndexByteArrayOp Nothing F64 res args
 236 emitPrimOp res IndexByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing wordRep res args
 237 emitPrimOp res IndexByteArrayOp_Int8      args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8  res args
 238 emitPrimOp res IndexByteArrayOp_Int16     args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16  res args
 239 emitPrimOp res IndexByteArrayOp_Int32     args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32  res args
 240 emitPrimOp res IndexByteArrayOp_Int64     args live = doIndexByteArrayOp Nothing I64  res args
 241 emitPrimOp res IndexByteArrayOp_Word8     args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8  res args
 242 emitPrimOp res IndexByteArrayOp_Word16    args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16  res args
 243 emitPrimOp res IndexByteArrayOp_Word32    args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32  res args
 244 emitPrimOp res IndexByteArrayOp_Word64    args live = doIndexByteArrayOp Nothing I64  res args
 245
 246 -- ReadXXXArray, identical to IndexXXXArray.
 247
 248 emitPrimOp res ReadByteArrayOp_Char       args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
 249 emitPrimOp res ReadByteArrayOp_WideChar   args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
 250 emitPrimOp res ReadByteArrayOp_Int        args live = doIndexByteArrayOp Nothing wordRep res args
 251 emitPrimOp res ReadByteArrayOp_Word       args live = doIndexByteArrayOp Nothing wordRep res args
 252 emitPrimOp res ReadByteArrayOp_Addr       args live = doIndexByteArrayOp Nothing wordRep res args
 253 emitPrimOp res ReadByteArrayOp_Float      args live = doIndexByteArrayOp Nothing F32 res args
 254 emitPrimOp res ReadByteArrayOp_Double     args live = doIndexByteArrayOp Nothing F64 res args
 255 emitPrimOp res ReadByteArrayOp_StablePtr  args live = doIndexByteArrayOp Nothing wordRep res args
 256 emitPrimOp res ReadByteArrayOp_Int8       args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8  res args
 257 emitPrimOp res ReadByteArrayOp_Int16      args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16  res args
 258 emitPrimOp res ReadByteArrayOp_Int32      args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32  res args
 259 emitPrimOp res ReadByteArrayOp_Int64      args live = doIndexByteArrayOp Nothing I64  res args
 260 emitPrimOp res ReadByteArrayOp_Word8      args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8  res args
 261 emitPrimOp res ReadByteArrayOp_Word16     args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16  res args
 262 emitPrimOp res ReadByteArrayOp_Word32     args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32  res args
 263 emitPrimOp res ReadByteArrayOp_Word64     args live = doIndexByteArrayOp Nothing I64  res args
 264
 265 -- WriteXXXoffAddr
 266
 267 emitPrimOp res WriteOffAddrOp_Char       args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
 268 emitPrimOp res WriteOffAddrOp_WideChar   args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
 269 emitPrimOp res WriteOffAddrOp_Int        args live = doWriteOffAddrOp Nothing wordRep res args
 270 emitPrimOp res WriteOffAddrOp_Word       args live = doWriteOffAddrOp Nothing wordRep res args
 271 emitPrimOp res WriteOffAddrOp_Addr       args live = doWriteOffAddrOp Nothing wordRep res args
 272 emitPrimOp res WriteOffAddrOp_Float      args live = doWriteOffAddrOp Nothing F32 res args
 273 emitPrimOp res WriteOffAddrOp_Double     args live = doWriteOffAddrOp Nothing F64 res args
 274 emitPrimOp res WriteOffAddrOp_StablePtr  args live = doWriteOffAddrOp Nothing wordRep res args
 275 emitPrimOp res WriteOffAddrOp_Int8       args live = doWriteOffAddrOp (Just mo_WordTo8) I8  res args
 276 emitPrimOp res WriteOffAddrOp_Int16      args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
 277 emitPrimOp res WriteOffAddrOp_Int32      args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
 278 emitPrimOp res WriteOffAddrOp_Int64      args live = doWriteOffAddrOp Nothing I64 res args
 279 emitPrimOp res WriteOffAddrOp_Word8      args live = doWriteOffAddrOp (Just mo_WordTo8) I8  res args
 280 emitPrimOp res WriteOffAddrOp_Word16     args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
 281 emitPrimOp res WriteOffAddrOp_Word32     args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
 282 emitPrimOp res WriteOffAddrOp_Word64     args live = doWriteOffAddrOp Nothing I64 res args
 283
 284 -- WriteXXXArray
 285
 286 emitPrimOp res WriteByteArrayOp_Char      args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
 287 emitPrimOp res WriteByteArrayOp_WideChar  args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
 288 emitPrimOp res WriteByteArrayOp_Int       args live = doWriteByteArrayOp Nothing wordRep res args
 289 emitPrimOp res WriteByteArrayOp_Word      args live = doWriteByteArrayOp Nothing wordRep res args
 290 emitPrimOp res WriteByteArrayOp_Addr      args live = doWriteByteArrayOp Nothing wordRep res args
 291 emitPrimOp res WriteByteArrayOp_Float     args live = doWriteByteArrayOp Nothing F32 res args
 292 emitPrimOp res WriteByteArrayOp_Double    args live = doWriteByteArrayOp Nothing F64 res args
 293 emitPrimOp res WriteByteArrayOp_StablePtr args live = doWriteByteArrayOp Nothing wordRep res args
 294 emitPrimOp res WriteByteArrayOp_Int8      args live = doWriteByteArrayOp (Just mo_WordTo8) I8  res args
 295 emitPrimOp res WriteByteArrayOp_Int16     args live = doWriteByteArrayOp (Just mo_WordTo16) I16  res args
 296 emitPrimOp res WriteByteArrayOp_Int32     args live = doWriteByteArrayOp (Just mo_WordTo32) I32  res args
 297 emitPrimOp res WriteByteArrayOp_Int64     args live = doWriteByteArrayOp Nothing I64  res args
 298 emitPrimOp res WriteByteArrayOp_Word8     args live = doWriteByteArrayOp (Just mo_WordTo8) I8  res args
 299 emitPrimOp res WriteByteArrayOp_Word16    args live = doWriteByteArrayOp (Just mo_WordTo16) I16  res args
 300 emitPrimOp res WriteByteArrayOp_Word32    args live = doWriteByteArrayOp (Just mo_WordTo32) I32  res args
 301 emitPrimOp res WriteByteArrayOp_Word64    args live = doWriteByteArrayOp Nothing I64  res args
 302
 303
 304 -- The rest just translate straightforwardly
 305 emitPrimOp [res] op [arg] live
 306    | nopOp op
 307    = stmtC (CmmAssign res arg)
 308
 309    | Just (mop,rep) <- narrowOp op
 310    = stmtC (CmmAssign res (CmmMachOp (mop rep wordRep) [
 311                           CmmMachOp (mop wordRep rep) [arg]]))
 312
 313 emitPrimOp [res] op args live
 314    | Just prim <- callishOp op
 315    = do vols <- getVolatileRegs live
 316         stmtC (CmmCall (CmmPrim prim) [(res,NoHint)]
 317                 [(a,NoHint) | a<-args] (Just vols)) -- ToDo: hints?
 318
 319    | Just mop <- translateOp op
 320    = let stmt = CmmAssign res (CmmMachOp mop args) in
 321      stmtC stmt
 322
 323 emitPrimOp _ op _ _
 324  = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
 325
 326
 327 -- These PrimOps are NOPs in Cmm
 328
 329 nopOp Int2WordOp     = True
 330 nopOp Word2IntOp     = True
 331 nopOp Int2AddrOp     = True
 332 nopOp Addr2IntOp     = True
 333 nopOp ChrOp          = True  -- Int# and Char# are rep'd the same
 334 nopOp OrdOp          = True
 335 nopOp _              = False
 336
 337 -- These PrimOps turn into double casts
 338
 339 narrowOp Narrow8IntOp   = Just (MO_S_Conv, I8)
 340 narrowOp Narrow16IntOp  = Just (MO_S_Conv, I16)
 341 narrowOp Narrow32IntOp  = Just (MO_S_Conv, I32)
 342 narrowOp Narrow8WordOp  = Just (MO_U_Conv, I8)
 343 narrowOp Narrow16WordOp = Just (MO_U_Conv, I16)
 344 narrowOp Narrow32WordOp = Just (MO_U_Conv, I32)
 345 narrowOp _              = Nothing
 346
 347 -- Native word signless ops
 348
 349 translateOp IntAddOp       = Just mo_wordAdd
 350 translateOp IntSubOp       = Just mo_wordSub
 351 translateOp WordAddOp      = Just mo_wordAdd
 352 translateOp WordSubOp      = Just mo_wordSub
 353 translateOp AddrAddOp      = Just mo_wordAdd
 354 translateOp AddrSubOp      = Just mo_wordSub
 355
 356 translateOp IntEqOp        = Just mo_wordEq
 357 translateOp IntNeOp        = Just mo_wordNe
 358 translateOp WordEqOp       = Just mo_wordEq
 359 translateOp WordNeOp       = Just mo_wordNe
 360 translateOp AddrEqOp       = Just mo_wordEq
 361 translateOp AddrNeOp       = Just mo_wordNe
 362
 363 translateOp AndOp          = Just mo_wordAnd
 364 translateOp OrOp           = Just mo_wordOr
 365 translateOp XorOp          = Just mo_wordXor
 366 translateOp NotOp          = Just mo_wordNot
 367 translateOp SllOp          = Just mo_wordShl
 368 translateOp SrlOp          = Just mo_wordUShr
 369
 370 translateOp AddrRemOp      = Just mo_wordURem
 371
 372 -- Native word signed ops
 373
 374 translateOp IntMulOp        = Just mo_wordMul
 375 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordRep)
 376 translateOp IntQuotOp       = Just mo_wordSQuot
 377 translateOp IntRemOp        = Just mo_wordSRem
 378 translateOp IntNegOp        = Just mo_wordSNeg
 379
 380
 381 translateOp IntGeOp        = Just mo_wordSGe
 382 translateOp IntLeOp        = Just mo_wordSLe
 383 translateOp IntGtOp        = Just mo_wordSGt
 384 translateOp IntLtOp        = Just mo_wordSLt
 385
 386 translateOp ISllOp         = Just mo_wordShl
 387 translateOp ISraOp         = Just mo_wordSShr
 388 translateOp ISrlOp         = Just mo_wordUShr
 389
 390 -- Native word unsigned ops
 391
 392 translateOp WordGeOp       = Just mo_wordUGe
 393 translateOp WordLeOp       = Just mo_wordULe
 394 translateOp WordGtOp       = Just mo_wordUGt
 395 translateOp WordLtOp       = Just mo_wordULt
 396
 397 translateOp WordMulOp      = Just mo_wordMul
 398 translateOp WordQuotOp     = Just mo_wordUQuot
 399 translateOp WordRemOp      = Just mo_wordURem
 400
 401 translateOp AddrGeOp       = Just mo_wordUGe
 402 translateOp AddrLeOp       = Just mo_wordULe
 403 translateOp AddrGtOp       = Just mo_wordUGt
 404 translateOp AddrLtOp       = Just mo_wordULt
 405
 406 -- Char# ops
 407
 408 translateOp CharEqOp       = Just (MO_Eq wordRep)
 409 translateOp CharNeOp       = Just (MO_Ne wordRep)
 410 translateOp CharGeOp       = Just (MO_U_Ge wordRep)
 411 translateOp CharLeOp       = Just (MO_U_Le wordRep)
 412 translateOp CharGtOp       = Just (MO_U_Gt wordRep)
 413 translateOp CharLtOp       = Just (MO_U_Lt wordRep)
 414
 415 -- Double ops
 416
 417 translateOp DoubleEqOp     = Just (MO_Eq F64)
 418 translateOp DoubleNeOp     = Just (MO_Ne F64)
 419 translateOp DoubleGeOp     = Just (MO_S_Ge F64)
 420 translateOp DoubleLeOp     = Just (MO_S_Le F64)
 421 translateOp DoubleGtOp     = Just (MO_S_Gt F64)
 422 translateOp DoubleLtOp     = Just (MO_S_Lt F64)
 423
 424 translateOp DoubleAddOp    = Just (MO_Add F64)
 425 translateOp DoubleSubOp    = Just (MO_Sub F64)
 426 translateOp DoubleMulOp    = Just (MO_Mul F64)
 427 translateOp DoubleDivOp    = Just (MO_S_Quot F64)
 428 translateOp DoubleNegOp    = Just (MO_S_Neg F64)
 429
 430 -- Float ops
 431
 432 translateOp FloatEqOp     = Just (MO_Eq F32)
 433 translateOp FloatNeOp     = Just (MO_Ne F32)
 434 translateOp FloatGeOp     = Just (MO_S_Ge F32)
 435 translateOp FloatLeOp     = Just (MO_S_Le F32)
 436 translateOp FloatGtOp     = Just (MO_S_Gt F32)
 437 translateOp FloatLtOp     = Just (MO_S_Lt F32)
 438
 439 translateOp FloatAddOp    = Just (MO_Add F32)
 440 translateOp FloatSubOp    = Just (MO_Sub F32)
 441 translateOp FloatMulOp    = Just (MO_Mul F32)
 442 translateOp FloatDivOp    = Just (MO_S_Quot F32)
 443 translateOp FloatNegOp    = Just (MO_S_Neg F32)
 444
 445 -- Conversions
 446
 447 translateOp Int2DoubleOp   = Just (MO_S_Conv wordRep F64)
 448 translateOp Double2IntOp   = Just (MO_S_Conv F64 wordRep)
 449
 450 translateOp Int2FloatOp    = Just (MO_S_Conv wordRep F32)
 451 translateOp Float2IntOp    = Just (MO_S_Conv F32 wordRep)
 452
 453 translateOp Float2DoubleOp = Just (MO_S_Conv F32 F64)
 454 translateOp Double2FloatOp = Just (MO_S_Conv F64 F32)
 455
 456 -- Word comparisons masquerading as more exotic things.
 457
 458 translateOp SameMutVarOp           = Just mo_wordEq
 459 translateOp SameMVarOp             = Just mo_wordEq
 460 translateOp SameMutableArrayOp     = Just mo_wordEq
 461 translateOp SameMutableByteArrayOp = Just mo_wordEq
 462 translateOp SameTVarOp             = Just mo_wordEq
 463 translateOp EqStablePtrOp          = Just mo_wordEq
 464
 465 translateOp _ = Nothing
 466
 467 -- These primops are implemented by CallishMachOps, because they sometimes
 468 -- turn into foreign calls depending on the backend.
 469
 470 callishOp DoublePowerOp  = Just MO_F64_Pwr
 471 callishOp DoubleSinOp    = Just MO_F64_Sin
 472 callishOp DoubleCosOp    = Just MO_F64_Cos
 473 callishOp DoubleTanOp    = Just MO_F64_Tan
 474 callishOp DoubleSinhOp   = Just MO_F64_Sinh
 475 callishOp DoubleCoshOp   = Just MO_F64_Cosh
 476 callishOp DoubleTanhOp   = Just MO_F64_Tanh
 477 callishOp DoubleAsinOp   = Just MO_F64_Asin
 478 callishOp DoubleAcosOp   = Just MO_F64_Acos
 479 callishOp DoubleAtanOp   = Just MO_F64_Atan
 480 callishOp DoubleLogOp    = Just MO_F64_Log
 481 callishOp DoubleExpOp    = Just MO_F64_Exp
 482 callishOp DoubleSqrtOp   = Just MO_F64_Sqrt
 483
 484 callishOp FloatPowerOp  = Just MO_F32_Pwr
 485 callishOp FloatSinOp    = Just MO_F32_Sin
 486 callishOp FloatCosOp    = Just MO_F32_Cos
 487 callishOp FloatTanOp    = Just MO_F32_Tan
 488 callishOp FloatSinhOp   = Just MO_F32_Sinh
 489 callishOp FloatCoshOp   = Just MO_F32_Cosh
 490 callishOp FloatTanhOp   = Just MO_F32_Tanh
 491 callishOp FloatAsinOp   = Just MO_F32_Asin
 492 callishOp FloatAcosOp   = Just MO_F32_Acos
 493 callishOp FloatAtanOp   = Just MO_F32_Atan
 494 callishOp FloatLogOp    = Just MO_F32_Log
 495 callishOp FloatExpOp    = Just MO_F32_Exp
 496 callishOp FloatSqrtOp   = Just MO_F32_Sqrt
 497
 498 callishOp _ = Nothing
 499
 500 ------------------------------------------------------------------------------
 501 -- Helpers for translating various minor variants of array indexing.
 502
 503 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
 504    = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
 505 doIndexOffAddrOp _ _ _ _
 506    = panic "CgPrimOp: doIndexOffAddrOp"
 507
 508 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
 509    = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
 510 doIndexByteArrayOp _ _ _ _
 511    = panic "CgPrimOp: doIndexByteArrayOp"
 512
 513 doReadPtrArrayOp res addr idx
 514    = mkBasicIndexedRead arrPtrsHdrSize Nothing wordRep res addr idx
 515
 516
 517 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
 518    = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
 519 doWriteOffAddrOp _ _ _ _
 520    = panic "CgPrimOp: doWriteOffAddrOp"
 521
 522 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
 523    = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
 524 doWriteByteArrayOp _ _ _ _
 525    = panic "CgPrimOp: doWriteByteArrayOp"
 526
 527 doWritePtrArrayOp addr idx val
 528    = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
 529         mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
 530
 531
 532 mkBasicIndexedRead off Nothing read_rep res base idx
 533    = stmtC (CmmAssign res (cmmLoadIndexOffExpr off read_rep base idx))
 534 mkBasicIndexedRead off (Just cast) read_rep res base idx
 535    = stmtC (CmmAssign res (CmmMachOp cast [
 536                                 cmmLoadIndexOffExpr off read_rep base idx]))
 537
 538 mkBasicIndexedWrite off Nothing write_rep base idx val
 539    = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
 540 mkBasicIndexedWrite off (Just cast) write_rep base idx val
 541    = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
 542
 543 -- ----------------------------------------------------------------------------
 544 -- Misc utils
 545
 546 cmmIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
 547 cmmIndexOffExpr off rep base idx
 548    = cmmIndexExpr rep (cmmOffsetB base off) idx
 549
 550 cmmLoadIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
 551 cmmLoadIndexOffExpr off rep base idx
 552    = CmmLoad (cmmIndexOffExpr off rep base idx) rep
 553
 554 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
 555 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr
 556