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 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.Bits
  46 import Data.Int         ( Int64 )
  47 import Data.Char        ( ord )
  48
  49 import GHC.Base         ( ByteArray#, MutableByteArray#, RealWorld )
  50 import GHC.IOBase       ( IO(..) )
  51 import GHC.Ptr          ( Ptr(..) )
  52
  53 -- -----------------------------------------------------------------------------
  54 -- Unlinked BCOs
  55
  56 -- CompiledByteCode represents the result of byte-code
  57 -- compiling a bunch of functions and data types
  58
  59 data CompiledByteCode
  60   = ByteCode [UnlinkedBCO] -- Bunch of interpretable bindings
  61              ItblEnv       -- A mapping from DataCons to their itbls
  62
  63 instance Outputable CompiledByteCode where
  64   ppr (ByteCode bcos _) = ppr bcos
  65
  66
  67 data UnlinkedBCO
  68    = UnlinkedBCO {
  69         unlinkedBCOName   :: Name,
  70         unlinkedBCOArity  :: Int,
  71         unlinkedBCOInstrs :: ByteArray#,                 -- insns
  72         unlinkedBCOBitmap :: ByteArray#,                 -- bitmap
  73         unlinkedBCOLits   :: (SizedSeq BCONPtr),        -- non-ptrs
  74         unlinkedBCOPtrs   :: (SizedSeq BCOPtr)          -- ptrs
  75    }
  76
  77 data BCOPtr
  78   = BCOPtrName   Name
  79   | BCOPtrPrimOp PrimOp
  80   | BCOPtrBCO    UnlinkedBCO
  81   | BCOPtrBreakInfo  BreakInfo
  82   | BCOPtrArray (MutableByteArray# RealWorld)
  83
  84 data BCONPtr
  85   = BCONPtrWord  Word
  86   | BCONPtrLbl   FastString
  87   | BCONPtrItbl  Name
  88
  89 -- | Finds external references.  Remember to remove the names
  90 -- defined by this group of BCOs themselves
  91 bcoFreeNames :: UnlinkedBCO -> NameSet
  92 bcoFreeNames bco
  93   = bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
  94   where
  95     bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
  96         = unionManyNameSets (
  97              mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
  98              mkNameSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :
  99              map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
 100           )
 101
 102 instance Outputable UnlinkedBCO where
 103    ppr (UnlinkedBCO nm arity insns bitmap lits ptrs)
 104       = sep [text "BCO", ppr nm, text "with",
 105              int (sizeSS lits), text "lits",
 106              int (sizeSS ptrs), text "ptrs" ]
 107
 108 -- -----------------------------------------------------------------------------
 109 -- The bytecode assembler
 110
 111 -- The object format for bytecodes is: 16 bits for the opcode, and 16
 112 -- for each field -- so the code can be considered a sequence of
 113 -- 16-bit ints.  Each field denotes either a stack offset or number of
 114 -- items on the stack (eg SLIDE), and index into the pointer table (eg
 115 -- PUSH_G), an index into the literal table (eg PUSH_I/D/L), or a
 116 -- bytecode address in this BCO.
 117
 118 -- Top level assembler fn.
 119 assembleBCOs :: [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode
 120 assembleBCOs proto_bcos tycons
 121   = do  itblenv <- mkITbls tycons
 122         bcos    <- mapM assembleBCO proto_bcos
 123         return (ByteCode bcos itblenv)
 124
 125 assembleBCO :: ProtoBCO Name -> IO UnlinkedBCO
 126 assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
 127    = let
 128          -- pass 1: collect up the offsets of the local labels.
 129          -- Remember that the first insn starts at offset 1 since offset 0
 130          -- (eventually) will hold the total # of insns.
 131          label_env = mkLabelEnv emptyFM 1 instrs
 132
 133          mkLabelEnv env i_offset [] = env
 134          mkLabelEnv env i_offset (i:is)
 135             = let new_env
 136                      = case i of LABEL n -> addToFM env n i_offset ; _ -> env
 137               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 138
 139          findLabel lab
 140             = case lookupFM label_env lab of
 141                  Just bco_offset -> bco_offset
 142                  Nothing -> pprPanic "assembleBCO.findLabel" (int lab)
 143      in
 144      do  -- pass 2: generate the instruction, ptr and nonptr bits
 145          insns <- return emptySS :: IO (SizedSeq Word16)
 146          lits  <- return emptySS :: IO (SizedSeq BCONPtr)
 147          ptrs  <- return emptySS :: IO (SizedSeq BCOPtr)
 148          let init_asm_state = (insns,lits,ptrs)
 149          (final_insns, final_lits, final_ptrs)
 150             <- mkBits findLabel init_asm_state instrs
 151
 152          let asm_insns = ssElts final_insns
 153              n_insns   = sizeSS final_insns
 154
 155              insns_arr
 156                  | n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
 157                  | otherwise = mkInstrArray n_insns asm_insns
 158              insns_barr = case insns_arr of UArray _lo _hi barr -> barr
 159
 160              bitmap_arr = mkBitmapArray bsize bitmap
 161              bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
 162
 163          let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
 164
 165          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
 166          -- objects, since they might get run too early.  Disable this until
 167          -- we figure out what to do.
 168          -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
 169
 170          return ul_bco
 171      -- where
 172      --     zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
 173      --                      free ptr
 174
 175 mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
 176 mkBitmapArray bsize bitmap
 177   = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
 178
 179 mkInstrArray :: Int -> [Word16] -> UArray Int Word16
 180 mkInstrArray n_insns asm_insns
 181   = listArray (0, n_insns) (fromIntegral n_insns : asm_insns)
 182
 183 -- instrs nonptrs ptrs
 184 type AsmState = (SizedSeq Word16,
 185                  SizedSeq BCONPtr,
 186                  SizedSeq BCOPtr)
 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 largeArgInstr :: Int -> Int
 206 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
 207
 208 largeArg :: Int -> [Int]
 209 largeArg i
 210  | wORD_SIZE_IN_BITS == 64
 211            = [(i .&. 0xFFFF000000000000) `shiftR` 48,
 212               (i .&. 0x0000FFFF00000000) `shiftR` 32,
 213               (i .&. 0x00000000FFFF0000) `shiftR` 16,
 214               (i .&. 0x000000000000FFFF)]
 215  | wORD_SIZE_IN_BITS == 32
 216            = [(i .&. 0xFFFF0000) `shiftR` 16,
 217               (i .&. 0x0000FFFF)]
 218  | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
 219
 220 -- This is where all the action is (pass 2 of the assembler)
 221 mkBits :: (Int -> Int)                  -- label finder
 222        -> AsmState
 223        -> [BCInstr]                     -- instructions (in)
 224        -> IO AsmState
 225
 226 mkBits findLabel st proto_insns
 227   = foldM doInstr st proto_insns
 228     where
 229        doInstr :: AsmState -> BCInstr -> IO AsmState
 230        doInstr st i
 231           = case i of
 232                STKCHECK  n
 233                 | n > 65535 ->
 234                        instrn st (largeArgInstr bci_STKCHECK : largeArg n)
 235                 | otherwise -> instr2 st bci_STKCHECK n
 236                PUSH_L    o1       -> instr2 st bci_PUSH_L o1
 237                PUSH_LL   o1 o2    -> instr3 st bci_PUSH_LL o1 o2
 238                PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
 239                PUSH_G    nm       -> do (p, st2) <- ptr st (BCOPtrName nm)
 240                                         instr2 st2 bci_PUSH_G p
 241                PUSH_PRIMOP op     -> do (p, st2) <- ptr st (BCOPtrPrimOp op)
 242                                         instr2 st2 bci_PUSH_G p
 243                PUSH_BCO proto     -> do ul_bco <- assembleBCO proto
 244                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
 245                                         instr2 st2 bci_PUSH_G p
 246                PUSH_ALTS proto    -> do ul_bco <- assembleBCO proto
 247                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
 248                                         instr2 st2 bci_PUSH_ALTS p
 249                PUSH_ALTS_UNLIFTED proto pk -> do
 250                                         ul_bco <- assembleBCO proto
 251                                         (p, st2) <- ptr st (BCOPtrBCO ul_bco)
 252                                         instr2 st2 (push_alts pk) p
 253                PUSH_UBX  (Left lit) nws
 254                                   -> do (np, st2) <- literal st lit
 255                                         instr3 st2 bci_PUSH_UBX np nws
 256                PUSH_UBX  (Right aa) nws
 257                                   -> do (np, st2) <- addr st aa
 258                                         instr3 st2 bci_PUSH_UBX np nws
 259
 260                PUSH_APPLY_N         -> do instr1 st bci_PUSH_APPLY_N
 261                PUSH_APPLY_V         -> do instr1 st bci_PUSH_APPLY_V
 262                PUSH_APPLY_F         -> do instr1 st bci_PUSH_APPLY_F
 263                PUSH_APPLY_D         -> do instr1 st bci_PUSH_APPLY_D
 264                PUSH_APPLY_L         -> do instr1 st bci_PUSH_APPLY_L
 265                PUSH_APPLY_P         -> do instr1 st bci_PUSH_APPLY_P
 266                PUSH_APPLY_PP        -> do instr1 st bci_PUSH_APPLY_PP
 267                PUSH_APPLY_PPP       -> do instr1 st bci_PUSH_APPLY_PPP
 268                PUSH_APPLY_PPPP      -> do instr1 st bci_PUSH_APPLY_PPPP
 269                PUSH_APPLY_PPPPP     -> do instr1 st bci_PUSH_APPLY_PPPPP
 270                PUSH_APPLY_PPPPPP    -> do instr1 st bci_PUSH_APPLY_PPPPPP
 271
 272                SLIDE     n by     -> instr3 st bci_SLIDE n by
 273                ALLOC_AP  n        -> instr2 st bci_ALLOC_AP 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     lab      -> 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                PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
 308
 309        i2s :: Int -> Word16
 310        i2s = fromIntegral
 311
 312        instrn :: AsmState -> [Int] -> IO AsmState
 313        instrn st [] = return st
 314        instrn (st_i, st_l, st_p) (i:is)
 315           = do st_i' <- addToSS st_i (i2s i)
 316                instrn (st_i', st_l, st_p) is
 317
 318        instr1 (st_i0,st_l0,st_p0) i1
 319           = do st_i1 <- addToSS st_i0 i1
 320                return (st_i1,st_l0,st_p0)
 321
 322        instr2 (st_i0,st_l0,st_p0) i1 i2
 323           = do st_i1 <- addToSS st_i0 (i2s i1)
 324                st_i2 <- addToSS st_i1 (i2s i2)
 325                return (st_i2,st_l0,st_p0)
 326
 327        instr3 (st_i0,st_l0,st_p0) i1 i2 i3
 328           = do st_i1 <- addToSS st_i0 (i2s i1)
 329                st_i2 <- addToSS st_i1 (i2s i2)
 330                st_i3 <- addToSS st_i2 (i2s i3)
 331                return (st_i3,st_l0,st_p0)
 332
 333        instr4 (st_i0,st_l0,st_p0) i1 i2 i3 i4
 334           = do st_i1 <- addToSS st_i0 (i2s i1)
 335                st_i2 <- addToSS st_i1 (i2s i2)
 336                st_i3 <- addToSS st_i2 (i2s i3)
 337                st_i4 <- addToSS st_i3 (i2s i4)
 338                return (st_i4,st_l0,st_p0)
 339
 340        float (st_i0,st_l0,st_p0) f
 341           = do let ws = mkLitF f
 342                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 343                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 344
 345        double (st_i0,st_l0,st_p0) d
 346           = do let ws = mkLitD d
 347                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 348                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 349
 350        int (st_i0,st_l0,st_p0) i
 351           = do let ws = mkLitI i
 352                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 353                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 354
 355        int64 (st_i0,st_l0,st_p0) i
 356           = do let ws = mkLitI64 i
 357                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 358                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 359
 360        addr (st_i0,st_l0,st_p0) a
 361           = do let ws = mkLitPtr a
 362                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
 363                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 364
 365        litlabel (st_i0,st_l0,st_p0) fs
 366           = do st_l1 <- addListToSS st_l0 [BCONPtrLbl fs]
 367                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 368
 369        ptr (st_i0,st_l0,st_p0) p
 370           = do st_p1 <- addToSS st_p0 p
 371                return (sizeSS st_p0, (st_i0,st_l0,st_p1))
 372
 373        itbl (st_i0,st_l0,st_p0) dcon
 374           = do st_l1 <- addToSS st_l0 (BCONPtrItbl (getName dcon))
 375                return (sizeSS st_l0, (st_i0,st_l1,st_p0))
 376
 377 #ifdef mingw32_TARGET_OS
 378        literal st (MachLabel fs (Just sz))
 379             = litlabel st (appendFS fs (mkFastString ('@':show sz)))
 380         -- On Windows, stdcall labels have a suffix indicating the no. of
 381         -- arg words, e.g. foo@8.  testcase: ffi012(ghci)
 382 #endif
 383        literal st (MachLabel fs _) = litlabel st fs
 384        literal st (MachWord w)     = int st (fromIntegral w)
 385        literal st (MachInt j)      = int st (fromIntegral j)
 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 st other            = pprPanic "ByteCodeLink.literal" (ppr other)
 392
 393
 394 push_alts NonPtrArg = bci_PUSH_ALTS_N
 395 push_alts FloatArg  = bci_PUSH_ALTS_F
 396 push_alts DoubleArg = bci_PUSH_ALTS_D
 397 push_alts VoidArg   = bci_PUSH_ALTS_V
 398 push_alts LongArg   = bci_PUSH_ALTS_L
 399 push_alts PtrArg    = bci_PUSH_ALTS_P
 400
 401 return_ubx NonPtrArg = bci_RETURN_N
 402 return_ubx FloatArg  = bci_RETURN_F
 403 return_ubx DoubleArg = bci_RETURN_D
 404 return_ubx VoidArg   = bci_RETURN_V
 405 return_ubx LongArg   = bci_RETURN_L
 406 return_ubx PtrArg    = bci_RETURN_P
 407
 408
 409 -- The size in 16-bit entities of an instruction.
 410 instrSize16s :: BCInstr -> Int
 411 instrSize16s instr
 412    = case instr of
 413         STKCHECK{}              -> 2
 414         PUSH_L{}                -> 2
 415         PUSH_LL{}               -> 3
 416         PUSH_LLL{}              -> 4
 417         PUSH_G{}                -> 2
 418         PUSH_PRIMOP{}           -> 2
 419         PUSH_BCO{}              -> 2
 420         PUSH_ALTS{}             -> 2
 421         PUSH_ALTS_UNLIFTED{}    -> 2
 422         PUSH_UBX{}              -> 3
 423         PUSH_APPLY_N{}          -> 1
 424         PUSH_APPLY_V{}          -> 1
 425         PUSH_APPLY_F{}          -> 1
 426         PUSH_APPLY_D{}          -> 1
 427         PUSH_APPLY_L{}          -> 1
 428         PUSH_APPLY_P{}          -> 1
 429         PUSH_APPLY_PP{}         -> 1
 430         PUSH_APPLY_PPP{}        -> 1
 431         PUSH_APPLY_PPPP{}       -> 1
 432         PUSH_APPLY_PPPPP{}      -> 1
 433         PUSH_APPLY_PPPPPP{}     -> 1
 434         SLIDE{}                 -> 3
 435         ALLOC_AP{}              -> 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
 496 mkLitI64 ii
 497    | wORD_SIZE == 4
 498    = runST (do
 499         arr <- newArray_ ((0::Int),1)
 500         writeArray arr 0 ii
 501         d_arr <- castSTUArray arr
 502         w0 <- readArray d_arr 0
 503         w1 <- readArray d_arr 1
 504         return [w0 :: Word,w1]
 505      )
 506    | wORD_SIZE == 8
 507    = runST (do
 508         arr <- newArray_ ((0::Int),0)
 509         writeArray arr 0 ii
 510         d_arr <- castSTUArray arr
 511         w0 <- readArray d_arr 0
 512         return [w0 :: Word]
 513      )
 514
 515 mkLitI i
 516    = runST (do
 517         arr <- newArray_ ((0::Int),0)
 518         writeArray arr 0 i
 519         i_arr <- castSTUArray arr
 520         w0 <- readArray i_arr 0
 521         return [w0 :: Word]
 522      )
 523
 524 mkLitPtr a
 525    = runST (do
 526         arr <- newArray_ ((0::Int),0)
 527         writeArray arr 0 a
 528         a_arr <- castSTUArray arr
 529         w0 <- readArray a_arr 0
 530         return [w0 :: Word]
 531      )
 532
 533 iNTERP_STACK_CHECK_THRESH = (INTERP_STACK_CHECK_THRESH :: Int)
 534 \end{code}