The problem here is caused by the fact that info tables include a
relative offset to the string naming the constructor. Executable
memory now resides at two places in the address space: one for writing
and one for executing. In the info tables generated by GHCi, we were
calculating the offset relative to the writable instance, rather than
the executable instance, which meant that the GHCi debugger couldn't
find the names for constructors it found in the heap.
ByteCodeGen: Generate machine-code sequences for foreign import
\begin{code}
ByteCodeGen: Generate machine-code sequences for foreign import
\begin{code}
-module ByteCodeFFI ( moan64, newExec ) where
+module ByteCodeFFI ( moan64 ) where
import Outputable
import System.IO
import Foreign
import Outputable
import System.IO
import Foreign
moan64 :: String -> SDoc -> a
moan64 msg pp_rep
moan64 :: String -> SDoc -> a
moan64 msg pp_rep
)
`seq`
pprPanic msg pp_rep
)
`seq`
pprPanic msg pp_rep
-
-newExec :: Storable a => [a] -> IO (FunPtr ())
-newExec code
- = alloca $ \pcode -> do
- ptr <- _allocateExec (fromIntegral $ codeSize undefined code) pcode
- pokeArray ptr code
- code <- peek pcode
- return (castPtrToFunPtr code)
- where
- codeSize :: Storable a => a -> [a] -> Int
- codeSize dummy array = sizeOf(dummy) * length array
-
-foreign import ccall unsafe "allocateExec"
- _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)
-import ByteCodeFFI ( newExec )
import Name ( Name, getName )
import NameEnv
import SMRep ( typeCgRep )
import Name ( Name, getName )
import NameEnv
import SMRep ( typeCgRep )
}
-- Make a piece of code to jump to "entry_label".
-- This is the only arch-dependent bit.
}
-- Make a piece of code to jump to "entry_label".
-- This is the only arch-dependent bit.
- addrCon <- newExec [conInfoTbl]
+ addrCon <- newExec pokeConItbl conInfoTbl
--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)
#endif
, infoTable = itbl
}
#endif
, infoTable = itbl
}
- poke ptr itbl
- = runState (castPtr ptr) $ do
+ poke = error "poke(StgConInfoTable): use pokeConItbl instead"
+
+
+pokeConItbl :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
+ -> IO ()
+pokeConItbl wr_ptr ex_ptr itbl
+ = runState (castPtr wr_ptr) $ do
#ifdef GHCI_TABLES_NEXT_TO_CODE
#ifdef GHCI_TABLES_NEXT_TO_CODE
- store (conDesc itbl `minusPtr` (ptr `plusPtr` conInfoTableSizeB))
+ store (conDesc itbl `minusPtr` (ex_ptr `plusPtr` conInfoTableSizeB))
#endif
store (infoTable itbl)
#ifndef GHCI_TABLES_NEXT_TO_CODE
#endif
store (infoTable itbl)
#ifndef GHCI_TABLES_NEXT_TO_CODE
load = do addr <- advance
lift (peek addr)
load = do addr <- advance
lift (peek addr)
+
+newExec :: Storable a => (Ptr a -> Ptr a -> a -> IO ()) -> a -> IO (FunPtr ())
+newExec poke_fn obj
+ = alloca $ \pcode -> do
+ wr_ptr <- _allocateExec (fromIntegral (sizeOf obj)) pcode
+ ex_ptr <- peek pcode
+ poke_fn wr_ptr ex_ptr obj
+ return (castPtrToFunPtr ex_ptr)
+ where
+ codeSize :: Storable a => a -> [a] -> Int
+ codeSize dummy array = sizeOf(dummy) * length array
+
+foreign import ccall unsafe "allocateExec"
+ _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)