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 Outputable
  34
  35 import Control.Monad    ( foldM )
  36 import Control.Monad.ST ( runST )
  37
  38 import Data.Array.MArray
  39 import Data.Array.Unboxed ( listArray )
  40 import Data.Array.Base  ( UArray(..) )
  41 import Data.Array.ST    ( castSTUArray )
  42 import Foreign
  43 import Data.Char        ( ord )
  44 import Data.List
  45
  46 import GHC.Base         ( ByteArray#, MutableByteArray#, RealWorld )
  47
  48 -- -----------------------------------------------------------------------------
  49 -- Unlinked BCOs
  50
  51 -- CompiledByteCode represents the result of byte-code
  52 -- compiling a bunch of functions and data types
  53
  54 data CompiledByteCode
  55   = ByteCode [UnlinkedBCO] -- Bunch of interpretable bindings
  56              ItblEnv       -- A mapping from DataCons to their itbls
  57
  58 instance Outputable CompiledByteCode where
  59   ppr (ByteCode bcos _) = ppr bcos
  60
  61
  62 data UnlinkedBCO
  63    = UnlinkedBCO {
  64         unlinkedBCOName   :: Name,
  65         unlinkedBCOArity  :: Int,
  66         unlinkedBCOInstrs :: ByteArray#,                 -- insns
  67         unlinkedBCOBitmap :: ByteArray#,                 -- bitmap
  68         unlinkedBCOLits   :: (SizedSeq BCONPtr),        -- non-ptrs
  69         unlinkedBCOPtrs   :: (SizedSeq BCOPtr)          -- ptrs
  70    }
  71
  72 data BCOPtr
  73   = BCOPtrName   Name
  74   | BCOPtrPrimOp PrimOp
  75   | BCOPtrBCO    UnlinkedBCO
  76   | BCOPtrBreakInfo  BreakInfo
  77   | BCOPtrArray (MutableByteArray# RealWorld)
  78
  79 data BCONPtr
  80   = BCONPtrWord  Word
  81   | BCONPtrLbl   FastString
  82   | BCONPtrItbl  Name
  83
  84 -- | Finds external references.  Remember to remove the names
  85 -- defined by this group of BCOs themselves
  86 bcoFreeNames :: UnlinkedBCO -> NameSet
  87 bcoFreeNames bco
  88   = bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
  89   where
  90     bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
  91         = unionManyNameSets (
  92              mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
  93              mkNameSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :
  94              map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
  95           )
  96
  97 instance Outputable UnlinkedBCO where
  98    ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
  99       = sep [text "BCO", ppr nm, text "with",
 100              ppr (sizeSS lits), text "lits",
 101              ppr (sizeSS ptrs), text "ptrs" ]
 102
 103 -- -----------------------------------------------------------------------------
 104 -- The bytecode assembler
 105
 106 -- The object format for bytecodes is: 16 bits for the opcode, and 16
 107 -- for each field -- so the code can be considered a sequence of
 108 -- 16-bit ints.  Each field denotes either a stack offset or number of
 109 -- items on the stack (eg SLIDE), and index into the pointer table (eg
 110 -- PUSH_G), an index into the literal table (eg PUSH_I/D/L), or a
 111 -- bytecode address in this BCO.
 112
 113 -- Top level assembler fn.
 114 assembleBCOs :: [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode
 115 assembleBCOs proto_bcos tycons
 116   = do  itblenv <- mkITbls tycons
 117         bcos    <- mapM assembleBCO proto_bcos
 118         return (ByteCode bcos itblenv)
 119
 120 assembleBCO :: ProtoBCO Name -> IO UnlinkedBCO
 121 assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced)
 122    = let
 123          -- pass 1: collect up the offsets of the local labels.
 124          -- Remember that the first insn starts at offset 1 since offset 0
 125          -- (eventually) will hold the total # of insns.
 126          label_env = mkLabelEnv emptyFM 1 instrs
 127
 128          mkLabelEnv env _ [] = env
 129          mkLabelEnv env i_offset (i:is)
 130             = let new_env
 131                      = case i of LABEL n -> addToFM env n i_offset ; _ -> env
 132               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 133
 134          findLabel :: Word16 -> Word16
 135          findLabel lab
 136             = case lookupFM label_env lab of
 137                  Just bco_offset -> bco_offset
 138                  Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab)
 139      in
 140      do  -- pass 2: generate the instruction, ptr and nonptr bits
 141          insns <- return emptySS :: IO (SizedSeq Word16)
 142          lits  <- return emptySS :: IO (SizedSeq BCONPtr)
 143          ptrs  <- return emptySS :: IO (SizedSeq BCOPtr)
 144          let init_asm_state = (insns,lits,ptrs)
 145          (final_insns, final_lits, final_ptrs)
 146             <- mkBits findLabel init_asm_state instrs
 147
 148          let asm_insns = ssElts final_insns
 149              n_insns   = sizeSS final_insns
 150
 151              insns_arr
 152                  | n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
 153                  | otherwise = mkInstrArray (fromIntegral n_insns) asm_insns
 154              !insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
 155
 156              bitmap_arr = mkBitmapArray bsize bitmap
 157              !bitmap_barr = case bitmap_arr of UArray _lo _hi _n barr -> barr
 158
 159          let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
 160
 161          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
 162          -- objects, since they might get run too early.  Disable this until
 163          -- we figure out what to do.
 164          -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
 165
 166          return ul_bco
 167      -- where
 168      --     zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
 169      --                      free ptr
 170
 171 mkBitmapArray :: Word16 -> [StgWord] -> UArray Int StgWord
 172 mkBitmapArray bsize bitmap
 173   = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
 174
 175 mkInstrArray :: Word16 -> [Word16] -> UArray Word16 Word16
 176 mkInstrArray n_insns asm_insns
 177   = listArray (0, n_insns) (n_insns : asm_insns)
 178
 179 -- instrs nonptrs ptrs
 180 type AsmState = (SizedSeq Word16,
 181                  SizedSeq BCONPtr,
 182                  SizedSeq BCOPtr)
 183
 184 data SizedSeq a = SizedSeq !Word [a]
 185 emptySS :: SizedSeq a
 186 emptySS = SizedSeq 0 []
 187
 188 -- Why are these two monadic???
 189 addToSS :: SizedSeq a -> a -> IO (SizedSeq a)
 190 addToSS (SizedSeq n r_xs) x = return (SizedSeq (n+1) (x:r_xs))
 191 addListToSS :: SizedSeq a -> [a] -> IO (SizedSeq a)
 192 addListToSS (SizedSeq n r_xs) xs
 193    = return (SizedSeq (n + genericLength xs) (reverse xs ++ r_xs))
 194
 195 ssElts :: SizedSeq a -> [a]
 196 ssElts (SizedSeq _ r_xs) = reverse r_xs
 197
 198 sizeSS :: SizedSeq a -> Word
 199 sizeSS (SizedSeq n _) = n
 200
 201 sizeSS16 :: SizedSeq a -> Word16
 202 sizeSS16 (SizedSeq n _) = fromIntegral n
 203
 204 -- Bring in all the bci_ bytecode constants.
 205 #include "Bytecodes.h"
 206
 207 largeArgInstr :: Word16 -> Word16
 208 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
 209
 210 largeArg :: Word -> [Word16]
 211 largeArg w
 212  | wORD_SIZE_IN_BITS == 64
 213            = [fromIntegral (w `shiftR` 48),
 214               fromIntegral (w `shiftR` 32),
 215               fromIntegral (w `shiftR` 16),
 216               fromIntegral w]
 217  | wORD_SIZE_IN_BITS == 32
 218            = [fromIntegral (w `shiftR` 16),
 219               fromIntegral w]
 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 :: (Word16 -> Word16)            -- 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 (fromIntegral 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        instrn :: AsmState -> [Word16] -> IO AsmState
 312        instrn st [] = return st
 313        instrn (st_i, st_l, st_p) (i:is)
 314           = do st_i' <- addToSS st_i 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) w1 w2
 322           = do st_i1 <- addToSS st_i0 w1
 323                st_i2 <- addToSS st_i1 w2
 324                return (st_i2,st_l0,st_p0)
 325
 326        instr3 (st_i0,st_l0,st_p0) w1 w2 w3
 327           = do st_i1 <- addToSS st_i0 w1
 328                st_i2 <- addToSS st_i1 w2
 329                st_i3 <- addToSS st_i2 w3
 330                return (st_i3,st_l0,st_p0)
 331
 332        instr4 (st_i0,st_l0,st_p0) w1 w2 w3 w4
 333           = do st_i1 <- addToSS st_i0 w1
 334                st_i2 <- addToSS st_i1 w2
 335                st_i3 <- addToSS st_i2 w3
 336                st_i4 <- addToSS st_i3 w4
 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 (sizeSS16 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 (sizeSS16 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 (sizeSS16 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 (sizeSS16 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 (sizeSS16 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 (sizeSS16 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 (sizeSS16 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 (sizeSS16 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 MachNullAddr     = int st 0
 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 _  other            = pprPanic "ByteCodeAsm.literal" (ppr other)
 392
 393
 394 push_alts :: CgRep -> Word16
 395 push_alts NonPtrArg = bci_PUSH_ALTS_N
 396 push_alts FloatArg  = bci_PUSH_ALTS_F
 397 push_alts DoubleArg = bci_PUSH_ALTS_D
 398 push_alts VoidArg   = bci_PUSH_ALTS_V
 399 push_alts LongArg   = bci_PUSH_ALTS_L
 400 push_alts PtrArg    = bci_PUSH_ALTS_P
 401
 402 return_ubx :: CgRep -> Word16
 403 return_ubx NonPtrArg = bci_RETURN_N
 404 return_ubx FloatArg  = bci_RETURN_F
 405 return_ubx DoubleArg = bci_RETURN_D
 406 return_ubx VoidArg   = bci_RETURN_V
 407 return_ubx LongArg   = bci_RETURN_L
 408 return_ubx PtrArg    = bci_RETURN_P
 409
 410
 411 -- The size in 16-bit entities of an instruction.
 412 instrSize16s :: BCInstr -> Word16
 413 instrSize16s instr
 414    = case instr of
 415         STKCHECK{}              -> 2
 416         PUSH_L{}                -> 2
 417         PUSH_LL{}               -> 3
 418         PUSH_LLL{}              -> 4
 419         PUSH_G{}                -> 2
 420         PUSH_PRIMOP{}           -> 2
 421         PUSH_BCO{}              -> 2
 422         PUSH_ALTS{}             -> 2
 423         PUSH_ALTS_UNLIFTED{}    -> 2
 424         PUSH_UBX{}              -> 3
 425         PUSH_APPLY_N{}          -> 1
 426         PUSH_APPLY_V{}          -> 1
 427         PUSH_APPLY_F{}          -> 1
 428         PUSH_APPLY_D{}          -> 1
 429         PUSH_APPLY_L{}          -> 1
 430         PUSH_APPLY_P{}          -> 1
 431         PUSH_APPLY_PP{}         -> 1
 432         PUSH_APPLY_PPP{}        -> 1
 433         PUSH_APPLY_PPPP{}       -> 1
 434         PUSH_APPLY_PPPPP{}      -> 1
 435         PUSH_APPLY_PPPPPP{}     -> 1
 436         SLIDE{}                 -> 3
 437         ALLOC_AP{}              -> 2
 438         ALLOC_AP_NOUPD{}        -> 2
 439         ALLOC_PAP{}             -> 3
 440         MKAP{}                  -> 3
 441         MKPAP{}                 -> 3
 442         UNPACK{}                -> 2
 443         PACK{}                  -> 3
 444         LABEL{}                 -> 0    -- !!
 445         TESTLT_I{}              -> 3
 446         TESTEQ_I{}              -> 3
 447         TESTLT_F{}              -> 3
 448         TESTEQ_F{}              -> 3
 449         TESTLT_D{}              -> 3
 450         TESTEQ_D{}              -> 3
 451         TESTLT_P{}              -> 3
 452         TESTEQ_P{}              -> 3
 453         JMP{}                   -> 2
 454         CASEFAIL{}              -> 1
 455         ENTER{}                 -> 1
 456         RETURN{}                -> 1
 457         RETURN_UBX{}            -> 1
 458         CCALL{}                 -> 3
 459         SWIZZLE{}               -> 3
 460         BRK_FUN{}               -> 4
 461
 462 -- Make lists of host-sized words for literals, so that when the
 463 -- words are placed in memory at increasing addresses, the
 464 -- bit pattern is correct for the host's word size and endianness.
 465 mkLitI   :: Int    -> [Word]
 466 mkLitF   :: Float  -> [Word]
 467 mkLitD   :: Double -> [Word]
 468 mkLitPtr :: Ptr () -> [Word]
 469 mkLitI64 :: Int64  -> [Word]
 470
 471 mkLitF f
 472    = runST (do
 473         arr <- newArray_ ((0::Int),0)
 474         writeArray arr 0 f
 475         f_arr <- castSTUArray arr
 476         w0 <- readArray f_arr 0
 477         return [w0 :: Word]
 478      )
 479
 480 mkLitD d
 481    | wORD_SIZE == 4
 482    = runST (do
 483         arr <- newArray_ ((0::Int),1)
 484         writeArray arr 0 d
 485         d_arr <- castSTUArray arr
 486         w0 <- readArray d_arr 0
 487         w1 <- readArray d_arr 1
 488         return [w0 :: Word, w1]
 489      )
 490    | wORD_SIZE == 8
 491    = runST (do
 492         arr <- newArray_ ((0::Int),0)
 493         writeArray arr 0 d
 494         d_arr <- castSTUArray arr
 495         w0 <- readArray d_arr 0
 496         return [w0 :: Word]
 497      )
 498    | otherwise
 499    = panic "mkLitD: Bad wORD_SIZE"
 500
 501 mkLitI64 ii
 502    | wORD_SIZE == 4
 503    = runST (do
 504         arr <- newArray_ ((0::Int),1)
 505         writeArray arr 0 ii
 506         d_arr <- castSTUArray arr
 507         w0 <- readArray d_arr 0
 508         w1 <- readArray d_arr 1
 509         return [w0 :: Word,w1]
 510      )
 511    | wORD_SIZE == 8
 512    = runST (do
 513         arr <- newArray_ ((0::Int),0)
 514         writeArray arr 0 ii
 515         d_arr <- castSTUArray arr
 516         w0 <- readArray d_arr 0
 517         return [w0 :: Word]
 518      )
 519    | otherwise
 520    = panic "mkLitI64: Bad wORD_SIZE"
 521
 522 mkLitI i
 523    = runST (do
 524         arr <- newArray_ ((0::Int),0)
 525         writeArray arr 0 i
 526         i_arr <- castSTUArray arr
 527         w0 <- readArray i_arr 0
 528         return [w0 :: Word]
 529      )
 530
 531 mkLitPtr a
 532    = runST (do
 533         arr <- newArray_ ((0::Int),0)
 534         writeArray arr 0 a
 535         a_arr <- castSTUArray arr
 536         w0 <- readArray a_arr 0
 537         return [w0 :: Word]
 538      )
 539
 540 iNTERP_STACK_CHECK_THRESH :: Int
 541 iNTERP_STACK_CHECK_THRESH = INTERP_STACK_CHECK_THRESH
 542 \end{code}