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