projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Beautify a bit
[ghc-hetmet.git]
/
compiler
/
ghci
/
ByteCodeLink.lhs
diff --git
a/compiler/ghci/ByteCodeLink.lhs
b/compiler/ghci/ByteCodeLink.lhs
index
6bca06a
..
3305daa
100644
(file)
--- a/
compiler/ghci/ByteCodeLink.lhs
+++ b/
compiler/ghci/ByteCodeLink.lhs
@@
-1,10
+1,9
@@
%
%
-% (c) The University of Glasgow 2000
+% (c) The University of Glasgow 2000-2006
%
%
-\section[ByteCodeLink]{Bytecode assembler and linker}
+ByteCodeLink: Bytecode assembler and linker
\begin{code}
\begin{code}
-
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module ByteCodeLink (
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module ByteCodeLink (
@@
-15,21
+14,20
@@
module ByteCodeLink (
#include "HsVersions.h"
#include "HsVersions.h"
-import ByteCodeItbls ( ItblEnv, ItblPtr )
-import ByteCodeAsm ( UnlinkedBCO(..), BCOPtr(..), sizeSS, ssElts )
-import ObjLink ( lookupSymbol )
+import ByteCodeItbls
+import ByteCodeAsm
+import ObjLink
-import Name ( Name, nameModule, nameOccName )
+import Name
import NameEnv
import NameEnv
-import OccName ( occNameFS )
-import PrimOp ( PrimOp, primOpOcc )
+import OccName
+import PrimOp
import Module
import Module
-import PackageConfig ( mainPackageId, packageIdFS )
-import FastString ( FastString(..), unpackFS, zEncodeFS )
-import Panic ( GhcException(..) )
+import PackageConfig
+import FastString
+import Panic
#ifdef DEBUG
#ifdef DEBUG
-import Name ( isExternalName )
import Outputable
#endif
import Outputable
#endif
@@
-48,7
+46,7
@@
import GHC.Exts ( BCO#, newBCO#, unsafeCoerce#, Int#,
import GHC.Arr ( Array(..) )
import GHC.IOBase ( IO(..) )
import GHC.Arr ( Array(..) )
import GHC.IOBase ( IO(..) )
-import GHC.Ptr ( Ptr(..) )
+import GHC.Ptr ( Ptr(..), castPtr )
import GHC.Base ( writeArray#, RealWorld, Int(..) )
\end{code}
import GHC.Base ( writeArray#, RealWorld, Int(..) )
\end{code}
@@
-126,7
+124,7
@@
linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS itblsSS
ptrs_parr = case ptrs_arr of Array lo hi parr -> parr
itbls_arr = listArray (0, n_itbls-1) linked_itbls
ptrs_parr = case ptrs_arr of Array lo hi parr -> parr
itbls_arr = listArray (0, n_itbls-1) linked_itbls
- :: UArray Int ItblPtr
+
itbls_barr = case itbls_arr of UArray lo hi barr -> barr
literals_arr = listArray (0, n_literals-1) linked_literals
itbls_barr = case itbls_arr of UArray lo hi barr -> barr
literals_arr = listArray (0, n_literals-1) linked_literals
@@
-224,7
+222,7
@@
lookupName ce nm
lookupIE :: ItblEnv -> Name -> IO (Ptr a)
lookupIE ie con_nm
= case lookupNameEnv ie con_nm of
lookupIE :: ItblEnv -> Name -> IO (Ptr a)
lookupIE ie con_nm
= case lookupNameEnv ie con_nm of
- Just (_, Ptr a) -> return (Ptr a)
+ Just (_, a) -> return (castPtr (itblCode a))
Nothing
-> do -- try looking up in the object files.
let sym_to_find1 = nameToCLabel con_nm "con_info"
Nothing
-> do -- try looking up in the object files.
let sym_to_find1 = nameToCLabel con_nm "con_info"