content: {-# LANGUAGE CPP             #-}
  {-# LANGUAGE DeriveFunctor   #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE MagicHash       #-}
  {-# LANGUAGE UnboxedTuples   #-}
  {-# LANGUAGE PatternSynonyms   #-}
  {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
  --
  --
  --  (c) The University of Glasgow 2002-2006
  --
  
  -- | Bytecode assembler and linker
  module GHC.ByteCode.Asm (
          assembleBCOs,
          bcoFreeNames,
          SizedSeq, sizeSS, ssElts,
          iNTERP_STACK_CHECK_THRESH,
          mkNativeCallInfoLit,
  
          -- * For testing
          assembleBCO
    ) where
  
  import GHC.Prelude hiding ( any )
  
  
  import GHC.ByteCode.Instr
  import GHC.ByteCode.InfoTable
  import GHC.ByteCode.Types
  import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord )
  
  import GHC.Types.Name
  import GHC.Types.Name.Set
  import GHC.Types.Literal
  import GHC.Types.Unique.DSet
  import GHC.Types.SptEntry
  import GHC.Types.Unique.FM
  import GHC.Unit.Types
  
  import GHC.Utils.Outputable
  import GHC.Utils.Panic
  
  import GHC.Core.TyCon
  import GHC.Data.SizedSeq
  import GHC.Data.SmallArray
  
  import GHC.StgToCmm.Layout     ( ArgRep(..) )
  import GHC.Cmm.Expr
  import GHC.Cmm.Reg             ( GlobalArgRegs(..) )
  import GHC.Cmm.CallConv        ( allArgRegsCover )
  import GHC.Platform
  import GHC.Platform.Profile
  import Language.Haskell.Syntax.Module.Name
  
  import Control.Monad
  import qualified Control.Monad.Trans.State.Strict as MTL
  
  import qualified Data.Array.Unboxed as Array
  import qualified Data.Array.IO as Array
  import Data.Array.Base  ( UArray(..), numElements, unsafeFreeze )
  
  #if ! defined(DEBUG)
  import Data.Array.Base  ( unsafeWrite )
  #endif
  
  import Foreign hiding (shiftL, shiftR)
  import Data.ByteString (ByteString)
  import Data.Char  (ord)
  import Data.Maybe (fromMaybe)
  import GHC.Float (castFloatToWord32, castDoubleToWord64)
  
  import qualified Data.List as List ( any )
  import GHC.Exts
  
  
  -- -----------------------------------------------------------------------------
  -- Unlinked BCOs
  
  -- CompiledByteCode represents the result of byte-code
  -- compiling a bunch of functions and data types
  
  -- | Finds external references.  Remember to remove the names
  -- defined by this group of BCOs themselves
  bcoFreeNames :: UnlinkedBCO -> UniqDSet Name
  bcoFreeNames bco
    = bco_refs bco `uniqDSetMinusUniqSet` mkNameSet [unlinkedBCOName bco]
    where
      bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
          = unionManyUniqDSets (
               mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] :
               mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] :
               map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ]
            )
  
  -- -----------------------------------------------------------------------------
  -- The bytecode assembler
  
  -- The object format for bytecodes is: 16 bits for the opcode, and 16
  -- for each field -- so the code can be considered a sequence of
  -- 16-bit ints.  Each field denotes either a stack offset or number of
  -- items on the stack (eg SLIDE), and index into the pointer table (eg
  -- PUSH_G), an index into the literal table (eg PUSH_I/D/L), or a
  -- bytecode address in this BCO.
  
  -- Top level assembler fn.
  assembleBCOs
    :: Profile
    -> FlatBag (ProtoBCO Name)
    -> [TyCon]
    -> [(Name, ByteString)]
    -> Maybe InternalModBreaks
    -> [SptEntry]
    -> IO CompiledByteCode
  assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
    -- TODO: the profile should be bundled with the interpreter: the rts ways are
    -- fixed for an interpreter
    let itbls = mkITbls profile tycons
    bcos    <- mapM (assembleBCO (profilePlatform profile)) proto_bcos
    return CompiledByteCode
      { bc_bcos = bcos
      , bc_itbls = itbls
      , bc_strs = top_strs
      , bc_breaks = modbreaks
      , bc_spt_entries = spt_entries
      }
  
  -- Note [Allocating string literals]
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- Our strategy for handling top-level string literal bindings is described in
  -- Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode,
  -- but not all Addr# literals in a program are guaranteed to be lifted to the
  -- top level. Our strategy for handling local Addr# literals is somewhat simpler:
  -- after assembling, we find all the BCONPtrStr arguments in the program, malloc
  -- memory for them, and bake the resulting addresses into the instruction stream
  -- in the form of BCONPtrWord arguments.
  --
  -- We used to allocate remote buffers for BCONPtrStr ByteStrings when
  -- assembling, but this gets in the way of bytecode serialization: we
  -- want the ability to serialize and reload assembled bytecode, so
  -- it's better to preserve BCONPtrStr as-is, and only perform the
  -- actual allocation at link-time.
  --
  -- Note that, as with top-level string literal bindings, this memory is never
  -- freed, so it just leaks if the BCO is unloaded. See Note [Generating code for
  -- top-level string literal bindings] in GHC.StgToByteCode for some discussion
  -- about why.
  --
  
  data RunAsmReader = RunAsmReader { isn_array :: {-# UNPACK #-} !(Array.IOUArray Int Word16)
                                    , ptr_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCOPtr)
                                    , lit_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCONPtr )
                                    }
  
  data RunAsmResult = RunAsmResult { final_isn_array :: !(Array.UArray Int Word16)
                                   , final_ptr_array :: !(SmallArray BCOPtr)
                                   , final_lit_array :: !(SmallArray BCONPtr) }
  
  -- How many words we have written so far.
  data AsmState = AsmState { nisn :: !Int, nptr :: !Int, nlit :: !Int }
  
  
  {-# NOINLINE inspectInstrs #-}
  -- | Perform analysis of the bytecode to determine
  --  1. How many instructions we will produce
  --  2. If we are going to need long jumps.
  --  3. The offsets that labels refer to
  inspectInstrs :: Platform -> Bool -> Word -> [BCInstr] -> InspectState
  inspectInstrs platform long_jump e instrs =
    inspectAsm long_jump e (mapM_ (assembleInspectAsm platform) instrs)
  
  {-# NOINLINE runInstrs #-}
  -- | Assemble the bytecode from the instructions.
  runInstrs ::  Platform -> Bool -> InspectState -> [BCInstr] -> IO RunAsmResult
  runInstrs platform long_jumps is_state instrs = do
    -- Produce arrays of exactly the right size, corresponding to the result of inspectInstrs.
    isn_array <- Array.newArray_ (0, (fromIntegral $ instrCount is_state) - 1)
    ptr_array <- newSmallArrayIO (fromIntegral $ ptrCount is_state) undefined
    lit_array <- newSmallArrayIO (fromIntegral $ litCount is_state) undefined
    let env :: LocalLabel -> Word
        env lbl = fromMaybe
          (pprPanic "assembleBCO.findLabel" (ppr lbl))
          (lookupUFM (lblEnv is_state) lbl)
    let initial_state  = AsmState 0 0 0
    let initial_reader = RunAsmReader{..}
    runAsm long_jumps env initial_reader initial_state (mapM_ (\i -> assembleRunAsm platform i) instrs)
    final_isn_array <- unsafeFreeze isn_array
    final_ptr_array <- unsafeFreezeSmallArrayIO ptr_array
    final_lit_array <- unsafeFreezeSmallArrayIO lit_array
    return $ RunAsmResult {..}
  
  assembleRunAsm :: Platform -> BCInstr -> RunAsm ()
  assembleRunAsm p i = assembleI @RunAsm p i
  
  assembleInspectAsm :: Platform -> BCInstr -> InspectAsm ()
  assembleInspectAsm p i = assembleI @InspectAsm p i
  
  assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
  assembleBCO platform
              (ProtoBCO { protoBCOName       = nm
                        , protoBCOInstrs     = instrs
                        , protoBCOBitmap     = bitmap
                        , protoBCOBitmapSize = bsize
                        , protoBCOArity      = arity }) = do
    -- pass 1: collect up the offsets of the local labels.
    let initial_offset = 0
  
        -- Jump instructions are variable-sized, there are long and short variants
        -- depending on the magnitude of the offset.  However, we can't tell what
        -- size instructions we will need until we have calculated the offsets of
        -- the labels, which depends on the size of the instructions...  So we
        -- first create the label environment assuming that all jumps are short,
        -- and if the final size is indeed small enough for short jumps, we are
        -- done.  Otherwise, we repeat the calculation, and we force all jumps in
        -- this BCO to be long.
        is0 = inspectInstrs platform False initial_offset instrs
        (is1, long_jumps)
          | isLargeInspectState is0
                      = (inspectInstrs platform True initial_offset instrs, True)
          | otherwise = (is0, False)
  
  
    -- pass 2: run assembler and generate instructions, literals and pointers
    RunAsmResult{..} <- runInstrs platform long_jumps is1 instrs
  
    -- precomputed size should be equal to final size
    massertPpr (fromIntegral (instrCount is1) == numElements final_isn_array
                && fromIntegral (ptrCount is1) == sizeofSmallArray final_ptr_array
                && fromIntegral (litCount is1) == sizeofSmallArray final_lit_array)
               (text "bytecode instruction count mismatch")
  
    let !insns_arr =  mkBCOByteArray $ final_isn_array
        !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap
        ul_bco = UnlinkedBCO { unlinkedBCOName = nm
                             , unlinkedBCOArity = arity
                             , unlinkedBCOInstrs = insns_arr
                             , unlinkedBCOBitmap = bitmap_arr
                             , unlinkedBCOLits = fromSmallArray final_lit_array
                             , unlinkedBCOPtrs = fromSmallArray final_ptr_array
                             }
  
    -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
    -- objects, since they might get run too early.  Disable this until
    -- we figure out what to do.
    -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
  
    return ul_bco
  
  -- | Construct a word-array containing an @StgLargeBitmap@.
  mkBitmapArray :: Word -> [StgWord] -> UArray Int Word
  -- Here the return type must be an array of Words, not StgWords,
  -- because the underlying ByteArray# will end up as a component
  -- of a BCO object.
  mkBitmapArray bsize bitmap
    = Array.listArray (0, length bitmap) $
        fromIntegral bsize : map (fromInteger . fromStgWord) bitmap
  
  
  data Operand
    = Op Word
    | IOp Int
    | SmallOp Word16
    | LabelOp LocalLabel
  
  wOp :: WordOff -> Operand
  wOp = Op . fromIntegral
  
  bOp :: ByteOff -> Operand
  bOp = Op . fromIntegral
  
  truncHalfWord :: Platform -> HalfWord -> Operand
  truncHalfWord platform w = case platformWordSize platform of
    PW4 | w <= 65535      -> Op (fromIntegral w)
    PW8 | w <= 4294967295 -> Op (fromIntegral w)
    _ -> pprPanic "GHC.ByteCode.Asm.truncHalfWord" (ppr w)
  
  
  ptr :: MonadAssembler m => BCOPtr -> m Word
  ptr = ioptr . return
  
  type LabelEnv = LocalLabel -> Word
  
  largeOp :: Bool -> Operand -> Bool
  largeOp long_jumps op = case op of
     SmallOp _ -> False
     Op w      -> isLargeW w
     IOp i     -> isLargeI i
     LabelOp _ -> long_jumps
  
  newtype RunAsm a = RunAsm' { runRunAsm :: Bool
                                         -> LabelEnv
                                         -> RunAsmReader
                                         -> AsmState
                                         -> IO (AsmState, a) }
  
  pattern RunAsm :: (Bool -> LabelEnv -> RunAsmReader -> AsmState -> IO (AsmState, a))
                    -> RunAsm a
  pattern RunAsm m <- RunAsm' m
    where
      RunAsm m = RunAsm' (oneShot $ \a -> oneShot $ \b -> oneShot $ \c -> oneShot $ \d -> m a b c d)
  {-# COMPLETE RunAsm #-}
  
  instance Functor RunAsm where
    fmap f (RunAsm x) = RunAsm (\a b c !s -> fmap (fmap f) (x a b c s))
  
  instance Applicative RunAsm where
    pure x = RunAsm $ \_ _ _ !s -> pure (s, x)
    (RunAsm f) <*> (RunAsm x) = RunAsm $ \a b c !s -> do
                                    (!s', f') <- f a b c s
                                    (!s'', x') <- x a b c s'
                                    return (s'', f' x')
    {-# INLINE (<*>) #-}
  
  
  instance Monad RunAsm where
    return  = pure
    (RunAsm m) >>= f = RunAsm $ \a b c !s -> m a b c s >>= \(s', r) -> runRunAsm (f r) a b c s'
    {-# INLINE (>>=) #-}
  
  runAsm :: Bool -> LabelEnv -> RunAsmReader -> AsmState -> RunAsm a -> IO a
  runAsm long_jumps e r s (RunAsm'{runRunAsm}) = fmap snd $ runRunAsm long_jumps e r s
  
  expand :: PlatformWordSize -> Bool -> Operand -> RunAsm ()
  expand word_size largeArgs o = do
    e <- askEnv
    case o of
      (SmallOp w) -> writeIsn w
      (LabelOp w) -> let !r = e w in handleLargeArg r
      (Op w) -> handleLargeArg w
      (IOp i) -> handleLargeArg i
  
    where
      handleLargeArg :: Integral a => a -> RunAsm ()
      handleLargeArg w  =
        if largeArgs
          then largeArg word_size (fromIntegral w)
          else writeIsn (fromIntegral w)
  
  lift :: IO a -> RunAsm a
  lift io = RunAsm $ \_ _ _ s -> io >>= \a -> pure (s, a)
  
  askLongJumps :: RunAsm Bool
  askLongJumps = RunAsm $ \a _ _ s -> pure (s, a)
  
  askEnv :: RunAsm LabelEnv
  askEnv = RunAsm $ \_ b _ s -> pure (s, b)
  
  writePtr :: BCOPtr -> RunAsm Word
  writePtr w
              = RunAsm $ \_ _ (RunAsmReader{..}) asm -> do
                writeSmallArrayIO ptr_array (nptr asm) w
                let !n' = nptr asm + 1
                let !asm' = asm { nptr = n' }
                return (asm', fromIntegral (nptr asm))
  
  writeLit :: BCONPtr -> RunAsm Word
  writeLit w = RunAsm $ \_ _ (RunAsmReader{..}) asm -> do
                writeSmallArrayIO lit_array (nlit asm) w
                let !n' = nlit asm + 1
                let !asm' = asm { nlit = n' }
                return (asm', fromIntegral (nlit asm))
  
  writeLits :: OneOrTwo BCONPtr -> RunAsm Word
  writeLits (OnlyOne l) = writeLit l
  writeLits (OnlyTwo l1 l2) = writeLit l1 <* writeLit l2
  
  writeIsn :: Word16 -> RunAsm ()
  writeIsn w = RunAsm $ \_ _ (RunAsmReader{..}) asm -> do
  #if defined(DEBUG)
                Array.writeArray isn_array (nisn asm) w
  #else
                unsafeWrite isn_array (nisn asm) w
  #endif
                let !n' = nisn asm + 1
                let !asm' = asm { nisn = n' }
                return (asm', ())
  
  {-# INLINE any #-}
  -- Any is unrolled manually so that the call in `emit` can be eliminated without
  -- relying on SpecConstr (which does not work across modules).
  any :: (a -> Bool) -> [a] -> Bool
  any _ [] = False
  any f [x] = f x
  any f [x,y] = f x || f y
  any f [x,y,z] = f x || f y || f z
  any f [x1,x2,x3,x4] = f x1 || f x2 || f x3 || f x4
  any f [x1,x2,x3,x4, x5] = f x1 || f x2 || f x3 || f x4 || f x5
  any f [x1,x2,x3,x4,x5,x6] = f x1 || f x2 || f x3 || f x4 || f x5 || f x6
  any f xs = List.any f xs
  
  {-# INLINE mapM6_ #-}
  mapM6_ :: Monad m => (a -> m b) -> [a] -> m ()
  mapM6_ _ [] = return ()
  mapM6_ f [x] = () <$ f x
  mapM6_ f [x,y] = () <$ f x <* f y
  mapM6_ f [x,y,z] = () <$ f x <* f y <* f z
  mapM6_ f [a1,a2,a3,a4] = () <$ f a1 <* f a2 <* f a3 <* f a4
  mapM6_ f [a1,a2,a3,a4,a5] = () <$ f a1 <* f a2 <* f a3 <* f a4 <* f a5
  mapM6_ f [a1,a2,a3,a4,a5,a6] = () <$ f a1 <* f a2 <* f a3 <* f a4 <* f a5 <* f a6
  mapM6_ f xs = mapM_ f xs
  
  instance MonadAssembler RunAsm where
    ioptr p_io = do
      p <- lift p_io
      writePtr p
    lit lits = writeLits lits
  
    label _ = return ()
  
    emit pwordsize w ops = do
      long_jumps <- askLongJumps
      -- See the definition of `any` above
      let largeArgs = any (largeOp long_jumps) ops
      let opcode
            | largeArgs = largeArgInstr w
            | otherwise = w
      writeIsn opcode
      mapM6_ (expand pwordsize largeArgs) ops
  
    {-# INLINE emit #-}
    {-# INLINE label #-}
    {-# INLINE lit #-}
    {-# INLINE ioptr #-}
  
  type LabelEnvMap = UniqFM LocalLabel Word
  
  data InspectState = InspectState
    { instrCount :: !Word
    , ptrCount :: !Word
    , litCount :: !Word
    , lblEnv :: LabelEnvMap
    }
  
  instance Outputable InspectState where
    ppr (InspectState i p l m) = text "InspectState" <+> ppr [ppr i, ppr p, ppr l, ppr (sizeUFM m)]
  
  isLargeInspectState :: InspectState -> Bool
  isLargeInspectState InspectState{..} =
    isLargeW (fromIntegral $ sizeUFM lblEnv)
      || isLargeW instrCount
  
  newtype InspectEnv = InspectEnv { _inspectLongJumps :: Bool
                                  }
  
  newtype InspectAsm a = InspectAsm' { runInspectAsm :: InspectEnv -> InspectState -> (# InspectState,  a #) }
  
  pattern InspectAsm :: (InspectEnv -> InspectState -> (# InspectState, a #))
                     -> InspectAsm a
  pattern InspectAsm m <- InspectAsm' m
    where
      InspectAsm m = InspectAsm' (oneShot $ \a -> oneShot $ \b -> m a b)
  {-# COMPLETE InspectAsm #-}
  
  instance Functor InspectAsm where
    fmap f (InspectAsm k) = InspectAsm $ \a b -> case k a b of
                                                    (# b', c #) -> (# b', f c #)
  
  instance Applicative InspectAsm where
    pure x = InspectAsm $ \_ s -> (# s, x #)
    (InspectAsm f) <*> (InspectAsm x) = InspectAsm $ \a b -> case f a b of
                                                                (# s', f' #) ->
                                                                  case x a s' of
                                                                    (# s'', x' #) -> (# s'', f' x' #)
  
  instance Monad InspectAsm where
    return = pure
    (InspectAsm m) >>= f = InspectAsm $ \ a b -> case m a b of
                                                  (# s', a' #) -> runInspectAsm (f a') a s'
  
  get_ :: InspectAsm InspectState
  get_ = InspectAsm $ \_ b -> (# b, b #)
  
  put_ :: InspectState -> InspectAsm ()
  put_ !s = InspectAsm $ \_ _ -> (# s, () #)
  
  modify_ :: (InspectState -> InspectState) -> InspectAsm ()
  modify_ f = InspectAsm $ \_ s -> let !s' = f s in (# s', () #)
  
  ask_ :: InspectAsm InspectEnv
  ask_ = InspectAsm $ \a b -> (# b, a #)
  
  inspectAsm :: Bool -> Word -> InspectAsm () -> InspectState
  inspectAsm long_jumps initial_offset (InspectAsm s) =
    case s (InspectEnv long_jumps) (InspectState initial_offset 0 0 emptyUFM) of
      (# res, () #) -> res
  {-# INLINE inspectAsm #-}
  
  
  
  instance MonadAssembler InspectAsm where
    ioptr _ = do
      s <- get_
      let n = ptrCount s
      put_ (s { ptrCount = n + 1 })
      return n
  
    lit ls = do
      s <- get_
      let n = litCount s
      put_ (s { litCount = n + oneTwoLength ls })
      return n
  
    label lbl = modify_ (\s -> let !count = instrCount s in let !env' = addToUFM (lblEnv s) lbl count in s { lblEnv = env' })
  
    emit pwordsize _ ops = do
      InspectEnv long_jumps <- ask_
      -- Size is written in this way as `mapM6_` is also used by RunAsm, and guaranteed
      -- to unroll for arguments up to size 6.
      let size = (MTL.execState (mapM6_ (\x -> MTL.modify (count' x +)) ops) 0) + 1
          largeOps = any (largeOp long_jumps) ops
          bigSize = largeArg16s pwordsize
          count' = if largeOps then countLarge bigSize else countSmall bigSize
  
      s <- get_
      put_ (s { instrCount = instrCount s + size })
  
    {-# INLINE emit #-}
    {-# INLINE label #-}
    {-# INLINE lit #-}
    {-# INLINE ioptr #-}
  
  count :: Word -> Bool -> Operand -> Word
  count _ _ (SmallOp _)          = 1
  count big largeOps (LabelOp _) = if largeOps then big else 1
  count big largeOps (Op _)      = if largeOps then big else 1
  count big largeOps (IOp _)     = if largeOps then big else 1
  {-# INLINE count #-}
  
  countSmall, countLarge :: Word -> Operand -> Word
  countLarge big x = count big True x
  countSmall big x = count big False x
  
  
  -- Bring in all the bci_ bytecode constants.
  #include "Bytecodes.h"
  
  largeArgInstr :: Word16 -> Word16
  largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
  
  {-# INLINE largeArg #-}
  largeArg :: PlatformWordSize -> Word64 -> RunAsm ()
  largeArg wsize w = case wsize of
     PW8 ->  do writeIsn (fromIntegral (w `shiftR` 48))
                writeIsn (fromIntegral (w `shiftR` 32))
                writeIsn (fromIntegral (w `shiftR` 16))
                writeIsn (fromIntegral w)
     PW4 -> assertPpr (w < fromIntegral (maxBound :: Word32))
                      (text "largeArg too big:" <+> ppr w) $ do
            writeIsn (fromIntegral (w `shiftR` 16))
            writeIsn (fromIntegral w)
  
  largeArg16s :: PlatformWordSize -> Word
  largeArg16s pwordsize = case pwordsize of
     PW8 -> 4
     PW4 -> 2
  
  data OneOrTwo a = OnlyOne a | OnlyTwo a a deriving (Functor)
  
  oneTwoLength :: OneOrTwo a -> Word
  oneTwoLength (OnlyOne {}) = 1
  oneTwoLength (OnlyTwo {}) = 2
  
  class Monad m => MonadAssembler m where
    ioptr :: IO BCOPtr -> m Word
    lit :: OneOrTwo BCONPtr -> m Word
    label :: LocalLabel -> m ()
    emit :: PlatformWordSize -> Word16 -> [Operand] -> m ()
  
  lit1 :: MonadAssembler m => BCONPtr -> m Word
  lit1 p = lit (OnlyOne p)
  
  {-# SPECIALISE assembleI :: Platform -> BCInstr -> InspectAsm () #-}
  {-# SPECIALISE assembleI :: Platform -> BCInstr -> RunAsm () #-}
  
  assembleI :: forall m . MonadAssembler m
            => Platform
            -> BCInstr
            -> m ()
  assembleI platform i = case i of
    STKCHECK n               -> emit_ bci_STKCHECK [Op n]
    PUSH_L o1                -> emit_ bci_PUSH_L [wOp o1]
    PUSH_LL o1 o2            -> emit_ bci_PUSH_LL [wOp o1, wOp o2]
    PUSH_LLL o1 o2 o3        -> emit_ bci_PUSH_LLL [wOp o1, wOp o2, wOp o3]
    PUSH8 o1                 -> emit_ bci_PUSH8 [bOp o1]
    PUSH16 o1                -> emit_ bci_PUSH16 [bOp o1]
    PUSH32 o1                -> emit_ bci_PUSH32 [bOp o1]
    PUSH8_W o1               -> emit_ bci_PUSH8_W [bOp o1]
    PUSH16_W o1              -> emit_ bci_PUSH16_W [bOp o1]
    PUSH32_W o1              -> emit_ bci_PUSH32_W [bOp o1]
    PUSH_G nm                -> do p <- ptr (BCOPtrName nm)
                                   emit_ bci_PUSH_G [Op p]
    PUSH_PRIMOP op           -> do p <- ptr (BCOPtrPrimOp op)
                                   emit_ bci_PUSH_G [Op p]
    PUSH_BCO proto           -> do let ul_bco = assembleBCO platform proto
                                   p <- ioptr (liftM BCOPtrBCO ul_bco)
                                   emit_ bci_PUSH_G [Op p]
    PUSH_ALTS proto pk
                             -> do let ul_bco = assembleBCO platform proto
                                   p <- ioptr (liftM BCOPtrBCO ul_bco)
                                   emit_ (push_alts pk) [Op p]
    PUSH_ALTS_TUPLE proto call_info tuple_proto
                             -> do let ul_bco = assembleBCO platform proto
                                       ul_tuple_bco = assembleBCO platform
                                                                  tuple_proto
                                   p <- ioptr (liftM BCOPtrBCO ul_bco)
                                   p_tup <- ioptr (liftM BCOPtrBCO ul_tuple_bco)
                                   info <- word (fromIntegral $
                                                mkNativeCallInfoSig platform call_info)
                                   emit_ bci_PUSH_ALTS_T
                                        [Op p, Op info, Op p_tup]
    PUSH_PAD8                -> emit_ bci_PUSH_PAD8 []
    PUSH_PAD16               -> emit_ bci_PUSH_PAD16 []
    PUSH_PAD32               -> emit_ bci_PUSH_PAD32 []
    PUSH_UBX8 lit            -> do np <- literal lit
                                   emit_ bci_PUSH_UBX8 [Op np]
    PUSH_UBX16 lit           -> do np <- literal lit
                                   emit_ bci_PUSH_UBX16 [Op np]
    PUSH_UBX32 lit           -> do np <- literal lit
                                   emit_ bci_PUSH_UBX32 [Op np]
    PUSH_UBX lit nws         -> do np <- literal lit
                                   emit_ bci_PUSH_UBX [Op np, wOp nws]
    -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode
    PUSH_ADDR nm             -> do np <- lit1 (BCONPtrAddr nm)
                                   emit_ bci_PUSH_UBX [Op np, SmallOp 1]
  
    PUSH_APPLY_N             -> emit_ bci_PUSH_APPLY_N []
    PUSH_APPLY_V             -> emit_ bci_PUSH_APPLY_V []
    PUSH_APPLY_F             -> emit_ bci_PUSH_APPLY_F []
    PUSH_APPLY_D             -> emit_ bci_PUSH_APPLY_D []
    PUSH_APPLY_L             -> emit_ bci_PUSH_APPLY_L []
    PUSH_APPLY_P             -> emit_ bci_PUSH_APPLY_P []
    PUSH_APPLY_PP            -> emit_ bci_PUSH_APPLY_PP []
    PUSH_APPLY_PPP           -> emit_ bci_PUSH_APPLY_PPP []
    PUSH_APPLY_PPPP          -> emit_ bci_PUSH_APPLY_PPPP []
    PUSH_APPLY_PPPPP         -> emit_ bci_PUSH_APPLY_PPPPP []
    PUSH_APPLY_PPPPPP        -> emit_ bci_PUSH_APPLY_PPPPPP []
  
    SLIDE     n by           -> emit_ bci_SLIDE [wOp n, wOp by]
    ALLOC_AP  n              -> emit_ bci_ALLOC_AP [truncHalfWord platform n]
    ALLOC_AP_NOUPD n         -> emit_ bci_ALLOC_AP_NOUPD [truncHalfWord platform n]
    ALLOC_PAP arity n        -> emit_ bci_ALLOC_PAP [truncHalfWord platform arity, truncHalfWord platform n]
    MKAP      off sz         -> emit_ bci_MKAP [wOp off, truncHalfWord platform sz]
    MKPAP     off sz         -> emit_ bci_MKPAP [wOp off, truncHalfWord platform sz]
    UNPACK    n              -> emit_ bci_UNPACK [wOp n]
    PACK      dcon sz        -> do itbl_no <- lit1 (BCONPtrItbl (getName dcon))
                                   emit_ bci_PACK [Op itbl_no, wOp sz]
    LABEL     lbl            -> label lbl
    TESTLT_I  i l            -> do np <- int i
                                   emit_ bci_TESTLT_I [Op np, LabelOp l]
    TESTEQ_I  i l            -> do np <- int i
                                   emit_ bci_TESTEQ_I [Op np, LabelOp l]
    TESTLT_W  w l            -> do np <- word w
                                   emit_ bci_TESTLT_W [Op np, LabelOp l]
    TESTEQ_W  w l            -> do np <- word w
                                   emit_ bci_TESTEQ_W [Op np, LabelOp l]
    TESTLT_I64  i l          -> do np <- word64 (fromIntegral i)
                                   emit_ bci_TESTLT_I64 [Op np, LabelOp l]
    TESTEQ_I64  i l          -> do np <- word64 (fromIntegral i)
                                   emit_ bci_TESTEQ_I64 [Op np, LabelOp l]
    TESTLT_I32  i l          -> do np <- word (fromIntegral i)
                                   emit_ bci_TESTLT_I32 [Op np, LabelOp l]
    TESTEQ_I32 i l           -> do np <- word (fromIntegral i)
                                   emit_ bci_TESTEQ_I32 [Op np, LabelOp l]
    TESTLT_I16  i l          -> do np <- word (fromIntegral i)
                                   emit_ bci_TESTLT_I16 [Op np, LabelOp l]
    TESTEQ_I16 i l           -> do np <- word (fromIntegral i)
                                   emit_ bci_TESTEQ_I16 [Op np, LabelOp l]
    TESTLT_I8  i l           -> do np <- word (fromIntegral i)
                                   emit_ bci_TESTLT_I8 [Op np, LabelOp l]
    TESTEQ_I8 i l            -> do np <- word (fromIntegral i)
                                   emit_ bci_TESTEQ_I8 [Op np, LabelOp l]
    TESTLT_W64  w l          -> do np <- word64 w
                                   emit_ bci_TESTLT_W64 [Op np, LabelOp l]
    TESTEQ_W64  w l          -> do np <- word64 w
                                   emit_ bci_TESTEQ_W64 [Op np, LabelOp l]
    TESTLT_W32  w l          -> do np <- word (fromIntegral w)
                                   emit_ bci_TESTLT_W32 [Op np, LabelOp l]
    TESTEQ_W32  w l          -> do np <- word (fromIntegral w)
                                   emit_ bci_TESTEQ_W32 [Op np, LabelOp l]
    TESTLT_W16  w l          -> do np <- word (fromIntegral w)
                                   emit_ bci_TESTLT_W16 [Op np, LabelOp l]
    TESTEQ_W16  w l          -> do np <- word (fromIntegral w)
                                   emit_ bci_TESTEQ_W16 [Op np, LabelOp l]
    TESTLT_W8  w l           -> do np <- word (fromIntegral w)
                                   emit_ bci_TESTLT_W8 [Op np, LabelOp l]
    TESTEQ_W8  w l           -> do np <- word (fromIntegral w)
                                   emit_ bci_TESTEQ_W8 [Op np, LabelOp l]
    TESTLT_F  f l            -> do np <- float f
                                   emit_ bci_TESTLT_F [Op np, LabelOp l]
    TESTEQ_F  f l            -> do np <- float f
                                   emit_ bci_TESTEQ_F [Op np, LabelOp l]
    TESTLT_D  d l            -> do np <- double d
                                   emit_ bci_TESTLT_D [Op np, LabelOp l]
    TESTEQ_D  d l            -> do np <- double d
                                   emit_ bci_TESTEQ_D [Op np, LabelOp l]
    TESTLT_P  i l            -> emit_ bci_TESTLT_P [SmallOp i, LabelOp l]
    TESTEQ_P  i l            -> emit_ bci_TESTEQ_P [SmallOp i, LabelOp l]
    CASEFAIL                 -> emit_ bci_CASEFAIL []
    SWIZZLE   stkoff n       -> emit_ bci_SWIZZLE [wOp stkoff, IOp n]
    JMP       l              -> emit_ bci_JMP [LabelOp l]
    ENTER                    -> emit_ bci_ENTER []
    RETURN rep               -> emit_ (return_non_tuple rep) []
    RETURN_TUPLE             -> emit_ bci_RETURN_T []
    CCALL off ffi i          -> do np <- lit1 $ BCONPtrFFIInfo ffi
                                   emit_ bci_CCALL [wOp off, Op np, SmallOp i]
    PRIMCALL                 -> emit_ bci_PRIMCALL []
  
    OP_ADD w -> case w of
      W64                   -> emit_ bci_OP_ADD_64 []
      W32                   -> emit_ bci_OP_ADD_32 []
      W16                   -> emit_ bci_OP_ADD_16 []
      W8                    -> emit_ bci_OP_ADD_08 []
      _                     -> unsupported_width
    OP_SUB w -> case w of
      W64                   -> emit_ bci_OP_SUB_64 []
      W32                   -> emit_ bci_OP_SUB_32 []
      W16                   -> emit_ bci_OP_SUB_16 []
      W8                    -> emit_ bci_OP_SUB_08 []
      _                     -> unsupported_width
    OP_AND w -> case w of
      W64                   -> emit_ bci_OP_AND_64 []
      W32                   -> emit_ bci_OP_AND_32 []
      W16                   -> emit_ bci_OP_AND_16 []
      W8                    -> emit_ bci_OP_AND_08 []
      _                     -> unsupported_width
    OP_XOR w -> case w of
      W64                   -> emit_ bci_OP_XOR_64 []
      W32                   -> emit_ bci_OP_XOR_32 []
      W16                   -> emit_ bci_OP_XOR_16 []
      W8                    -> emit_ bci_OP_XOR_08 []
      _                     -> unsupported_width
    OP_OR w -> case w of
      W64                    -> emit_ bci_OP_OR_64 []
      W32                    -> emit_ bci_OP_OR_32 []
      W16                    -> emit_ bci_OP_OR_16 []
      W8                     -> emit_ bci_OP_OR_08 []
      _                      -> unsupported_width
    OP_NOT w -> case w of
      W64                   -> emit_ bci_OP_NOT_64 []
      W32                   -> emit_ bci_OP_NOT_32 []
      W16                   -> emit_ bci_OP_NOT_16 []
      W8                    -> emit_ bci_OP_NOT_08 []
      _                     -> unsupported_width
    OP_NEG w -> case w of
      W64                   -> emit_ bci_OP_NEG_64 []
      W32                   -> emit_ bci_OP_NEG_32 []
      W16                   -> emit_ bci_OP_NEG_16 []
      W8                    -> emit_ bci_OP_NEG_08 []
      _                     -> unsupported_width
    OP_MUL w -> case w of
      W64                   -> emit_ bci_OP_MUL_64 []
      W32                   -> emit_ bci_OP_MUL_32 []
      W16                   -> emit_ bci_OP_MUL_16 []
      W8                    -> emit_ bci_OP_MUL_08 []
      _                     -> unsupported_width
    OP_SHL w -> case w of
      W64                   -> emit_ bci_OP_SHL_64 []
      W32                   -> emit_ bci_OP_SHL_32 []
      W16                   -> emit_ bci_OP_SHL_16 []
      W8                    -> emit_ bci_OP_SHL_08 []
      _                     -> unsupported_width
    OP_ASR w -> case w of
      W64                   -> emit_ bci_OP_ASR_64 []
      W32                   -> emit_ bci_OP_ASR_32 []
      W16                   -> emit_ bci_OP_ASR_16 []
      W8                    -> emit_ bci_OP_ASR_08 []
      _                     -> unsupported_width
    OP_LSR w -> case w of
      W64                   -> emit_ bci_OP_LSR_64 []
      W32                   -> emit_ bci_OP_LSR_32 []
      W16                   -> emit_ bci_OP_LSR_16 []
      W8                    -> emit_ bci_OP_LSR_08 []
      _                     -> unsupported_width
  
    OP_NEQ w -> case w of
      W64                   -> emit_ bci_OP_NEQ_64 []
      W32                   -> emit_ bci_OP_NEQ_32 []
      W16                   -> emit_ bci_OP_NEQ_16 []
      W8                    -> emit_ bci_OP_NEQ_08 []
      _                     -> unsupported_width
    OP_EQ w -> case w of
      W64                    -> emit_ bci_OP_EQ_64 []
      W32                    -> emit_ bci_OP_EQ_32 []
      W16                    -> emit_ bci_OP_EQ_16 []
      W8                     -> emit_ bci_OP_EQ_08 []
      _                      -> unsupported_width
  
    OP_U_LT w -> case w of
      W64                  -> emit_ bci_OP_U_LT_64 []
      W32                  -> emit_ bci_OP_U_LT_32 []
      W16                  -> emit_ bci_OP_U_LT_16 []
      W8                   -> emit_ bci_OP_U_LT_08 []
      _                    -> unsupported_width
    OP_S_LT w -> case w of
      W64                  -> emit_ bci_OP_S_LT_64 []
      W32                  -> emit_ bci_OP_S_LT_32 []
      W16                  -> emit_ bci_OP_S_LT_16 []
      W8                   -> emit_ bci_OP_S_LT_08 []
      _                    -> unsupported_width
    OP_U_GE w -> case w of
      W64                  -> emit_ bci_OP_U_GE_64 []
      W32                  -> emit_ bci_OP_U_GE_32 []
      W16                  -> emit_ bci_OP_U_GE_16 []
      W8                   -> emit_ bci_OP_U_GE_08 []
      _                    -> unsupported_width
    OP_S_GE w -> case w of
      W64                  -> emit_ bci_OP_S_GE_64 []
      W32                  -> emit_ bci_OP_S_GE_32 []
      W16                  -> emit_ bci_OP_S_GE_16 []
      W8                   -> emit_ bci_OP_S_GE_08 []
      _                    -> unsupported_width
    OP_U_GT w -> case w of
      W64                  -> emit_ bci_OP_U_GT_64 []
      W32                  -> emit_ bci_OP_U_GT_32 []
      W16                  -> emit_ bci_OP_U_GT_16 []
      W8                   -> emit_ bci_OP_U_GT_08 []
      _                    -> unsupported_width
    OP_S_GT w -> case w of
      W64                  -> emit_ bci_OP_S_GT_64 []
      W32                  -> emit_ bci_OP_S_GT_32 []
      W16                  -> emit_ bci_OP_S_GT_16 []
      W8                   -> emit_ bci_OP_S_GT_08 []
      _                    -> unsupported_width
    OP_U_LE w -> case w of
      W64                  -> emit_ bci_OP_U_LE_64 []
      W32                  -> emit_ bci_OP_U_LE_32 []
      W16                  -> emit_ bci_OP_U_LE_16 []
      W8                   -> emit_ bci_OP_U_LE_08 []
      _                    -> unsupported_width
    OP_S_LE w -> case w of
      W64                  -> emit_ bci_OP_S_LE_64 []
      W32                  -> emit_ bci_OP_S_LE_32 []
      W16                  -> emit_ bci_OP_S_LE_16 []
      W8                   -> emit_ bci_OP_S_LE_08 []
      _                    -> unsupported_width
  
    OP_INDEX_ADDR w -> case w of
      W64                  -> emit_ bci_OP_INDEX_ADDR_64 []
      W32                  -> emit_ bci_OP_INDEX_ADDR_32 []
      W16                  -> emit_ bci_OP_INDEX_ADDR_16 []
      W8                   -> emit_ bci_OP_INDEX_ADDR_08 []
      _                    -> unsupported_width
  
    BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
      p1 <- ptr $ BCOPtrBreakArray info_mod
      let -- cast that checks that round-tripping through Word32 doesn't change the value
          infoW32 = let r = fromIntegral infox :: Word32
                     in if fromIntegral r == infox
                      then r
                      else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr infox)
          ix_hi = fromIntegral (infoW32 `shiftR` 16)
          ix_lo = fromIntegral (infoW32 .&. 0xffff)
      info_addr        <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
      info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS     $ moduleUnitId info_mod
      np               <- lit1 $ BCONPtrCostCentre ibi
      emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
                        , SmallOp ix_hi, SmallOp ix_lo, Op np ]
  
  #if MIN_VERSION_rts(1,0,3)
    BCO_NAME name            -> do np <- lit1 (BCONPtrStr name)
                                   emit_ bci_BCO_NAME [Op np]
  #endif
  
  
  
    where
      unsupported_width = panic "GHC.ByteCode.Asm: Unsupported Width"
      emit_ = emit word_size
  
      literal :: Literal -> m Word
      literal (LitLabel fs _)   = litlabel fs
      literal LitNullAddr       = word 0
      literal (LitFloat r)      = float (fromRational r)
      literal (LitDouble r)     = double (fromRational r)
      literal (LitChar c)       = int (ord c)
      literal (LitString bs)    = lit1 (BCONPtrStr bs)
         -- LitString requires a zero-terminator when emitted
      literal (LitNumber nt i) = case nt of
        LitNumInt     -> word (fromIntegral i)
        LitNumWord    -> word (fromIntegral i)
        LitNumInt8    -> word8 (fromIntegral i)
        LitNumWord8   -> word8 (fromIntegral i)
        LitNumInt16   -> word16 (fromIntegral i)
        LitNumWord16  -> word16 (fromIntegral i)
        LitNumInt32   -> word32 (fromIntegral i)
        LitNumWord32  -> word32 (fromIntegral i)
        LitNumInt64   -> word64 (fromIntegral i)
        LitNumWord64  -> word64 (fromIntegral i)
        LitNumBigNat  -> panic "GHC.ByteCode.Asm.literal: LitNumBigNat"
  
      -- We can lower 'LitRubbish' to an arbitrary constant, but @NULL@ is most
      -- likely to elicit a crash (rather than corrupt memory) in case absence
      -- analysis messed up.
      literal (LitRubbish {}) = word 0
  
      litlabel fs = lit1 (BCONPtrLbl fs)
      words ws = lit (fmap BCONPtrWord ws)
      word w = words (OnlyOne w)
      word2 w1 w2 = words (OnlyTwo w1 w2)
      word_size  = platformWordSize platform
      word_size_bits = platformWordSizeInBits platform
  
      -- Make lists of host-sized words for literals, so that when the
      -- words are placed in memory at increasing addresses, the
      -- bit pattern is correct for the host's word size and endianness.
      --
      -- Note that we only support host endianness == target endianness for now,
      -- even with the external interpreter. This would need to be fixed to
      -- support host endianness /= target endianness
      int :: Int -> m Word
      int  i = word (fromIntegral i)
  
      float :: Float -> m Word
      float f = word32 (castFloatToWord32 f)
  
      double :: Double -> m Word
      double d = word64 (castDoubleToWord64 d)
  
      word64 :: Word64 -> m Word
      word64 ww = case word_size of
         PW4 ->
          let !wl = fromIntegral ww
              !wh = fromIntegral (ww `unsafeShiftR` 32)
          in case platformByteOrder platform of
              LittleEndian -> word2 wl wh
              BigEndian    -> word2 wh wl
         PW8 -> word (fromIntegral ww)
  
      word8 :: Word8 -> m Word
      word8  x = case platformByteOrder platform of
        LittleEndian -> word (fromIntegral x)
        BigEndian    -> word (fromIntegral x `unsafeShiftL` (word_size_bits - 8))
  
      word16 :: Word16 -> m Word
      word16 x = case platformByteOrder platform of
        LittleEndian -> word (fromIntegral x)
        BigEndian    -> word (fromIntegral x `unsafeShiftL` (word_size_bits - 16))
  
      word32 :: Word32 -> m Word
      word32 x = case platformByteOrder platform of
        LittleEndian -> word (fromIntegral x)
        BigEndian    -> case word_size of
          PW4 -> word (fromIntegral x)
          PW8 -> word (fromIntegral x `unsafeShiftL` 32)
  
  
  isLargeW :: Word -> Bool
  isLargeW n = n > 65535
  
  isLargeI :: Int -> Bool
  isLargeI n = n > 32767 || n < -32768
  
  push_alts :: ArgRep -> Word16
  push_alts V   = bci_PUSH_ALTS_V
  push_alts P   = bci_PUSH_ALTS_P
  push_alts N   = bci_PUSH_ALTS_N
  push_alts L   = bci_PUSH_ALTS_L
  push_alts F   = bci_PUSH_ALTS_F
  push_alts D   = bci_PUSH_ALTS_D
  push_alts V16 = error "push_alts: vector"
  push_alts V32 = error "push_alts: vector"
  push_alts V64 = error "push_alts: vector"
  
  return_non_tuple :: ArgRep -> Word16
  return_non_tuple V   = bci_RETURN_V
  return_non_tuple P   = bci_RETURN_P
  return_non_tuple N   = bci_RETURN_N
  return_non_tuple L   = bci_RETURN_L
  return_non_tuple F   = bci_RETURN_F
  return_non_tuple D   = bci_RETURN_D
  return_non_tuple V16 = error "return_non_tuple: vector"
  return_non_tuple V32 = error "return_non_tuple: vector"
  return_non_tuple V64 = error "return_non_tuple: vector"
  
  {-
    we can only handle up to a fixed number of words on the stack,
    because we need a stg_ctoi_tN stack frame for each size N. See
    Note [unboxed tuple bytecodes and tuple_BCO].
  
    If needed, you can support larger tuples by adding more in
    Jumps.cmm, StgMiscClosures.cmm, Interpreter.c and MiscClosures.h and
    raising this limit.
  
    Note that the limit is the number of words passed on the stack.
    If the calling convention passes part of the tuple in registers, the
    maximum number of tuple elements may be larger. Elements can also
    take multiple words on the stack (for example Double# on a 32 bit
    platform).
   -}
  maxTupleReturnNativeStackSize :: WordOff
  maxTupleReturnNativeStackSize = 62
  
  {-
    Construct the call_info word that stg_ctoi_t, stg_ret_t and stg_primcall
    use to convert arguments between the native calling convention and the
    interpreter.
  
    See Note [GHCi and native call registers] for more information.
   -}
  mkNativeCallInfoSig :: Platform -> NativeCallInfo -> Word32
  mkNativeCallInfoSig platform NativeCallInfo{..}
    | nativeCallType == NativeTupleReturn && nativeCallStackSpillSize > maxTupleReturnNativeStackSize
    = pprPanic "mkNativeCallInfoSig: tuple too big for the bytecode compiler"
               (ppr nativeCallStackSpillSize <+> text "stack words." <+>
                text "Use -fobject-code to get around this limit"
               )
    | otherwise
    = -- 24 bits for register bitmap
      assertPpr (length argRegs <= 24) (text "too many registers for bitmap:" <+> ppr (length argRegs))
  
      -- 8 bits for continuation offset (only for NativeTupleReturn)
      assertPpr (cont_offset < 255) (text "continuation offset too large:" <+> ppr cont_offset)
  
      -- all regs accounted for
      assertPpr (all (`elem` (map fst argRegs)) (regSetToList nativeCallRegs))
        ( vcat
          [ text "not all registers accounted for"
          , text "argRegs:" <+> ppr argRegs
          , text "nativeCallRegs:" <+> ppr nativeCallRegs
          ] ) $
        -- SIMD GHCi TODO: the above assertion doesn't account for register overlap;
        -- it will need to be adjusted for SIMD vector support in the bytecode interpreter.
  
      foldl' reg_bit 0 argRegs .|. (cont_offset `shiftL` 24)
    where
      cont_offset :: Word32
      cont_offset
        | nativeCallType == NativeTupleReturn = fromIntegral nativeCallStackSpillSize
        | otherwise                           = 0 -- there is no continuation for primcalls
  
      reg_bit :: Word32 -> (GlobalReg, Int) -> Word32
      reg_bit x (r, n)
        | r `elemRegSet` nativeCallRegs = x .|. 1 `shiftL` n
        | otherwise                     = x
      argRegs = zip (allArgRegsCover platform SCALAR_ARG_REGS) [0..]
        -- The bytecode interpreter does not (currently) handle vector registers,
        -- so we only use the scalar argument-passing registers here.
  
  mkNativeCallInfoLit :: Platform -> NativeCallInfo -> Literal
  mkNativeCallInfoLit platform call_info =
    mkLitWord platform . fromIntegral $ mkNativeCallInfoSig platform call_info
  
  iNTERP_STACK_CHECK_THRESH :: Int
  iNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH
  