X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeItbls.lhs;h=d3cb3f756b7cd2f1f52530d9888d9fac05ac7b76;hb=ead424357937b23f30295608b467aacbc3a8a8bc;hp=863a7b730ecb1d6e543468a7e7a09578d2fc0657;hpb=80564ddc183ea98856994112858f0b9f3e178f94;p=ghc-hetmet.git diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs index 863a7b7..d3cb3f7 100644 --- a/compiler/ghci/ByteCodeItbls.lhs +++ b/compiler/ghci/ByteCodeItbls.lhs @@ -10,6 +10,7 @@ module ByteCodeItbls ( ItblEnv, ItblPtr, mkITbls ) where #include "HsVersions.h" +import ByteCodeFFI ( newExec ) import Name ( Name, getName ) import NameEnv import SMRep ( typeCgRep ) @@ -35,7 +36,15 @@ import GHC.Ptr ( Ptr(..) ) %************************************************************************ \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 @@ -107,16 +116,11 @@ make_constr_itbls cons -- 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) - 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 @@ -390,10 +394,4 @@ load :: Storable a => PtrIO a 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}