    {-# LANGUAGE BangPatterns, CPP, DeriveFunctor, MagicHash, RecordWildCards #-}
    {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
    --
    --  (c) The University of Glasgow 2002-2006
    --

    -- | Bytecode assembler and linker
    module GHC.ByteCode.Asm (
            assembleBCOs, assembleOneBCO,

            bcoFreeNames,
            SizedSeq, sizeSS, ssElts,
            iNTERP_STACK_CHECK_THRESH
      ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.ByteCode.Instr
    import GHC.ByteCode.InfoTable
    import GHC.ByteCode.Types
    import GHCi.RemoteTypes
    import GHC.Runtime.Interpreter

    import GHC.Driver.Types
    import GHC.Types.Name
    import GHC.Types.Name.Set
    import GHC.Types.Literal
    import GHC.Core.TyCon
    import GHC.Data.FastString
    import GHC.StgToCmm.Layout     ( ArgRep(..) )
    import GHC.Runtime.Heap.Layout
    import GHC.Driver.Session
    import GHC.Utils.Outputable
    import GHC.Platform
    import GHC.Utils.Misc
    import GHC.Types.Unique
    import GHC.Types.Unique.DSet

    -- From iserv
    import SizedSeq

    import Control.Monad
    import Control.Monad.ST ( runST )
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.State.Strict

    import Data.Array.MArray

    import qualified Data.Array.Unboxed as Array
    import Data.Array.Base  ( UArray(..) )

    import Data.Array.Unsafe( castSTUArray )

    import Foreign
    import Data.Char        ( ord )
    import Data.List        ( genericLength )
    import Data.Map (Map)
    import Data.Maybe (fromMaybe)
    import qualified Data.Map as Map

    -- -----------------------------------------------------------------------------
    -- 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 :: UnlinkedBCO -> UniqDSet Name
    bcoFreeNames UnlinkedBCO
    bco
      = UnlinkedBCO -> UniqDSet Name
    bco_refs UnlinkedBCO
    bco UniqDSet Name -> UniqSet Name -> UniqDSet Name
    forall a. UniqDSet a -> UniqSet a -> UniqDSet a
    `uniqDSetMinusUniqSet` [Name] -> UniqSet Name
    mkNameSet [UnlinkedBCO -> Name
    unlinkedBCOName UnlinkedBCO
    bco]
      where
        bco_refs :: UnlinkedBCO -> UniqDSet Name
    bco_refs (UnlinkedBCO Name
    _ Int
    _ UArray Int Word16
    _ UArray Int Word64
    _ SizedSeq BCONPtr
    nonptrs SizedSeq BCOPtr
    ptrs)
            = [UniqDSet Name] -> UniqDSet Name
    forall a. [UniqDSet a] -> UniqDSet a
    unionManyUniqDSets (
                 [Name] -> UniqDSet Name
    forall a. Uniquable a => [a] -> UniqDSet a
    mkUniqDSet [ Name
    n | BCOPtrName Name
    n <- SizedSeq BCOPtr -> [BCOPtr]
    forall a. SizedSeq a -> [a]
    ssElts SizedSeq BCOPtr
    ptrs ] UniqDSet Name -> [UniqDSet Name] -> [UniqDSet Name]
    forall a. a -> [a] -> [a]
    :
                 [Name] -> UniqDSet Name
    forall a. Uniquable a => [a] -> UniqDSet a
    mkUniqDSet [ Name
    n | BCONPtrItbl Name
    n <- SizedSeq BCONPtr -> [BCONPtr]
    forall a. SizedSeq a -> [a]
    ssElts SizedSeq BCONPtr
    nonptrs ] UniqDSet Name -> [UniqDSet Name] -> [UniqDSet Name]
    forall a. a -> [a] -> [a]
    :
                 (UnlinkedBCO -> UniqDSet Name) -> [UnlinkedBCO] -> [UniqDSet Name]
    forall a b. (a -> b) -> [a] -> [b]
    map UnlinkedBCO -> UniqDSet Name
    bco_refs [ UnlinkedBCO
    bco | BCOPtrBCO UnlinkedBCO
    bco <- SizedSeq BCOPtr -> [BCOPtr]
    forall a. SizedSeq a -> [a]
    ssElts SizedSeq BCOPtr
    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
      :: HscEnv -> [ProtoBCO Name] -> [TyCon] -> [RemotePtr ()]
      -> Maybe ModBreaks
      -> IO CompiledByteCode
    assembleBCOs :: HscEnv
    -> [ProtoBCO Name]
    -> [TyCon]
    -> [RemotePtr ()]
    -> Maybe ModBreaks
    -> IO CompiledByteCode
    assembleBCOs HscEnv
    hsc_env [ProtoBCO Name]
    proto_bcos [TyCon]
    tycons [RemotePtr ()]
    top_strs Maybe ModBreaks
    modbreaks = do
      ItblEnv
    itblenv <- HscEnv -> [TyCon] -> IO ItblEnv
    mkITbls HscEnv
    hsc_env [TyCon]
    tycons
      [UnlinkedBCO]
    bcos    <- (ProtoBCO Name -> IO UnlinkedBCO)
    -> [ProtoBCO Name] -> IO [UnlinkedBCO]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO (DynFlags -> Platform
    targetPlatform (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env))) [ProtoBCO Name]
    proto_bcos
      ([UnlinkedBCO]
    bcos',[RemotePtr ()]
    ptrs) <- HscEnv -> [UnlinkedBCO] -> IO ([UnlinkedBCO], [RemotePtr ()])
    mallocStrings HscEnv
    hsc_env [UnlinkedBCO]
    bcos
      CompiledByteCode -> IO CompiledByteCode
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompiledByteCode :: [UnlinkedBCO]
    -> ItblEnv
    -> [FFIInfo]
    -> [RemotePtr ()]
    -> Maybe ModBreaks
    -> CompiledByteCode
    CompiledByteCode
        { bc_bcos :: [UnlinkedBCO]
    bc_bcos = [UnlinkedBCO]
    bcos'
        , bc_itbls :: ItblEnv
    bc_itbls =  ItblEnv
    itblenv
        , bc_ffis :: [FFIInfo]
    bc_ffis = (ProtoBCO Name -> [FFIInfo]) -> [ProtoBCO Name] -> [FFIInfo]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ProtoBCO Name -> [FFIInfo]
    forall a. ProtoBCO a -> [FFIInfo]
    protoBCOFFIs [ProtoBCO Name]
    proto_bcos
        , bc_strs :: [RemotePtr ()]
    bc_strs = [RemotePtr ()]
    top_strs [RemotePtr ()] -> [RemotePtr ()] -> [RemotePtr ()]
    forall a. [a] -> [a] -> [a]
    ++ [RemotePtr ()]
    ptrs
        , bc_breaks :: Maybe ModBreaks
    bc_breaks = Maybe ModBreaks
    modbreaks
        }

    -- Find all the literal strings and malloc them together.  We want to
    -- do this because:
    --
    --  a) It should be done when we compile the module, not each time we relink it
    --  b) For -fexternal-interpreter It's more efficient to malloc the strings
    --     as a single batch message, especially when compiling in parallel.
    --
    mallocStrings :: HscEnv -> [UnlinkedBCO] -> IO ([UnlinkedBCO], [RemotePtr ()])
    mallocStrings :: HscEnv -> [UnlinkedBCO] -> IO ([UnlinkedBCO], [RemotePtr ()])
    mallocStrings HscEnv
    hsc_env [UnlinkedBCO]
    ulbcos = do
      let bytestrings :: [ByteString]
    bytestrings = [ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse (State [ByteString] () -> [ByteString] -> [ByteString]
    forall s a. State s a -> s -> s
    execState ((UnlinkedBCO -> State [ByteString] ())
    -> [UnlinkedBCO] -> State [ByteString] ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ UnlinkedBCO -> State [ByteString] ()
    forall {m :: * -> *}.
    Monad m =>
    UnlinkedBCO -> StateT [ByteString] m ()
    collect [UnlinkedBCO]
    ulbcos) [])
      [RemotePtr ()]
    ptrs <- HscEnv -> Message [RemotePtr ()] -> IO [RemotePtr ()]
    forall a. Binary a => HscEnv -> Message a -> IO a
    iservCmd HscEnv
    hsc_env ([ByteString] -> Message [RemotePtr ()]
    MallocStrings [ByteString]
    bytestrings)
      ([UnlinkedBCO], [RemotePtr ()])
    -> IO ([UnlinkedBCO], [RemotePtr ()])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (State [RemotePtr ()] [UnlinkedBCO]
    -> [RemotePtr ()] -> [UnlinkedBCO]
    forall s a. State s a -> s -> a
    evalState ((UnlinkedBCO -> StateT [RemotePtr ()] Identity UnlinkedBCO)
    -> [UnlinkedBCO] -> State [RemotePtr ()] [UnlinkedBCO]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM UnlinkedBCO -> StateT [RemotePtr ()] Identity UnlinkedBCO
    forall {m :: * -> *} {a}.
    Monad m =>
    UnlinkedBCO -> StateT [RemotePtr a] m UnlinkedBCO
    splice [UnlinkedBCO]
    ulbcos) [RemotePtr ()]
    ptrs, [RemotePtr ()]
    ptrs)
     where
      splice :: UnlinkedBCO -> StateT [RemotePtr a] m UnlinkedBCO
    splice bco :: UnlinkedBCO
    bco@UnlinkedBCO{Int
    UArray Int Word16
    UArray Int Word64
    SizedSeq BCONPtr
    SizedSeq BCOPtr
    Name
    unlinkedBCOPtrs :: UnlinkedBCO -> SizedSeq BCOPtr
    unlinkedBCOLits :: UnlinkedBCO -> SizedSeq BCONPtr
    unlinkedBCOInstrs :: UnlinkedBCO -> UArray Int Word16
    unlinkedBCOBitmap :: UnlinkedBCO -> UArray Int Word64
    unlinkedBCOArity :: UnlinkedBCO -> Int
    unlinkedBCOPtrs :: SizedSeq BCOPtr
    unlinkedBCOLits :: SizedSeq BCONPtr
    unlinkedBCOBitmap :: UArray Int Word64
    unlinkedBCOInstrs :: UArray Int Word16
    unlinkedBCOArity :: Int
    unlinkedBCOName :: Name
    unlinkedBCOName :: UnlinkedBCO -> Name
    ..} = do
        SizedSeq BCONPtr
    lits <- (BCONPtr -> StateT [RemotePtr a] m BCONPtr)
    -> SizedSeq BCONPtr -> StateT [RemotePtr a] m (SizedSeq BCONPtr)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM BCONPtr -> StateT [RemotePtr a] m BCONPtr
    forall {m :: * -> *} {a}.
    Monad m =>
    BCONPtr -> StateT [RemotePtr a] m BCONPtr
    spliceLit SizedSeq BCONPtr
    unlinkedBCOLits
        SizedSeq BCOPtr
    ptrs <- (BCOPtr -> StateT [RemotePtr a] m BCOPtr)
    -> SizedSeq BCOPtr -> StateT [RemotePtr a] m (SizedSeq BCOPtr)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM BCOPtr -> StateT [RemotePtr a] m BCOPtr
    splicePtr SizedSeq BCOPtr
    unlinkedBCOPtrs
        UnlinkedBCO -> StateT [RemotePtr a] m UnlinkedBCO
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnlinkedBCO
    bco { unlinkedBCOLits :: SizedSeq BCONPtr
    unlinkedBCOLits = SizedSeq BCONPtr
    lits, unlinkedBCOPtrs :: SizedSeq BCOPtr
    unlinkedBCOPtrs = SizedSeq BCOPtr
    ptrs }

      spliceLit :: BCONPtr -> StateT [RemotePtr a] m BCONPtr
    spliceLit (BCONPtrStr ByteString
    _) = do
        [RemotePtr a]
    rptrs <- StateT [RemotePtr a] m [RemotePtr a]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
        case [RemotePtr a]
    rptrs of
          (RemotePtr Word64
    p : [RemotePtr a]
    rest) -> do
            [RemotePtr a] -> StateT [RemotePtr a] m ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put [RemotePtr a]
    rest
            BCONPtr -> StateT [RemotePtr a] m BCONPtr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word -> BCONPtr
    BCONPtrWord (Word64 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    p))
          [RemotePtr a]
    _ -> String -> StateT [RemotePtr a] m BCONPtr
    forall a. String -> a
    panic String
    "mallocStrings:spliceLit"
      spliceLit BCONPtr
    other = BCONPtr -> StateT [RemotePtr a] m BCONPtr
    forall (m :: * -> *) a. Monad m => a -> m a
    return BCONPtr
    other

      splicePtr :: BCOPtr -> StateT [RemotePtr a] m BCOPtr
    splicePtr (BCOPtrBCO UnlinkedBCO
    bco) = UnlinkedBCO -> BCOPtr
    BCOPtrBCO (UnlinkedBCO -> BCOPtr)
    -> StateT [RemotePtr a] m UnlinkedBCO
    -> StateT [RemotePtr a] m BCOPtr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnlinkedBCO -> StateT [RemotePtr a] m UnlinkedBCO
    splice UnlinkedBCO
    bco
      splicePtr BCOPtr
    other = BCOPtr -> StateT [RemotePtr a] m BCOPtr
    forall (m :: * -> *) a. Monad m => a -> m a
    return BCOPtr
    other

      collect :: UnlinkedBCO -> StateT [ByteString] m ()
    collect UnlinkedBCO{Int
    UArray Int Word16
    UArray Int Word64
    SizedSeq BCONPtr
    SizedSeq BCOPtr
    Name
    unlinkedBCOPtrs :: SizedSeq BCOPtr
    unlinkedBCOLits :: SizedSeq BCONPtr
    unlinkedBCOBitmap :: UArray Int Word64
    unlinkedBCOInstrs :: UArray Int Word16
    unlinkedBCOArity :: Int
    unlinkedBCOName :: Name
    unlinkedBCOPtrs :: UnlinkedBCO -> SizedSeq BCOPtr
    unlinkedBCOLits :: UnlinkedBCO -> SizedSeq BCONPtr
    unlinkedBCOInstrs :: UnlinkedBCO -> UArray Int Word16
    unlinkedBCOBitmap :: UnlinkedBCO -> UArray Int Word64
    unlinkedBCOArity :: UnlinkedBCO -> Int
    unlinkedBCOName :: UnlinkedBCO -> Name
    ..} = do
        (BCONPtr -> StateT [ByteString] m ())
    -> SizedSeq BCONPtr -> StateT [ByteString] m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BCONPtr -> StateT [ByteString] m ()
    forall {m :: * -> *}.
    Monad m =>
    BCONPtr -> StateT [ByteString] m ()
    collectLit SizedSeq BCONPtr
    unlinkedBCOLits
        (BCOPtr -> StateT [ByteString] m ())
    -> SizedSeq BCOPtr -> StateT [ByteString] m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BCOPtr -> StateT [ByteString] m ()
    collectPtr SizedSeq BCOPtr
    unlinkedBCOPtrs

      collectLit :: BCONPtr -> StateT [ByteString] m ()
    collectLit (BCONPtrStr ByteString
    bs) = do
        [ByteString]
    strs <- StateT [ByteString] m [ByteString]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
        [ByteString] -> StateT [ByteString] m ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put (ByteString
    bsByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    strs)
      collectLit BCONPtr
    _ = () -> StateT [ByteString] m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      collectPtr :: BCOPtr -> StateT [ByteString] m ()
    collectPtr (BCOPtrBCO UnlinkedBCO
    bco) = UnlinkedBCO -> StateT [ByteString] m ()
    collect UnlinkedBCO
    bco
      collectPtr BCOPtr
    _ = () -> StateT [ByteString] m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    assembleOneBCO :: HscEnv -> ProtoBCO Name -> IO UnlinkedBCO
    assembleOneBCO :: HscEnv -> ProtoBCO Name -> IO UnlinkedBCO
    assembleOneBCO HscEnv
    hsc_env ProtoBCO Name
    pbco = do
      UnlinkedBCO
    ubco <- Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO (DynFlags -> Platform
    targetPlatform (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)) ProtoBCO Name
    pbco
      ([UnlinkedBCO
    ubco'], [RemotePtr ()]
    _ptrs) <- HscEnv -> [UnlinkedBCO] -> IO ([UnlinkedBCO], [RemotePtr ()])
    mallocStrings HscEnv
    hsc_env [UnlinkedBCO
    ubco]
      UnlinkedBCO -> IO UnlinkedBCO
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnlinkedBCO
    ubco'

    assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO Platform
    platform (ProtoBCO { protoBCOName :: forall a. ProtoBCO a -> a
    protoBCOName       = Name
    nm
                                 , protoBCOInstrs :: forall a. ProtoBCO a -> [BCInstr]
    protoBCOInstrs     = [BCInstr]
    instrs
                                 , protoBCOBitmap :: forall a. ProtoBCO a -> [StgWord]
    protoBCOBitmap     = [StgWord]
    bitmap
                                 , protoBCOBitmapSize :: forall a. ProtoBCO a -> Word16
    protoBCOBitmapSize = Word16
    bsize
                                 , protoBCOArity :: forall a. ProtoBCO a -> Int
    protoBCOArity      = Int
    arity }) = do
      -- pass 1: collect up the offsets of the local labels.
      let asm :: Assembler ()
    asm = (BCInstr -> Assembler ()) -> [BCInstr] -> Assembler ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Platform -> BCInstr -> Assembler ()
    assembleI Platform
    platform) [BCInstr]
    instrs

          initial_offset :: Word
    initial_offset = Word
    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.
          (Word
    n_insns0, LabelEnvMap
    lbl_map0) = Platform -> Bool -> Word -> Assembler () -> (Word, LabelEnvMap)
    forall a.
    Platform -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
    inspectAsm Platform
    platform Bool
    False Word
    initial_offset Assembler ()
    asm
          ((Word
    n_insns, LabelEnvMap
    lbl_map), Bool
    long_jumps)
            | Word -> Bool
    isLarge Word
    n_insns0 = (Platform -> Bool -> Word -> Assembler () -> (Word, LabelEnvMap)
    forall a.
    Platform -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
    inspectAsm Platform
    platform Bool
    True Word
    initial_offset Assembler ()
    asm, Bool
    True)
            | Bool
    otherwise = ((Word
    n_insns0, LabelEnvMap
    lbl_map0), Bool
    False)

          env :: Word16 -> Word
          env :: Word16 -> Word
    env Word16
    lbl = Word -> Maybe Word -> Word
    forall a. a -> Maybe a -> a
    fromMaybe
            (String -> SDoc -> Word
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "assembleBCO.findLabel" (Word16 -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Word16
    lbl))
            (Word16 -> LabelEnvMap -> Maybe Word
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Word16
    lbl LabelEnvMap
    lbl_map)

      -- pass 2: run assembler and generate instructions, literals and pointers
      let initial_state :: (SizedSeq a, SizedSeq a, SizedSeq a)
    initial_state = (SizedSeq a
    forall a. SizedSeq a
    emptySS, SizedSeq a
    forall a. SizedSeq a
    emptySS, SizedSeq a
    forall a. SizedSeq a
    emptySS)
      (SizedSeq Word16
    final_insns, SizedSeq BCONPtr
    final_lits, SizedSeq BCOPtr
    final_ptrs) <- (StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
     -> (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
     -> IO (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr))
    -> (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
    -> IO (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
    -> (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
    -> IO (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
    forall {a} {a} {a}. (SizedSeq a, SizedSeq a, SizedSeq a)
    initial_state (StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
     -> IO (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
    -> IO (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
    forall a b. (a -> b) -> a -> b
    $ Platform
    -> Bool
    -> (Word16 -> Word)
    -> Assembler ()
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
    forall a.
    Platform
    -> Bool
    -> (Word16 -> Word)
    -> Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    runAsm Platform
    platform Bool
    long_jumps Word16 -> Word
    env Assembler ()
    asm

      -- precomputed size should be equal to final size
      ASSERT(n_insns == sizeSS final_insns) return ()

      let asm_insns :: [Word16]
    asm_insns = SizedSeq Word16 -> [Word16]
    forall a. SizedSeq a -> [a]
    ssElts SizedSeq Word16
    final_insns
          insns_arr :: UArray Int Word16
    insns_arr = (Int, Int) -> [Word16] -> UArray Int Word16
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [e] -> a i e
    Array.listArray (Int
    0, Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    n_insns Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [Word16]
    asm_insns
          bitmap_arr :: UArray Int Word64
    bitmap_arr = Word16 -> [StgWord] -> UArray Int Word64
    mkBitmapArray Word16
    bsize [StgWord]
    bitmap
          ul_bco :: UnlinkedBCO
    ul_bco = Name
    -> Int
    -> UArray Int Word16
    -> UArray Int Word64
    -> SizedSeq BCONPtr
    -> SizedSeq BCOPtr
    -> UnlinkedBCO
    UnlinkedBCO Name
    nm Int
    arity UArray Int Word16
    insns_arr UArray Int Word64
    bitmap_arr SizedSeq BCONPtr
    final_lits SizedSeq BCOPtr
    final_ptrs

      -- 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))

      UnlinkedBCO -> IO UnlinkedBCO
    forall (m :: * -> *) a. Monad m => a -> m a
    return UnlinkedBCO
    ul_bco

    mkBitmapArray :: Word16 -> [StgWord] -> UArray Int Word64
    -- 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 :: Word16 -> [StgWord] -> UArray Int Word64
    mkBitmapArray Word16
    bsize [StgWord]
    bitmap
      = (Int, Int) -> [Word64] -> UArray Int Word64
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [e] -> a i e
    Array.listArray (Int
    0, [StgWord] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [StgWord]
    bitmap) ([Word64] -> UArray Int Word64) -> [Word64] -> UArray Int Word64
    forall a b. (a -> b) -> a -> b
    $
          Word16 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    bsize Word64 -> [Word64] -> [Word64]
    forall a. a -> [a] -> [a]
    : (StgWord -> Word64) -> [StgWord] -> [Word64]
    forall a b. (a -> b) -> [a] -> [b]
    map (Integer -> Word64
    forall a. Num a => Integer -> a
    fromInteger (Integer -> Word64) -> (StgWord -> Integer) -> StgWord -> Word64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgWord -> Integer
    fromStgWord) [StgWord]
    bitmap

    -- instrs nonptrs ptrs
    type AsmState = (SizedSeq Word16,
                     SizedSeq BCONPtr,
                     SizedSeq BCOPtr)

    data Operand
      = Op Word
      | SmallOp Word16
      | LabelOp Word16
    -- (unused)  | LargeOp Word

    data Assembler a
      = AllocPtr (IO BCOPtr) (Word -> Assembler a)
      | AllocLit [BCONPtr] (Word -> Assembler a)
      | AllocLabel Word16 (Assembler a)
      | Emit Word16 [Operand] (Assembler a)
      | NullAsm a
      deriving ((forall a b. (a -> b) -> Assembler a -> Assembler b)
    -> (forall a b. a -> Assembler b -> Assembler a)
    -> Functor Assembler
    forall a b. a -> Assembler b -> Assembler a
    forall a b. (a -> b) -> Assembler a -> Assembler b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> Assembler b -> Assembler a
    $c<$ :: forall a b. a -> Assembler b -> Assembler a
    fmap :: forall a b. (a -> b) -> Assembler a -> Assembler b
    $cfmap :: forall a b. (a -> b) -> Assembler a -> Assembler b
    Functor)

    instance Applicative Assembler where
        pure :: forall a. a -> Assembler a
    pure = a -> Assembler a
    forall a. a -> Assembler a
    NullAsm
        <*> :: forall a b. Assembler (a -> b) -> Assembler a -> Assembler b
    (<*>) = Assembler (a -> b) -> Assembler a -> Assembler b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad Assembler where
      NullAsm a
    x >>= :: forall a b. Assembler a -> (a -> Assembler b) -> Assembler b
    >>= a -> Assembler b
    f = a -> Assembler b
    f a
    x
      AllocPtr IO BCOPtr
    p Word -> Assembler a
    k >>= a -> Assembler b
    f = IO BCOPtr -> (Word -> Assembler b) -> Assembler b
    forall a. IO BCOPtr -> (Word -> Assembler a) -> Assembler a
    AllocPtr IO BCOPtr
    p (Word -> Assembler a
    k (Word -> Assembler a) -> (a -> Assembler b) -> Word -> Assembler b
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> a -> Assembler b
    f)
      AllocLit [BCONPtr]
    l Word -> Assembler a
    k >>= a -> Assembler b
    f = [BCONPtr] -> (Word -> Assembler b) -> Assembler b
    forall a. [BCONPtr] -> (Word -> Assembler a) -> Assembler a
    AllocLit [BCONPtr]
    l (Word -> Assembler a
    k (Word -> Assembler a) -> (a -> Assembler b) -> Word -> Assembler b
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> a -> Assembler b
    f)
      AllocLabel Word16
    lbl Assembler a
    k >>= a -> Assembler b
    f = Word16 -> Assembler b -> Assembler b
    forall a. Word16 -> Assembler a -> Assembler a
    AllocLabel Word16
    lbl (Assembler a
    k Assembler a -> (a -> Assembler b) -> Assembler b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> Assembler b
    f)
      Emit Word16
    w [Operand]
    ops Assembler a
    k >>= a -> Assembler b
    f = Word16 -> [Operand] -> Assembler b -> Assembler b
    forall a. Word16 -> [Operand] -> Assembler a -> Assembler a
    Emit Word16
    w [Operand]
    ops (Assembler a
    k Assembler a -> (a -> Assembler b) -> Assembler b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> Assembler b
    f)

    ioptr :: IO BCOPtr -> Assembler Word
    ioptr :: IO BCOPtr -> Assembler Word
    ioptr IO BCOPtr
    p = IO BCOPtr -> (Word -> Assembler Word) -> Assembler Word
    forall a. IO BCOPtr -> (Word -> Assembler a) -> Assembler a
    AllocPtr IO BCOPtr
    p Word -> Assembler Word
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    ptr :: BCOPtr -> Assembler Word
    ptr :: BCOPtr -> Assembler Word
    ptr = IO BCOPtr -> Assembler Word
    ioptr (IO BCOPtr -> Assembler Word)
    -> (BCOPtr -> IO BCOPtr) -> BCOPtr -> Assembler Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BCOPtr -> IO BCOPtr
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    lit :: [BCONPtr] -> Assembler Word
    lit :: [BCONPtr] -> Assembler Word
    lit [BCONPtr]
    l = [BCONPtr] -> (Word -> Assembler Word) -> Assembler Word
    forall a. [BCONPtr] -> (Word -> Assembler a) -> Assembler a
    AllocLit [BCONPtr]
    l Word -> Assembler Word
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    label :: Word16 -> Assembler ()
    label :: Word16 -> Assembler ()
    label Word16
    w = Word16 -> Assembler () -> Assembler ()
    forall a. Word16 -> Assembler a -> Assembler a
    AllocLabel Word16
    w (() -> Assembler ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    emit :: Word16 -> [Operand] -> Assembler ()
    emit :: Word16 -> [Operand] -> Assembler ()
    emit Word16
    w [Operand]
    ops = Word16 -> [Operand] -> Assembler () -> Assembler ()
    forall a. Word16 -> [Operand] -> Assembler a -> Assembler a
    Emit Word16
    w [Operand]
    ops (() -> Assembler ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    type LabelEnv = Word16 -> Word

    largeOp :: Bool -> Operand -> Bool
    largeOp :: Bool -> Operand -> Bool
    largeOp Bool
    long_jumps Operand
    op = case Operand
    op of
       SmallOp Word16
    _ -> Bool
    False
       Op Word
    w      -> Word -> Bool
    isLarge Word
    w
       LabelOp Word16
    _ -> Bool
    long_jumps
    -- LargeOp _ -> True

    runAsm :: Platform -> Bool -> LabelEnv -> Assembler a -> StateT AsmState IO a
    runAsm :: forall a.
    Platform
    -> Bool
    -> (Word16 -> Word)
    -> Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    runAsm Platform
    platform Bool
    long_jumps Word16 -> Word
    e = Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    forall {a}.
    Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    go
      where
        go :: Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    go (NullAsm a
    x) = a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
        go (AllocPtr IO BCOPtr
    p_io Word -> Assembler a
    k) = do
          BCOPtr
    p <- IO BCOPtr
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO BCOPtr
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift IO BCOPtr
    p_io
          Word
    w <- ((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
     -> (Word, (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO Word
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state (((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
      -> (Word, (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
     -> StateT
          (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO Word)
    -> ((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
        -> (Word, (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO Word
    forall a b. (a -> b) -> a -> b
    $ \(SizedSeq Word16
    st_i0,SizedSeq BCONPtr
    st_l0,SizedSeq BCOPtr
    st_p0) ->
            let st_p1 :: SizedSeq BCOPtr
    st_p1 = SizedSeq BCOPtr -> BCOPtr -> SizedSeq BCOPtr
    forall a. SizedSeq a -> a -> SizedSeq a
    addToSS SizedSeq BCOPtr
    st_p0 BCOPtr
    p
            in (SizedSeq BCOPtr -> Word
    forall a. SizedSeq a -> Word
    sizeSS SizedSeq BCOPtr
    st_p0, (SizedSeq Word16
    st_i0,SizedSeq BCONPtr
    st_l0,SizedSeq BCOPtr
    st_p1))
          Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    go (Assembler a
     -> StateT
          (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a)
    -> Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    forall a b. (a -> b) -> a -> b
    $ Word -> Assembler a
    k Word
    w
        go (AllocLit [BCONPtr]
    lits Word -> Assembler a
    k) = do
          Word
    w <- ((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
     -> (Word, (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO Word
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state (((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
      -> (Word, (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
     -> StateT
          (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO Word)
    -> ((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
        -> (Word, (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO Word
    forall a b. (a -> b) -> a -> b
    $ \(SizedSeq Word16
    st_i0,SizedSeq BCONPtr
    st_l0,SizedSeq BCOPtr
    st_p0) ->
            let st_l1 :: SizedSeq BCONPtr
    st_l1 = SizedSeq BCONPtr -> [BCONPtr] -> SizedSeq BCONPtr
    forall a. SizedSeq a -> [a] -> SizedSeq a
    addListToSS SizedSeq BCONPtr
    st_l0 [BCONPtr]
    lits
            in (SizedSeq BCONPtr -> Word
    forall a. SizedSeq a -> Word
    sizeSS SizedSeq BCONPtr
    st_l0, (SizedSeq Word16
    st_i0,SizedSeq BCONPtr
    st_l1,SizedSeq BCOPtr
    st_p0))
          Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    go (Assembler a
     -> StateT
          (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a)
    -> Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    forall a b. (a -> b) -> a -> b
    $ Word -> Assembler a
    k Word
    w
        go (AllocLabel Word16
    _ Assembler a
    k) = Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    go Assembler a
    k
        go (Emit Word16
    w [Operand]
    ops Assembler a
    k) = do
          let largeOps :: Bool
    largeOps = (Operand -> Bool) -> [Operand] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Operand -> Bool
    largeOp Bool
    long_jumps) [Operand]
    ops
              opcode :: Word16
    opcode
                | Bool
    largeOps = Word16 -> Word16
    largeArgInstr Word16
    w
                | Bool
    otherwise = Word16
    w
              words :: [Word16]
    words = (Operand -> [Word16]) -> [Operand] -> [Word16]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Operand -> [Word16]
    expand [Operand]
    ops
              expand :: Operand -> [Word16]
    expand (SmallOp Word16
    w) = [Word16
    w]
              expand (LabelOp Word16
    w) = Operand -> [Word16]
    expand (Word -> Operand
    Op (Word16 -> Word
    e Word16
    w))
              expand (Op Word
    w) = if Bool
    largeOps then Platform -> Word -> [Word16]
    largeArg Platform
    platform Word
    w else [Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    w]
    --        expand (LargeOp w) = largeArg platform w
          ((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
     -> ((), (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state (((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
      -> ((), (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
     -> StateT
          (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ())
    -> ((SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)
        -> ((), (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr)))
    -> StateT
         (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(SizedSeq Word16
    st_i0,SizedSeq BCONPtr
    st_l0,SizedSeq BCOPtr
    st_p0) ->
            let st_i1 :: SizedSeq Word16
    st_i1 = SizedSeq Word16 -> [Word16] -> SizedSeq Word16
    forall a. SizedSeq a -> [a] -> SizedSeq a
    addListToSS SizedSeq Word16
    st_i0 (Word16
    opcode Word16 -> [Word16] -> [Word16]
    forall a. a -> [a] -> [a]
    : [Word16]
    words)
            in ((), (SizedSeq Word16
    st_i1,SizedSeq BCONPtr
    st_l0,SizedSeq BCOPtr
    st_p0))
          Assembler a
    -> StateT (SizedSeq Word16, SizedSeq BCONPtr, SizedSeq BCOPtr) IO a
    go Assembler a
    k

    type LabelEnvMap = Map Word16 Word

    data InspectState = InspectState
      { InspectState -> Word
    instrCount :: !Word
      , InspectState -> Word
    ptrCount :: !Word
      , InspectState -> Word
    litCount :: !Word
      , InspectState -> LabelEnvMap
    lblEnv :: LabelEnvMap
      }

    inspectAsm :: Platform -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
    inspectAsm :: forall a.
    Platform -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
    inspectAsm Platform
    platform Bool
    long_jumps Word
    initial_offset
      = InspectState -> Assembler a -> (Word, LabelEnvMap)
    forall {a}. InspectState -> Assembler a -> (Word, LabelEnvMap)
    go (Word -> Word -> Word -> LabelEnvMap -> InspectState
    InspectState Word
    initial_offset Word
    0 Word
    0 LabelEnvMap
    forall k a. Map k a
    Map.empty)
      where
        go :: InspectState -> Assembler a -> (Word, LabelEnvMap)
    go InspectState
    s (NullAsm a
    _) = (InspectState -> Word
    instrCount InspectState
    s, InspectState -> LabelEnvMap
    lblEnv InspectState
    s)
        go InspectState
    s (AllocPtr IO BCOPtr
    _ Word -> Assembler a
    k) = InspectState -> Assembler a -> (Word, LabelEnvMap)
    go (InspectState
    s { ptrCount :: Word
    ptrCount = Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    1 }) (Word -> Assembler a
    k Word
    n)
          where n :: Word
    n = InspectState -> Word
    ptrCount InspectState
    s
        go InspectState
    s (AllocLit [BCONPtr]
    ls Word -> Assembler a
    k) = InspectState -> Assembler a -> (Word, LabelEnvMap)
    go (InspectState
    s { litCount :: Word
    litCount = Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + [BCONPtr] -> Word
    forall i a. Num i => [a] -> i
    genericLength [BCONPtr]
    ls }) (Word -> Assembler a
    k Word
    n)
          where n :: Word
    n = InspectState -> Word
    litCount InspectState
    s
        go InspectState
    s (AllocLabel Word16
    lbl Assembler a
    k) = InspectState -> Assembler a -> (Word, LabelEnvMap)
    go InspectState
    s' Assembler a
    k
          where s' :: InspectState
    s' = InspectState
    s { lblEnv :: LabelEnvMap
    lblEnv = Word16 -> Word -> LabelEnvMap -> LabelEnvMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Word16
    lbl (InspectState -> Word
    instrCount InspectState
    s) (InspectState -> LabelEnvMap
    lblEnv InspectState
    s) }
        go InspectState
    s (Emit Word16
    _ [Operand]
    ops Assembler a
    k) = InspectState -> Assembler a -> (Word, LabelEnvMap)
    go InspectState
    s' Assembler a
    k
          where
            s' :: InspectState
    s' = InspectState
    s { instrCount :: Word
    instrCount = InspectState -> Word
    instrCount InspectState
    s Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    size }
            size :: Word
    size = [Word] -> Word
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((Operand -> Word) -> [Operand] -> [Word]
    forall a b. (a -> b) -> [a] -> [b]
    map Operand -> Word
    count [Operand]
    ops) Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    1
            largeOps :: Bool
    largeOps = (Operand -> Bool) -> [Operand] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Operand -> Bool
    largeOp Bool
    long_jumps) [Operand]
    ops
            count :: Operand -> Word
    count (SmallOp Word16
    _) = Word
    1
            count (LabelOp Word16
    _) = Operand -> Word
    count (Word -> Operand
    Op Word
    0)
            count (Op Word
    _) = if Bool
    largeOps then Platform -> Word
    largeArg16s Platform
    platform else Word
    1
    --      count (LargeOp _) = largeArg16s platform

    -- Bring in all the bci_ bytecode constants.
    #include "rts/Bytecodes.h"

    largeArgInstr :: Word16 -> Word16
    largeArgInstr :: Word16 -> Word16
    largeArgInstr Word16
    bci = bci_FLAG_LARGE_ARGS .|. bci

    largeArg :: Platform -> Word -> [Word16]
    largeArg :: Platform -> Word -> [Word16]
    largeArg Platform
    platform Word
    w = case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
       PlatformWordSize
    PW8 -> [Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    w Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48),
               Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    w Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32),
               Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    w Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16),
               Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    w]
       PlatformWordSize
    PW4 -> [Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    w Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16),
               Word -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    w]

    largeArg16s :: Platform -> Word
    largeArg16s :: Platform -> Word
    largeArg16s Platform
    platform = case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
       PlatformWordSize
    PW8 -> Word
    4
       PlatformWordSize
    PW4 -> Word
    2

    assembleI :: Platform
              -> BCInstr
              -> Assembler ()
    assembleI :: Platform -> BCInstr -> Assembler ()
    assembleI Platform
    platform BCInstr
    i = case BCInstr
    i of
      STKCHECK Word
    n               -> Word16 -> [Operand] -> Assembler ()
    emit bci_STKCHECK [Op n]
      PUSH_L Word16
    o1                -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_L [SmallOp o1]
      PUSH_LL Word16
    o1 Word16
    o2            -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_LL [SmallOp o1, SmallOp o2]
      PUSH_LLL Word16
    o1 Word16
    o2 Word16
    o3        -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_LLL [SmallOp o1, SmallOp o2, SmallOp o3]
      PUSH8 Word16
    o1                 -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH8 [SmallOp o1]
      PUSH16 Word16
    o1                -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH16 [SmallOp o1]
      PUSH32 Word16
    o1                -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH32 [SmallOp o1]
      PUSH8_W Word16
    o1               -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH8_W [SmallOp o1]
      PUSH16_W Word16
    o1              -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH16_W [SmallOp o1]
      PUSH32_W Word16
    o1              -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH32_W [SmallOp o1]
      PUSH_G Name
    nm                -> do Word
    p <- BCOPtr -> Assembler Word
    ptr (Name -> BCOPtr
    BCOPtrName Name
    nm)
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_G [Op p]
      PUSH_PRIMOP PrimOp
    op           -> do Word
    p <- BCOPtr -> Assembler Word
    ptr (PrimOp -> BCOPtr
    BCOPtrPrimOp PrimOp
    op)
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_G [Op p]
      PUSH_BCO ProtoBCO Name
    proto           -> do let ul_bco :: IO UnlinkedBCO
    ul_bco = Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO Platform
    platform ProtoBCO Name
    proto
                                     Word
    p <- IO BCOPtr -> Assembler Word
    ioptr ((UnlinkedBCO -> BCOPtr) -> IO UnlinkedBCO -> IO BCOPtr
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM UnlinkedBCO -> BCOPtr
    BCOPtrBCO IO UnlinkedBCO
    ul_bco)
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_G [Op p]
      PUSH_ALTS ProtoBCO Name
    proto          -> do let ul_bco :: IO UnlinkedBCO
    ul_bco = Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO Platform
    platform ProtoBCO Name
    proto
                                     Word
    p <- IO BCOPtr -> Assembler Word
    ioptr ((UnlinkedBCO -> BCOPtr) -> IO UnlinkedBCO -> IO BCOPtr
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM UnlinkedBCO -> BCOPtr
    BCOPtrBCO IO UnlinkedBCO
    ul_bco)
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_ALTS [Op p]
      PUSH_ALTS_UNLIFTED ProtoBCO Name
    proto ArgRep
    pk
                               -> do let ul_bco :: IO UnlinkedBCO
    ul_bco = Platform -> ProtoBCO Name -> IO UnlinkedBCO
    assembleBCO Platform
    platform ProtoBCO Name
    proto
                                     Word
    p <- IO BCOPtr -> Assembler Word
    ioptr ((UnlinkedBCO -> BCOPtr) -> IO UnlinkedBCO -> IO BCOPtr
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM UnlinkedBCO -> BCOPtr
    BCOPtrBCO IO UnlinkedBCO
    ul_bco)
                                     Word16 -> [Operand] -> Assembler ()
    emit (ArgRep -> Word16
    push_alts ArgRep
    pk) [Word -> Operand
    Op Word
    p]
      BCInstr
    PUSH_PAD8                -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_PAD8 []
      BCInstr
    PUSH_PAD16               -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_PAD16 []
      BCInstr
    PUSH_PAD32               -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_PAD32 []
      PUSH_UBX8 Literal
    lit            -> do Word
    np <- Literal -> Assembler Word
    literal Literal
    lit
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_UBX8 [Op np]
      PUSH_UBX16 Literal
    lit           -> do Word
    np <- Literal -> Assembler Word
    literal Literal
    lit
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_UBX16 [Op np]
      PUSH_UBX32 Literal
    lit           -> do Word
    np <- Literal -> Assembler Word
    literal Literal
    lit
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_UBX32 [Op np]
      PUSH_UBX Literal
    lit Word16
    nws         -> do Word
    np <- Literal -> Assembler Word
    literal Literal
    lit
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_UBX [Op np, SmallOp nws]

      BCInstr
    PUSH_APPLY_N             -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_N []
      BCInstr
    PUSH_APPLY_V             -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_V []
      BCInstr
    PUSH_APPLY_F             -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_F []
      BCInstr
    PUSH_APPLY_D             -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_D []
      BCInstr
    PUSH_APPLY_L             -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_L []
      BCInstr
    PUSH_APPLY_P             -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_P []
      BCInstr
    PUSH_APPLY_PP            -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_PP []
      BCInstr
    PUSH_APPLY_PPP           -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_PPP []
      BCInstr
    PUSH_APPLY_PPPP          -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_PPPP []
      BCInstr
    PUSH_APPLY_PPPPP         -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_PPPPP []
      BCInstr
    PUSH_APPLY_PPPPPP        -> Word16 -> [Operand] -> Assembler ()
    emit bci_PUSH_APPLY_PPPPPP []

      SLIDE     Word16
    n Word16
    by           -> Word16 -> [Operand] -> Assembler ()
    emit bci_SLIDE [SmallOp n, SmallOp by]
      ALLOC_AP  Word16
    n              -> Word16 -> [Operand] -> Assembler ()
    emit bci_ALLOC_AP [SmallOp n]
      ALLOC_AP_NOUPD Word16
    n         -> Word16 -> [Operand] -> Assembler ()
    emit bci_ALLOC_AP_NOUPD [SmallOp n]
      ALLOC_PAP Word16
    arity Word16
    n        -> Word16 -> [Operand] -> Assembler ()
    emit bci_ALLOC_PAP [SmallOp arity, SmallOp n]
      MKAP      Word16
    off Word16
    sz         -> Word16 -> [Operand] -> Assembler ()
    emit bci_MKAP [SmallOp off, SmallOp sz]
      MKPAP     Word16
    off Word16
    sz         -> Word16 -> [Operand] -> Assembler ()
    emit bci_MKPAP [SmallOp off, SmallOp sz]
      UNPACK    Word16
    n              -> Word16 -> [Operand] -> Assembler ()
    emit bci_UNPACK [SmallOp n]
      PACK      DataCon
    dcon Word16
    sz        -> do Word
    itbl_no <- [BCONPtr] -> Assembler Word
    lit [Name -> BCONPtr
    BCONPtrItbl (DataCon -> Name
    forall a. NamedThing a => a -> Name
    getName DataCon
    dcon)]
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_PACK [Op itbl_no, SmallOp sz]
      LABEL     Word16
    lbl            -> Word16 -> Assembler ()
    label Word16
    lbl
      TESTLT_I  Int
    i Word16
    l            -> do Word
    np <- Int -> Assembler Word
    int Int
    i
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTLT_I [Op np, LabelOp l]
      TESTEQ_I  Int
    i Word16
    l            -> do Word
    np <- Int -> Assembler Word
    int Int
    i
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTEQ_I [Op np, LabelOp l]
      TESTLT_W  Word
    w Word16
    l            -> do Word
    np <- Word -> Assembler Word
    word Word
    w
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTLT_W [Op np, LabelOp l]
      TESTEQ_W  Word
    w Word16
    l            -> do Word
    np <- Word -> Assembler Word
    word Word
    w
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTEQ_W [Op np, LabelOp l]
      TESTLT_F  Float
    f Word16
    l            -> do Word
    np <- Float -> Assembler Word
    float Float
    f
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTLT_F [Op np, LabelOp l]
      TESTEQ_F  Float
    f Word16
    l            -> do Word
    np <- Float -> Assembler Word
    float Float
    f
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTEQ_F [Op np, LabelOp l]
      TESTLT_D  Double
    d Word16
    l            -> do Word
    np <- Double -> Assembler Word
    double Double
    d
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTLT_D [Op np, LabelOp l]
      TESTEQ_D  Double
    d Word16
    l            -> do Word
    np <- Double -> Assembler Word
    double Double
    d
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_TESTEQ_D [Op np, LabelOp l]
      TESTLT_P  Word16
    i Word16
    l            -> Word16 -> [Operand] -> Assembler ()
    emit bci_TESTLT_P [SmallOp i, LabelOp l]
      TESTEQ_P  Word16
    i Word16
    l            -> Word16 -> [Operand] -> Assembler ()
    emit bci_TESTEQ_P [SmallOp i, LabelOp l]
      BCInstr
    CASEFAIL                 -> Word16 -> [Operand] -> Assembler ()
    emit bci_CASEFAIL []
      SWIZZLE   Word16
    stkoff Word16
    n       -> Word16 -> [Operand] -> Assembler ()
    emit bci_SWIZZLE [SmallOp stkoff, SmallOp n]
      JMP       Word16
    l              -> Word16 -> [Operand] -> Assembler ()
    emit bci_JMP [LabelOp l]
      BCInstr
    ENTER                    -> Word16 -> [Operand] -> Assembler ()
    emit bci_ENTER []
      BCInstr
    RETURN                   -> Word16 -> [Operand] -> Assembler ()
    emit bci_RETURN []
      RETURN_UBX ArgRep
    rep           -> Word16 -> [Operand] -> Assembler ()
    emit (ArgRep -> Word16
    return_ubx ArgRep
    rep) []
      CCALL Word16
    off RemotePtr C_ffi_cif
    m_addr Word16
    i       -> do Word
    np <- RemotePtr C_ffi_cif -> Assembler Word
    forall {a}. RemotePtr a -> Assembler Word
    addr RemotePtr C_ffi_cif
    m_addr
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_CCALL [SmallOp off, Op np, SmallOp i]
      BRK_FUN Word16
    index Unique
    uniq RemotePtr CostCentre
    cc    -> do Word
    p1 <- BCOPtr -> Assembler Word
    ptr BCOPtr
    BCOPtrBreakArray
                                     Word
    q <- Int -> Assembler Word
    int (Unique -> Int
    getKey Unique
    uniq)
                                     Word
    np <- RemotePtr CostCentre -> Assembler Word
    forall {a}. RemotePtr a -> Assembler Word
    addr RemotePtr CostCentre
    cc
                                     Word16 -> [Operand] -> Assembler ()
    emit bci_BRK_FUN [Op p1, SmallOp index,
                                                       Op q, Op np]

      where
        literal :: Literal -> Assembler Word
    literal (LitLabel FastString
    fs (Just Int
    sz) FunctionOrData
    _)
         | Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSMinGW32
             = FastString -> Assembler Word
    litlabel (FastString -> FastString -> FastString
    appendFS FastString
    fs (String -> FastString
    mkFastString (Char
    '@'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Int -> String
    forall a. Show a => a -> String
    show Int
    sz)))
         -- On Windows, stdcall labels have a suffix indicating the no. of
         -- arg words, e.g. foo@8.  testcase: ffi012(ghci)
        literal (LitLabel FastString
    fs Maybe Int
    _ FunctionOrData
    _) = FastString -> Assembler Word
    litlabel FastString
    fs
        literal Literal
    LitNullAddr       = Int -> Assembler Word
    int Int
    0
        literal (LitFloat Rational
    r)      = Float -> Assembler Word
    float (Rational -> Float
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r)
        literal (LitDouble Rational
    r)     = Double -> Assembler Word
    double (Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r)
        literal (LitChar Char
    c)       = Int -> Assembler Word
    int (Char -> Int
    ord Char
    c)
        literal (LitString ByteString
    bs)    = [BCONPtr] -> Assembler Word
    lit [ByteString -> BCONPtr
    BCONPtrStr ByteString
    bs]
           -- LitString requires a zero-terminator when emitted
        literal (LitNumber LitNumType
    nt Integer
    i) = case LitNumType
    nt of
          LitNumType
    LitNumInt     -> Int -> Assembler Word
    int (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i)
          LitNumType
    LitNumWord    -> Int -> Assembler Word
    int (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i)
          LitNumType
    LitNumInt64   -> Int64 -> Assembler Word
    int64 (Integer -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i)
          LitNumType
    LitNumWord64  -> Int64 -> Assembler Word
    int64 (Integer -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i)
          LitNumType
    LitNumInteger -> String -> Assembler Word
    forall a. String -> a
    panic String
    "GHC.ByteCode.Asm.literal: LitNumInteger"
          LitNumType
    LitNumNatural -> String -> Assembler Word
    forall a. String -> a
    panic String
    "GHC.ByteCode.Asm.literal: LitNumNatural"
        -- 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 Literal
    LitRubbish         = Int -> Assembler Word
    int Int
    0

        litlabel :: FastString -> Assembler Word
    litlabel FastString
    fs = [BCONPtr] -> Assembler Word
    lit [FastString -> BCONPtr
    BCONPtrLbl FastString
    fs]
        addr :: RemotePtr a -> Assembler Word
    addr (RemotePtr Word64
    a) = [Word] -> Assembler Word
    words [Word64 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    a]
        float :: Float -> Assembler Word
    float = [Word] -> Assembler Word
    words ([Word] -> Assembler Word)
    -> (Float -> [Word]) -> Float -> Assembler Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Float -> [Word]
    mkLitF
        double :: Double -> Assembler Word
    double = [Word] -> Assembler Word
    words ([Word] -> Assembler Word)
    -> (Double -> [Word]) -> Double -> Assembler Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> Double -> [Word]
    mkLitD Platform
    platform
        int :: Int -> Assembler Word
    int = [Word] -> Assembler Word
    words ([Word] -> Assembler Word)
    -> (Int -> [Word]) -> Int -> Assembler Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Word]
    mkLitI
        int64 :: Int64 -> Assembler Word
    int64 = [Word] -> Assembler Word
    words ([Word] -> Assembler Word)
    -> (Int64 -> [Word]) -> Int64 -> Assembler Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> Int64 -> [Word]
    mkLitI64 Platform
    platform
        words :: [Word] -> Assembler Word
    words [Word]
    ws = [BCONPtr] -> Assembler Word
    lit ((Word -> BCONPtr) -> [Word] -> [BCONPtr]
    forall a b. (a -> b) -> [a] -> [b]
    map Word -> BCONPtr
    BCONPtrWord [Word]
    ws)
        word :: Word -> Assembler Word
    word Word
    w = [Word] -> Assembler Word
    words [Word
    w]

    isLarge :: Word -> Bool
    isLarge :: Word -> Bool
    isLarge Word
    n = Word
    n Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word
    65535

    push_alts :: ArgRep -> Word16
    push_alts :: ArgRep -> Word16
    push_alts ArgRep
    V   = bci_PUSH_ALTS_V
    push_alts ArgRep
    P   = bci_PUSH_ALTS_P
    push_alts ArgRep
    N   = bci_PUSH_ALTS_N
    push_alts ArgRep
    L   = bci_PUSH_ALTS_L
    push_alts ArgRep
    F   = bci_PUSH_ALTS_F
    push_alts ArgRep
    D   = bci_PUSH_ALTS_D
    push_alts ArgRep
    V16 = String -> Word16
    forall a. HasCallStack => String -> a
    error String
    "push_alts: vector"
    push_alts ArgRep
    V32 = String -> Word16
    forall a. HasCallStack => String -> a
    error String
    "push_alts: vector"
    push_alts ArgRep
    V64 = String -> Word16
    forall a. HasCallStack => String -> a
    error String
    "push_alts: vector"

    return_ubx :: ArgRep -> Word16
    return_ubx :: ArgRep -> Word16
    return_ubx ArgRep
    V   = bci_RETURN_V
    return_ubx ArgRep
    P   = bci_RETURN_P
    return_ubx ArgRep
    N   = bci_RETURN_N
    return_ubx ArgRep
    L   = bci_RETURN_L
    return_ubx ArgRep
    F   = bci_RETURN_F
    return_ubx ArgRep
    D   = bci_RETURN_D
    return_ubx ArgRep
    V16 = String -> Word16
    forall a. HasCallStack => String -> a
    error String
    "return_ubx: vector"
    return_ubx ArgRep
    V32 = String -> Word16
    forall a. HasCallStack => String -> a
    error String
    "return_ubx: vector"
    return_ubx ArgRep
    V64 = String -> Word16
    forall a. HasCallStack => String -> a
    error String
    "return_ubx: vector"

    -- 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.
    mkLitI   ::             Int    -> [Word]
    mkLitF   ::             Float  -> [Word]
    mkLitD   :: Platform -> Double -> [Word]
    mkLitI64 :: Platform -> Int64  -> [Word]

    mkLitF :: Float -> [Word]
    mkLitF Float
    f
       = (forall s. ST s [Word]) -> [Word]
    forall a. (forall s. ST s a) -> a
    runST (do
            STUArray s Int Float
    arr <- (Int, Int) -> ST s (STUArray s Int Float)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    0)
            STUArray s Int Float -> Int -> Float -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Float
    arr Int
    0 Float
    f
            STUArray s Int Word
    f_arr <- STUArray s Int Float -> ST s (STUArray s Int Word)
    forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    castSTUArray STUArray s Int Float
    arr
            Word
    w0 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    f_arr Int
    0
            [Word] -> ST s [Word]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word
    w0 :: Word]
         )

    mkLitD :: Platform -> Double -> [Word]
    mkLitD Platform
    platform Double
    d = case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
       PlatformWordSize
    PW4 -> (forall s. ST s [Word]) -> [Word]
    forall a. (forall s. ST s a) -> a
    runST (do
            STUArray s Int Double
    arr <- (Int, Int) -> ST s (STUArray s Int Double)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    1)
            STUArray s Int Double -> Int -> Double -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Double
    arr Int
    0 Double
    d
            STUArray s Int Word
    d_arr <- STUArray s Int Double -> ST s (STUArray s Int Word)
    forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    castSTUArray STUArray s Int Double
    arr
            Word
    w0 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    d_arr Int
    0
            Word
    w1 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    d_arr Int
    1
            [Word] -> ST s [Word]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word
    w0 :: Word, Word
    w1]
         )
       PlatformWordSize
    PW8 -> (forall s. ST s [Word]) -> [Word]
    forall a. (forall s. ST s a) -> a
    runST (do
            STUArray s Int Double
    arr <- (Int, Int) -> ST s (STUArray s Int Double)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    0)
            STUArray s Int Double -> Int -> Double -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Double
    arr Int
    0 Double
    d
            STUArray s Int Word
    d_arr <- STUArray s Int Double -> ST s (STUArray s Int Word)
    forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    castSTUArray STUArray s Int Double
    arr
            Word
    w0 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    d_arr Int
    0
            [Word] -> ST s [Word]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word
    w0 :: Word]
         )

    mkLitI64 :: Platform -> Int64 -> [Word]
    mkLitI64 Platform
    platform Int64
    ii = case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
       PlatformWordSize
    PW4 -> (forall s. ST s [Word]) -> [Word]
    forall a. (forall s. ST s a) -> a
    runST (do
            STUArray s Int Int64
    arr <- (Int, Int) -> ST s (STUArray s Int Int64)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    1)
            STUArray s Int Int64 -> Int -> Int64 -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Int64
    arr Int
    0 Int64
    ii
            STUArray s Int Word
    d_arr <- STUArray s Int Int64 -> ST s (STUArray s Int Word)
    forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    castSTUArray STUArray s Int Int64
    arr
            Word
    w0 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    d_arr Int
    0
            Word
    w1 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    d_arr Int
    1
            [Word] -> ST s [Word]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word
    w0 :: Word,Word
    w1]
         )
       PlatformWordSize
    PW8 -> (forall s. ST s [Word]) -> [Word]
    forall a. (forall s. ST s a) -> a
    runST (do
            STUArray s Int Int64
    arr <- (Int, Int) -> ST s (STUArray s Int Int64)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ ((Int
    0::Int),Int
    0)
            STUArray s Int Int64 -> Int -> Int64 -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> e -> m ()
    writeArray STUArray s Int Int64
    arr Int
    0 Int64
    ii
            STUArray s Int Word
    d_arr <- STUArray s Int Int64 -> ST s (STUArray s Int Word)
    forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
    castSTUArray STUArray s Int Int64
    arr
            Word
    w0 <- STUArray s Int Word -> Int -> ST s Word
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> i -> m e
    readArray STUArray s Int Word
    d_arr Int
    0
            [Word] -> ST s [Word]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word
    w0 :: Word]
         )

    mkLitI :: Int -> [Word]
    mkLitI Int
    i = [Int -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    i :: Word]

    iNTERP_STACK_CHECK_THRESH :: Int
    iNTERP_STACK_CHECK_THRESH :: Int
    iNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH