From 65691f95b3727c277a24ec5f0d5a4058c9a681e2 Mon Sep 17 00:00:00 2001 From: Lemmih Date: Mon, 23 Jan 2006 11:06:25 +0000 Subject: [PATCH] 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. --- ghc/compiler/Makefile | 2 +- ghc/compiler/parser/cutils.c | 70 ++++++++++++++++++++++++++++++++++++++++ ghc/compiler/parser/cutils.h | 16 +++++++++ ghc/compiler/parser/hschooks.c | 36 --------------------- ghc/compiler/parser/hschooks.h | 6 ---- ghc/rts/Linker.c | 13 ++++++++ 6 files changed, 100 insertions(+), 43 deletions(-) create mode 100644 ghc/compiler/parser/cutils.c create mode 100644 ghc/compiler/parser/cutils.h diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 97cd2c6..7298560 100644 --- 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 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 + +#ifdef HAVE_UNISTD_H +#include +#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 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 --- 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' 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 --- 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 --- 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 -- 1.7.10.4