X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeItbls.lhs;h=2d07befb69e902ae8892d9d490f0fcd049adc882;hp=887f637319560b597fa036d7f61ad4c66ed56a8b;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hpb=89692d034948e58dd461639897690e2d3ab8cd44

diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index 887f637..2d07bef 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_GHC -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/WorkingConventions#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
 }
 
@@ -279,17 +291,32 @@ instance Storable StgConInfoTable where
    alignment conInfoTable = SIZEOF_VOID_P
    peek ptr 
       = runState (castPtr ptr) $ do
+#ifdef GHCI_TABLES_NEXT_TO_CODE
            desc <- load
+#endif
            itbl <- load
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+           desc <- load
+#endif
            return  
               StgConInfoTable 
-              { conDesc   = desc
+              { 
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+                conDesc   = castPtr $ ptr `plusPtr` conInfoTableSizeB `plusPtr` desc
+#else
+                conDesc   = desc
+#endif
               , infoTable = itbl
               }
    poke ptr itbl 
       = runState (castPtr ptr) $ do
-           store (conDesc itbl)
+#ifdef GHCI_TABLES_NEXT_TO_CODE
+           store (conDesc itbl `minusPtr` (ptr `plusPtr` conInfoTableSizeB))
+#endif
            store (infoTable itbl)
+#ifndef GHCI_TABLES_NEXT_TO_CODE
+           store (conDesc itbl)
+#endif
 
 data StgInfoTable = StgInfoTable {
 #ifndef GHCI_TABLES_NEXT_TO_CODE