Prim.hs 127 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2
{-# LANGUAGE LambdaCase #-}
3 4 5

#if __GLASGOW_HASKELL__ <= 808
-- GHC 8.10 deprecates this flag, but GHC 8.8 needs it
6 7
-- emitPrimOp is quite large
{-# OPTIONS_GHC -fmax-pmcheck-iterations=4000000 #-}
8
#endif
9

10
----------------------------------------------------------------------------
11 12 13 14 15 16 17
--
-- Stg to C--: primitive operations
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

18
module GHC.StgToCmm.Prim (
19
   cgOpApp,
20 21 22
   cgPrimOp, -- internal(ish), used by cgCase to get code for a
             -- comparison without also turning it into a Bool.
   shouldInlinePrimOp
23 24 25 26
 ) where

#include "HsVersions.h"

27 28
import GhcPrelude hiding ((<*>))

29 30 31 32 33 34 35 36
import GHC.StgToCmm.Layout
import GHC.StgToCmm.Foreign
import GHC.StgToCmm.Env
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Heap
import GHC.StgToCmm.Prof ( costCentreFrom )
37

38
import DynFlags
John Ericson's avatar
John Ericson committed
39
import GHC.Platform
40
import BasicTypes
41
import BlockId
42
import MkGraph
43
import GHC.Stg.Syntax
44
import Cmm
45
import Module   ( rtsUnitId )
46
import Type     ( Type, tyConAppTyCon )
47 48 49 50 51 52 53
import TyCon
import CLabel
import CmmUtils
import PrimOp
import SMRep
import FastString
import Outputable
54
import Util
55
import Data.Maybe
56

tibbe's avatar
tibbe committed
57
import Data.Bits ((.&.), bit)
58
import Control.Monad (liftM, when, unless)
59

60
------------------------------------------------------------------------
61
--      Primitive operations and foreign calls
62 63 64 65 66 67
------------------------------------------------------------------------

{- Note [Foreign call results]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~
A foreign call always returns an unboxed tuple of results, one
of which is the state token.  This seems to happen even for pure
68
calls.
69 70 71 72 73 74

Even if we returned a single result for pure calls, it'd still be
right to wrap it in a singleton unboxed tuple, because the result
might be a Haskell closure pointer, we don't want to evaluate it. -}

----------------------------------
75 76 77
cgOpApp :: StgOp        -- The op
        -> [StgArg]     -- Arguments
        -> Type         -- Result type (always an unboxed tuple)
78
        -> FCode ReturnKind
79

80
-- Foreign calls
81
cgOpApp (StgFCallOp fcall ty) stg_args res_ty
82
  = cgForeignCall fcall ty stg_args res_ty
83 84
      -- Note [Foreign call results]

85
-- tagToEnum# is special: we need to pull the constructor
86 87
-- out of the table, and perform an appropriate return.

88
cgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty
89
  = ASSERT(isEnumerationTyCon tycon)
90
    do  { dflags <- getDynFlags
91
        ; args' <- getNonVoidArgAmodes [arg]
92 93
        ; let amode = case args' of [amode] -> amode
                                    _ -> panic "TagToEnumOp had void arg"
94
        ; emitReturn [tagToClosure dflags tycon amode] }
95
   where
96 97 98 99 100 101
          -- If you're reading this code in the attempt to figure
          -- out why the compiler panic'ed here, it is probably because
          -- you used tagToEnum# in a non-monomorphic setting, e.g.,
          --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
          -- That won't work.
        tycon = tyConAppTyCon res_ty
102

103 104
cgOpApp (StgPrimOp primop) args res_ty = do
    dflags <- getDynFlags
105
    cmm_args <- getNonVoidArgAmodes args
106
    case emitPrimOp dflags primop cmm_args of
107 108
        Nothing -> do  -- out-of-line
          let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
109
          emitCall (NativeNodeCall, NativeReturn) fun cmm_args
110

111
        Just f  -- inline
112 113 114 115 116 117 118 119
          | ReturnsPrim VoidRep <- result_info
          -> do f []
                emitReturn []

          | ReturnsPrim rep <- result_info
          -> do dflags <- getDynFlags
                res <- newTemp (primRepCmmType dflags rep)
                f [res]
120
                emitReturn [CmmReg (CmmLocal res)]
121 122 123 124

          | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
          -> do (regs, _hints) <- newUnboxedTupleRegs res_ty
                f regs
125
                emitReturn (map (CmmReg . CmmLocal) regs)
126 127 128 129

          | otherwise -> panic "cgPrimop"
          where
             result_info = getPrimOpResultInfo primop
130

131
cgOpApp (StgPrimCallOp primcall) args _res_ty
132
  = do  { cmm_args <- getNonVoidArgAmodes args
133
        ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
134
        ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
135

tibbe's avatar
tibbe committed
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
-- | Interpret the argument as an unsigned value, assuming the value
-- is given in two-complement form in the given width.
--
-- Example: @asUnsigned W64 (-1)@ is 18446744073709551615.
--
-- This function is used to work around the fact that many array
-- primops take Int# arguments, but we interpret them as unsigned
-- quantities in the code gen. This means that we have to be careful
-- every time we work on e.g. a CmmInt literal that corresponds to the
-- array size, as it might contain a negative Integer value if the
-- user passed a value larger than 2^(wORD_SIZE_IN_BITS-1) as the Int#
-- literal.
asUnsigned :: Width -> Integer -> Integer
asUnsigned w n = n .&. (bit (widthInBits w) - 1)

151
---------------------------------------------------
152 153 154 155
cgPrimOp   :: [LocalReg]        -- where to put the results
           -> PrimOp            -- the op
           -> [StgArg]          -- arguments
           -> FCode ()
156

157 158 159 160 161 162
cgPrimOp results op args = do
  dflags <- getDynFlags
  arg_exprs <- getNonVoidArgAmodes args
  case emitPrimOp dflags op arg_exprs of
    Nothing -> panic "External prim op"
    Just f -> f results
163 164 165


------------------------------------------------------------------------
166
--      Emitting code for a primop
167 168
------------------------------------------------------------------------

169 170 171 172 173 174 175
shouldInlinePrimOp :: DynFlags -> PrimOp -> [CmmExpr] -> Bool
shouldInlinePrimOp dflags op args = isJust $ emitPrimOp dflags op args

-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use
-- ByteOff (or some other fixed width signed type) to represent
-- array sizes or indices. This means that these will overflow for
-- large enough sizes.
176

177 178 179 180 181
-- TODO: Several primops, such as 'copyArray#', only have an inline
-- implementation (below) but could possibly have both an inline
-- implementation and an out-of-line implementation, just like
-- 'newArray#'. This would lower the amount of code generated,
-- hopefully without a performance impact (needs to be measured).
182

183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308
-- | The big function handling all the primops. The 'OpDest' function type
-- abstracts over a few common cases, and the "most manual" fallback.
--
-- In the simple case, there is just one implementation, and we emit that.
--
-- In more complex cases, there is a foreign call (out of line) fallback. This
-- might happen e.g. if there's enough static information, such as statically
-- know arguments.
dispatchPrimop
  :: DynFlags
  -> PrimOp            -- ^ The primop
  -> [CmmExpr]         -- ^ The primop arguments
  -> OpDest
dispatchPrimop dflags = \case
  NewByteArrayOp_Char -> \case
    [(CmmLit (CmmInt n w))]
      | asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone  $ \ [res] -> doNewByteArrayOp res (fromInteger n)
    _ -> OpDest_External

  NewArrayOp -> \case
    [(CmmLit (CmmInt n w)), init]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \[res] -> doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel
        [ (mkIntExpr dflags (fromInteger n),
           fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags)
        , (mkIntExpr dflags (nonHdrSizeW (arrPtrsRep dflags (fromInteger n))),
           fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags)
        ]
        (fromInteger n) init
    _ -> OpDest_External

  CopyArrayOp -> \case
    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
      OpDest_AllDone $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
    _ -> OpDest_External

  CopyMutableArrayOp -> \case
    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
      OpDest_AllDone $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
    _ -> OpDest_External

  CopyArrayArrayOp -> \case
    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
      OpDest_AllDone $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
    _ -> OpDest_External

  CopyMutableArrayArrayOp -> \case
    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
      OpDest_AllDone $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
    _ -> OpDest_External

  CloneArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  CloneMutableArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  FreezeArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  ThawArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  NewSmallArrayOp -> \case
    [(CmmLit (CmmInt n w)), init]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] ->
        doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel
        [ (mkIntExpr dflags (fromInteger n),
           fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
        ]
        (fromInteger n) init
    _ -> OpDest_External

  CopySmallArrayOp -> \case
    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
      OpDest_AllDone $ \ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)
    _ -> OpDest_External

  CopySmallMutableArrayOp -> \case
    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
      OpDest_AllDone $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)
    _ -> OpDest_External

  CloneSmallArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  CloneSmallMutableArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  FreezeSmallArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

  ThawSmallArrayOp -> \case
    [src, src_off, (CmmLit (CmmInt n w))]
      | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
      -> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
    _ -> OpDest_External

-- First we handle various awkward cases specially.

  ParOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    -- for now, just implement this in a C function
    -- later, we might want to inline it.
309
    emitCCall
310
        [(res,NoHint)]
311
        (CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
312
        [(baseExpr, AddrHint), (arg,AddrHint)]
313

314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
  SparkOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    -- returns the value of arg in res.  We're going to therefore
    -- refer to arg twice (once to pass to newSpark(), and once to
    -- assign to res), so put it in a temporary.
    tmp <- assignTemp arg
    tmp2 <- newTemp (bWord dflags)
    emitCCall
        [(tmp2,NoHint)]
        (CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
        [(baseExpr, AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]
    emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))

  GetCCSOfOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    let
      val
       | gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
       | otherwise                      = CmmLit (zeroCLit dflags)
    emitAssign (CmmLocal res) val

  GetCurrentCCSOp -> \[_] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) cccsExpr

  MyThreadIdOp -> \[] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) currentTSOExpr

  ReadMutVarOp -> \[mutv] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))

  WriteMutVarOp -> \[mutv, var] -> OpDest_AllDone $ \res@[] -> do
