projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Handle LongArg's in the FFI on x86
[ghc-hetmet.git]
/
compiler
/
ghci
/
ByteCodeItbls.lhs
diff --git
a/compiler/ghci/ByteCodeItbls.lhs
b/compiler/ghci/ByteCodeItbls.lhs
index
74346c6
..
a7c2d4b
100644
(file)
--- a/
compiler/ghci/ByteCodeItbls.lhs
+++ b/
compiler/ghci/ByteCodeItbls.lhs
@@
-1,16
+1,18
@@
%
%
-% (c) The University of Glasgow 2000
+% (c) The University of Glasgow 2000-2006
%
%
-\section[ByteCodeItbls]{Generate infotables for interpreter-made bytecodes}
+ByteCodeItbls: Generate infotables for interpreter-made bytecodes
\begin{code}
\begin{code}
-
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
-module ByteCodeItbls ( ItblEnv, ItblPtr, mkITbls ) where
+module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls
+ , StgInfoTable(..)
+ ) 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 )
@@
-23,14
+25,10
@@
import Util ( lengthIs, listLengthCmp )
import Foreign
import Foreign.C
import Foreign
import Foreign.C
-import DATA_BITS ( Bits(..), shiftR )
+import Data.Bits ( Bits(..), shiftR )
import GHC.Exts ( Int(I#), addr2Int# )
import GHC.Exts ( Int(I#), addr2Int# )
-#if __GLASGOW_HASKELL__ < 503
-import Ptr ( Ptr(..) )
-#else
import GHC.Ptr ( Ptr(..) )
import GHC.Ptr ( Ptr(..) )
-#endif
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-40,7
+38,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
@@
-97,22
+103,26
@@
make_constr_itbls cons
| ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
| otherwise = mIN_PAYLOAD_SIZE - ptrs
itbl = StgInfoTable {
| ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
| otherwise = mIN_PAYLOAD_SIZE - ptrs
itbl = StgInfoTable {
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ entry = entry_addr,
+#endif
ptrs = fromIntegral ptrs,
nptrs = fromIntegral nptrs_really,
tipe = fromIntegral cONSTR,
ptrs = fromIntegral ptrs,
nptrs = fromIntegral nptrs_really,
tipe = fromIntegral cONSTR,
- srtlen = fromIntegral conNo,
- code = code
+ srtlen = fromIntegral conNo
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ , code = code
+#endif
}
-- Make a piece of code to jump to "entry_label".
-- This is the only arch-dependent bit.
code = mkJumpToAddr entry_addr
in
}
-- Make a piece of code to jump to "entry_label".
-- 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 `plusPtr` (2 * wORD_SIZE))
+ 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
@@
-275,48
+285,77
@@
type HalfWord = Word16
#endif
data StgInfoTable = StgInfoTable {
#endif
data StgInfoTable = StgInfoTable {
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ entry :: Ptr (),
+#endif
ptrs :: HalfWord,
nptrs :: HalfWord,
tipe :: HalfWord,
ptrs :: HalfWord,
nptrs :: HalfWord,
tipe :: HalfWord,
- srtlen :: HalfWord,
- code :: [ItblCode]
-}
+ srtlen :: HalfWord
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ , code :: [ItblCode]
+#endif
+ }
instance Storable StgInfoTable where
sizeOf itbl
= sum
instance Storable StgInfoTable where
sizeOf itbl
= sum
- [fieldSz ptrs itbl,
+ [
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ fieldSz entry itbl,
+#endif
+ fieldSz ptrs itbl,
fieldSz nptrs itbl,
fieldSz tipe itbl,
fieldSz nptrs itbl,
fieldSz tipe itbl,
- fieldSz srtlen itbl,
- fieldSz (head.code) itbl * itblCodeLength]
+ fieldSz srtlen itbl
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ ,fieldSz (head.code) itbl * itblCodeLength
+#endif
+ ]
alignment itbl
= SIZEOF_VOID_P
poke a0 itbl
= runState (castPtr a0)
alignment itbl
= SIZEOF_VOID_P
poke a0 itbl
= runState (castPtr a0)
- $ do store (ptrs itbl)
+ $ do
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ store (entry itbl)
+#endif
+ store (ptrs itbl)
store (nptrs itbl)
store (tipe itbl)
store (srtlen itbl)
store (nptrs itbl)
store (tipe itbl)
store (srtlen itbl)
+#ifdef GHCI_TABLES_NEXT_TO_CODE
sequence_ (map store (code itbl))
sequence_ (map store (code itbl))
+#endif
peek a0
= runState (castPtr a0)
peek a0
= runState (castPtr a0)
- $ do ptrs <- load
+ $ do
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ entry <- load
+#endif
+ ptrs <- load
nptrs <- load
tipe <- load
srtlen <- load
nptrs <- load
tipe <- load
srtlen <- load
+#ifdef GHCI_TABLES_NEXT_TO_CODE
code <- sequence (replicate itblCodeLength load)
code <- sequence (replicate itblCodeLength load)
+#endif
return
StgInfoTable {
return
StgInfoTable {
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+ entry = entry,
+#endif
ptrs = ptrs,
nptrs = nptrs,
tipe = tipe,
ptrs = ptrs,
nptrs = nptrs,
tipe = tipe,
- srtlen = srtlen,
- code = code
+ srtlen = srtlen
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+ ,code = code
+#endif
}
fieldSz :: (Storable a, Storable b) => (a -> b) -> a -> Int
}
fieldSz :: (Storable a, Storable b) => (a -> b) -> a -> Int
@@
-357,10
+396,4
@@
load :: Storable a => PtrIO a
load = do addr <- advance
lift (peek addr)
load = do addr <- advance
lift (peek addr)
-foreign import ccall unsafe "stgMallocBytesRWX"
- _stgMallocBytesRWX :: CInt -> IO (Ptr a)
-
-malloc_exec :: Int -> IO (Ptr a)
-malloc_exec bytes = _stgMallocBytesRWX (fromIntegral bytes)
-
\end{code}
\end{code}