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