343 344 345
    old_val <- CmmLocal <$> newTemp (cmmExprType dflags var)
    emitAssign old_val (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))

346 347
    -- Without this write barrier, other CPUs may see this pointer before
    -- the writes for the closure it points to have occurred.
348 349 350
    -- Note that this also must come after we read the old value to ensure
    -- that the read of old_val comes before another core's write to the
    -- MutVar's value.
351 352 353 354 355
    emitPrimCall res MO_WriteBarrier []
    emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var
    emitCCall
            [{-no results-}]
            (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
356
            [(baseExpr, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)]
357 358

--  #define sizzeofByteArrayzh(r,a) \
siddhanathan's avatar
siddhanathan committed
359
--     r = ((StgArrBytes *)(a))->bytes
360 361
  SizeofByteArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
362 363

--  #define sizzeofMutableByteArrayzh(r,a) \
siddhanathan's avatar
siddhanathan committed
364
--      r = ((StgArrBytes *)(a))->bytes
365
  SizeofMutableByteArrayOp -> dispatchPrimop dflags SizeofByteArrayOp
366

367
--  #define getSizzeofMutableByteArrayzh(r,a) \
siddhanathan's avatar
siddhanathan committed
368
--      r = ((StgArrBytes *)(a))->bytes
369 370
  GetSizeofMutableByteArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
371

372 373

--  #define touchzh(o)                  /* nothing */
374 375
  TouchOp -> \args@[_] -> OpDest_AllDone $ \res@[] -> do
    emitPrimCall res MO_Touch args
376 377

--  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
378 379
  ByteArrayContents_Char -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) (cmmOffsetB dflags arg (arrWordsHdrSize dflags))
380 381

--  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
382 383
  StableNameToIntOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
384

385 386
  ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2])
387 388

--  #define addrToHValuezh(r,a) r=(P_)a
389 390
  AddrToAnyOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) arg
391

gcampax's avatar
gcampax committed
392
--  #define hvalueToAddrzh(r, a) r=(W_)a
393 394
  AnyToAddrOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) arg
gcampax's avatar
gcampax committed
395

396 397 398
{- Freezing arrays-of-ptrs requires changing an info table, for the
   benefit of the generational collector.  It needs to scavenge mutable
   objects, even if they are in old space.  When they become immutable,
399
   they can be removed from this scavenge list.  -}
400 401

--  #define unsafeFreezzeArrayzh(r,a)
402
--      {
403
--        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_DIRTY_info);
404 405
--        r = a;
--      }
406 407 408 409 410 411 412 413 414 415 416 417
  UnsafeFreezeArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emit $ catAGraphs
      [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
        mkAssign (CmmLocal res) arg ]
  UnsafeFreezeArrayArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emit $ catAGraphs
      [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
        mkAssign (CmmLocal res) arg ]
  UnsafeFreezeSmallArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emit $ catAGraphs
      [ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),
        mkAssign (CmmLocal res) arg ]
