compiler/ghci/ByteCodeAsm.lhs

   1 %
   2 % (c) The University of Glasgow 2002-2006
   3 %
   4
   5 ByteCodeLink: Bytecode assembler and linker
   6
   7 \begin{code}
   8 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
   9
  10 module ByteCodeAsm (
  11         assembleBCOs, assembleBCO,
  12
  13         CompiledByteCode(..),
  14         UnlinkedBCO(..), BCOPtr(..), BCONPtr(..), bcoFreeNames,
  15         SizedSeq, sizeSS, ssElts,
  16         iNTERP_STACK_CHECK_THRESH
  17   ) where
  18
  19 #include "HsVersions.h"
  20
  21 import ByteCodeInstr
  22 import ByteCodeItbls
  23
  24 import Name
  25 import NameSet
  26 import FiniteMap
  27 import Literal
  28 import TyCon
  29 import PrimOp
  30 import Constants
  31 import FastString
  32 import SMRep
  33 import FiniteMap
  34 import Outputable
  35
  36 import Control.Monad    ( foldM )
  37 import Control.Monad.ST ( runST )
  38
  39 import GHC.Word         ( Word(..) )
  40 import Data.Array.MArray
  41 import Data.Array.Unboxed ( listArray )
  42 import Data.Array.Base  ( UArray(..) )
  43 import Data.Array.ST    ( castSTUArray )
  44 import Foreign          ( Word16, free )
  45 import Data.Bits
  46 import Data.Int         ( Int64 )
  47 import Data.Char        ( ord )
  48
  49 import GHC.Base         ( ByteArray# )
  50 import GHC.IOBase       ( IO(..) )
  51 import GHC.Ptr          ( Ptr(..) )
  52
  53 -- -----------------------------------------------------------------------------
  54 -- Unlinked BCOs
  55
  56 -- CompiledByteCode represents the result of byte-code
  57 -- compiling a bunch of functions and data types
  58
  59 data CompiledByteCode
  60   = ByteCode [UnlinkedBCO] -- Bunch of interpretable bindings
  61              ItblEnv       -- A mapping from DataCons to their itbls
  62
  63 instance Outputable CompiledByteCode where
  64   ppr (ByteCode bcos _) = ppr bcos
  65
  66
  67 data UnlinkedBCO
  68    = UnlinkedBCO {
  69         unlinkedBCOName   :: Name,
  70         unlinkedBCOArity  :: Int,
  71         unlinkedBCOInstrs :: ByteArray#,                 -- insns
  72         unlinkedBCOBitmap :: ByteArray#,                 -- bitmap
  73         unlinkedBCOLits   :: (SizedSeq BCONPtr),        -- non-ptrs
  74         unlinkedBCOPtrs   :: (SizedSeq BCOPtr)          -- ptrs
  75    }
  76
  77 data BCOPtr
  78   = BCOPtrName   Name
  79   | BCOPtrPrimOp PrimOp
  80   | BCOPtrBCO    UnlinkedBCO
  81
  82 data BCONPtr
  83   = BCONPtrWord  Word
  84   | BCONPtrLbl   FastString
  85   | BCONPtrItbl  Name
  86
  87 -- | Finds external references.  Remember to remove the names
  88 -- defined by this group of BCOs themselves
  89 bcoFreeNames :: UnlinkedBCO -> NameSet
  90 bcoFreeNames bco
  91   = bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
  92   where
  93     bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
  94         = unionManyNameSets (
  95              mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
  96              mkNameSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :
  97              map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
  98           )
  99
 100 instance Outputable UnlinkedBCO where
 101    ppr (UnlinkedBCO nm arity insns bitmap lits ptrs)
 102       = sep [text "BCO", ppr nm, text "with",
 103              int (sizeSS lits), text "lits",
 104              int (sizeSS ptrs), text "ptrs" ]
 105
 106 -- -----------------------------------------------------------------------------
 107 -- The bytecode assembler
 108
 109 -- The object format for bytecodes is: 16 bits for the opcode, and 16
 110 -- for each field -- so the code can be considered a sequence of
 111 -- 16-bit ints.  Each field denotes either a stack offset or number of
 112 -- items on the stack (eg SLIDE), and index into the pointer table (eg
 113 -- PUSH_G), an index into the literal table (eg PUSH_I/D/L), or a
 114 -- bytecode address in this BCO.
 115
 116 -- Top level assembler fn.
 117 assembleBCOs :: [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode
 118 assembleBCOs proto_bcos tycons
 119   = do  itblenv <- mkITbls tycons
 120         bcos    <- mapM assembleBCO proto_bcos
 121         return (ByteCode bcos itblenv)
 122
 123 assembleBCO :: ProtoBCO Name -> IO UnlinkedBCO
 124 assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
 125    = let
 126          -- pass 1: collect up the offsets of the local labels.
 127          -- Remember that the first insn starts at offset 1 since offset 0
 128          -- (eventually) will hold the total # of insns.
 129          label_env = mkLabelEnv emptyFM 1 instrs
 130
 131          mkLabelEnv env i_offset [] = env
 132          mkLabelEnv env i_offset (i:is)
 133             = let new_env
 134                      = case i of LABEL n -> addToFM env n i_offset ; _ -> env
 135               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 136
 137          findLabel lab
 138             = case lookupFM label_env lab of
 139                  Just bco_offset -> bco_offset
 140                  Nothing -> pprPanic "assembleBCO.findLabel" (int lab)
 141      in
 142      do  -- pass 2: generate the instruction, ptr and nonptr bits
 143          insns <- return emptySS :: IO (SizedSeq Word16)
 144          lits  <- return emptySS :: IO (SizedSeq BCONPtr)
 145          ptrs  <- return emptySS :: IO (SizedSeq BCOPtr)
 146          let init_asm_state = (insns,lits,ptrs)
 147          (final_insns, final_lits, final_ptrs)
 148             <- mkBits findLabel init_asm_state instrs
 149
 150          let asm_insns = ssElts final_insns
 151              n_insns   = sizeSS final_insns
 152
 153              insns_arr
 154                  | n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
 155                  | otherwise = mkInstrArray n_insns asm_insns
 156              insns_barr = case insns_arr of UArray _lo _hi barr -> barr
 157
 158              bitmap_arr = mkBitmapArray bsize bitmap
 159              bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
 160
 161          let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits
 162                                         final_ptrs
 163
 164          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
 165          -- objects, since they might get run too early.  Disable this until
 166          -- we figure out what to do.
 167          -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
 168
 169          return ul_bco
 170      where
 171          zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
 172                            free ptr
 173
 174 mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
 175 mkBitmapArray bsize bitmap
 176   = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
 177
 178 mkInstrArray :: Int -> [Word16] -> UArray Int Word16
 179 mkInstrArray n_insns asm_insns
 180   = listArray (0, n_insns) (fromIntegral n_insns : asm_insns)
 181
 182 -- instrs nonptrs ptrs
 183 type AsmState = (SizedSeq Word16,
 184                  SizedSeq BCONPtr,
 185                  SizedSeq BCOPtr)
 186
 187 data SizedSeq a = SizedSeq !Int [a]
 188 emptySS = SizedSeq 0 []
 189
 190 -- Why are these two monadic???
 191 addToSS (SizedSeq n r_xs) x = return (SizedSeq (n+1) (x:r_xs))
 192 addListToSS (SizedSeq n r_xs) xs
 193    = return (SizedSeq (n + length xs) (reverse xs ++ r_xs))
 194
 195 ssElts :: SizedSeq a -> [a]
 196 ssElts (SizedSeq n r_xs) = reverse r_xs
 197
 198 sizeSS :: SizedSeq a -> Int
 199 sizeSS (SizedSeq n r_xs) = n
 200
 201 -- Bring in all the bci_ bytecode constants.
 202 #include "Bytecodes.h"
 203
 204 largeArgInstr :: Int -> Int
 205 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
 206
 207 largeArg :: Int -> [Int]
 208 largeArg i
 209  | wORD_SIZE_IN_BITS == 64
 210            = [(i .&. 0xFFFF000000000000) `shiftR` 48,
 211               (i .&. 0x0000FFFF00000000) `shiftR` 32,
 212               (i .&. 0x00000000FFFF0000) `shiftR` 16,
 213               (i .&. 0x000000000000FFFF)]
 214  | wORD_SIZE_IN_BITS == 32
 215            = [(i .&. 0xFFFF0000) `shiftR` 16,
 216               (i .&. 0x0000FFFF)]
 217  | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
 218
 219 -- This is where all the action is (pass 2 of the assembler)
 220 mkBits :: (Int -> Int)                  -- label finder
 221        -> AsmState
 222        -> [BCInstr]                     -- instructions (in)
 223        -> IO AsmState
 224
 225 mkBits findLabel st proto_insns
 226   = foldM doInstr st proto_insns
 227     where
 228        doInstr :: AsmState -> BCInstr -> IO AsmState
 229        doInstr st i
 230           = case i of
 231                STKCHECK  n
 232                 | n > 65535 ->
 233                        instrn st (largeArgInstr bci_STKCHECK : largeArg n)
 234                 | otherwise -> instr2 st bci_STKCHECK n
 235                PUSH_L    o1       -> instr2 st bci_PUSH_L o1
 236                PUSH_LL   o1 o2    -> instr3 st bci_PUSH_LL o1 o2
 237                PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
 238                PUSH_G    nm       -> do (p, st2) <- ptr st (BCOPtrName nm)
 239                                         instr2 st2 bci_PUSH_G p
 240                PUSH_PRIMOP op     -> do (p, st2) <- ptr st (BCOPtrPrimOp op)
 241                                         instr2 st2 bci_PUSH_G p
 242                PUSH_BCO proto     -> do ul_bco <- assembleBCO proto
 243                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
 244                                         instr2 st2 bci_PUSH_G p
 245                PUSH_ALTS proto    -> do ul_bco <- assembleBCO proto
 246                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
 247                                         instr2 st2 bci_PUSH_ALTS p
 248                PUSH_ALTS_UNLIFTED proto pk -> do
 249                                         ul_bco <- assembleBCO proto
 250                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
 251                                         instr2 st2 (push_alts pk) p
 252                PUSH_UBX  (Left lit) nws
 253                                   -> do (np, st2) <- literal st lit
 254                                         instr3 st2 bci_PUSH_UBX np nws
 255                PUSH_UBX  (Right aa) nws
 256                                   -> do (np, st2) <- addr st aa
 257                                         instr3 st2 bci_PUSH_UBX np nws
 258
 259                PUSH_APPLY_N         -> do instr1 st bci_PUSH_APPLY_N
 260                PUSH_APPLY_V         -> do instr1 st bci_PUSH_APPLY_V
 261                PUSH_APPLY_F         -> do instr1 st bci_PUSH_APPLY_F
 262                PUSH_APPLY_D         -> do instr1 st bci_PUSH_APPLY_D
 263                PUSH_APPLY_L         -> do instr1 st bci_PUSH_APPLY_L
 264                PUSH_APPLY_P         -> do instr1 st bci_PUSH_APPLY_P
 265                PUSH_APPLY_PP        -> do instr1 st bci_PUSH_APPLY_PP
 266                PUSH_APPLY_PPP       -> do instr1 st bci_PUSH_APPLY_PPP
 267                PUSH_APPLY_PPPP      -> do instr1 st bci_PUSH_APPLY_PPPP
 268                PUSH_APPLY_PPPPP     -> do instr1 st bci_PUSH_APPLY_PPPPP
 269                PUSH_APPLY_PPPPPP    -> do instr1 st bci_PUSH_APPLY_PPPPPP
 270
 271                SLIDE     n by     -> instr3 st bci_SLIDE n by
 272                ALLOC_AP  n        -> instr2 st bci_ALLOC_AP n
 273                ALLOC_PAP arity n  -> instr3 st bci_ALLOC_PAP arity n
 274                MKAP      off sz   -> instr3 st bci_MKAP off sz
 275                MKPAP     off sz   -> instr3 st bci_MKPAP off sz
 276                UNPACK    n        -> instr2 st bci_UNPACK n
 277                PACK      dcon sz  -> do (itbl_no,st2) <- itbl st dcon
 278                                         instr3 st2 bci_PACK itbl_no sz
 279                LABEL     lab      -> return st
 280                TESTLT_I  i l      -> do (np, st2) <- int st i
 281                                         instr3 st2 bci_TESTLT_I np (findLabel l)
 282                TESTEQ_I  i l      -> do (np, st2) <- int st i
 283                                         instr3 st2 bci_TESTEQ_I np (findLabel l)
 284                TESTLT_F  f l      -> do (np, st2) <- float st f
 285                                         instr3 st2 bci_TESTLT_F np (findLabel l)
 286                TESTEQ_F  f l      -> do (np, st2) <- float st f
 287                                         instr3 st2 bci_TESTEQ_F np (findLabel l)
 288                TESTLT_D  d l      -> do (np, st2) <- double st d
 289                                         instr3 st2 bci_TESTLT_D np (findLabel l)
 290                TESTEQ_D  d l      -> do (np, st2) <- double st d
 291                                         instr3 st2 bci_TESTEQ_D np (findLabel l)
 292                TESTLT_P  i l      -> instr3 st bci_TESTLT_P i (findLabel l)
 293                TESTEQ_P  i l      -> instr3 st bci_TESTEQ_P i (findLabel l)
 294                CASEFAIL           -> instr1 st bci_CASEFAIL
 295                SWIZZLE   stkoff n -> instr3 st bci_SWIZZLE stkoff n
 296                JMP       l        -> instr2 st bci_JMP (findLabel l)
 297                ENTER              -> instr1 st bci_ENTER
 298                RETURN             -> instr1 st bci_RETURN
 299                RETURN_UBX rep     -> instr1 st (return_ubx rep)
 300                CCALL off m_addr   -> do (np, st2) <- addr st m_addr
 301                                         instr3 st2 bci_CCALL off np
 302
 303        i2s :: Int -> Word16
 304        i2s = fromIntegral
 305
 306        instrn :: AsmState -> [Int] -> IO AsmState
 307        instrn st [] = return st
 308        instrn (st_i, st_l, st_p) (i:is)
 309           = do st_i' <- addToSS st_i (i2s i)
 310                instrn (st_i', st_l, st_p) is
 311
 312        instr1 (st_i0,st_l0,st_p0) i1
 313           = do st_i1 <- addToSS st_i0 i1
 314                return (st_i1,st_l0,st_p0)
 315
 316        instr2 (st_i0,st_l0,st_p0) i1 i2
 317           = do st_i1 <- addToSS st_i0 (i2s i1)
 318                st_i2 <- addToSS st_i1 (i2s i2)
 319                return (st_i2,st_l0,st_p0)
 320
 321        instr3 (st_i0,st_l0,st_p0) i1 i2 i3
 322           = do st_i1 <- addToSS st_i0 (i2s i1)
 323                st_i2 <- addToSS st_i1 (i2s i2)
 324                st_i3 <- addToSS st_i2 (i2s i3)
 325                return (st_i3,st_l0,st_p0)
 326
 327        instr4 (st_i0,st_l0,st_p0) i1 i2 i3 i4
 328           = do st_i1 <- addToSS st_i0 (i2s i1)
 329                st_i2 <- addToSS st_i1 (i2s i2)
 330                st_i3 <- addToSS st_i2 (i2s i3)
 331                st_i4 <- addToSS st_i3 (i2s i4)
 332                return (st_i4,st_l0,st_p0)
 333
 334        float (st_i0,st_l0,st_p0) f
 335           = do let ws = mkLitF f
 336                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 337                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 338
 339        double (st_i0,st_l0,st_p0) d
 340           = do let ws = mkLitD d
 341                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 342                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 343
 344        int (st_i0,st_l0,st_p0) i
 345           = do let ws = mkLitI i
 346                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 347                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 348
 349        int64 (st_i0,st_l0,st_p0) i
 350           = do let ws = mkLitI64 i
 351                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 352                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 353
 354        addr (st_i0,st_l0,st_p0) a
 355           = do let ws = mkLitPtr a
 356                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 357                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 358
 359        litlabel (st_i0,st_l0,st_p0) fs
 360           = do st_l1 <- addListToSS st_l0 [BCONPtrLbl fs]
 361                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 362
 363        ptr (st_i0,st_l0,st_p0) p
 364           = do st_p1 <- addToSS st_p0 p
 365                return (sizeSS st_p0, (st_i0,st_l0,st_p1))
 366
 367        itbl (st_i0,st_l0,st_p0) dcon
 368           = do st_l1 <- addToSS st_l0 (BCONPtrItbl (getName dcon))
 369                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 370
 371 #ifdef mingw32_TARGET_OS
 372        literal st (MachLabel fs (Just sz))
 373             = litlabel st (appendFS fs (mkFastString ('@':show sz)))
 374         -- On Windows, stdcall labels have a suffix indicating the no. of
 375         -- arg words, e.g. foo@8.  testcase: ffi012(ghci)
 376 #endif
 377        literal st (MachLabel fs _) = litlabel st fs
 378        literal st (MachWord w)     = int st (fromIntegral w)
 379        literal st (MachInt j)      = int st (fromIntegral j)
 380        literal st (MachFloat r)    = float st (fromRational r)
 381        literal st (MachDouble r)   = double st (fromRational r)
 382        literal st (MachChar c)     = int st (ord c)
 383        literal st (MachInt64 ii)   = int64 st (fromIntegral ii)
 384        literal st (MachWord64 ii)  = int64 st (fromIntegral ii)
 385        literal st other            = pprPanic "ByteCodeLink.literal" (ppr other)
 386
 387
 388 push_alts NonPtrArg = bci_PUSH_ALTS_N
 389 push_alts FloatArg  = bci_PUSH_ALTS_F
 390 push_alts DoubleArg = bci_PUSH_ALTS_D
 391 push_alts VoidArg   = bci_PUSH_ALTS_V
 392 push_alts LongArg   = bci_PUSH_ALTS_L
 393 push_alts PtrArg    = bci_PUSH_ALTS_P
 394
 395 return_ubx NonPtrArg = bci_RETURN_N
 396 return_ubx FloatArg  = bci_RETURN_F
 397 return_ubx DoubleArg = bci_RETURN_D
 398 return_ubx VoidArg   = bci_RETURN_V
 399 return_ubx LongArg   = bci_RETURN_L
 400 return_ubx PtrArg    = bci_RETURN_P
 401
 402
 403 -- The size in 16-bit entities of an instruction.
 404 instrSize16s :: BCInstr -> Int
 405 instrSize16s instr
 406    = case instr of
 407         STKCHECK{}              -> 2
 408         PUSH_L{}                -> 2
 409         PUSH_LL{}               -> 3
 410         PUSH_LLL{}              -> 4
 411         PUSH_G{}                -> 2
 412         PUSH_PRIMOP{}           -> 2
 413         PUSH_BCO{}              -> 2
 414         PUSH_ALTS{}             -> 2
 415         PUSH_ALTS_UNLIFTED{}    -> 2
 416         PUSH_UBX{}              -> 3
 417         PUSH_APPLY_N{}          -> 1
 418         PUSH_APPLY_V{}          -> 1
 419         PUSH_APPLY_F{}          -> 1
 420         PUSH_APPLY_D{}          -> 1
 421         PUSH_APPLY_L{}          -> 1
 422         PUSH_APPLY_P{}          -> 1
 423         PUSH_APPLY_PP{}         -> 1
 424         PUSH_APPLY_PPP{}        -> 1
 425         PUSH_APPLY_PPPP{}       -> 1
 426         PUSH_APPLY_PPPPP{}      -> 1
 427         PUSH_APPLY_PPPPPP{}     -> 1
 428         SLIDE{}                 -> 3
 429         ALLOC_AP{}              -> 2
 430         ALLOC_PAP{}             -> 3
 431         MKAP{}                  -> 3
 432         MKPAP{}                 -> 3
 433         UNPACK{}                -> 2
 434         PACK{}                  -> 3
 435         LABEL{}                 -> 0    -- !!
 436         TESTLT_I{}              -> 3
 437         TESTEQ_I{}              -> 3
 438         TESTLT_F{}              -> 3
 439         TESTEQ_F{}              -> 3
 440         TESTLT_D{}              -> 3
 441         TESTEQ_D{}              -> 3
 442         TESTLT_P{}              -> 3
 443         TESTEQ_P{}              -> 3
 444         JMP{}                   -> 2
 445         CASEFAIL{}              -> 1
 446         ENTER{}                 -> 1
 447         RETURN{}                -> 1
 448         RETURN_UBX{}            -> 1
 449         CCALL{}                 -> 3
 450         SWIZZLE{}               -> 3
 451
 452 -- Make lists of host-sized words for literals, so that when the
 453 -- words are placed in memory at increasing addresses, the
 454 -- bit pattern is correct for the host's word size and endianness.
 455 mkLitI   :: Int    -> [Word]
 456 mkLitF   :: Float  -> [Word]
 457 mkLitD   :: Double -> [Word]
 458 mkLitPtr :: Ptr () -> [Word]
 459 mkLitI64 :: Int64  -> [Word]
 460
 461 mkLitF f
 462    = runST (do
 463         arr <- newArray_ ((0::Int),0)
 464         writeArray arr 0 f
 465         f_arr <- castSTUArray arr
 466         w0 <- readArray f_arr 0
 467         return [w0 :: Word]
 468      )
 469
 470 mkLitD d
 471    | wORD_SIZE == 4
 472    = runST (do
 473         arr <- newArray_ ((0::Int),1)
 474         writeArray arr 0 d
 475         d_arr <- castSTUArray arr
 476         w0 <- readArray d_arr 0
 477         w1 <- readArray d_arr 1
 478         return [w0 :: Word, w1]
 479      )
 480    | wORD_SIZE == 8
 481    = runST (do
 482         arr <- newArray_ ((0::Int),0)
 483         writeArray arr 0 d
 484         d_arr <- castSTUArray arr
 485         w0 <- readArray d_arr 0
 486         return [w0 :: Word]
 487      )
 488
 489 mkLitI64 ii
 490    | wORD_SIZE == 4
 491    = runST (do
 492         arr <- newArray_ ((0::Int),1)
 493         writeArray arr 0 ii
 494         d_arr <- castSTUArray arr
 495         w0 <- readArray d_arr 0
 496         w1 <- readArray d_arr 1
 497         return [w0 :: Word,w1]
 498      )
 499    | wORD_SIZE == 8
 500    = runST (do
 501         arr <- newArray_ ((0::Int),0)
 502         writeArray arr 0 ii
 503         d_arr <- castSTUArray arr
 504         w0 <- readArray d_arr 0
 505         return [w0 :: Word]
 506      )
 507
 508 mkLitI i
 509    = runST (do
 510         arr <- newArray_ ((0::Int),0)
 511         writeArray arr 0 i
 512         i_arr <- castSTUArray arr
 513         w0 <- readArray i_arr 0
 514         return [w0 :: Word]
 515      )
 516
 517 mkLitPtr a
 518    = runST (do
 519         arr <- newArray_ ((0::Int),0)
 520         writeArray arr 0 a
 521         a_arr <- castSTUArray arr
 522         w0 <- readArray a_arr 0
 523         return [w0 :: Word]
 524      )
 525
 526 iNTERP_STACK_CHECK_THRESH = (INTERP_STACK_CHECK_THRESH :: Int)
 527 \end{code}