Partially fix GHCi when unregisterised

We were constructing info tables designed for TABLES_NEXT_TO_CODE,
but were building without TABLES_NEXT_TO_CODE.

This patch also fixes a bug when we are unregisterised on amd64 and
have code with an address above 2^32.

diff --git a/compiler/Makefile b/compiler/Makefile
index d634828..f4ab45b 100644 (file)
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -346,6 +346,10 @@ endif
        @echo "#define HOST_VENDOR \"$(TargetVendor_CPP)\"" >> $@
        @echo "#define TARGET_VENDOR \"$(TargetVendor_CPP)\"" >> $@
        @echo >> $@
+ifeq "$(GhcWithTablesNextToCode)" "YES"
+       @echo "#define TABLES_NEXT_TO_CODE 1" >> $@
+endif
+       @echo >> $@
        @echo "#endif /* __PLATFORM_H__ */"          >> $@
        @echo "Done."
 

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index f233cbb..e6d36c0 100644 (file)
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -202,7 +202,7 @@ retVec :: CmmExpr -> CmmExpr -> CmmExpr
 -- Get a return vector from the info pointer
 retVec info_amode zero_indexed_tag
   = let slot = vectorSlot info_amode zero_indexed_tag
-#ifdef x86_64_TARGET_ARCH
+#if defined(x86_64_TARGET_ARCH) && defined(TABLES_NEXT_TO_CODE)
         tableEntry = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
        -- offsets are 32-bits on x86-64, due to the inability of
        -- the tools to handle 64-bit PC-relative relocations.  See also

diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index d990da2..cd07515 100644 (file)
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -92,11 +92,16 @@ make_constr_itbls cons
                     | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
                     | otherwise = mIN_PAYLOAD_SIZE - ptrs
                  itbl  = StgInfoTable {
+#ifndef TABLES_NEXT_TO_CODE
+                           entry = entry_addr,
+#endif
                            ptrs  = fromIntegral ptrs, 
                            nptrs = fromIntegral nptrs_really,
                            tipe  = fromIntegral cONSTR,
-                           srtlen = fromIntegral conNo,
-                           code  = code
+                           srtlen = fromIntegral conNo
+#ifdef TABLES_NEXT_TO_CODE
+                         , code  = code
+#endif
                         }
                  -- Make a piece of code to jump to "entry_label".
                  -- This is the only arch-dependent bit.
@@ -107,7 +112,11 @@ make_constr_itbls cons
                     --putStrLn ("# ptrs  of itbl is " ++ show ptrs)
                     --putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
                     poke addr itbl
-                    return (getName dcon, addr `plusPtr` (2 * wORD_SIZE))
+                    return (getName dcon, addr
+#ifdef TABLES_NEXT_TO_CODE
+                                               `plusPtr` (2 * wORD_SIZE)
+#endif
+                           )
 
 
 -- Make code which causes a jump to the given address.  This is the
@@ -270,48 +279,77 @@ type HalfWord = Word16
 #endif
 
 data StgInfoTable = StgInfoTable {
+#ifndef TABLES_NEXT_TO_CODE
+   entry  :: Ptr (),
+#endif
    ptrs   :: HalfWord,
    nptrs  :: HalfWord,
    tipe   :: HalfWord,
-   srtlen :: HalfWord,
-   code   :: [ItblCode]
-}
+   srtlen :: HalfWord
+#ifdef TABLES_NEXT_TO_CODE
+ , code   :: [ItblCode]
+#endif
+  }
 
 instance Storable StgInfoTable where
 
    sizeOf itbl 
       = sum
-        [fieldSz ptrs itbl,
+        [
+#ifndef TABLES_NEXT_TO_CODE
+         fieldSz entry itbl,
+#endif
+         fieldSz ptrs itbl,
          fieldSz nptrs itbl,
          fieldSz tipe itbl,
-         fieldSz srtlen itbl,
-         fieldSz (head.code) itbl * itblCodeLength]
+         fieldSz srtlen itbl
+#ifdef TABLES_NEXT_TO_CODE
+        ,fieldSz (head.code) itbl * itblCodeLength
+#endif
+        ]
 
    alignment itbl 
       = SIZEOF_VOID_P
 
    poke a0 itbl
       = runState (castPtr a0)
-      $ do store (ptrs   itbl)
+      $ do
+#ifndef TABLES_NEXT_TO_CODE
+           store (entry  itbl)
+#endif
+           store (ptrs   itbl)
            store (nptrs  itbl)
            store (tipe   itbl)
            store (srtlen itbl)
+#ifdef TABLES_NEXT_TO_CODE
            sequence_ (map store (code itbl))
