projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
unused exports
[ghc-hetmet.git]
/
compiler
/
ghci
/
ByteCodeFFI.lhs
diff --git
a/compiler/ghci/ByteCodeFFI.lhs
b/compiler/ghci/ByteCodeFFI.lhs
index
ef3fd3e
..
982cdec
100644
(file)
--- a/
compiler/ghci/ByteCodeFFI.lhs
+++ b/
compiler/ghci/ByteCodeFFI.lhs
@@
-1,29
+1,31
@@
%
%
-% (c) The University of Glasgow 2001
+% (c) The University of Glasgow 2001-2006
%
%
-\section[ByteCodeGen]{Generate machine-code sequences for foreign import}
+
+ByteCodeGen: Generate machine-code sequences for foreign import
\begin{code}
\begin{code}
-module ByteCodeFFI ( mkMarshalCode, moan64 ) where
+module ByteCodeFFI ( mkMarshalCode, moan64, newExec ) where
#include "HsVersions.h"
import Outputable
#include "HsVersions.h"
import Outputable
-import SMRep ( CgRep(..), cgRepSizeW )
-import ForeignCall ( CCallConv(..) )
+import SMRep
+import ForeignCall
import Panic
-- DON'T remove apparently unused imports here ..
-- there is ifdeffery below
import Control.Exception ( throwDyn )
import Panic
-- DON'T remove apparently unused imports here ..
-- there is ifdeffery below
import Control.Exception ( throwDyn )
-import DATA_BITS ( Bits(..), shiftR, shiftL )
-import Foreign ( newArray )
+import Data.Bits ( Bits(..), shiftR, shiftL )
import Data.List ( mapAccumL )
import Data.List ( mapAccumL )
-import DATA_WORD ( Word8, Word32 )
-import Foreign ( Ptr )
+import Data.Word ( Word8, Word32 )
+import Foreign ( Ptr, FunPtr, castPtrToFunPtr,
+ Storable, sizeOf, pokeArray )
+import Foreign.C ( CUInt )
import System.IO.Unsafe ( unsafePerformIO )
import System.IO.Unsafe ( unsafePerformIO )
-import IO ( hPutStrLn, stderr )
+import System.IO ( hPutStrLn, stderr )
-- import Debug.Trace ( trace )
\end{code}
-- import Debug.Trace ( trace )
\end{code}
@@
-70,14
+72,23
@@
we don't clear our own (single) arg off the C stack.
-}
mkMarshalCode :: CCallConv
-> (Int, CgRep) -> Int -> [(Int, CgRep)]
-}
mkMarshalCode :: CCallConv
-> (Int, CgRep) -> Int -> [(Int, CgRep)]
- -> IO (Ptr Word8)
+ -> IO (FunPtr ())
mkMarshalCode cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
= let bytes = mkMarshalCode_wrk cconv (r_offW, r_rep)
addr_offW arg_offs_n_reps
mkMarshalCode cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
= let bytes = mkMarshalCode_wrk cconv (r_offW, r_rep)
addr_offW arg_offs_n_reps
- in Foreign.newArray bytes
-
+ in newExec bytes
+newExec :: Storable a => [a] -> IO (FunPtr ())
+newExec code
+ = do ptr <- _allocateExec (fromIntegral $ codeSize undefined code)
+ pokeArray ptr code
+ return (castPtrToFunPtr ptr)
+ where
+ codeSize :: Storable a => a -> [a] -> Int
+ codeSize dummy array = sizeOf(dummy) * length array
+foreign import ccall unsafe "allocateExec"
+ _allocateExec :: CUInt -> IO (Ptr a)
mkMarshalCode_wrk :: CCallConv
-> (Int, CgRep) -> Int -> [(Int, CgRep)]
mkMarshalCode_wrk :: CCallConv
-> (Int, CgRep) -> Int -> [(Int, CgRep)]
@@
-252,7
+263,7
@@
mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
NonPtrArg -> i32
DoubleArg -> f64
FloatArg -> f32
NonPtrArg -> i32
DoubleArg -> f64
FloatArg -> f32
- -- LongArg -> i64
+ LongArg -> i64
VoidArg -> []
other -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(x86)"
(ppr r_rep)
VoidArg -> []
other -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(x86)"
(ppr r_rep)