418

419
--  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
420 421
  UnsafeFreezeByteArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emitAssign (CmmLocal res) arg
422 423 424

-- Reading/writing pointer arrays

425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458
  ReadArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  IndexArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  WriteArrayOp -> \[obj, ix, v] -> OpDest_AllDone $ \[] -> do
    doWritePtrArrayOp obj ix v

  IndexArrayArrayOp_ByteArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  IndexArrayArrayOp_ArrayArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  ReadArrayArrayOp_ByteArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  ReadArrayArrayOp_MutableByteArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  ReadArrayArrayOp_ArrayArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  ReadArrayArrayOp_MutableArrayArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadPtrArrayOp res obj ix
  WriteArrayArrayOp_ByteArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
    doWritePtrArrayOp obj ix v
  WriteArrayArrayOp_MutableByteArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
    doWritePtrArrayOp obj ix v
  WriteArrayArrayOp_ArrayArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
    doWritePtrArrayOp obj ix v
  WriteArrayArrayOp_MutableArrayArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
    doWritePtrArrayOp obj ix v

  ReadSmallArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadSmallPtrArrayOp res obj ix
  IndexSmallArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
    doReadSmallPtrArrayOp res obj ix
  WriteSmallArrayOp -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
    doWriteSmallPtrArrayOp obj ix v
459 460 461

-- Getting the size of pointer arrays

462 463 464
  SizeofArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
    emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg
      (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags))
Ben Gamari's avatar
Ben Gamari committed
465
        (bWord dflags))
466 467 468 469
  SizeofMutableArrayOp -> dispatchPrimop dflags SizeofArrayOp
  SizeofArrayArrayOp -> dispatchPrimop dflags SizeofArrayOp
  SizeofMutableArrayArrayOp -> dispatchPrimop dflags SizeofArrayOp
  SizeofSmallArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
470
    emit $ mkAssign (CmmLocal res)
471
     (cmmLoadIndexW dflags arg
Ben Gamari's avatar
Ben Gamari committed
472 473
     (fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgSmallMutArrPtrs_ptrs dflags))
        (bWord dflags))
474 475

  SizeofSmallMutableArrayOp -> dispatchPrimop dflags SizeofSmallArrayOp
476
  GetSizeofSmallMutableArrayOp -> dispatchPrimop dflags SizeofSmallArrayOp
477

478 479
-- IndexXXXoffAddr

480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511
  IndexOffAddrOp_Char -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8 res args
  IndexOffAddrOp_WideChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args
  IndexOffAddrOp_Int -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  IndexOffAddrOp_Word -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  IndexOffAddrOp_Addr -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  IndexOffAddrOp_Float -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing f32 res args
  IndexOffAddrOp_Double -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing f64 res args
  IndexOffAddrOp_StablePtr -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  IndexOffAddrOp_Int8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_s_8ToWord dflags)) b8  res args
  IndexOffAddrOp_Int16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_s_16ToWord dflags)) b16 res args
  IndexOffAddrOp_Int32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_s_32ToWord dflags)) b32 res args
  IndexOffAddrOp_Int64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing b64 res args
  IndexOffAddrOp_Word8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8  res args
  IndexOffAddrOp_Word16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_16ToWord dflags)) b16 res args
  IndexOffAddrOp_Word32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args
  IndexOffAddrOp_Word64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing b64 res args
512 513 514

-- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.

515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546
  ReadOffAddrOp_Char -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8 res args
  ReadOffAddrOp_WideChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args
  ReadOffAddrOp_Int -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  ReadOffAddrOp_Word -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  ReadOffAddrOp_Addr -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  ReadOffAddrOp_Float -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing f32 res args
  ReadOffAddrOp_Double -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing f64 res args
  ReadOffAddrOp_StablePtr -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing (bWord dflags) res args
  ReadOffAddrOp_Int8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_s_8ToWord dflags)) b8  res args
  ReadOffAddrOp_Int16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_s_16ToWord dflags)) b16 res args
  ReadOffAddrOp_Int32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_s_32ToWord dflags)) b32 res args
  ReadOffAddrOp_Int64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing b64 res args
  ReadOffAddrOp_Word8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8  res args
  ReadOffAddrOp_Word16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_16ToWord dflags)) b16 res args
  ReadOffAddrOp_Word32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   (Just (mo_u_32ToWord dflags)) b32 res args
  ReadOffAddrOp_Word64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexOffAddrOp   Nothing b64 res args
547 548 549

-- IndexXXXArray

550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581
  IndexByteArrayOp_Char -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8 res args
  IndexByteArrayOp_WideChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32 res args
  IndexByteArrayOp_Int -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  IndexByteArrayOp_Word -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  IndexByteArrayOp_Addr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  IndexByteArrayOp_Float -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing f32 res args
  IndexByteArrayOp_Double -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing f64 res args
  IndexByteArrayOp_StablePtr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  IndexByteArrayOp_Int8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_s_8ToWord dflags)) b8  res args
  IndexByteArrayOp_Int16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_s_16ToWord dflags)) b16  res args
  IndexByteArrayOp_Int32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_s_32ToWord dflags)) b32  res args
  IndexByteArrayOp_Int64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing b64  res args
  IndexByteArrayOp_Word8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8  res args
  IndexByteArrayOp_Word16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_16ToWord dflags)) b16  res args
  IndexByteArrayOp_Word32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32  res args
  IndexByteArrayOp_Word64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing b64  res args
582 583 584

-- ReadXXXArray, identical to IndexXXXArray.

585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616
  ReadByteArrayOp_Char -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8 res args
  ReadByteArrayOp_WideChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32 res args
  ReadByteArrayOp_Int -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  ReadByteArrayOp_Word -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  ReadByteArrayOp_Addr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  ReadByteArrayOp_Float -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing f32 res args
  ReadByteArrayOp_Double -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing f64 res args
  ReadByteArrayOp_StablePtr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing (bWord dflags) res args
  ReadByteArrayOp_Int8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_s_8ToWord dflags)) b8  res args
  ReadByteArrayOp_Int16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_s_16ToWord dflags)) b16  res args
  ReadByteArrayOp_Int32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_s_32ToWord dflags)) b32  res args
  ReadByteArrayOp_Int64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing b64  res args
  ReadByteArrayOp_Word8 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_8ToWord dflags)) b8  res args
  ReadByteArrayOp_Word16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_16ToWord dflags)) b16  res args
  ReadByteArrayOp_Word32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   (Just (mo_u_32ToWord dflags)) b32  res args
  ReadByteArrayOp_Word64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOp   Nothing b64  res args
