projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Extend the GHC API with breakpoints and breakpoint handlers
[ghc-hetmet.git]
/
compiler
/
ghci
/
ByteCodeItbls.lhs
diff --git
a/compiler/ghci/ByteCodeItbls.lhs
b/compiler/ghci/ByteCodeItbls.lhs
index
863a7b7
..
d3cb3f7
100644
(file)
--- a/
compiler/ghci/ByteCodeItbls.lhs
+++ b/
compiler/ghci/ByteCodeItbls.lhs
@@
-10,6
+10,7
@@
module ByteCodeItbls ( ItblEnv, ItblPtr, mkITbls ) where
#include "HsVersions.h"
#include "HsVersions.h"
+import ByteCodeFFI ( newExec )
import Name ( Name, getName )
import NameEnv
import SMRep ( typeCgRep )
import Name ( Name, getName )
import NameEnv
import SMRep ( typeCgRep )
@@
-35,7
+36,15
@@
import GHC.Ptr ( Ptr(..) )
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-type ItblPtr = Ptr StgInfoTable
+newtype ItblPtr = ItblPtr (Ptr ()) deriving Show
+
+itblCode :: ItblPtr -> Ptr ()
+itblCode (ItblPtr ptr)
+ = (castPtr ptr)
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ `plusPtr` (wORD_SIZE * 2)
+#endif
+
type ItblEnv = NameEnv (Name, ItblPtr)
-- We need the Name in the range so we know which
-- elements to filter out when unloading a module
type ItblEnv = NameEnv (Name, ItblPtr)
-- We need the Name in the range so we know which
-- elements to filter out when unloading a module
@@
-107,16
+116,11
@@
make_constr_itbls cons
-- This is the only arch-dependent bit.
code = mkJumpToAddr entry_addr
in
-- This is the only arch-dependent bit.
code = mkJumpToAddr entry_addr
in
- do addr <- malloc_exec (sizeOf itbl)
+ do addr <- newExec [itbl]
--putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
--putStrLn ("# ptrs of itbl is " ++ show ptrs)
--putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
--putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
--putStrLn ("# ptrs of itbl is " ++ show ptrs)
--putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
- poke addr itbl
- return (getName dcon, addr
-#ifdef GHCI_TABLES_NEXT_TO_CODE
- `plusPtr` (2 * wORD_SIZE)
-#endif
- )
+ return (getName dcon, ItblPtr (castFunPtrToPtr addr))
-- Make code which causes a jump to the given address. This is the
-- Make code which causes a jump to the given address. This is the
@@
-390,10
+394,4
@@
load :: Storable a => PtrIO a
load = do addr <- advance
lift (peek addr)
load = do addr <- advance
lift (peek addr)
-foreign import ccall unsafe "allocateExec"
- _allocateExec :: CUInt -> IO (Ptr a)
-
-malloc_exec :: Int -> IO (Ptr a)
-malloc_exec bytes = _allocateExec (fromIntegral bytes)
-
\end{code}
\end{code}