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