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