X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2Fhschooks.c;h=f3e7447a494e78574ddd71cf923773ef0d4acfdd;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=de549363dc519cf065a515685d9f6e8cc93df192;hpb=19bbe5eb14f549aa8ed395bebbb99a2f4dd668ca;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/hschooks.c b/ghc/compiler/parser/hschooks.c index de54936..f3e7447 100644 --- a/ghc/compiler/parser/hschooks.c +++ b/ghc/compiler/parser/hschooks.c @@ -4,141 +4,52 @@ 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 + * 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 "rtsdefs.h" +#include "Rts.h" +#include "RtsFlags.h" #endif -#if __GLASGOW_HASKELL__ >= 408 -#include "../rts/RtsFlags.h" #include "HsFFI.h" + +#include + +#ifdef HAVE_UNISTD_H +#include #endif 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 } 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 ) -{ -#if __GLASGOW_HASKELL__ >= 408 - RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE; - if (RtsFlags.GcFlags.heapSizeSuggestion > - RtsFlags.GcFlags.maxHeapSize) { - RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; - } -#endif -} - -#if __GLASGOW_HASKELL__ >= 303 - -void -ErrorHdrHook (long fd) -{ - char msg[]="\n"; - write(fd,msg,1); -} - -void -PatErrorHdrHook (long fd) -{ - const char msg[]="\n*** Pattern-matching error within GHC!\n\nThis is a compiler bug; please report it to glasgow-haskell-bugs@haskell.org.\n\nFail:"; - write(fd,msg,sizeof(msg)-1); -} - -void -PreTraceHook (long fd) -{ - 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 -} - -#else /* pre-3.03 GHC with old IO system */ - -void -ErrorHdrHook (FILE *where) -{ - fprintf(where, "\n"); /* no "Fail: " */ -} - -void -PatErrorHdrHook (FILE *where) -{ - fprintf(where, "\n*** Pattern-matching error within GHC!\n\nThis is a compiler bug; please report it to glasgow-haskell-bugs@haskell.org.\n\nFail: "); -} - -void -PreTraceHook (FILE *where) -{ - fprintf(where, "\n"); /* not "Trace On" */ -} - -void -PostTraceHook (FILE *where) -{ - fprintf(where, "\n"); /* not "Trace Off" */ -} - -#endif - -#if __GLASGOW_HASKELL__ >= 400 -void -OutOfHeapHook (unsigned long request_size, unsigned long heap_size) - /* both in bytes */ +OutOfHeapHook (unsigned long request_size/* always zero these days */, + 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); -} - -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); + fprintf(stderr, "GHC stack-space overflow: current limit is %ld bytes.\nUse the `-K' option to increase it.\n", stack_size); } -#endif