Commit 65691f95 authored by David Himmelstrup's avatar David Himmelstrup

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.
parent 95c75256
......@@ -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.
......
/*
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;
}
}
/* -----------------------------------------------------------------------------
*
* 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 );
......@@ -38,25 +38,6 @@ defaultsHook (void)
#endif
}
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)
......@@ -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));
}
......@@ -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 );
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment