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