617

618 619
-- IndexWord8ArrayAsXXX

620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647
  IndexByteArrayOp_Word8AsChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_8ToWord dflags)) b8 b8 res args
  IndexByteArrayOp_Word8AsWideChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args
  IndexByteArrayOp_Word8AsInt -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  IndexByteArrayOp_Word8AsWord -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  IndexByteArrayOp_Word8AsAddr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  IndexByteArrayOp_Word8AsFloat -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing f32 b8 res args
  IndexByteArrayOp_Word8AsDouble -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing f64 b8 res args
  IndexByteArrayOp_Word8AsStablePtr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  IndexByteArrayOp_Word8AsInt16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_s_16ToWord dflags)) b16 b8 res args
  IndexByteArrayOp_Word8AsInt32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_s_32ToWord dflags)) b32 b8 res args
  IndexByteArrayOp_Word8AsInt64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing b64 b8 res args
  IndexByteArrayOp_Word8AsWord16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_16ToWord dflags)) b16 b8 res args
  IndexByteArrayOp_Word8AsWord32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args
  IndexByteArrayOp_Word8AsWord64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing b64 b8 res args
648 649 650

-- ReadInt8ArrayAsXXX, identical to IndexInt8ArrayAsXXX

651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678
  ReadByteArrayOp_Word8AsChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_8ToWord dflags)) b8 b8 res args
  ReadByteArrayOp_Word8AsWideChar -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args
  ReadByteArrayOp_Word8AsInt -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  ReadByteArrayOp_Word8AsWord -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  ReadByteArrayOp_Word8AsAddr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  ReadByteArrayOp_Word8AsFloat -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing f32 b8 res args
  ReadByteArrayOp_Word8AsDouble -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing f64 b8 res args
  ReadByteArrayOp_Word8AsStablePtr -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing (bWord dflags) b8 res args
  ReadByteArrayOp_Word8AsInt16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_s_16ToWord dflags)) b16 b8 res args
  ReadByteArrayOp_Word8AsInt32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_s_32ToWord dflags)) b32 b8 res args
  ReadByteArrayOp_Word8AsInt64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing b64 b8 res args
  ReadByteArrayOp_Word8AsWord16 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_16ToWord dflags)) b16 b8 res args
  ReadByteArrayOp_Word8AsWord32 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   (Just (mo_u_32ToWord dflags)) b32 b8 res args
  ReadByteArrayOp_Word8AsWord64 -> \args -> OpDest_AllDone $ \res -> do
    doIndexByteArrayOpAs   Nothing b64 b8 res args
679

680 681
-- WriteXXXoffAddr

682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713
  WriteOffAddrOp_Char -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo8 dflags))  b8 res args
  WriteOffAddrOp_WideChar -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
  WriteOffAddrOp_Int -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing (bWord dflags) res args
  WriteOffAddrOp_Word -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing (bWord dflags) res args
  WriteOffAddrOp_Addr -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing (bWord dflags) res args
  WriteOffAddrOp_Float -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing f32 res args
  WriteOffAddrOp_Double -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing f64 res args
  WriteOffAddrOp_StablePtr -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing (bWord dflags) res args
  WriteOffAddrOp_Int8 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo8 dflags))  b8 res args
  WriteOffAddrOp_Int16 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args
  WriteOffAddrOp_Int32 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
  WriteOffAddrOp_Int64 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing b64 res args
  WriteOffAddrOp_Word8 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo8 dflags))  b8 res args
  WriteOffAddrOp_Word16 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args
  WriteOffAddrOp_Word32 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
  WriteOffAddrOp_Word64 -> \args -> OpDest_AllDone $ \res -> do
    doWriteOffAddrOp Nothing b64 res args
714 715 716

-- WriteXXXArray

717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748
  WriteByteArrayOp_Char -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8 res args
  WriteByteArrayOp_WideChar -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
  WriteByteArrayOp_Int -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing (bWord dflags) res args
  WriteByteArrayOp_Word -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing (bWord dflags) res args
  WriteByteArrayOp_Addr -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing (bWord dflags) res args
  WriteByteArrayOp_Float -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing f32 res args
  WriteByteArrayOp_Double -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing f64 res args
  WriteByteArrayOp_StablePtr -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing (bWord dflags) res args
  WriteByteArrayOp_Int8 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8 res args
  WriteByteArrayOp_Int16 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16 res args
  WriteByteArrayOp_Int32 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
  WriteByteArrayOp_Int64 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b64 res args
  WriteByteArrayOp_Word8 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8  res args
  WriteByteArrayOp_Word16 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16 res args
  WriteByteArrayOp_Word32 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
  WriteByteArrayOp_Word64 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b64 res args
749

750 751
-- WriteInt8ArrayAsXXX

752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779
  WriteByteArrayOp_Word8AsChar -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo8 dflags))  b8 res args
  WriteByteArrayOp_Word8AsWideChar -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args
  WriteByteArrayOp_Word8AsInt -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsWord -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsAddr -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsFloat -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsDouble -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsStablePtr -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsInt16 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args
  WriteByteArrayOp_Word8AsInt32 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args
  WriteByteArrayOp_Word8AsInt64 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
  WriteByteArrayOp_Word8AsWord16 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args
  WriteByteArrayOp_Word8AsWord32 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args
  WriteByteArrayOp_Word8AsWord64 -> \args -> OpDest_AllDone $ \res -> do
    doWriteByteArrayOp Nothing b8 res args
780

Ian Lynagh's avatar
Ian Lynagh committed
781
-- Copying and setting byte arrays
782
  CopyByteArrayOp -> \[src,src_off,dst,dst_off,n] -> OpDest_AllDone $ \[] -> do
783
    doCopyByteArrayOp src src_off dst dst_off n
784
  CopyMutableByteArrayOp -> \[src,src_off,dst,dst_off,n] -> OpDest_AllDone $ \[] -> do
785
    doCopyMutableByteArrayOp src src_off dst dst_off n
