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 import BasicTypes
  14 import ForeignCall
  15 import ClosureInfo
  16 import StgSyn
  17 import CgForeignCall
  18 import CgBindery
  19 import CgMonad
  20 import CgHeapery
  21 import CgInfoTbls
  22 import CgTicky
  23 import CgProf
  24 import CgUtils
  25 import OldCmm
  26 import CLabel
  27 import OldCmmUtils
  28 import PrimOp
  29 import SMRep
  30 import Module
  31 import Constants
  32 import Outputable
  33 import FastString
  34
  35 -- ---------------------------------------------------------------------------
  36 -- Code generation for PrimOps
  37
  38 cgPrimOp   :: CmmFormals        -- where to put the results
  39            -> PrimOp            -- the op
  40            -> [StgArg]          -- arguments
  41            -> StgLiveVars       -- live vars, in case we need to save them
  42            -> Code
  43
  44 cgPrimOp results op args live
  45   = do arg_exprs <- getArgAmodes args
  46        let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
  47        emitPrimOp results op non_void_args live
  48
  49
  50 emitPrimOp :: CmmFormals        -- where to put the results
  51            -> PrimOp            -- the op
  52            -> [CmmExpr]         -- arguments
  53            -> StgLiveVars       -- live vars, in case we need to save them
  54            -> Code
  55
  56 --  First we handle various awkward cases specially.  The remaining
  57 -- easy cases are then handled by translateOp, defined below.
  58
  59 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
  60 {-
  61    With some bit-twiddling, we can define int{Add,Sub}Czh portably in
  62    C, and without needing any comparisons.  This may not be the
  63    fastest way to do it - if you have better code, please send it! --SDM
  64
  65    Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
  66
  67    We currently don't make use of the r value if c is != 0 (i.e.
  68    overflow), we just convert to big integers and try again.  This
  69    could be improved by making r and c the correct values for
  70    plugging into a new J#.
  71
  72    { r = ((I_)(a)) + ((I_)(b));                                 \
  73      c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
  74          >> (BITS_IN (I_) - 1);                                 \
  75    }
  76    Wading through the mass of bracketry, it seems to reduce to:
  77    c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
  78
  79 -}
  80    = stmtsC [
  81         CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
  82         CmmAssign (CmmLocal res_c) $
  83           CmmMachOp mo_wordUShr [
  84                 CmmMachOp mo_wordAnd [
  85                     CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
  86                     CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
  87                 ],
  88                 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
  89           ]
  90      ]
  91
  92
  93 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
  94 {- Similarly:
  95    #define subIntCzh(r,c,a,b)                                   \
  96    { r = ((I_)(a)) - ((I_)(b));                                 \
  97      c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
  98          >> (BITS_IN (I_) - 1);                                 \
  99    }
 100
 101    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
 102 -}
 103    = stmtsC [
 104         CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
 105         CmmAssign (CmmLocal res_c) $
 106           CmmMachOp mo_wordUShr [
 107                 CmmMachOp mo_wordAnd [
 108                     CmmMachOp mo_wordXor [aa,bb],
 109                     CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
 110                 ],
 111                 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
 112           ]
 113      ]
 114
 115
 116 emitPrimOp [res] ParOp [arg] live
 117   = do
 118         -- for now, just implement this in a C function
 119         -- later, we might want to inline it.
 120     vols <- getVolatileRegs live
 121     emitForeignCall' PlayRisky
 122         [CmmHinted res NoHint]
 123         (CmmCallee newspark CCallConv)
 124         [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
 125           , (CmmHinted arg AddrHint)  ]
 126         (Just vols)
 127         NoC_SRT -- No SRT b/c we do PlayRisky
 128         CmmMayReturn
 129   where
 130         newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
 131
 132 emitPrimOp [res] ReadMutVarOp [mutv] _
 133    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord))
 134
 135 emitPrimOp [] WriteMutVarOp [mutv,var] live
 136    = do
 137         stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
 138         vols <- getVolatileRegs live
 139         emitForeignCall' PlayRisky
 140                 [{-no results-}]
 141                 (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
 142                          CCallConv)
 143                 [   (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
 144                   , (CmmHinted mutv AddrHint)  ]
 145                 (Just vols)
 146                 NoC_SRT -- No SRT b/c we do PlayRisky
 147                 CmmMayReturn
 148
 149 --  #define sizzeofByteArrayzh(r,a) \
 150 --     r = ((StgArrWords *)(a))->bytes
 151 emitPrimOp [res] SizeofByteArrayOp [arg] _
 152    = stmtC $
 153         CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
 154
 155 --  #define sizzeofMutableByteArrayzh(r,a) \
 156 --      r = ((StgArrWords *)(a))->bytes
 157 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
 158    = emitPrimOp [res] SizeofByteArrayOp [arg] live
 159
 160
 161 --  #define touchzh(o)                  /* nothing */
 162 emitPrimOp [] TouchOp [_] _
 163    = nopC
 164
 165 --  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
 166 emitPrimOp [res] ByteArrayContents_Char [arg] _
 167    = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
 168
 169 --  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
 170 emitPrimOp [res] StableNameToIntOp [arg] _
 171    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
 172
 173 --  #define eqStableNamezh(r,sn1,sn2)                                   \
 174 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 175 emitPrimOp [res] EqStableNameOp [arg1,arg2] _
 176    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
 177                                 cmmLoadIndexW arg1 fixedHdrSize bWord,
 178                                 cmmLoadIndexW arg2 fixedHdrSize bWord
 179                          ]))
 180
 181
 182 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
 183    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
 184
 185 --  #define addrToHValuezh(r,a) r=(P_)a
 186 emitPrimOp [res] AddrToHValueOp [arg] _
 187    = stmtC (CmmAssign (CmmLocal res) arg)
 188
 189 --  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
 190 --  Note: argument may be tagged!
 191 emitPrimOp [res] DataToTagOp [arg] _
 192    = stmtC (CmmAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
 193
 194 {- Freezing arrays-of-ptrs requires changing an info table, for the
 195    benefit of the generational collector.  It needs to scavenge mutable
 196    objects, even if they are in old space.  When they become immutable,
 197    they can be removed from this scavenge list.  -}
 198
 199 --  #define unsafeFreezzeArrayzh(r,a)
 200 --      {
 201 --        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
 202 --        r = a;
 203 --      }
 204 emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
 205    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
 206              CmmAssign (CmmLocal res) arg ]
 207
 208 --  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
 209 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
 210    = stmtC (CmmAssign (CmmLocal res) arg)
 211
 212 emitPrimOp [] CopyArrayOp [src,src_off,dst,dst_off,n] live =
 213     doCopyArrayOp src src_off dst dst_off n live
 214 emitPrimOp [] CopyMutableArrayOp [src,src_off,dst,dst_off,n] live =
 215     doCopyMutableArrayOp src src_off dst dst_off n live
 216 emitPrimOp [res] CloneArrayOp [src,src_off,n] live =
 217     emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n live
 218 emitPrimOp [res] CloneMutableArrayOp [src,src_off,n] live =
 219     emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n live
 220 emitPrimOp [res] FreezeArrayOp [src,src_off,n] live =
 221     emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n live
 222 emitPrimOp [res] ThawArrayOp [src,src_off,n] live =
 223     emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n live
 224
 225 -- Reading/writing pointer arrays
 226
 227 emitPrimOp [r] ReadArrayOp  [obj,ix]   _  = doReadPtrArrayOp r obj ix
 228 emitPrimOp [r] IndexArrayOp [obj,ix]   _  = doReadPtrArrayOp r obj ix
 229 emitPrimOp []  WriteArrayOp [obj,ix,v] _  = doWritePtrArrayOp obj ix v
 230
 231 emitPrimOp [res] SizeofArrayOp [arg] _
 232    = stmtC $ CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
 233 emitPrimOp [res] SizeofMutableArrayOp [arg] live
 234    = emitPrimOp [res] SizeofArrayOp [arg] live
 235
 236 -- IndexXXXoffAddr
 237
 238 emitPrimOp res IndexOffAddrOp_Char      args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
 239 emitPrimOp res IndexOffAddrOp_WideChar  args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
 240 emitPrimOp res IndexOffAddrOp_Int       args _ = doIndexOffAddrOp Nothing bWord res args
 241 emitPrimOp res IndexOffAddrOp_Word      args _ = doIndexOffAddrOp Nothing bWord res args
 242 emitPrimOp res IndexOffAddrOp_Addr      args _ = doIndexOffAddrOp Nothing bWord res args
 243 emitPrimOp res IndexOffAddrOp_Float     args _ = doIndexOffAddrOp Nothing f32 res args
 244 emitPrimOp res IndexOffAddrOp_Double    args _ = doIndexOffAddrOp Nothing f64 res args
 245 emitPrimOp res IndexOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing bWord res args
 246 emitPrimOp res IndexOffAddrOp_Int8      args _ = doIndexOffAddrOp (Just mo_s_8ToWord)  b8  res args
 247 emitPrimOp res IndexOffAddrOp_Int16     args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
 248 emitPrimOp res IndexOffAddrOp_Int32     args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
 249 emitPrimOp res IndexOffAddrOp_Int64     args _ = doIndexOffAddrOp Nothing b64 res args
 250 emitPrimOp res IndexOffAddrOp_Word8     args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8   res args
 251 emitPrimOp res IndexOffAddrOp_Word16    args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
 252 emitPrimOp res IndexOffAddrOp_Word32    args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
 253 emitPrimOp res IndexOffAddrOp_Word64    args _ = doIndexOffAddrOp Nothing b64 res args
 254
 255 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
 256
 257 emitPrimOp res ReadOffAddrOp_Char      args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
 258 emitPrimOp res ReadOffAddrOp_WideChar  args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
 259 emitPrimOp res ReadOffAddrOp_Int       args _ = doIndexOffAddrOp Nothing bWord res args
 260 emitPrimOp res ReadOffAddrOp_Word      args _ = doIndexOffAddrOp Nothing bWord res args
 261 emitPrimOp res ReadOffAddrOp_Addr      args _ = doIndexOffAddrOp Nothing bWord res args
 262 emitPrimOp res ReadOffAddrOp_Float     args _ = doIndexOffAddrOp Nothing f32 res args
 263 emitPrimOp res ReadOffAddrOp_Double    args _ = doIndexOffAddrOp Nothing f64 res args
 264 emitPrimOp res ReadOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing bWord res args
 265 emitPrimOp res ReadOffAddrOp_Int8      args _ = doIndexOffAddrOp (Just mo_s_8ToWord) b8  res args
 266 emitPrimOp res ReadOffAddrOp_Int16     args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
 267 emitPrimOp res ReadOffAddrOp_Int32     args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
 268 emitPrimOp res ReadOffAddrOp_Int64     args _ = doIndexOffAddrOp Nothing b64 res args
 269 emitPrimOp res ReadOffAddrOp_Word8     args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8  res args
 270 emitPrimOp res ReadOffAddrOp_Word16    args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
 271 emitPrimOp res ReadOffAddrOp_Word32    args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
 272 emitPrimOp res ReadOffAddrOp_Word64    args _ = doIndexOffAddrOp Nothing b64 res args
 273
 274 -- IndexXXXArray
 275
 276 emitPrimOp res IndexByteArrayOp_Char      args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
 277 emitPrimOp res IndexByteArrayOp_WideChar  args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
 278 emitPrimOp res IndexByteArrayOp_Int       args _ = doIndexByteArrayOp Nothing bWord res args
 279 emitPrimOp res IndexByteArrayOp_Word      args _ = doIndexByteArrayOp Nothing bWord res args
 280 emitPrimOp res IndexByteArrayOp_Addr      args _ = doIndexByteArrayOp Nothing bWord res args
 281 emitPrimOp res IndexByteArrayOp_Float     args _ = doIndexByteArrayOp Nothing f32 res args
 282 emitPrimOp res IndexByteArrayOp_Double    args _ = doIndexByteArrayOp Nothing f64 res args
 283 emitPrimOp res IndexByteArrayOp_StablePtr args _ = doIndexByteArrayOp Nothing bWord res args
 284 emitPrimOp res IndexByteArrayOp_Int8      args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8  res args
 285 emitPrimOp res IndexByteArrayOp_Int16     args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16  res args
 286 emitPrimOp res IndexByteArrayOp_Int32     args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32  res args
 287 emitPrimOp res IndexByteArrayOp_Int64     args _ = doIndexByteArrayOp Nothing b64  res args
 288 emitPrimOp res IndexByteArrayOp_Word8     args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8  res args
 289 emitPrimOp res IndexByteArrayOp_Word16    args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16  res args
 290 emitPrimOp res IndexByteArrayOp_Word32    args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32  res args
 291 emitPrimOp res IndexByteArrayOp_Word64    args _ = doIndexByteArrayOp Nothing b64  res args
 292
 293 -- ReadXXXArray, identical to IndexXXXArray.
 294
 295 emitPrimOp res ReadByteArrayOp_Char       args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
 296 emitPrimOp res ReadByteArrayOp_WideChar   args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
 297 emitPrimOp res ReadByteArrayOp_Int        args _ = doIndexByteArrayOp Nothing bWord res args
 298 emitPrimOp res ReadByteArrayOp_Word       args _ = doIndexByteArrayOp Nothing bWord res args
 299 emitPrimOp res ReadByteArrayOp_Addr       args _ = doIndexByteArrayOp Nothing bWord res args
 300 emitPrimOp res ReadByteArrayOp_Float      args _ = doIndexByteArrayOp Nothing f32 res args
 301 emitPrimOp res ReadByteArrayOp_Double     args _ = doIndexByteArrayOp Nothing f64 res args
 302 emitPrimOp res ReadByteArrayOp_StablePtr  args _ = doIndexByteArrayOp Nothing bWord res args
 303 emitPrimOp res ReadByteArrayOp_Int8       args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8  res args
 304 emitPrimOp res ReadByteArrayOp_Int16      args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16  res args
 305 emitPrimOp res ReadByteArrayOp_Int32      args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32  res args
 306 emitPrimOp res ReadByteArrayOp_Int64      args _ = doIndexByteArrayOp Nothing b64  res args
 307 emitPrimOp res ReadByteArrayOp_Word8      args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8  res args
 308 emitPrimOp res ReadByteArrayOp_Word16     args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16  res args
 309 emitPrimOp res ReadByteArrayOp_Word32     args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32  res args
 310 emitPrimOp res ReadByteArrayOp_Word64     args _ = doIndexByteArrayOp Nothing b64  res args
 311
 312 -- WriteXXXoffAddr
 313
 314 emitPrimOp res WriteOffAddrOp_Char       args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
 315 emitPrimOp res WriteOffAddrOp_WideChar   args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
 316 emitPrimOp res WriteOffAddrOp_Int        args _ = doWriteOffAddrOp Nothing bWord res args
 317 emitPrimOp res WriteOffAddrOp_Word       args _ = doWriteOffAddrOp Nothing bWord res args
 318 emitPrimOp res WriteOffAddrOp_Addr       args _ = doWriteOffAddrOp Nothing bWord res args
 319 emitPrimOp res WriteOffAddrOp_Float      args _ = doWriteOffAddrOp Nothing f32 res args
 320 emitPrimOp res WriteOffAddrOp_Double     args _ = doWriteOffAddrOp Nothing f64 res args
 321 emitPrimOp res WriteOffAddrOp_StablePtr  args _ = doWriteOffAddrOp Nothing bWord res args
 322 emitPrimOp res WriteOffAddrOp_Int8       args _ = doWriteOffAddrOp (Just mo_WordTo8) b8  res args
 323 emitPrimOp res WriteOffAddrOp_Int16      args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
 324 emitPrimOp res WriteOffAddrOp_Int32      args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
 325 emitPrimOp res WriteOffAddrOp_Int64      args _ = doWriteOffAddrOp Nothing b64 res args
 326 emitPrimOp res WriteOffAddrOp_Word8      args _ = doWriteOffAddrOp (Just mo_WordTo8) b8  res args
 327 emitPrimOp res WriteOffAddrOp_Word16     args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
 328 emitPrimOp res WriteOffAddrOp_Word32     args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
 329 emitPrimOp res WriteOffAddrOp_Word64     args _ = doWriteOffAddrOp Nothing b64 res args
 330
 331 -- WriteXXXArray
 332
 333 emitPrimOp res WriteByteArrayOp_Char      args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
 334 emitPrimOp res WriteByteArrayOp_WideChar  args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
 335 emitPrimOp res WriteByteArrayOp_Int       args _ = doWriteByteArrayOp Nothing bWord res args
 336 emitPrimOp res WriteByteArrayOp_Word      args _ = doWriteByteArrayOp Nothing bWord res args
 337 emitPrimOp res WriteByteArrayOp_Addr      args _ = doWriteByteArrayOp Nothing bWord res args
 338 emitPrimOp res WriteByteArrayOp_Float     args _ = doWriteByteArrayOp Nothing f32 res args
 339 emitPrimOp res WriteByteArrayOp_Double    args _ = doWriteByteArrayOp Nothing f64 res args
 340 emitPrimOp res WriteByteArrayOp_StablePtr args _ = doWriteByteArrayOp Nothing bWord res args
 341 emitPrimOp res WriteByteArrayOp_Int8      args _ = doWriteByteArrayOp (Just mo_WordTo8) b8  res args
 342 emitPrimOp res WriteByteArrayOp_Int16     args _ = doWriteByteArrayOp (Just mo_WordTo16) b16  res args
 343 emitPrimOp res WriteByteArrayOp_Int32     args _ = doWriteByteArrayOp (Just mo_WordTo32) b32  res args
 344 emitPrimOp res WriteByteArrayOp_Int64     args _ = doWriteByteArrayOp Nothing b64  res args
 345 emitPrimOp res WriteByteArrayOp_Word8     args _ = doWriteByteArrayOp (Just mo_WordTo8) b8  res args
 346 emitPrimOp res WriteByteArrayOp_Word16    args _ = doWriteByteArrayOp (Just mo_WordTo16) b16  res args
 347 emitPrimOp res WriteByteArrayOp_Word32    args _ = doWriteByteArrayOp (Just mo_WordTo32) b32  res args
 348 emitPrimOp res WriteByteArrayOp_Word64    args _ = doWriteByteArrayOp Nothing b64  res args
 349
 350
 351 -- The rest just translate straightforwardly
 352 emitPrimOp [res] op [arg] _
 353    | nopOp op
 354    = stmtC (CmmAssign (CmmLocal res) arg)
 355
 356    | Just (mop,rep) <- narrowOp op
 357    = stmtC (CmmAssign (CmmLocal res) $
 358             CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
 359
 360 emitPrimOp [res] op args live
 361    | Just prim <- callishOp op
 362    = do vols <- getVolatileRegs live
 363         emitForeignCall' PlayRisky
 364            [CmmHinted res NoHint]
 365            (CmmPrim prim)
 366            [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
 367            (Just vols)
 368            NoC_SRT -- No SRT b/c we do PlayRisky
 369            CmmMayReturn
 370
 371    | Just mop <- translateOp op
 372    = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
 373      stmtC stmt
 374
 375 emitPrimOp _ op _ _
 376  = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
 377
 378
 379 -- These PrimOps are NOPs in Cmm
 380
 381 nopOp :: PrimOp -> Bool
 382 nopOp Int2WordOp     = True
 383 nopOp Word2IntOp     = True
 384 nopOp Int2AddrOp     = True
 385 nopOp Addr2IntOp     = True
 386 nopOp ChrOp          = True  -- Int# and Char# are rep'd the same
 387 nopOp OrdOp          = True
 388 nopOp _              = False
 389
 390 -- These PrimOps turn into double casts
 391
 392 narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
 393 narrowOp Narrow8IntOp   = Just (MO_SS_Conv, W8)
 394 narrowOp Narrow16IntOp  = Just (MO_SS_Conv, W16)
 395 narrowOp Narrow32IntOp  = Just (MO_SS_Conv, W32)
 396 narrowOp Narrow8WordOp  = Just (MO_UU_Conv, W8)
 397 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
 398 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
 399 narrowOp _              = Nothing
 400
 401 -- Native word signless ops
 402
 403 translateOp :: PrimOp -> Maybe MachOp
 404 translateOp IntAddOp       = Just mo_wordAdd
 405 translateOp IntSubOp       = Just mo_wordSub
 406 translateOp WordAddOp      = Just mo_wordAdd
 407 translateOp WordSubOp      = Just mo_wordSub
 408 translateOp AddrAddOp      = Just mo_wordAdd
 409 translateOp AddrSubOp      = Just mo_wordSub
 410
 411 translateOp IntEqOp        = Just mo_wordEq
 412 translateOp IntNeOp        = Just mo_wordNe
 413 translateOp WordEqOp       = Just mo_wordEq
 414 translateOp WordNeOp       = Just mo_wordNe
 415 translateOp AddrEqOp       = Just mo_wordEq
 416 translateOp AddrNeOp       = Just mo_wordNe
 417
 418 translateOp AndOp          = Just mo_wordAnd
 419 translateOp OrOp           = Just mo_wordOr
 420 translateOp XorOp          = Just mo_wordXor
 421 translateOp NotOp          = Just mo_wordNot
 422 translateOp SllOp          = Just mo_wordShl
 423 translateOp SrlOp          = Just mo_wordUShr
 424
 425 translateOp AddrRemOp      = Just mo_wordURem
 426
 427 -- Native word signed ops
 428
 429 translateOp IntMulOp        = Just mo_wordMul
 430 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
 431 translateOp IntQuotOp       = Just mo_wordSQuot
 432 translateOp IntRemOp        = Just mo_wordSRem
 433 translateOp IntNegOp        = Just mo_wordSNeg
 434
 435
 436 translateOp IntGeOp        = Just mo_wordSGe
 437 translateOp IntLeOp        = Just mo_wordSLe
 438 translateOp IntGtOp        = Just mo_wordSGt
 439 translateOp IntLtOp        = Just mo_wordSLt
 440
 441 translateOp ISllOp         = Just mo_wordShl
 442 translateOp ISraOp         = Just mo_wordSShr
 443 translateOp ISrlOp         = Just mo_wordUShr
 444
 445 -- Native word unsigned ops
 446
 447 translateOp WordGeOp       = Just mo_wordUGe
 448 translateOp WordLeOp       = Just mo_wordULe
 449 translateOp WordGtOp       = Just mo_wordUGt
 450 translateOp WordLtOp       = Just mo_wordULt
 451
 452 translateOp WordMulOp      = Just mo_wordMul
 453 translateOp WordQuotOp     = Just mo_wordUQuot
 454 translateOp WordRemOp      = Just mo_wordURem
 455
 456 translateOp AddrGeOp       = Just mo_wordUGe
 457 translateOp AddrLeOp       = Just mo_wordULe
 458 translateOp AddrGtOp       = Just mo_wordUGt
 459 translateOp AddrLtOp       = Just mo_wordULt
 460
 461 -- Char# ops
 462
 463 translateOp CharEqOp       = Just (MO_Eq wordWidth)
 464 translateOp CharNeOp       = Just (MO_Ne wordWidth)
 465 translateOp CharGeOp       = Just (MO_U_Ge wordWidth)
 466 translateOp CharLeOp       = Just (MO_U_Le wordWidth)
 467 translateOp CharGtOp       = Just (MO_U_Gt wordWidth)
 468 translateOp CharLtOp       = Just (MO_U_Lt wordWidth)
 469
 470 -- Double ops
 471
 472 translateOp DoubleEqOp     = Just (MO_F_Eq W64)
 473 translateOp DoubleNeOp     = Just (MO_F_Ne W64)
 474 translateOp DoubleGeOp     = Just (MO_F_Ge W64)
 475 translateOp DoubleLeOp     = Just (MO_F_Le W64)
 476 translateOp DoubleGtOp     = Just (MO_F_Gt W64)
 477 translateOp DoubleLtOp     = Just (MO_F_Lt W64)
 478
 479 translateOp DoubleAddOp    = Just (MO_F_Add W64)
 480 translateOp DoubleSubOp    = Just (MO_F_Sub W64)
 481 translateOp DoubleMulOp    = Just (MO_F_Mul W64)
 482 translateOp DoubleDivOp    = Just (MO_F_Quot W64)
 483 translateOp DoubleNegOp    = Just (MO_F_Neg W64)
 484
 485 -- Float ops
 486
 487 translateOp FloatEqOp     = Just (MO_F_Eq W32)
 488 translateOp FloatNeOp     = Just (MO_F_Ne W32)
 489 translateOp FloatGeOp     = Just (MO_F_Ge W32)
 490 translateOp FloatLeOp     = Just (MO_F_Le W32)
 491 translateOp FloatGtOp     = Just (MO_F_Gt W32)
 492 translateOp FloatLtOp     = Just (MO_F_Lt W32)
 493
 494 translateOp FloatAddOp    = Just (MO_F_Add  W32)
 495 translateOp FloatSubOp    = Just (MO_F_Sub  W32)
 496 translateOp FloatMulOp    = Just (MO_F_Mul  W32)
 497 translateOp FloatDivOp    = Just (MO_F_Quot W32)
 498 translateOp FloatNegOp    = Just (MO_F_Neg  W32)
 499
 500 -- Conversions
 501
 502 translateOp Int2DoubleOp   = Just (MO_SF_Conv wordWidth W64)
 503 translateOp Double2IntOp   = Just (MO_FS_Conv W64 wordWidth)
 504
 505 translateOp Int2FloatOp    = Just (MO_SF_Conv wordWidth W32)
 506 translateOp Float2IntOp    = Just (MO_FS_Conv W32 wordWidth)
 507
 508 translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
 509 translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
 510
 511 -- Word comparisons masquerading as more exotic things.
 512
 513 translateOp SameMutVarOp           = Just mo_wordEq
 514 translateOp SameMVarOp             = Just mo_wordEq
 515 translateOp SameMutableArrayOp     = Just mo_wordEq
 516 translateOp SameMutableByteArrayOp = Just mo_wordEq
 517 translateOp SameTVarOp             = Just mo_wordEq
 518 translateOp EqStablePtrOp          = Just mo_wordEq
 519
 520 translateOp _ = Nothing
 521
 522 -- These primops are implemented by CallishMachOps, because they sometimes
 523 -- turn into foreign calls depending on the backend.
 524
 525 callishOp :: PrimOp -> Maybe CallishMachOp
 526 callishOp DoublePowerOp  = Just MO_F64_Pwr
 527 callishOp DoubleSinOp    = Just MO_F64_Sin
 528 callishOp DoubleCosOp    = Just MO_F64_Cos
 529 callishOp DoubleTanOp    = Just MO_F64_Tan
 530 callishOp DoubleSinhOp   = Just MO_F64_Sinh
 531 callishOp DoubleCoshOp   = Just MO_F64_Cosh
 532 callishOp DoubleTanhOp   = Just MO_F64_Tanh
 533 callishOp DoubleAsinOp   = Just MO_F64_Asin
 534 callishOp DoubleAcosOp   = Just MO_F64_Acos
 535 callishOp DoubleAtanOp   = Just MO_F64_Atan
 536 callishOp DoubleLogOp    = Just MO_F64_Log
 537 callishOp DoubleExpOp    = Just MO_F64_Exp
 538 callishOp DoubleSqrtOp   = Just MO_F64_Sqrt
 539
 540 callishOp FloatPowerOp  = Just MO_F32_Pwr
 541 callishOp FloatSinOp    = Just MO_F32_Sin
 542 callishOp FloatCosOp    = Just MO_F32_Cos
 543 callishOp FloatTanOp    = Just MO_F32_Tan
 544 callishOp FloatSinhOp   = Just MO_F32_Sinh
 545 callishOp FloatCoshOp   = Just MO_F32_Cosh
 546 callishOp FloatTanhOp   = Just MO_F32_Tanh
 547 callishOp FloatAsinOp   = Just MO_F32_Asin
 548 callishOp FloatAcosOp   = Just MO_F32_Acos
 549 callishOp FloatAtanOp   = Just MO_F32_Atan
 550 callishOp FloatLogOp    = Just MO_F32_Log
 551 callishOp FloatExpOp    = Just MO_F32_Exp
 552 callishOp FloatSqrtOp   = Just MO_F32_Sqrt
 553
 554 callishOp _ = Nothing
 555
 556 ------------------------------------------------------------------------------
 557 -- Helpers for translating various minor variants of array indexing.
 558
 559 -- Bytearrays outside the heap; hence non-pointers
 560 doIndexOffAddrOp, doIndexByteArrayOp
 561         :: Maybe MachOp -> CmmType
 562         -> [LocalReg] -> [CmmExpr] -> Code
 563 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
 564    = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
 565 doIndexOffAddrOp _ _ _ _
 566    = panic "CgPrimOp: doIndexOffAddrOp"
 567
 568 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
 569    = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
 570 doIndexByteArrayOp _ _ _ _
 571    = panic "CgPrimOp: doIndexByteArrayOp"
 572
 573 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
 574 doReadPtrArrayOp res addr idx
 575    = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
 576
 577
 578 doWriteOffAddrOp, doWriteByteArrayOp
 579         :: Maybe MachOp -> CmmType
 580         -> [LocalReg] -> [CmmExpr] -> Code
 581 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
 582    = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
 583 doWriteOffAddrOp _ _ _ _
 584    = panic "CgPrimOp: doWriteOffAddrOp"
 585
 586 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
 587    = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
 588 doWriteByteArrayOp _ _ _ _
 589    = panic "CgPrimOp: doWriteByteArrayOp"
 590
 591 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 592 doWritePtrArrayOp addr idx val
 593    = do mkBasicIndexedWrite arrPtrsHdrSize Nothing bWord addr idx val
 594         stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
 595    -- the write barrier.  We must write a byte into the mark table:
 596    -- bits8[a + header_size + StgMutArrPtrs_size(a) + x >> N]
 597         stmtC $ CmmStore (
 598           cmmOffsetExpr
 599            (cmmOffsetExprW (cmmOffsetB addr arrPtrsHdrSize)
 600                           (loadArrPtrsSize addr))
 601            (CmmMachOp mo_wordUShr [idx,
 602                                    CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)])
 603           ) (CmmLit (CmmInt 1 W8))
 604
 605 loadArrPtrsSize :: CmmExpr -> CmmExpr
 606 loadArrPtrsSize addr = CmmLoad (cmmOffsetB addr off) bWord
 607  where off = fixedHdrSize*wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs
 608
 609 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
 610                    -> LocalReg -> CmmExpr -> CmmExpr -> Code
 611 mkBasicIndexedRead off Nothing read_rep res base idx
 612    = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
 613 mkBasicIndexedRead off (Just cast) read_rep res base idx
 614    = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
 615                                 cmmLoadIndexOffExpr off read_rep base idx]))
 616
 617 mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType
 618                     -> CmmExpr -> CmmExpr -> CmmExpr -> Code
 619 mkBasicIndexedWrite off Nothing write_rep base idx val
 620    = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
 621 mkBasicIndexedWrite off (Just cast) write_rep base idx val
 622    = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
 623
 624 -- ----------------------------------------------------------------------------
 625 -- Misc utils
 626
 627 cmmIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
 628 cmmIndexOffExpr off rep base idx
 629    = cmmIndexExpr (typeWidth rep) (cmmOffsetB base off) idx
 630
 631 cmmLoadIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
 632 cmmLoadIndexOffExpr off rep base idx
 633    = CmmLoad (cmmIndexOffExpr off rep base idx) rep
 634
 635 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
 636 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr
 637
 638 -- ----------------------------------------------------------------------------
 639 -- Copying pointer arrays
 640
 641 -- | Takes a source 'Array#', an offset in the source array, a
 642 -- destination 'MutableArray#', an offset into the destination array,
 643 -- and the number of elements to copy.  Copies the given number of
 644 -- elements from the source array to the destination array.
 645 doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
 646               -> StgLiveVars -> Code
 647 doCopyArrayOp = emitCopyArray copy
 648   where
 649     -- Copy data (we assume the arrays aren't overlapping since
 650     -- they're of different types)
 651     copy _src _dst = emitMemcpyCall
 652
 653 -- | Takes a source 'MutableArray#', an offset in the source array, a
 654 -- destination 'MutableArray#', an offset into the destination array,
 655 -- and the number of elements to copy.  Copies the given number of
 656 -- elements from the source array to the destination array.
 657 doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
 658                      -> StgLiveVars -> Code
 659 doCopyMutableArrayOp = emitCopyArray copy
 660   where
 661     -- The only time the memory might overlap is when the two arrays
 662     -- we were provided are the same array!
 663     -- TODO: Optimize branch for common case of no aliasing.
 664     copy src dst dst_p src_p bytes live =
 665         emitIfThenElse (cmmEqWord src dst)
 666         (emitMemmoveCall dst_p src_p bytes live)
 667         (emitMemcpyCall dst_p src_p bytes live)
 668
 669 emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
 670                   -> StgLiveVars -> Code)
 671               -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
 672               -> StgLiveVars
 673               -> Code
 674 emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 live = do
 675     -- Assign the arguments to temporaries so the code generator can
 676     -- calculate liveness for us.
 677     src <- assignTemp_ src0
 678     src_off <- assignTemp_ src_off0
 679     dst <- assignTemp_ dst0
 680     dst_off <- assignTemp_ dst_off0
 681     n <- assignTemp_ n0
 682
 683     -- Set the dirty bit in the header.
 684     stmtC (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
 685
 686     dst_elems_p <- assignTemp $ cmmOffsetB dst arrPtrsHdrSize
 687     dst_p <- assignTemp $ cmmOffsetExprW dst_elems_p dst_off
 688     src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize) src_off
 689     bytes <- assignTemp $ cmmMulWord n (CmmLit (mkIntCLit wORD_SIZE))
 690
 691     copy src dst dst_p src_p bytes live
 692
 693     -- The base address of the destination card table
 694     dst_cards_p <- assignTemp $ cmmOffsetExprW dst_elems_p (loadArrPtrsSize dst)
 695
 696     emitSetCards dst_off dst_cards_p n live
 697
 698 -- | Takes an info table label, a register to return the newly
 699 -- allocated array in, a source array, an offset in the source array,
 700 -- and the number of elements to copy.  Allocates a new array and
 701 -- initializes it form the source array.
 702 emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
 703                -> StgLiveVars -> Code
 704 emitCloneArray info_p res_r src0 src_off0 n0 live = do
 705     -- Assign the arguments to temporaries so the code generator can
 706     -- calculate liveness for us.
 707     src <- assignTemp_ src0
 708     src_off <- assignTemp_ src_off0
 709     n <- assignTemp_ n0
 710
 711     card_words <- assignTemp $ (n `cmmUShrWord`
 712                                 (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)))
 713                   `cmmAddWord` CmmLit (mkIntCLit 1)
 714     size <- assignTemp $ n `cmmAddWord` card_words
 715     words <- assignTemp $ arrPtrsHdrSizeW `cmmAddWord` size
 716
 717     arr_r <- newTemp bWord
 718     emitAllocateCall arr_r myCapability words live
 719     tickyAllocPrim (CmmLit (mkIntCLit arrPtrsHdrSize)) (n `cmmMulWord` wordSize)
 720         (CmmLit $ mkIntCLit 0)
 721
 722     let arr = CmmReg (CmmLocal arr_r)
 723     emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCSAddr
 724     stmtC $ CmmStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
 725                                       oFFSET_StgMutArrPtrs_ptrs)) n
 726     stmtC $ CmmStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
 727                                       oFFSET_StgMutArrPtrs_size)) size
 728
 729     dst_p <- assignTemp $ cmmOffsetB arr arrPtrsHdrSize
 730     src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize)
 731              src_off
 732
 733     emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) live
 734
 735     emitMemsetCall (cmmOffsetExprW dst_p n)
 736         (CmmLit (mkIntCLit 1))
 737         (card_words `cmmMulWord` wordSize)
 738         live
 739     stmtC $ CmmAssign (CmmLocal res_r) arr
 740   where
 741     arrPtrsHdrSizeW = CmmLit $ mkIntCLit $ fixedHdrSize +
 742                       (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE)
 743     wordSize = CmmLit (mkIntCLit wORD_SIZE)
 744     myCapability = CmmReg baseReg `cmmSubWord`
 745                    CmmLit (mkIntCLit oFFSET_Capability_r)
 746
 747 -- | Takes and offset in the destination array, the base address of
 748 -- the card table, and the number of elements affected (*not* the
 749 -- number of cards).  Marks the relevant cards as dirty.
 750 emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
 751 emitSetCards dst_start dst_cards_start n live = do
 752     start_card <- assignTemp $ card dst_start
 753     emitMemsetCall (dst_cards_start `cmmAddWord` start_card)
 754         (CmmLit (mkIntCLit 1))
 755         ((card (dst_start `cmmAddWord` n) `cmmSubWord` start_card)
 756          `cmmAddWord` CmmLit (mkIntCLit 1))
 757         live
 758   where
 759     -- Convert an element index to a card index
 760     card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS))
 761
 762 -- | Emit a call to @memcpy@.
 763 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
 764 emitMemcpyCall dst src n live = do
 765     vols <- getVolatileRegs live
 766     emitForeignCall' PlayRisky
 767         [{-no results-}]
 768         (CmmCallee memcpy CCallConv)
 769         [ (CmmHinted dst AddrHint)
 770         , (CmmHinted src AddrHint)
 771         , (CmmHinted n NoHint)
 772         ]
 773         (Just vols)
 774         NoC_SRT -- No SRT b/c we do PlayRisky
 775         CmmMayReturn
 776   where
 777     memcpy = CmmLit (CmmLabel (mkForeignLabel (fsLit "memcpy") Nothing
 778                                ForeignLabelInExternalPackage IsFunction))
 779
 780 -- | Emit a call to @memmove@.
 781 emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
 782 emitMemmoveCall dst src n live = do
 783     vols <- getVolatileRegs live
 784     emitForeignCall' PlayRisky
 785         [{-no results-}]
 786         (CmmCallee memmove CCallConv)
 787         [ (CmmHinted dst AddrHint)
 788         , (CmmHinted src AddrHint)
 789         , (CmmHinted n NoHint)
 790         ]
 791         (Just vols)
 792         NoC_SRT -- No SRT b/c we do PlayRisky
 793         CmmMayReturn
 794   where
 795     memmove = CmmLit (CmmLabel (mkForeignLabel (fsLit "memmove") Nothing
 796                                ForeignLabelInExternalPackage IsFunction))
 797
 798 -- | Emit a call to @memset@.  The second argument must fit inside an
 799 -- unsigned char.
 800 emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
 801 emitMemsetCall dst c n live = do
 802     vols <- getVolatileRegs live
 803     emitForeignCall' PlayRisky
 804         [{-no results-}]
 805         (CmmCallee memset CCallConv)
 806         [ (CmmHinted dst AddrHint)
 807         , (CmmHinted c NoHint)
 808         , (CmmHinted n NoHint)
 809         ]
 810         (Just vols)
 811         NoC_SRT -- No SRT b/c we do PlayRisky
 812         CmmMayReturn
 813   where
 814     memset = CmmLit (CmmLabel (mkForeignLabel (fsLit "memset") Nothing
 815                                ForeignLabelInExternalPackage IsFunction))
 816
 817 -- | Emit a call to @allocate@.
 818 emitAllocateCall :: LocalReg -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
 819 emitAllocateCall res cap n live = do
 820     vols <- getVolatileRegs live
 821     emitForeignCall' PlayRisky
 822         [CmmHinted res AddrHint]
 823         (CmmCallee allocate CCallConv)
 824         [ (CmmHinted cap AddrHint)
 825         , (CmmHinted n NoHint)
 826         ]
 827         (Just vols)
 828         NoC_SRT -- No SRT b/c we do PlayRisky
 829         CmmMayReturn
 830   where
 831     allocate = CmmLit (CmmLabel (mkForeignLabel (fsLit "allocate") Nothing
 832                                  ForeignLabelInExternalPackage IsFunction))