ghc/compiler/codeGen/CgPrimOp.hs

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