786
  CopyByteArrayToAddrOp -> \[src,src_off,dst,n] -> OpDest_AllDone $ \[] -> do
787
    doCopyByteArrayToAddrOp src src_off dst n
788
  CopyMutableByteArrayToAddrOp -> \[src,src_off,dst,n] -> OpDest_AllDone $ \[] -> do
789
    doCopyMutableByteArrayToAddrOp src src_off dst n
790
  CopyAddrToByteArrayOp -> \[src,dst,dst_off,n] -> OpDest_AllDone $ \[] -> do
791
    doCopyAddrToByteArrayOp src dst dst_off n
792
  SetByteArrayOp -> \[ba,off,len,c] -> OpDest_AllDone $ \[] -> do
Ian Lynagh's avatar
Ian Lynagh committed
793
    doSetByteArrayOp ba off len c
794

795
-- Comparing byte arrays
796
  CompareByteArraysOp -> \[ba1,ba1_off,ba2,ba2_off,n] -> OpDest_AllDone $ \[res] -> do
797 798
    doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n

799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817
  BSwap16Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBSwapCall res w W16
  BSwap32Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBSwapCall res w W32
  BSwap64Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBSwapCall res w W64
  BSwapOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBSwapCall res w (wordWidth dflags)

  BRev8Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBRevCall res w W8
  BRev16Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBRevCall res w W16
  BRev32Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBRevCall res w W32
  BRev64Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBRevCall res w W64
  BRevOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitBRevCall res w (wordWidth dflags)
818

tibbe's avatar
tibbe committed
819
-- Population count
820 821 822 823 824 825 826 827 828 829
  PopCnt8Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPopCntCall res w W8
  PopCnt16Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPopCntCall res w W16
  PopCnt32Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPopCntCall res w W32
  PopCnt64Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPopCntCall res w W64
  PopCntOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPopCntCall res w (wordWidth dflags)
tibbe's avatar
tibbe committed
830

831
-- Parallel bit deposit
832 833 834 835 836 837 838 839 840 841
  Pdep8Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPdepCall res src mask W8
  Pdep16Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPdepCall res src mask W16
  Pdep32Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPdepCall res src mask W32
  Pdep64Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPdepCall res src mask W64
  PdepOp -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPdepCall res src mask (wordWidth dflags)
842 843

-- Parallel bit extract
844 845 846 847 848 849 850 851 852 853
  Pext8Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPextCall res src mask W8
  Pext16Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPextCall res src mask W16
  Pext32Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPextCall res src mask W32
  Pext64Op -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPextCall res src mask W64
  PextOp -> \[src, mask] -> OpDest_AllDone $ \[res] -> do
    emitPextCall res src mask (wordWidth dflags)
854

855
-- count leading zeros
856 857 858 859 860 861 862 863 864 865
  Clz8Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitClzCall res w W8
  Clz16Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitClzCall res w W16
  Clz32Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitClzCall res w W32
  Clz64Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitClzCall res w W64
  ClzOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitClzCall res w (wordWidth dflags)
866 867

-- count trailing zeros
868 869 870 871 872 873 874 875 876 877
  Ctz8Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitCtzCall res w W8
  Ctz16Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitCtzCall res w W16
  Ctz32Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitCtzCall res w W32
  Ctz64Op -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitCtzCall res w W64
  CtzOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitCtzCall res w (wordWidth dflags)
878

879
-- Unsigned int to floating point conversions
880 881 882 883
  Word2FloatOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPrimCall [res] (MO_UF_Conv W32) [w]
  Word2DoubleOp -> \[w] -> OpDest_AllDone $ \[res] -> do
    emitPrimCall [res] (MO_UF_Conv W64) [w]
884

885
-- SIMD primops
886
  (VecBroadcastOp vcat n w) -> \[e] -> OpDest_AllDone $ \[res] -> do
887
    checkVecCompatibility dflags vcat n w
888
    doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros (replicate n e) res
889
   where
890 891 892 893 894 895 896 897 898 899 900 901
    zeros :: CmmExpr
    zeros = CmmLit $ CmmVec (replicate n zero)

    zero :: CmmLit
    zero = case vcat of
             IntVec   -> CmmInt 0 w
             WordVec  -> CmmInt 0 w
             FloatVec -> CmmFloat 0 w

    ty :: CmmType
    ty = vecVmmType vcat n w

902
  (VecPackOp vcat n w) -> \es -> OpDest_AllDone $ \[res] -> do
903
    checkVecCompatibility dflags vcat n w
904
    when (es `lengthIsNot` n) $
905 906
        panic "emitPrimOp: VecPackOp has wrong number of arguments"
    doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros es res
907
   where
908 909 910 911 912 913 914 915 916 917 918 919
    zeros :: CmmExpr
    zeros = CmmLit $ CmmVec (replicate n zero)

    zero :: CmmLit
    zero = case vcat of
             IntVec   -> CmmInt 0 w
             WordVec  -> CmmInt 0 w
             FloatVec -> CmmFloat 0 w

    ty :: CmmType
    ty = vecVmmType vcat n w

920
  (VecUnpackOp vcat n w) -> \[arg] -> OpDest_AllDone $ \res -> do
921
    checkVecCompatibility dflags vcat n w
922
    when (res `lengthIsNot` n) $
923 924
        panic "emitPrimOp: VecUnpackOp has wrong number of results"
    doVecUnpackOp (vecElemProjectCast dflags vcat w) ty arg res
925
   where
926 927
    ty :: CmmType
    ty = vecVmmType vcat n w
928

929
  (VecInsertOp vcat n w) -> \[v,e,i] -> OpDest_AllDone $ \[res] -> do
930
    checkVecCompatibility dflags vcat n w
931
    doVecInsertOp (vecElemInjectCast dflags vcat w) ty v e i res
932
   where
933 934
    ty :: CmmType
    ty = vecVmmType vcat n w
935

