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 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 !Word16 [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 -> Word16
 199 sizeSS (SizedSeq n _) = n
 200
 201 -- Bring in all the bci_ bytecode constants.
 202 #include "Bytecodes.h"
 203
 204 largeArgInstr :: Word16 -> Word16
 205 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
 206
 207 largeArg :: Word -> [Word16]
 208 largeArg w
 209  | wORD_SIZE_IN_BITS == 64
 210            = [fromIntegral (w `shiftR` 48),
 211               fromIntegral (w `shiftR` 32),
 212               fromIntegral (w `shiftR` 16),
 213               fromIntegral w]
 214  | wORD_SIZE_IN_BITS == 32
 215            = [fromIntegral (w `shiftR` 16),
 216               fromIntegral w]
 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 :: (Word16 -> Word16)            -- 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 (fromIntegral 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_AP_NOUPD n   -> instr2 st bci_ALLOC_AP_NOUPD n
 274                ALLOC_PAP arity n  -> instr3 st bci_ALLOC_PAP arity n
 275                MKAP      off sz   -> instr3 st bci_MKAP off sz
 276                MKPAP     off sz   -> instr3 st bci_MKPAP off sz
 277                UNPACK    n        -> instr2 st bci_UNPACK n
 278                PACK      dcon sz  -> do (itbl_no,st2) <- itbl st dcon
 279                                         instr3 st2 bci_PACK itbl_no sz
 280                LABEL     _        -> return st
 281                TESTLT_I  i l      -> do (np, st2) <- int st i
 282                                         instr3 st2 bci_TESTLT_I np (findLabel l)
 283                TESTEQ_I  i l      -> do (np, st2) <- int st i
 284                                         instr3 st2 bci_TESTEQ_I np (findLabel l)
 285                TESTLT_F  f l      -> do (np, st2) <- float st f
 286                                         instr3 st2 bci_TESTLT_F np (findLabel l)
 287                TESTEQ_F  f l      -> do (np, st2) <- float st f
 288                                         instr3 st2 bci_TESTEQ_F np (findLabel l)
 289                TESTLT_D  d l      -> do (np, st2) <- double st d
 290                                         instr3 st2 bci_TESTLT_D np (findLabel l)
 291                TESTEQ_D  d l      -> do (np, st2) <- double st d
 292                                         instr3 st2 bci_TESTEQ_D np (findLabel l)
 293                TESTLT_P  i l      -> instr3 st bci_TESTLT_P i (findLabel l)
 294                TESTEQ_P  i l      -> instr3 st bci_TESTEQ_P i (findLabel l)
 295                CASEFAIL           -> instr1 st bci_CASEFAIL
 296                SWIZZLE   stkoff n -> instr3 st bci_SWIZZLE stkoff n
 297                JMP       l        -> instr2 st bci_JMP (findLabel l)
 298                ENTER              -> instr1 st bci_ENTER
 299                RETURN             -> instr1 st bci_RETURN
 300                RETURN_UBX rep     -> instr1 st (return_ubx rep)
 301                CCALL off m_addr   -> do (np, st2) <- addr st m_addr
 302                                         instr3 st2 bci_CCALL off np
 303                BRK_FUN array index info -> do
 304                   (p1, st2) <- ptr st  (BCOPtrArray array)
 305                   (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)
 306                   instr4 st3 bci_BRK_FUN p1 index p2
 307
 308        instrn :: AsmState -> [Word16] -> IO AsmState
 309        instrn st [] = return st
 310        instrn (st_i, st_l, st_p) (i:is)
 311           = do st_i' <- addToSS st_i i
 312                instrn (st_i', st_l, st_p) is
 313
 314        instr1 (st_i0,st_l0,st_p0) i1
 315           = do st_i1 <- addToSS st_i0 i1
 316                return (st_i1,st_l0,st_p0)
 317
 318        instr2 (st_i0,st_l0,st_p0) w1 w2
 319           = do st_i1 <- addToSS st_i0 w1
 320                st_i2 <- addToSS st_i1 w2
 321                return (st_i2,st_l0,st_p0)
 322
 323        instr3 (st_i0,st_l0,st_p0) w1 w2 w3
 324           = do st_i1 <- addToSS st_i0 w1
 325                st_i2 <- addToSS st_i1 w2
 326                st_i3 <- addToSS st_i2 w3
 327                return (st_i3,st_l0,st_p0)
 328
 329        instr4 (st_i0,st_l0,st_p0) w1 w2 w3 w4
 330           = do st_i1 <- addToSS st_i0 w1
 331                st_i2 <- addToSS st_i1 w2
 332                st_i3 <- addToSS st_i2 w3
 333                st_i4 <- addToSS st_i3 w4
 334                return (st_i4,st_l0,st_p0)
 335
 336        float (st_i0,st_l0,st_p0) f
 337           = do let ws = mkLitF f
 338                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 339                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 340
 341        double (st_i0,st_l0,st_p0) d
 342           = do let ws = mkLitD d
 343                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 344                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 345
 346        int (st_i0,st_l0,st_p0) i
 347           = do let ws = mkLitI i
 348                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 349                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 350
 351        int64 (st_i0,st_l0,st_p0) i
 352           = do let ws = mkLitI64 i
 353                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 354                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 355
 356        addr (st_i0,st_l0,st_p0) a
 357           = do let ws = mkLitPtr a
 358                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 359                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 360
 361        litlabel (st_i0,st_l0,st_p0) fs
 362           = do st_l1 <- addListToSS st_l0 [BCONPtrLbl fs]
 363                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 364
 365        ptr (st_i0,st_l0,st_p0) p
 366           = do st_p1 <- addToSS st_p0 p
 367                return (sizeSS st_p0, (st_i0,st_l0,st_p1))
 368
 369        itbl (st_i0,st_l0,st_p0) dcon
 370           = do st_l1 <- addToSS st_l0 (BCONPtrItbl (getName dcon))
 371                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 372
 373 #ifdef mingw32_TARGET_OS
 374        literal st (MachLabel fs (Just sz) _)
 375             = litlabel st (appendFS fs (mkFastString ('@':show sz)))
 376         -- On Windows, stdcall labels have a suffix indicating the no. of
 377         -- arg words, e.g. foo@8.  testcase: ffi012(ghci)
 378 #endif
 379        literal st (MachLabel fs _ _) = litlabel st fs
 380        literal st (MachWord w)     = int st (fromIntegral w)
 381        literal st (MachInt j)      = int st (fromIntegral j)
 382        literal st MachNullAddr     = int st 0
 383        literal st (MachFloat r)    = float st (fromRational r)
 384        literal st (MachDouble r)   = double st (fromRational r)
 385        literal st (MachChar c)     = int st (ord c)
 386        literal st (MachInt64 ii)   = int64 st (fromIntegral ii)
 387        literal st (MachWord64 ii)  = int64 st (fromIntegral ii)
 388        literal _  other            = pprPanic "ByteCodeAsm.literal" (ppr other)
 389
 390
 391 push_alts :: CgRep -> Word16
 392 push_alts NonPtrArg = bci_PUSH_ALTS_N
 393 push_alts FloatArg  = bci_PUSH_ALTS_F
 394 push_alts DoubleArg = bci_PUSH_ALTS_D
 395 push_alts VoidArg   = bci_PUSH_ALTS_V
 396 push_alts LongArg   = bci_PUSH_ALTS_L
 397 push_alts PtrArg    = bci_PUSH_ALTS_P
 398
 399 return_ubx :: CgRep -> Word16
 400 return_ubx NonPtrArg = bci_RETURN_N
 401 return_ubx FloatArg  = bci_RETURN_F
 402 return_ubx DoubleArg = bci_RETURN_D
 403 return_ubx VoidArg   = bci_RETURN_V
 404 return_ubx LongArg   = bci_RETURN_L
 405 return_ubx PtrArg    = bci_RETURN_P
 406
 407
 408 -- The size in 16-bit entities of an instruction.
 409 instrSize16s :: BCInstr -> Word16
 410 instrSize16s instr
 411    = case instr of
 412         STKCHECK{}              -> 2
 413         PUSH_L{}                -> 2
 414         PUSH_LL{}               -> 3
 415         PUSH_LLL{}              -> 4
 416         PUSH_G{}                -> 2
 417         PUSH_PRIMOP{}           -> 2
 418         PUSH_BCO{}              -> 2
 419         PUSH_ALTS{}             -> 2
 420         PUSH_ALTS_UNLIFTED{}    -> 2
 421         PUSH_UBX{}              -> 3
 422         PUSH_APPLY_N{}          -> 1
 423         PUSH_APPLY_V{}          -> 1
 424         PUSH_APPLY_F{}          -> 1
 425         PUSH_APPLY_D{}          -> 1
 426         PUSH_APPLY_L{}          -> 1
 427         PUSH_APPLY_P{}          -> 1
 428         PUSH_APPLY_PP{}         -> 1
 429         PUSH_APPLY_PPP{}        -> 1
 430         PUSH_APPLY_PPPP{}       -> 1
 431         PUSH_APPLY_PPPPP{}      -> 1
 432         PUSH_APPLY_PPPPPP{}     -> 1
 433         SLIDE{}                 -> 3
 434         ALLOC_AP{}              -> 2
 435         ALLOC_AP_NOUPD{}        -> 2
 436         ALLOC_PAP{}             -> 3
 437         MKAP{}                  -> 3
 438         MKPAP{}                 -> 3
 439         UNPACK{}                -> 2
 440         PACK{}                  -> 3
 441         LABEL{}                 -> 0    -- !!
 442         TESTLT_I{}              -> 3
 443         TESTEQ_I{}              -> 3
 444         TESTLT_F{}              -> 3
 445         TESTEQ_F{}              -> 3
 446         TESTLT_D{}              -> 3
 447         TESTEQ_D{}              -> 3
 448         TESTLT_P{}              -> 3
 449         TESTEQ_P{}              -> 3
 450         JMP{}                   -> 2
 451         CASEFAIL{}              -> 1
 452         ENTER{}                 -> 1
 453         RETURN{}                -> 1
 454         RETURN_UBX{}            -> 1
 455         CCALL{}                 -> 3
 456         SWIZZLE{}               -> 3
 457         BRK_FUN{}               -> 4
 458
 459 -- Make lists of host-sized words for literals, so that when the
 460 -- words are placed in memory at increasing addresses, the
 461 -- bit pattern is correct for the host's word size and endianness.
 462 mkLitI   :: Int    -> [Word]
 463 mkLitF   :: Float  -> [Word]
 464 mkLitD   :: Double -> [Word]
 465 mkLitPtr :: Ptr () -> [Word]
 466 mkLitI64 :: Int64  -> [Word]
 467
 468 mkLitF f
 469    = runST (do
 470         arr <- newArray_ ((0::Int),0)
 471         writeArray arr 0 f
 472         f_arr <- castSTUArray arr
 473         w0 <- readArray f_arr 0
 474         return [w0 :: Word]
 475      )
 476
 477 mkLitD d
 478    | wORD_SIZE == 4
 479    = runST (do
 480         arr <- newArray_ ((0::Int),1)
 481         writeArray arr 0 d
 482         d_arr <- castSTUArray arr
 483         w0 <- readArray d_arr 0
 484         w1 <- readArray d_arr 1
 485         return [w0 :: Word, w1]
 486      )
 487    | wORD_SIZE == 8
 488    = runST (do
 489         arr <- newArray_ ((0::Int),0)
 490         writeArray arr 0 d
 491         d_arr <- castSTUArray arr
 492         w0 <- readArray d_arr 0
 493         return [w0 :: Word]
 494      )
 495    | otherwise
 496    = panic "mkLitD: Bad wORD_SIZE"
 497
 498 mkLitI64 ii
 499    | wORD_SIZE == 4
 500    = runST (do
 501         arr <- newArray_ ((0::Int),1)
 502         writeArray arr 0 ii
 503         d_arr <- castSTUArray arr
 504         w0 <- readArray d_arr 0
 505         w1 <- readArray d_arr 1
 506         return [w0 :: Word,w1]
 507      )
 508    | wORD_SIZE == 8
 509    = runST (do
 510         arr <- newArray_ ((0::Int),0)
 511         writeArray arr 0 ii
 512         d_arr <- castSTUArray arr
 513         w0 <- readArray d_arr 0
 514         return [w0 :: Word]
 515      )
 516    | otherwise
 517    = panic "mkLitI64: Bad wORD_SIZE"
 518
 519 mkLitI i
 520    = runST (do
 521         arr <- newArray_ ((0::Int),0)
 522         writeArray arr 0 i
 523         i_arr <- castSTUArray arr
 524         w0 <- readArray i_arr 0
 525         return [w0 :: Word]
 526      )
 527
 528 mkLitPtr a
 529    = runST (do
 530         arr <- newArray_ ((0::Int),0)
 531         writeArray arr 0 a
 532         a_arr <- castSTUArray arr
 533         w0 <- readArray a_arr 0
 534         return [w0 :: Word]
 535      )
 536
 537 iNTERP_STACK_CHECK_THRESH :: Int
 538 iNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH
 539 \end{code}