Fix for feature request #655 (Loading the GHC library from GHCi.)

Moved the utility functions out of hschooks, avoided
linking the GHC library with hschooks.o and
added a couple of symbols to the linkers export list.

diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index 97cd2c6..7298560 100644 (file)
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -756,7 +756,7 @@ PKG_DEPENDS += base haskell98
 PACKAGE_CPP_OPTS += -DPKG_DEPENDS='$(PKG_DEPENDS)'
 
 # Omit Main from the library, the client will want to plug their own Main in
-LIBOBJS = $(filter-out $(odir)/main/Main.o, $(OBJS))
+LIBOBJS = $(filter-out $(odir)/main/Main.o $(odir)/parser/hschooks.o, $(OBJS))
 
 # disable splitting: it won't really help with GHC, and the specialised
 # build system for ghc/compiler isn't set up to handle it.

diff --git a/ghc/compiler/parser/cutils.c b/ghc/compiler/parser/cutils.c
new file mode 100644 (file)
index 0000000..08832f2
--- /dev/null
+++ b/ghc/compiler/parser/cutils.c
@@ -0,0 +1,70 @@
+/*
+These utility routines are used various
+places in the GHC library.
+*/
+
+/* For GHC 4.08, we are relying on the fact that RtsFlags has
+ * compatible layout with the current version, because we're
+ * #including the current version of RtsFlags.h below.  4.08 didn't
+ * ship with its own RtsFlags.h, unfortunately.   For later GHC
+ * versions, we #include the correct RtsFlags.h.
+ */
+#if __GLASGOW_HASKELL__ < 502
+#include "../includes/Rts.h"
+#include "../includes/RtsFlags.h"
+#else
+#include "Rts.h"
+#include "RtsFlags.h"
+#endif
+
+#include "HsFFI.h"
+
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/*
+Calling 'strlen' and 'memcpy' directly gives problems with GCC's inliner,
+and causes gcc to require too many registers on x84
+*/
+
+HsInt
+ghc_strlen( HsAddr a )
+{
+    return (strlen((char *)a));
+}
+
+HsInt
+ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len )
+{
+    return (memcmp((char *)a1, a2, len));
+}
+
+HsInt
+ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len )
+{
+    return (memcmp((char *)a1 + i, a2, len));
+}
+
+void
+enableTimingStats( void )      /* called from the driver */
+{
+#if __GLASGOW_HASKELL__ >= 411
+    RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
+#endif
+    /* ignored when bootstrapping with an older GHC */
+}
+
+void
+setHeapSize( HsInt size )
+{
+    RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;
+    if (RtsFlags.GcFlags.maxHeapSize != 0 &&
+       RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) {
+       RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
+    }
+}
+
+

diff --git a/ghc/compiler/parser/cutils.h b/ghc/compiler/parser/cutils.h
new file mode 100644 (file)
index 0000000..c7c1867
--- /dev/null
+++ b/ghc/compiler/parser/cutils.h
@@ -0,0 +1,16 @@
+/* -----------------------------------------------------------------------------
+ *
+ * Utility C functions.
+ *
+ * -------------------------------------------------------------------------- */
+
+#include "HsFFI.h"
+
+// Out-of-line string functions, see PrimPacked.lhs
+HsInt ghc_strlen( HsAddr a );
+HsInt ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len );
+HsInt ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len );
+
+
+void enableTimingStats( void );
+void setHeapSize( HsInt size );

diff --git a/ghc/compiler/parser/hschooks.c b/ghc/compiler/parser/hschooks.c
index 5c1f023..f3e7447 100644 (file)
--- a/ghc/compiler/parser/hschooks.c
+++ b/ghc/compiler/parser/hschooks.c
@@ -39,25 +39,6 @@ defaultsHook (void)
 }
 
 void
-enableTimingStats( void )      /* called from the driver */
-{
-#if __GLASGOW_HASKELL__ >= 411
-    RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
-#endif
-    /* ignored when bootstrapping with an older GHC */
-}
-
-void
-setHeapSize( HsInt size )
-{
-    RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;
-    if (RtsFlags.GcFlags.maxHeapSize != 0 &&
-       RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) {
-       RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
-    }
-}
-
-void
 OutOfHeapHook (unsigned long request_size/* always zero these days */,
               unsigned long heap_size)
     /* both in bytes */
@@ -72,20 +53,3 @@ StackOverflowHook (unsigned long stack_size)    /* in bytes */
     fprintf(stderr, "GHC stack-space overflow: current limit is %ld bytes.\nUse the `-K<size>' option to increase it.\n", stack_size);
 }
 
-HsInt
-ghc_strlen( HsAddr a )
-{
-    return (strlen((char *)a));
-}
-
-HsInt
-ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len )
-{
-    return (memcmp((char *)a1, a2, len));
-}
-
-HsInt
-ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len )
-{
-    return (memcmp((char *)a1 + i, a2, len));
-}

diff --git a/ghc/compiler/parser/hschooks.h b/ghc/compiler/parser/hschooks.h
index c68b41e..4ce1c0f 100644 (file)
--- a/ghc/compiler/parser/hschooks.h
+++ b/ghc/compiler/parser/hschooks.h
@@ -6,10 +6,4 @@
  * -------------------------------------------------------------------------- */
 
 #include "HsFFI.h"
-void enableTimingStats( void );
-void setHeapSize( HsInt size );
 
-// Out-of-line string functions, see PrimPacked.lhs
-HsInt ghc_strlen( HsAddr a );
-HsInt ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len );
-HsInt ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len );

diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index ac3296f..87fda47 100644 (file)
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -656,6 +656,19 @@ typedef struct _RtsSymbolVal {
       SymX(writeTVarzh_fast)                   \
       SymX(xorIntegerzh_fast)                  \
       SymX(yieldzh_fast)                        \
+      SymX(stg_interp_constr_entry)             \
+      SymX(stg_interp_constr1_entry)            \
+      SymX(stg_interp_constr2_entry)            \
+      SymX(stg_interp_constr3_entry)            \
+      SymX(stg_interp_constr4_entry)            \
+      SymX(stg_interp_constr5_entry)            \
+      SymX(stg_interp_constr6_entry)            \
+      SymX(stg_interp_constr7_entry)            \
+      SymX(stg_interp_constr8_entry)            \
+      SymX(stgMallocBytesRWX)                   \
+      SymX(getAllocations)                      \
+      SymX(revertCAFs)                          \
+      SymX(RtsFlags)                            \
       RTS_USER_SIGNALS_SYMBOLS
 
 #ifdef SUPPORT_LONG_LONGS