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
 308        i2s :: Int -> Word16
 309        i2s = fromIntegral
 310
 311        instrn :: AsmState -> [Int] -> IO AsmState
 312        instrn st [] = return st
 313        instrn (st_i, st_l, st_p) (i:is)
 314           = do st_i' <- addToSS st_i (i2s 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) i1 i2
 322           = do st_i1 <- addToSS st_i0 (i2s i1)
 323                st_i2 <- addToSS st_i1 (i2s i2)
 324                return (st_i2,st_l0,st_p0)
 325
 326        instr3 (st_i0,st_l0,st_p0) i1 i2 i3
 327           = do st_i1 <- addToSS st_i0 (i2s i1)
 328                st_i2 <- addToSS st_i1 (i2s i2)
 329                st_i3 <- addToSS st_i2 (i2s i3)
 330                return (st_i3,st_l0,st_p0)
 331
 332        instr4 (st_i0,st_l0,st_p0) i1 i2 i3 i4
 333           = do st_i1 <- addToSS st_i0 (i2s i1)
 334                st_i2 <- addToSS st_i1 (i2s i2)
 335                st_i3 <- addToSS st_i2 (i2s i3)
 336                st_i4 <- addToSS st_i3 (i2s i4)
 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 (sizeSS 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 (sizeSS 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 (sizeSS 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 (sizeSS 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 (sizeSS 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 (sizeSS 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 (sizeSS 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 (sizeSS 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 (MachFloat r)    = float st (fromRational r)
 386        literal st (MachDouble r)   = double st (fromRational r)
 387        literal st (MachChar c)     = int st (ord c)
 388        literal st (MachInt64 ii)   = int64 st (fromIntegral ii)
 389        literal st (MachWord64 ii)  = int64 st (fromIntegral ii)
 390        literal st other            = pprPanic "ByteCodeLink.literal" (ppr other)
 391
 392
 393 push_alts NonPtrArg = bci_PUSH_ALTS_N
 394 push_alts FloatArg  = bci_PUSH_ALTS_F
 395 push_alts DoubleArg = bci_PUSH_ALTS_D
 396 push_alts VoidArg   = bci_PUSH_ALTS_V
 397 push_alts LongArg   = bci_PUSH_ALTS_L
 398 push_alts PtrArg    = bci_PUSH_ALTS_P
 399
 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 -> Int
 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_PAP{}             -> 3
 436         MKAP{}                  -> 3
 437         MKPAP{}                 -> 3
 438         UNPACK{}                -> 2
 439         PACK{}                  -> 3
 440         LABEL{}                 -> 0    -- !!
 441         TESTLT_I{}              -> 3
 442         TESTEQ_I{}              -> 3
 443         TESTLT_F{}              -> 3
 444         TESTEQ_F{}              -> 3
 445         TESTLT_D{}              -> 3
 446         TESTEQ_D{}              -> 3
 447         TESTLT_P{}              -> 3
 448         TESTEQ_P{}              -> 3
 449         JMP{}                   -> 2
 450         CASEFAIL{}              -> 1
 451         ENTER{}                 -> 1
 452         RETURN{}                -> 1
 453         RETURN_UBX{}            -> 1
 454         CCALL{}                 -> 3
 455         SWIZZLE{}               -> 3
 456         BRK_FUN{}               -> 4
 457
 458 -- Make lists of host-sized words for literals, so that when the
 459 -- words are placed in memory at increasing addresses, the
 460 -- bit pattern is correct for the host's word size and endianness.
 461 mkLitI   :: Int    -> [Word]
 462 mkLitF   :: Float  -> [Word]
 463 mkLitD   :: Double -> [Word]
 464 mkLitPtr :: Ptr () -> [Word]
 465 mkLitI64 :: Int64  -> [Word]
 466
 467 mkLitF f
 468    = runST (do
 469         arr <- newArray_ ((0::Int),0)
 470         writeArray arr 0 f
 471         f_arr <- castSTUArray arr
 472         w0 <- readArray f_arr 0
 473         return [w0 :: Word]
 474      )
 475
 476 mkLitD d
 477    | wORD_SIZE == 4
 478    = runST (do
 479         arr <- newArray_ ((0::Int),1)
 480         writeArray arr 0 d
 481         d_arr <- castSTUArray arr
 482         w0 <- readArray d_arr 0
 483         w1 <- readArray d_arr 1
 484         return [w0 :: Word, w1]
 485      )
 486    | wORD_SIZE == 8
 487    = runST (do
 488         arr <- newArray_ ((0::Int),0)
 489         writeArray arr 0 d
 490         d_arr <- castSTUArray arr
 491         w0 <- readArray d_arr 0
 492         return [w0 :: Word]
 493      )
 494
 495 mkLitI64 ii
 496    | wORD_SIZE == 4
 497    = runST (do
 498         arr <- newArray_ ((0::Int),1)
 499         writeArray arr 0 ii
 500         d_arr <- castSTUArray arr
 501         w0 <- readArray d_arr 0
 502         w1 <- readArray d_arr 1
 503         return [w0 :: Word,w1]
 504      )
 505    | wORD_SIZE == 8
 506    = runST (do
 507         arr <- newArray_ ((0::Int),0)
 508         writeArray arr 0 ii
 509         d_arr <- castSTUArray arr
 510         w0 <- readArray d_arr 0
 511         return [w0 :: Word]
 512      )
 513
 514 mkLitI i
 515    = runST (do
 516         arr <- newArray_ ((0::Int),0)
 517         writeArray arr 0 i
 518         i_arr <- castSTUArray arr
 519         w0 <- readArray i_arr 0
 520         return [w0 :: Word]
 521      )
 522
 523 mkLitPtr a
 524    = runST (do
 525         arr <- newArray_ ((0::Int),0)
 526         writeArray arr 0 a
 527         a_arr <- castSTUArray arr
 528         w0 <- readArray a_arr 0
 529         return [w0 :: Word]
 530      )
 531
 532 iNTERP_STACK_CHECK_THRESH = (INTERP_STACK_CHECK_THRESH :: Int)
 533 \end{code}