ghc/compiler/ghci/ByteCodeAsm.lhs

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