compiler/codeGen/CgPrimOp.hs

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