Allow more than 64k instructions in a BCO; fixes #789
[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
125          --     sizeOf Word / sizeOf Word16
126          -- since offset 0 (eventually) will hold the total # of insns.
127          lableInitialOffset
128           | wORD_SIZE_IN_BITS == 64 = 4
129           | wORD_SIZE_IN_BITS == 32 = 2
130           | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
131          label_env = mkLabelEnv emptyFM lableInitialOffset instrs
132
133          mkLabelEnv :: FiniteMap Word16 Word -> Word -> [BCInstr]
134                     -> FiniteMap Word16 Word
135          mkLabelEnv env _ [] = env
136          mkLabelEnv env i_offset (i:is)
137             = let new_env
138                      = case i of LABEL n -> addToFM env n i_offset ; _ -> env
139               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
140
141          findLabel :: Word16 -> Word
142          findLabel lab
143             = case lookupFM label_env lab of
144                  Just bco_offset -> bco_offset
145                  Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab)
146      in
147      do  -- pass 2: generate the instruction, ptr and nonptr bits
148          insns <- return emptySS :: IO (SizedSeq Word16)
149          lits  <- return emptySS :: IO (SizedSeq BCONPtr)
150          ptrs  <- return emptySS :: IO (SizedSeq BCOPtr)
151          let init_asm_state = (insns,lits,ptrs)
152          (final_insns, final_lits, final_ptrs)
153             <- mkBits findLabel init_asm_state instrs
154
155          let asm_insns = ssElts final_insns
156              n_insns   = sizeSS final_insns
157
158              insns_arr = mkInstrArray lableInitialOffset n_insns asm_insns
159              !insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
160
161              bitmap_arr = mkBitmapArray bsize bitmap
162              !bitmap_barr = case bitmap_arr of UArray _lo _hi _n barr -> barr
163
164          let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
165
166          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
167          -- objects, since they might get run too early.  Disable this until
168          -- we figure out what to do.
169          -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
170
171          return ul_bco
172      -- where
173      --     zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
174      --                      free ptr
175
176 mkBitmapArray :: Word16 -> [StgWord] -> UArray Int StgWord
177 mkBitmapArray bsize bitmap
178   = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
179
180 mkInstrArray :: Word -> Word -> [Word16] -> UArray Word Word16
181 mkInstrArray lableInitialOffset n_insns asm_insns
182   = let size = lableInitialOffset + n_insns
183     in listArray (0, size - 1) (largeArg size ++ asm_insns)
184
185 -- instrs nonptrs ptrs
186 type AsmState = (SizedSeq Word16,
187                  SizedSeq BCONPtr,
188                  SizedSeq BCOPtr)
189
190 data SizedSeq a = SizedSeq !Word [a]
191 emptySS :: SizedSeq a
192 emptySS = SizedSeq 0 []
193
194 -- Why are these two monadic???
195 addToSS :: SizedSeq a -> a -> IO (SizedSeq a)
196 addToSS (SizedSeq n r_xs) x = return (SizedSeq (n+1) (x:r_xs))
197 addListToSS :: SizedSeq a -> [a] -> IO (SizedSeq a)
198 addListToSS (SizedSeq n r_xs) xs
199    = return (SizedSeq (n + genericLength xs) (reverse xs ++ r_xs))
200
201 ssElts :: SizedSeq a -> [a]
202 ssElts (SizedSeq _ r_xs) = reverse r_xs
203
204 sizeSS :: SizedSeq a -> Word
205 sizeSS (SizedSeq n _) = n
206
207 sizeSS16 :: SizedSeq a -> Word16
208 sizeSS16 (SizedSeq n _) = fromIntegral n
209
210 -- Bring in all the bci_ bytecode constants.
211 #include "Bytecodes.h"
212
213 largeArgInstr :: Word16 -> Word16
214 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
215
216 largeArg :: Word -> [Word16]
217 largeArg w
218  | wORD_SIZE_IN_BITS == 64
219            = [fromIntegral (w `shiftR` 48),
220               fromIntegral (w `shiftR` 32),
221               fromIntegral (w `shiftR` 16),
222               fromIntegral w]
223  | wORD_SIZE_IN_BITS == 32
224            = [fromIntegral (w `shiftR` 16),
225               fromIntegral w]
226  | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
227
228 -- This is where all the action is (pass 2 of the assembler)
229 mkBits :: (Word16 -> Word)              -- label finder
230        -> AsmState
231        -> [BCInstr]                     -- instructions (in)
232        -> IO AsmState
233
234 mkBits findLabel st proto_insns
235   = foldM doInstr st proto_insns
236     where
237        doInstr :: AsmState -> BCInstr -> IO AsmState
238        doInstr st i
239           = case i of
240                STKCHECK  n -> instr1Large st bci_STKCHECK n
241                PUSH_L    o1       -> instr2 st bci_PUSH_L o1
242                PUSH_LL   o1 o2    -> instr3 st bci_PUSH_LL o1 o2
243                PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
244                PUSH_G    nm       -> do (p, st2) <- ptr st (BCOPtrName nm)
245                                         instr2 st2 bci_PUSH_G p
246                PUSH_PRIMOP op     -> do (p, st2) <- ptr st (BCOPtrPrimOp op)
247                                         instr2 st2 bci_PUSH_G p
248                PUSH_BCO proto     -> do ul_bco <- assembleBCO proto
249                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
250                                         instr2 st2 bci_PUSH_G p
251                PUSH_ALTS proto    -> do ul_bco <- assembleBCO proto
252                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
253                                         instr2 st2 bci_PUSH_ALTS p
254                PUSH_ALTS_UNLIFTED proto pk -> do
255                                         ul_bco <- assembleBCO proto
256                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
257                                         instr2 st2 (push_alts pk) p
258                PUSH_UBX  (Left lit) nws
259                                   -> do (np, st2) <- literal st lit
260                                         instr3 st2 bci_PUSH_UBX np nws
261                PUSH_UBX  (Right aa) nws
262                                   -> do (np, st2) <- addr st aa
263                                         instr3 st2 bci_PUSH_UBX np nws
264
265                PUSH_APPLY_N         -> do instr1 st bci_PUSH_APPLY_N
266                PUSH_APPLY_V         -> do instr1 st bci_PUSH_APPLY_V
267                PUSH_APPLY_F         -> do instr1 st bci_PUSH_APPLY_F
268                PUSH_APPLY_D         -> do instr1 st bci_PUSH_APPLY_D
269                PUSH_APPLY_L         -> do instr1 st bci_PUSH_APPLY_L
270                PUSH_APPLY_P         -> do instr1 st bci_PUSH_APPLY_P
271                PUSH_APPLY_PP        -> do instr1 st bci_PUSH_APPLY_PP
272                PUSH_APPLY_PPP       -> do instr1 st bci_PUSH_APPLY_PPP
273                PUSH_APPLY_PPPP      -> do instr1 st bci_PUSH_APPLY_PPPP
274                PUSH_APPLY_PPPPP     -> do instr1 st bci_PUSH_APPLY_PPPPP
275                PUSH_APPLY_PPPPPP    -> do instr1 st bci_PUSH_APPLY_PPPPPP
276
277                SLIDE     n by     -> instr3 st bci_SLIDE n by
278                ALLOC_AP  n        -> instr2 st bci_ALLOC_AP n
279                ALLOC_AP_NOUPD n   -> instr2 st bci_ALLOC_AP_NOUPD n
280                ALLOC_PAP arity n  -> instr3 st bci_ALLOC_PAP arity n
281                MKAP      off sz   -> instr3 st bci_MKAP off sz
282                MKPAP     off sz   -> instr3 st bci_MKPAP off sz
283                UNPACK    n        -> instr2 st bci_UNPACK n
284                PACK      dcon sz  -> do (itbl_no,st2) <- itbl st dcon
285                                         instr3 st2 bci_PACK itbl_no sz
286                LABEL     _        -> return st
287                TESTLT_I  i l      -> do (np, st2) <- int st i
288                                         instr2Large st2 bci_TESTLT_I np (findLabel l)
289                TESTEQ_I  i l      -> do (np, st2) <- int st i
290                                         instr2Large st2 bci_TESTEQ_I np (findLabel l)
291                TESTLT_F  f l      -> do (np, st2) <- float st f
292                                         instr2Large st2 bci_TESTLT_F np (findLabel l)
293                TESTEQ_F  f l      -> do (np, st2) <- float st f
294                                         instr2Large st2 bci_TESTEQ_F np (findLabel l)
295                TESTLT_D  d l      -> do (np, st2) <- double st d
296                                         instr2Large st2 bci_TESTLT_D np (findLabel l)
297                TESTEQ_D  d l      -> do (np, st2) <- double st d
298                                         instr2Large st2 bci_TESTEQ_D np (findLabel l)
299                TESTLT_P  i l      -> instr2Large st bci_TESTLT_P i (findLabel l)
300                TESTEQ_P  i l      -> instr2Large st bci_TESTEQ_P i (findLabel l)
301                CASEFAIL           -> instr1 st bci_CASEFAIL
302                SWIZZLE   stkoff n -> instr3 st bci_SWIZZLE stkoff n
303                JMP       l        -> instr1Large st bci_JMP (findLabel l)
304                ENTER              -> instr1 st bci_ENTER
305                RETURN             -> instr1 st bci_RETURN
306                RETURN_UBX rep     -> instr1 st (return_ubx rep)
307                CCALL off m_addr   -> do (np, st2) <- addr st m_addr
308                                         instr3 st2 bci_CCALL off np
309                BRK_FUN array index info -> do
310                   (p1, st2) <- ptr st  (BCOPtrArray array)
311                   (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)
312                   instr4 st3 bci_BRK_FUN p1 index p2
313
314        instrn :: AsmState -> [Word16] -> IO AsmState
315        instrn st [] = return st
316        instrn (st_i, st_l, st_p) (i:is)
317           = do st_i' <- addToSS st_i i
318                instrn (st_i', st_l, st_p) is
319
320        instr1Large st i1 large
321         | large > 65535 = instrn st (largeArgInstr i1 : largeArg large)
322         | otherwise = instr2 st i1 (fromIntegral large)
323
324        instr2Large st i1 i2 large
325         | large > 65535 = instrn st (largeArgInstr i1 : i2 : largeArg large)
326         | otherwise = instr3 st i1 i2 (fromIntegral large)
327
328        instr1 (st_i0,st_l0,st_p0) i1
329           = do st_i1 <- addToSS st_i0 i1
330                return (st_i1,st_l0,st_p0)
331
332        instr2 (st_i0,st_l0,st_p0) w1 w2
333           = do st_i1 <- addToSS st_i0 w1
334                st_i2 <- addToSS st_i1 w2
335                return (st_i2,st_l0,st_p0)
336
337        instr3 (st_i0,st_l0,st_p0) w1 w2 w3
338           = do st_i1 <- addToSS st_i0 w1
339                st_i2 <- addToSS st_i1 w2
340                st_i3 <- addToSS st_i2 w3
341                return (st_i3,st_l0,st_p0)
342
343        instr4 (st_i0,st_l0,st_p0) w1 w2 w3 w4
344           = do st_i1 <- addToSS st_i0 w1
345                st_i2 <- addToSS st_i1 w2
346                st_i3 <- addToSS st_i2 w3
347                st_i4 <- addToSS st_i3 w4
348                return (st_i4,st_l0,st_p0)
349
350        float (st_i0,st_l0,st_p0) f
351           = do let ws = mkLitF f
352                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
353                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
354
355        double (st_i0,st_l0,st_p0) d
356           = do let ws = mkLitD d
357                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
358                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
359
360        int (st_i0,st_l0,st_p0) i
361           = do let ws = mkLitI i
362                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
363                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
364
365        int64 (st_i0,st_l0,st_p0) i
366           = do let ws = mkLitI64 i
367                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
368                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
369
370        addr (st_i0,st_l0,st_p0) a
371           = do let ws = mkLitPtr a
372                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
373                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
374
375        litlabel (st_i0,st_l0,st_p0) fs
376           = do st_l1 <- addListToSS st_l0 [BCONPtrLbl fs]
377                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
378
379        ptr (st_i0,st_l0,st_p0) p
380           = do st_p1 <- addToSS st_p0 p
381                return (sizeSS16 st_p0, (st_i0,st_l0,st_p1))
382
383        itbl (st_i0,st_l0,st_p0) dcon
384           = do st_l1 <- addToSS st_l0 (BCONPtrItbl (getName dcon))
385                return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
386
387 #ifdef mingw32_TARGET_OS
388        literal st (MachLabel fs (Just sz) _)
389             = litlabel st (appendFS fs (mkFastString ('@':show sz)))
390         -- On Windows, stdcall labels have a suffix indicating the no. of
391         -- arg words, e.g. foo@8.  testcase: ffi012(ghci)
392 #endif
393        literal st (MachLabel fs _ _) = litlabel st fs
394        literal st (MachWord w)     = int st (fromIntegral w)
395        literal st (MachInt j)      = int st (fromIntegral j)
396        literal st MachNullAddr     = int st 0
397        literal st (MachFloat r)    = float st (fromRational r)
398        literal st (MachDouble r)   = double st (fromRational r)
399        literal st (MachChar c)     = int st (ord c)
400        literal st (MachInt64 ii)   = int64 st (fromIntegral ii)
401        literal st (MachWord64 ii)  = int64 st (fromIntegral ii)
402        literal _  other            = pprPanic "ByteCodeAsm.literal" (ppr other)
403
404
405 push_alts :: CgRep -> Word16
406 push_alts NonPtrArg = bci_PUSH_ALTS_N
407 push_alts FloatArg  = bci_PUSH_ALTS_F
408 push_alts DoubleArg = bci_PUSH_ALTS_D
409 push_alts VoidArg   = bci_PUSH_ALTS_V
410 push_alts LongArg   = bci_PUSH_ALTS_L
411 push_alts PtrArg    = bci_PUSH_ALTS_P
412
413 return_ubx :: CgRep -> Word16
414 return_ubx NonPtrArg = bci_RETURN_N
415 return_ubx FloatArg  = bci_RETURN_F
416 return_ubx DoubleArg = bci_RETURN_D
417 return_ubx VoidArg   = bci_RETURN_V
418 return_ubx LongArg   = bci_RETURN_L
419 return_ubx PtrArg    = bci_RETURN_P
420
421
422 -- The size in 16-bit entities of an instruction.
423 instrSize16s :: BCInstr -> Word
424 instrSize16s instr
425    = case instr of
426         STKCHECK{}              -> 2
427         PUSH_L{}                -> 2
428         PUSH_LL{}               -> 3
429         PUSH_LLL{}              -> 4
430         PUSH_G{}                -> 2
431         PUSH_PRIMOP{}           -> 2
432         PUSH_BCO{}              -> 2
433         PUSH_ALTS{}             -> 2
434         PUSH_ALTS_UNLIFTED{}    -> 2
435         PUSH_UBX{}              -> 3
436         PUSH_APPLY_N{}          -> 1
437         PUSH_APPLY_V{}          -> 1
438         PUSH_APPLY_F{}          -> 1
439         PUSH_APPLY_D{}          -> 1
440         PUSH_APPLY_L{}          -> 1
441         PUSH_APPLY_P{}          -> 1
442         PUSH_APPLY_PP{}         -> 1
443         PUSH_APPLY_PPP{}        -> 1
444         PUSH_APPLY_PPPP{}       -> 1
445         PUSH_APPLY_PPPPP{}      -> 1
446         PUSH_APPLY_PPPPPP{}     -> 1
447         SLIDE{}                 -> 3
448         ALLOC_AP{}              -> 2
449         ALLOC_AP_NOUPD{}        -> 2
450         ALLOC_PAP{}             -> 3
451         MKAP{}                  -> 3
452         MKPAP{}                 -> 3
453         UNPACK{}                -> 2
454         PACK{}                  -> 3
455         LABEL{}                 -> 0    -- !!
456         TESTLT_I{}              -> 3
457         TESTEQ_I{}              -> 3
458         TESTLT_F{}              -> 3
459         TESTEQ_F{}              -> 3
460         TESTLT_D{}              -> 3
461         TESTEQ_D{}              -> 3
462         TESTLT_P{}              -> 3
463         TESTEQ_P{}              -> 3
464         JMP{}                   -> 2
465         CASEFAIL{}              -> 1
466         ENTER{}                 -> 1
467         RETURN{}                -> 1
468         RETURN_UBX{}            -> 1
469         CCALL{}                 -> 3
470         SWIZZLE{}               -> 3
471         BRK_FUN{}               -> 4
472
473 -- Make lists of host-sized words for literals, so that when the
474 -- words are placed in memory at increasing addresses, the
475 -- bit pattern is correct for the host's word size and endianness.
476 mkLitI   :: Int    -> [Word]
477 mkLitF   :: Float  -> [Word]
478 mkLitD   :: Double -> [Word]
479 mkLitPtr :: Ptr () -> [Word]
480 mkLitI64 :: Int64  -> [Word]
481
482 mkLitF f
483    = runST (do
484         arr <- newArray_ ((0::Int),0)
485         writeArray arr 0 f
486         f_arr <- castSTUArray arr
487         w0 <- readArray f_arr 0
488         return [w0 :: Word]
489      )
490
491 mkLitD d
492    | wORD_SIZE == 4
493    = runST (do
494         arr <- newArray_ ((0::Int),1)
495         writeArray arr 0 d
496         d_arr <- castSTUArray arr
497         w0 <- readArray d_arr 0
498         w1 <- readArray d_arr 1
499         return [w0 :: Word, w1]
500      )
501    | wORD_SIZE == 8
502    = runST (do
503         arr <- newArray_ ((0::Int),0)
504         writeArray arr 0 d
505         d_arr <- castSTUArray arr
506         w0 <- readArray d_arr 0
507         return [w0 :: Word]
508      )
509    | otherwise
510    = panic "mkLitD: Bad wORD_SIZE"
511
512 mkLitI64 ii
513    | wORD_SIZE == 4
514    = runST (do
515         arr <- newArray_ ((0::Int),1)
516         writeArray arr 0 ii
517         d_arr <- castSTUArray arr
518         w0 <- readArray d_arr 0
519         w1 <- readArray d_arr 1
520         return [w0 :: Word,w1]
521      )
522    | wORD_SIZE == 8
523    = runST (do
524         arr <- newArray_ ((0::Int),0)
525         writeArray arr 0 ii
526         d_arr <- castSTUArray arr
527         w0 <- readArray d_arr 0
528         return [w0 :: Word]
529      )
530    | otherwise
531    = panic "mkLitI64: Bad wORD_SIZE"
532
533 mkLitI i
534    = runST (do
535         arr <- newArray_ ((0::Int),0)
536         writeArray arr 0 i
537         i_arr <- castSTUArray arr
538         w0 <- readArray i_arr 0
539         return [w0 :: Word]
540      )
541
542 mkLitPtr a
543    = runST (do
544         arr <- newArray_ ((0::Int),0)
545         writeArray arr 0 a
546         a_arr <- castSTUArray arr
547         w0 <- readArray a_arr 0
548         return [w0 :: Word]
549      )
550
551 iNTERP_STACK_CHECK_THRESH :: Int
552 iNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH
553 \end{code}