X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeItbls.lhs;h=73b58cd2227b0e061bc90547844c7db8dbc8373e;hp=2973c03e47f033dfaab7dcf8b20e999cb0658d0b;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=b648333f6b4c78f7ac1528cd9f780221a058591e diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs index 2973c03..73b58cd 100644 --- a/compiler/ghci/ByteCodeItbls.lhs +++ b/compiler/ghci/ByteCodeItbls.lhs @@ -6,6 +6,13 @@ ByteCodeItbls: Generate infotables for interpreter-made bytecodes \begin{code} {-# OPTIONS -optc-DNON_POSIX_SOURCE #-} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings +-- for details + module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls , StgInfoTable(..) ) where @@ -22,6 +29,7 @@ import Constants ( mIN_PAYLOAD_SIZE, wORD_SIZE ) import CgHeapery ( mkVirtHeapOffsets ) import FastString ( FastString(..) ) import Util ( lengthIs, listLengthCmp ) +import Outputable import Foreign import Foreign.C @@ -32,7 +40,8 @@ import GHC.Exts ( Int(I#), addr2Int# ) import GHC.Ptr ( Ptr(..) ) import GHC.Prim -import Outputable +import Debug.Trace +import Text.Printf \end{code} %************************************************************************ @@ -48,9 +57,12 @@ itblCode :: ItblPtr -> Ptr () itblCode (ItblPtr ptr) = (castPtr ptr) #ifdef GHCI_TABLES_NEXT_TO_CODE - `plusPtr` (3 * wORD_SIZE) + `plusPtr` conInfoTableSizeB #endif +-- XXX bogus +conInfoTableSizeB = 3 * wORD_SIZE + type ItblEnv = NameEnv (Name, ItblPtr) -- We need the Name in the range so we know which -- elements to filter out when unloading a module @@ -112,7 +124,7 @@ make_constr_itbls cons , code = code #endif } - qNameCString <- newCString $ dataConIdentity dcon + qNameCString <- newArray0 0 $ dataConIdentity dcon let conInfoTbl = StgConInfoTable { conDesc = qNameCString, infoTable = itbl @@ -268,7 +280,7 @@ type HalfWord = Word16 #endif data StgConInfoTable = StgConInfoTable { - conDesc :: CString, + conDesc :: Ptr Word8, infoTable :: StgInfoTable } @@ -290,7 +302,7 @@ instance Storable StgConInfoTable where StgConInfoTable { #ifdef GHCI_TABLES_NEXT_TO_CODE - conDesc = castPtr $ ptr `plusPtr` wORD_SIZE `plusPtr` desc + conDesc = castPtr $ ptr `plusPtr` conInfoTableSizeB `plusPtr` desc #else conDesc = desc #endif @@ -299,7 +311,7 @@ instance Storable StgConInfoTable where poke ptr itbl = runState (castPtr ptr) $ do #ifdef GHCI_TABLES_NEXT_TO_CODE - store (conDesc itbl `minusPtr` (ptr `plusPtr` wORD_SIZE)) + store (conDesc itbl `minusPtr` (ptr `plusPtr` conInfoTableSizeB)) #endif store (infoTable itbl) #ifndef GHCI_TABLES_NEXT_TO_CODE