compiler/codeGen/CgPrimOp.hs

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