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