Remove platform CPP from nativeGen/PPC/CodeGen.hs

[ghc-hetmet.git] / compiler / ghci / ByteCodeItbls.lhs

diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index fd39e44..696ed0f 100644 (file)
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -19,7 +19,6 @@ module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls
 
 #include "HsVersions.h"
 
-import ByteCodeFFI     ( newExec )
 import Name            ( Name, getName )
 import NameEnv
 import SMRep           ( typeCgRep )
@@ -85,7 +84,7 @@ mkITbl tc
         dcs = tyConDataCons tc
         n   = tyConFamilySize tc
 
-#include "../includes/ClosureTypes.h"
+#include "../includes/rts/storage/ClosureTypes.h"
 cONSTR :: Int  -- Defined in ClosureTypes.h
 cONSTR = CONSTR 
 
@@ -128,7 +127,7 @@ make_constr_itbls cons
                             }
                -- 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)
@@ -152,7 +151,7 @@ ptrToInt (Ptr a#) = I# (addr2Int# a#)
 #if sparc_TARGET_ARCH
 -- After some consideration, we'll try this, where
 -- 0x55555555 stands in for the address to jump to.
--- According to ghc/includes/MachRegs.h, %g3 is very
+-- According to includes/rts/MachRegs.h, %g3 is very
 -- likely indeed to be baggable.
 --
 --   0000 07155555              sethi   %hi(0x55555555), %g3
@@ -305,10 +304,15 @@ instance Storable StgConInfoTable where
 #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
-           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
@@ -427,4 +431,18 @@ load :: Storable a => PtrIO a
 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)  
 \end{code}