+#endif
 
    peek a0
       = runState (castPtr a0)
-      $ do ptrs   <- load
+      $ do
+#ifndef TABLES_NEXT_TO_CODE
+           entry  <- load
+#endif
+           ptrs   <- load
            nptrs  <- load
            tipe   <- load
            srtlen <- load
+#ifdef TABLES_NEXT_TO_CODE
            code   <- sequence (replicate itblCodeLength load)
+#endif
            return 
               StgInfoTable { 
+#ifndef TABLES_NEXT_TO_CODE
+                 entry  = entry,
+#endif
                  ptrs   = ptrs,
                  nptrs  = nptrs, 
                  tipe   = tipe,
-                 srtlen = srtlen,
-                 code   = code
+                 srtlen = srtlen
+#ifdef TABLES_NEXT_TO_CODE
+                ,code   = code
+#endif
               }
 
 fieldSz :: (Storable a, Storable b) => (a -> b) -> a -> Int

diff --git a/includes/Makefile b/includes/Makefile
index a181c23..b1c57f9 100644 (file)
--- a/includes/Makefile
+++ b/includes/Makefile
@@ -9,10 +9,18 @@ include $(TOP)/mk/boilerplate.mk
 H_FILES = $(filter-out gmp.h,$(wildcard *.h)) gmp.h
 
 #
-# Options -- if we're building unregisterised, add a couple of -D's
+# Options
 #
-ifeq "$(GhcUnregisterised)" "YES"
-SRC_CC_OPTS += -DNO_REGS -DUSE_MINIINTERPRETER
+ifeq "$(GhcWithNoRegs)" "YES"
+SRC_CC_OPTS += -DNO_REGS
+endif
+
+ifeq "$(GhcWithMiniInterpreter)" "YES"
+SRC_CC_OPTS += -DUSE_MINIINTERPRETER
+endif
+
+ifeq "$(GhcWithTablesNextToCode)" "YES"
+SRC_CC_OPTS += -DTABLES_NEXT_TO_CODE
 endif
 
 SRC_CC_OPTS += -I. -I../rts

diff --git a/includes/RtsConfig.h b/includes/RtsConfig.h
index 8590ccd..c40924a 100644 (file)
--- a/includes/RtsConfig.h
+++ b/includes/RtsConfig.h
@@ -46,15 +46,6 @@
 #  define LAZY_BLACKHOLING
 #endif
 
-/* TABLES_NEXT_TO_CODE says whether to assume that info tables are
- * assumed to reside just before the code for a function.
- *
- * UNDEFINING THIS WON'T WORK ON ITS OWN.  You have been warned.
- */
-#if !defined(USE_MINIINTERPRETER) && !defined(ia64_HOST_ARCH) && !defined (powerpc64_HOST_ARCH)
-#define TABLES_NEXT_TO_CODE
-#endif
-
 /* -----------------------------------------------------------------------------
    Labels - entry labels & info labels point to the same place in
    TABLES_NEXT_TO_CODE, so we only generate the _info label.  Jumps

diff --git a/mk/config.mk.in b/mk/config.mk.in
index be48d99..043d60a 100644 (file)
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -277,6 +277,23 @@ else
 GhcWithInterpreter=NO
 endif
 
+# GhcWithTablesNextToCode, which corresponds to the TABLES_NEXT_TO_CODE
+# CPP symbol, says whether to assume that info tables are assumed to
+# reside just before the code for a function.
+ifeq "$(GhcUnregisterised)" "YES"
+GhcWithTablesNextToCode=NO
+GhcWithNoRegs=YES
+GhcWithMiniInterpreter=YES
+else
+ifeq "$(findstring $(HostArch_CPP), ia64 powerpc64)" ""
+GhcWithTablesNextToCode=YES
+else
+GhcWithTablesNextToCode=NO
+endif
+GhcWithNoRegs=NO
+GhcWithMiniInterpreter=NO
+endif
+
 #
 # Building various ways?
 # (right now, empty if not).

diff --git a/rts/Makefile b/rts/Makefile
index 9828f55..43368d4 100644 (file)
--- a/rts/Makefile
+++ b/rts/Makefile
@@ -124,6 +124,11 @@ SRC_CC_OPTS += -DNOSMP
 SRC_HC_OPTS += -optc-DNOSMP
 endif
 
+ifeq "$(GhcWithTablesNextToCode)" "YES"
+SRC_CC_OPTS += -DTABLES_NEXT_TO_CODE
+SRC_HC_OPTS += -optc-DTABLES_NEXT_TO_CODE
+endif
+
 ifneq "$(DLLized)" "YES"
 SRC_HC_OPTS += -static
 endif