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