X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeFFI.lhs;h=982cdec29e6b30bf6946c001f07801eb657ca687;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=ef3fd3e0d6a2b653fc03d39707224148d60975cf;hpb=92e1b7accd21ea69c9890b266ec719ab54aef4eb;p=ghc-hetmet.git

diff --git a/compiler/ghci/ByteCodeFFI.lhs b/compiler/ghci/ByteCodeFFI.lhs
index ef3fd3e..982cdec 100644
--- 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}
-module ByteCodeFFI ( mkMarshalCode, moan64 ) where
+module ByteCodeFFI ( mkMarshalCode, moan64, newExec ) where
 
 #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 DATA_BITS	( Bits(..), shiftR, shiftL )
-import Foreign		( newArray )
+import Data.Bits	( Bits(..), shiftR, shiftL )
 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 IO		( hPutStrLn, stderr )
+import System.IO	( hPutStrLn, stderr )
 -- 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)] 
-              -> 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
-     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)] 
@@ -252,7 +263,7 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
            NonPtrArg -> i32
            DoubleArg -> f64  
            FloatArg  -> f32
-           -- LongArg -> i64
+           LongArg   -> i64
            VoidArg   -> []
            other     -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(x86)" 
                                (ppr r_rep)