X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2Fhschooks.c;h=cca3002fc56201ef7d6a2f864202a77c4c504192;hb=aafc20f801e42f218f2537a97b5609445129254d;hp=a9fd56a3f52456ed6e1e1154cb7f7509397ee0fb;hpb=1ca2417ee22d6d35c06ff9ac89683004e23e614f;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/hschooks.c b/ghc/compiler/parser/hschooks.c index a9fd56a..cca3002 100644 --- a/ghc/compiler/parser/hschooks.c +++ b/ghc/compiler/parser/hschooks.c @@ -4,16 +4,23 @@ for various bits of the RTS. They are linked in instead of the defaults. */ -#if __GLASGOW_HASKELL__ >= 400 -#include "Rts.h" +/* For GHC 4.08, we are relying on the fact that RtsFlags has + * compatibile 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 "rtsdefs.h" +#include "Rts.h" +#include "RtsFlags.h" #endif -#if __GLASGOW_HASKELL__ >= 408 -#include "../includes/RtsFlags.h" #include "HsFFI.h" -#endif + +#include #ifdef HAVE_UNISTD_H #include @@ -22,11 +29,10 @@ in instead of the defaults. void defaultsHook (void) { -#if __GLASGOW_HASKELL__ >= 408 RtsFlags.GcFlags.heapSizeSuggestion = 6*1024*1024 / BLOCK_SIZE; RtsFlags.GcFlags.maxStkSize = 8*1024*1024 / sizeof(W_); -#endif #if __GLASGOW_HASKELL__ >= 411 + /* GHC < 4.11 didn't have these */ RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS; RtsFlags.GcFlags.statsFile = stderr; #endif @@ -44,65 +50,28 @@ enableTimingStats( void ) /* called from the driver */ void setHeapSize( HsInt size ) { -#if __GLASGOW_HASKELL__ >= 408 RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE; if (RtsFlags.GcFlags.maxHeapSize != 0 && RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) { RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; } -#endif } void -PreTraceHook (long fd) +OutOfHeapHook (unsigned long request_size/* always zero these days */, + unsigned long heap_size) + /* both in bytes */ { - const char msg[]="\n"; - write(fd,msg,sizeof(msg)-1); -} - -void -PostTraceHook (long fd) -{ -#if 0 - const char msg[]="\n"; - write(fd,msg,sizeof(msg)-1); -#endif -} - -#if __GLASGOW_HASKELL__ >= 400 -void -OutOfHeapHook (unsigned long request_size, unsigned long heap_size) - /* both in bytes */ -{ - fprintf(stderr, "GHC's heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse the `-H' option to increase the total heap size.\n", - request_size, + fprintf(stderr, "GHC's heap exhausted: current limit is %lu bytes;\nUse the `-M' option to increase the total heap size.\n", heap_size); } void StackOverflowHook (unsigned long stack_size) /* in bytes */ { - fprintf(stderr, "GHC stack-space overflow: current size %ld bytes.\nUse the `-K' option to increase it.\n", stack_size); -} - -#else /* GHC < 4.00 */ - -void -OutOfHeapHook (W_ request_size, W_ heap_size) /* both in bytes */ -{ - fprintf(stderr, "GHC's heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse the `-H' option to increase the total heap size.\n", - request_size, - heap_size); + fprintf(stderr, "GHC stack-space overflow: current limit is %ld bytes.\nUse the `-K' option to increase it.\n", stack_size); } -void -StackOverflowHook (I_ stack_size) /* in bytes */ -{ - fprintf(stderr, "GHC stack-space overflow: current size %ld bytes.\nUse the `-K' option to increase it.\n", stack_size); -} - -#endif - HsInt ghc_strlen( HsAddr a ) {