\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module ByteCodeLink (
HValue,
ClosureEnv, emptyClosureEnv, extendClosureEnv,
import PackageConfig
import FastString
import Panic
-
-#ifdef DEBUG
import Outputable
-#endif
-- Standard libraries
import GHC.Word ( Word(..) )
import Data.Array.Base
import GHC.Arr ( STArray(..) )
-import Control.Exception ( throwDyn )
import Control.Monad ( zipWithM )
import Control.Monad.ST ( stToIO )
ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
let
- ptrs_parr = case ptrs_arr of Array lo hi parr -> parr
+ !ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
literals_arr = listArray (0, n_literals-1) linked_literals
:: UArray Int Word
- literals_barr = case literals_arr of UArray lo hi barr -> barr
+ !literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
- (I# arity#) = arity
+ !(I# arity#) = arity
newBCO insns_barr literals_barr ptrs_parr arity# bitmap
instance MArray IOArray e IO where
getBounds (IOArray marr) = stToIO $ getBounds marr
+ getNumElements (IOArray marr) = stToIO $ getNumElements marr
newArray lu init = stToIO $ do
marr <- newArray lu init; return (IOArray marr)
newArray_ lu = stToIO $ do
-- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
writeArrayBCO :: IOArray Int a -> Int -> BCO# -> IO ()
-writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
+writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
(# s#, () #) }
linkFail :: String -> String -> IO a
linkFail who what
- = throwDyn (ProgramError $
+ = ghcError (ProgramError $
unlines [ ""
, "During interactive linking, GHCi couldn't find the following symbol:"
, ' ' : ' ' : what
else qual_name
where
pkgid = modulePackageId mod
- mod = nameModule n
+ mod = ASSERT( isExternalName n ) nameModule n
package_part = unpackFS (zEncodeFS (packageIdFS (modulePackageId mod)))
module_part = unpackFS (zEncodeFS (moduleNameFS (moduleName mod)))
occ_part = unpackFS (zEncodeFS (occNameFS (nameOccName n)))
primopToCLabel :: PrimOp -> String{-suffix-} -> String
primopToCLabel primop suffix
- = let str = "base_GHCziPrimopWrappers_" ++ unpackFS (zEncodeFS (occNameFS (primOpOcc primop))) ++ '_':suffix
+ = let str = "ghczmprim_GHCziPrimopWrappers_" ++ unpackFS (zEncodeFS (occNameFS (primOpOcc primop))) ++ '_':suffix
in --trace ("primopToCLabel: " ++ str)
str
\end{code}