936
  (VecIndexByteArrayOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
937
    checkVecCompatibility dflags vcat n w
938 939
    doIndexByteArrayOp Nothing ty res0 args
   where
940 941
    ty :: CmmType
    ty = vecVmmType vcat n w
942

943
  (VecReadByteArrayOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
944
    checkVecCompatibility dflags vcat n w
945 946
    doIndexByteArrayOp Nothing ty res0 args
   where
947 948
    ty :: CmmType
    ty = vecVmmType vcat n w
949

950
  (VecWriteByteArrayOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
951
    checkVecCompatibility dflags vcat n w
952 953
    doWriteByteArrayOp Nothing ty res0 args
   where
954 955
    ty :: CmmType
    ty = vecVmmType vcat n w
956

957
  (VecIndexOffAddrOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
958
    checkVecCompatibility dflags vcat n w
959 960
    doIndexOffAddrOp Nothing ty res0 args
   where
961 962
    ty :: CmmType
    ty = vecVmmType vcat n w
963

964
  (VecReadOffAddrOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
965
    checkVecCompatibility dflags vcat n w
966 967
    doIndexOffAddrOp Nothing ty res0 args
   where
968 969
    ty :: CmmType
    ty = vecVmmType vcat n w
970

971
  (VecWriteOffAddrOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
972
    checkVecCompatibility dflags vcat n w
973 974
    doWriteOffAddrOp Nothing ty res0 args
   where
975 976
    ty :: CmmType
    ty = vecVmmType vcat n w
977

978
  (VecIndexScalarByteArrayOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
979
    checkVecCompatibility dflags vcat n w
980 981
    doIndexByteArrayOpAs Nothing vecty ty res0 args
   where
982 983
    vecty :: CmmType
    vecty = vecVmmType vcat n w
984

985 986 987
    ty :: CmmType
    ty = vecCmmCat vcat w

988
  (VecReadScalarByteArrayOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
989
    checkVecCompatibility dflags vcat n w
990 991
    doIndexByteArrayOpAs Nothing vecty ty res0 args
   where
992 993
    vecty :: CmmType
    vecty = vecVmmType vcat n w
994

995 996
    ty :: CmmType
    ty = vecCmmCat vcat w
997

998
  (VecWriteScalarByteArrayOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
999
    checkVecCompatibility dflags vcat n w
1000 1001
    doWriteByteArrayOp Nothing ty res0 args
   where
1002 1003
    ty :: CmmType
    ty = vecCmmCat vcat w
1004

1005
  (VecIndexScalarOffAddrOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
1006
    checkVecCompatibility dflags vcat n w
1007 1008
    doIndexOffAddrOpAs Nothing vecty ty res0 args
   where
1009 1010
    vecty :: CmmType
    vecty = vecVmmType vcat n w
1011

1012 1013 1014
    ty :: CmmType
    ty = vecCmmCat vcat w

1015
  (VecReadScalarOffAddrOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
1016
    checkVecCompatibility dflags vcat n w
1017 1018
    doIndexOffAddrOpAs Nothing vecty ty res0 args
   where
1019 1020
    vecty :: CmmType
    vecty = vecVmmType vcat n w
1021

1022 1023
    ty :: CmmType
    ty = vecCmmCat vcat w
1024

1025
  (VecWriteScalarOffAddrOp vcat n w) -> \args -> OpDest_AllDone $ \res0 -> do
1026
    checkVecCompatibility dflags vcat n w
1027 1028
    doWriteOffAddrOp Nothing ty res0 args
   where
1029 1030
    ty :: CmmType
    ty = vecCmmCat vcat w
1031

gmainland's avatar
gmainland committed
1032
-- Prefetch
1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066
  PrefetchByteArrayOp3         -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchByteArrayOp 3  args
  PrefetchMutableByteArrayOp3  -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchMutableByteArrayOp 3  args
  PrefetchAddrOp3              -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchAddrOp  3  args
  PrefetchValueOp3             -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchValueOp 3 args

  PrefetchByteArrayOp2         -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchByteArrayOp 2  args
  PrefetchMutableByteArrayOp2  -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchMutableByteArrayOp 2  args
  PrefetchAddrOp2              -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchAddrOp 2  args
  PrefetchValueOp2             -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchValueOp 2 args
  PrefetchByteArrayOp1         -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchByteArrayOp 1  args
  PrefetchMutableByteArrayOp1  -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchMutableByteArrayOp 1  args
  PrefetchAddrOp1              -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchAddrOp 1  args
  PrefetchValueOp1             -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchValueOp 1 args

  PrefetchByteArrayOp0         -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchByteArrayOp 0  args
  PrefetchMutableByteArrayOp0  -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchMutableByteArrayOp 0  args
  PrefetchAddrOp0              -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchAddrOp 0  args
  PrefetchValueOp0             -> \args -> OpDest_AllDone $ \[] -> do
    doPrefetchValueOp 0 args
1067

1068
-- Atomic read-modify-write
1069
  FetchAddByteArrayOp_Int -> \[mba, ix, n] -> OpDest_AllDone $ \[res] -> do
1070
    doAtomicRMW res AMO_Add mba ix (bWord dflags) n
1071
  FetchSubByteArrayOp_Int -> \[mba, ix, n] -> OpDest_AllDone $ \[res] -> do
1072
    doAtomicRMW res AMO_Sub mba ix (bWord dflags) n
1073
  FetchAndByteArrayOp_Int -> \[mba, ix, n] -> OpDest_AllDone $ \[res] -> do
1074
    doAtomicRMW res AMO_And mba ix (bWord dflags) n
1075
  FetchNandByteArrayOp_Int -> \[mba, ix, n] -> OpDest_AllDone $ \[res] -> do
1076
    doAtomicRMW res AMO_Nand mba ix (bWord dflags) n
1077
  FetchOrByteArrayOp_Int -> \[mba, ix, n] -> OpDest_AllDone $ \[res] -> do
1078
    doAtomicRMW res AMO_Or mba ix (bWord dflags) n
1079
  FetchXorByteArrayOp_Int -> \[mba, ix, n] -> OpDest_AllDone $ \[res] -> do
1080
    doAtomicRMW res AMO_Xor mba ix (bWord dflags) n
1081
  AtomicReadByteArrayOp_Int -> \[mba, ix] -> OpDest_AllDone $ \[res] -> do
1082
    doAtomicReadByteArray res mba ix (bWord dflags)
1083
  AtomicWriteByteArrayOp_Int -> \[mba, ix, val] -> OpDest_AllDone $ \[] -> do
1084
    doAtomicWriteByteArray mba ix (bWord dflags) val
1085
  CasByteArrayOp_Int -> \[mba, ix, old, new] -> OpDest_AllDone $ \[res] -> do
1086
    doCasByteArray res mba ix (bWord dflags) old new
gmainland's avatar
gmainland committed
1087

1088 1089
-- The rest just translate straightforwardly

1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140
  Int2WordOp      -> \_ -> OpDest_Nop
  Word2IntOp      -> \_ -> OpDest_Nop
  Int2AddrOp      -> \_ -> OpDest_Nop
  Addr2IntOp      -> \_ -> OpDest_Nop
  ChrOp           -> \_ -> OpDest_Nop  -- Int# and Char# are rep'd the same
  OrdOp           -> \_ -> OpDest_Nop

  Narrow8IntOp   -> \_ -> OpDest_Narrow (MO_SS_Conv, W8)
  Narrow16IntOp  -> \_ -> OpDest_Narrow (MO_SS_Conv, W16)
  Narrow32IntOp  -> \_ -> OpDest_Narrow (MO_SS_Conv, W32)
  Narrow8WordOp  -> \_ -> OpDest_Narrow (MO_UU_Conv, W8)
  Narrow16WordOp -> \_ -> OpDest_Narrow (MO_UU_Conv, W16)
  Narrow32WordOp -> \_ -> OpDest_Narrow (MO_UU_Conv, W32)

  DoublePowerOp  -> \_ -> OpDest_Callish MO_F64_Pwr
  DoubleSinOp    -> \_ -> OpDest_Callish MO_F64_Sin
  DoubleCosOp    -> \_ -> OpDest_Callish MO_F64_Cos
  DoubleTanOp    -> \_ -> OpDest_Callish MO_F64_Tan
  DoubleSinhOp   -> \_ -> OpDest_Callish MO_F64_Sinh
  DoubleCoshOp   -> \_ -> OpDest_Callish MO_F64_Cosh
  DoubleTanhOp   -> \_ -> OpDest_Callish MO_F64_Tanh
  DoubleAsinOp   -> \_ -> OpDest_Callish MO_F64_Asin
  DoubleAcosOp   -> \_ -> OpDest_Callish MO_F64_Acos
  DoubleAtanOp   -> \_ -> OpDest_Callish MO_F64_Atan
  DoubleAsinhOp  -> \_ -> OpDest_Callish MO_F64_Asinh
  DoubleAcoshOp  -> \_ -> OpDest_Callish MO_F64_Acosh
  DoubleAtanhOp  -> \_ -> OpDest_Callish MO_F64_Atanh
  DoubleLogOp    -> \_ -> OpDest_Callish MO_F64_Log
  DoubleLog1POp  -> \_ -> OpDest_Callish MO_F64_Log1P
  DoubleExpOp    -> \_ -> OpDest_Callish MO_F64_Exp
  DoubleExpM1Op  -> \_ -> OpDest_Callish MO_F64_ExpM1
  DoubleSqrtOp   -> \_ -> OpDest_Callish MO_F64_Sqrt

  FloatPowerOp   -> \_ -> OpDest_Callish MO_F32_Pwr
  FloatSinOp     -> \_ -> OpDest_Callish MO_F32_Sin
  FloatCosOp     -> \_ -> OpDest_Callish MO_F32_Cos
  FloatTanOp     -> \_ -> OpDest_Callish MO_F32_Tan
  FloatSinhOp    -> \_ -> OpDest_Callish MO_F32_Sinh
  FloatCoshOp    -> \_ -> OpDest_Callish MO_F32_Cosh
  FloatTanhOp    -> \_ -> OpDest_Callish MO_F32_Tanh
  FloatAsinOp    -> \_ -> OpDest_Callish MO_F32_Asin
  FloatAcosOp    -> \_ -> OpDest_Callish MO_F32_Acos
  FloatAtanOp    -> \_ -> OpDest_Callish MO_F32_Atan
  FloatAsinhOp   -> \_ -> OpDest_Callish MO_F32_Asinh
  FloatAcoshOp   -> \_ -> OpDest_Callish MO_F32_Acosh
  FloatAtanhOp   -> \_ -> OpDest_Callish MO_F32_Atanh
  FloatLogOp     -> \_ -> OpDest_Callish MO_F32_Log
  FloatLog1POp   -> \_ -> OpDest_Callish MO_F32_Log1P
  FloatExpOp     -> \_ -> OpDest_Callish MO_F32_Exp
  FloatExpM1Op   -> \_ -> OpDest_Callish MO_F32_ExpM1
  FloatSqrtOp    -> \_ -> OpDest_Callish MO_F32_Sqrt
1141

1142
-- Native word signless ops
1143

1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165
  IntAddOp       -> \_ -> OpDest_Translate (mo_wordAdd dflags)
  IntSubOp       -> \_ -> OpDest_Translate (mo_wordSub dflags)
  WordAddOp      -> \_ -> OpDest_Translate (mo_wordAdd dflags)
  WordSubOp      -> \_ -> OpDest_Translate (mo_wordSub dflags)
  AddrAddOp      -> \_ -> OpDest_Translate (mo_wordAdd dflags)
  AddrSubOp      -> \_ -> OpDest_Translate (mo_wordSub dflags)

  IntEqOp        -> \_ -> OpDest_Translate (mo_wordEq dflags)
  IntNeOp        -> \_ -> OpDest_Translate (mo_wordNe dflags)
  WordEqOp       -> \_ -> OpDest_Translate (mo_wordEq dflags)
  WordNeOp       -> \_ -> OpDest_Translate (mo_wordNe dflags)
  AddrEqOp       -> \_ -> OpDest_Translate (mo_wordEq dflags)
  AddrNeOp       -> \_ -> OpDest_Translate (mo_wordNe dflags)

  AndOp          -> \_ -> OpDest_Translate (mo_wordAnd dflags)
  OrOp           -> \_ -> OpDest_Translate (mo_wordOr dflags)
  XorOp          -> \_ -> OpDest_Translate (mo_wordXor dflags)
  NotOp          -> \_ -> OpDest_Translate (mo_wordNot dflags)
  SllOp          -> \_ -> OpDest_Translate (mo_wordShl dflags)
  SrlOp          -> \_ -> OpDest_Translate (mo_wordUShr dflags)

  AddrRemOp      -> \_ -> OpDest_Translate (mo_wordURem dflags)
1166

1167
-- Native word signed ops
1168

1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186
  IntMulOp        -> \_ -> OpDest_Translate (mo_wordMul dflags)
  IntMulMayOfloOp -> \_ -> OpDest_Translate (MO_S_MulMayOflo (wordWidth dflags))
  IntQuotOp       -> \_ -> OpDest_Translate (mo_wordSQuot dflags)
  IntRemOp        -> \_ -> OpDest_Translate (mo_wordSRem dflags)
  IntNegOp        -> \_ -> OpDest_Translate (mo_wordSNeg dflags)

  IntGeOp        -> \_ -> OpDest_Translate (mo_wordSGe dflags)
  IntLeOp        -> \_ -> OpDest_Translate (mo_wordSLe dflags)
  IntGtOp        -> \_ -> OpDest_Translate (mo_wordSGt dflags)
  IntLtOp        -> \_ -> OpDest_Translate (mo_wordSLt dflags)

  AndIOp         -> \_ -> OpDest_Translate (mo_wordAnd dflags)
  OrIOp          -> \_ -> OpDest_Translate (mo_wordOr dflags)
  XorIOp         -> \_ -> OpDest_Translate (mo_wordXor dflags)
  NotIOp         -> \_ -> OpDest_Translate (mo_wordNot dflags)
  ISllOp         -> \_ -> OpDest_Translate (mo_wordShl dflags)
  ISraOp         -> \_ -> OpDest_Translate (mo_wordSShr dflags)
  ISrlOp         -> \_ -> OpDest_Translate (mo_wordUShr dflags)
1187

1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428
-- Native word unsigned ops

  WordGeOp       -> \_ -> OpDest_Translate (mo_wordUGe dflags)
  WordLeOp       -> \_ -> OpDest_Translate (mo_wordULe dflags)
  WordGtOp       -> \_ -> OpDest_Translate (mo_wordUGt dflags)
  WordLtOp       -> \_ -> OpDest_Translate (mo_wordULt dflags)

  WordMulOp      -> \_ -> OpDest_Translate (mo_wordMul dflags)
  WordQuotOp     -> \_ -> OpDest_Translate (mo_wordUQuot dflags)
  WordRemOp      -> \_ -> OpDest_Translate (mo_wordURem dflags)

  AddrGeOp       -> \_ -> OpDest_Translate (mo_wordUGe dflags)
  AddrLeOp       -> \_ -> OpDest_Translate (mo_wordULe dflags)
  AddrGtOp       -> \_ -> OpDest_Translate (mo_wordUGt dflags)
  AddrLtOp       -> \_ -> OpDest_Translate (mo_wordULt dflags)

-- Int8# signed ops

  Int8Extend     -> \_ -> OpDest_Translate (MO_SS_Conv W8 (wordWidth dflags))
  Int8Narrow     -> \_ -> OpDest_Translate (MO_SS_Conv (wordWidth dflags) W8)
  Int8NegOp      -> \_ -> OpDest_Translate (MO_S_Neg W8)
  Int8AddOp      -> \_ -> OpDest_Translate (MO_Add W8)
  Int8SubOp      -> \_ -> OpDest_Translate (MO_Sub W8)
  Int8MulOp      -> \_ -> OpDest_Translate (MO_Mul W8)
  Int8QuotOp     -> \_ -> OpDest_Translate (MO_S_Quot W8)
  Int8RemOp      -> \_ -> OpDest_Translate (MO_S_Rem W8)

  Int8EqOp       -> \_ -> OpDest_Translate (MO_Eq W8)
  Int8GeOp       -> \_ -> OpDest_Translate (MO_S_Ge W8)
  Int8GtOp       -> \_ -> OpDest_Translate (MO_S_Gt W8)
  Int8LeOp       -> \_ -> OpDest_Translate (MO_S_Le W8)
  Int8LtOp       -> \_ -> OpDest_Translate (MO_S_Lt W8)
  Int8NeOp       -> \_ -> OpDest_Translate (MO_Ne W8)

-- Word8# unsigned ops

  Word8Extend     -> \_ -> OpDest_Translate (MO_UU_Conv W8 (wordWidth dflags))
  Word8Narrow     -> \_ -> OpDest_Translate (MO_UU_Conv (wordWidth dflags) W8)
  Word8NotOp      -> \_ -> OpDest_Translate (MO_Not W8)
  Word8AddOp      -> \_ -> OpDest_Translate (MO_Add W8)
  Word8SubOp      -> \_ -> OpDest_Translate (MO_Sub W8)
  Word8MulOp      -> \_ -> OpDest_Translate (MO_Mul W8)
  Word8QuotOp     -> \_ -> OpDest_Translate (MO_U_Quot W8)
  Word8RemOp      -> \_ -> OpDest_Translate (MO_U_Rem W8)

  Word8EqOp       -> \_ -> OpDest_Translate (MO_Eq W8)
  Word8GeOp       -> \_ -> OpDest_Translate (MO_U_Ge W8)
  Word8GtOp       -> \_ -> OpDest_Translate (MO_U_Gt W8)
  Word8LeOp       -> \_ -> OpDest_Translate (MO_U_Le W8)
  Word8LtOp       -> \_ -> OpDest_Translate (MO_U_Lt W8)
  Word8NeOp       -> \_ -> OpDest_Translate (MO_Ne W8)

-- Int16# signed ops

  Int16Extend     -> \_ -> OpDest_Translate (MO_SS_Conv W16 (wordWidth dflags))
  Int16Narrow     -> \_ -> OpDest_Translate (MO_SS_Conv (wordWidth dflags) W16)
  Int16NegOp      -> \_ -> OpDest_Translate (MO_S_Neg W16)
  Int16AddOp      -> \_ -> OpDest_Translate (MO_Add W16)
  Int16SubOp      -> \_ -> OpDest_Translate (MO_Sub W16)
  Int16MulOp      -> \_ -> OpDest_Translate (MO_Mul W16)
  Int16QuotOp     -> \_ -> OpDest_Translate (MO_S_Quot W16)
  Int16RemOp      -> \_ -> OpDest_Translate (MO_S_Rem W16)

  Int16EqOp       -> \_ -> OpDest_Translate (MO_Eq W16)
  Int16GeOp       -> \_ -> OpDest_Translate (MO_S_Ge W16)
  Int16GtOp       -> \_ -> OpDest_Translate (MO_S_Gt W16)
  Int16LeOp       -> \_ -> OpDest_Translate (MO_S_Le W16)
  Int16LtOp       -> \_ -> OpDest_Translate (MO_S_Lt W16)
  Int16NeOp       -> \_ -> OpDest_Translate (MO_Ne W16)

-- Word16# unsigned ops

  Word16Extend     -> \_ -> OpDest_Translate (MO_UU_Conv W16 (wordWidth dflags))
  Word16Narrow     -> \_ -> OpDest_Translate (MO_UU_Conv (wordWidth dflags) W16)
  Word16NotOp      -> \_ -> OpDest_Translate (MO_Not W16)