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