ghc/compiler/parser/hschooks.c

   1 /*
   2 These routines customise the error messages
   3 for various bits of the RTS.  They are linked
   4 in instead of the defaults.
   5 */
   6
   7 #if __GLASGOW_HASKELL__ >= 400
   8 #include "Rts.h"
   9 #else
  10 #include "rtsdefs.h"
  11 #endif
  12
  13 #if __GLASGOW_HASKELL__ >= 408
  14 #include "../rts/RtsFlags.h"
  15 #include "HsFFI.h"
  16 #endif
  17
  18 void
  19 defaultsHook (void)
  20 {
  21 #if __GLASGOW_HASKELL__ >= 408
  22     RtsFlags.GcFlags.heapSizeSuggestion = 6*1024*1024 / BLOCK_SIZE;
  23 #endif
  24 #if __GLASGOW_HASKELL__ >= 411
  25     RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
  26     RtsFlags.GcFlags.statsFile = stderr;
  27 #endif
  28 }
  29
  30 void
  31 enableTimingStats( void )       /* called from the driver */
  32 {
  33 #if __GLASGOW_HASKELL__ >= 411
  34     RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
  35 #endif
  36     /* ignored when bootstrapping with an older GHC */
  37 }
  38
  39 void
  40 setHeapSize( HsInt size )
  41 {
  42 #if __GLASGOW_HASKELL__ >= 408
  43     RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;
  44     if (RtsFlags.GcFlags.heapSizeSuggestion >
  45         RtsFlags.GcFlags.maxHeapSize) {
  46         RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
  47     }
  48 #endif
  49 }
  50
  51 #if __GLASGOW_HASKELL__ >= 303
  52
  53 void
  54 ErrorHdrHook (long fd)
  55 {
  56     char msg[]="\n";
  57     write(fd,msg,1);
  58 }
  59
  60 void
  61 PatErrorHdrHook (long fd)
  62 {
  63     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:";
  64     write(fd,msg,sizeof(msg)-1);
  65 }
  66
  67 void
  68 PreTraceHook (long fd)
  69 {
  70     const char msg[]="\n";
  71     write(fd,msg,sizeof(msg)-1);
  72 }
  73
  74 void
  75 PostTraceHook (long fd)
  76 {
  77 #if 0
  78     const char msg[]="\n";
  79     write(fd,msg,sizeof(msg)-1);
  80 #endif
  81 }
  82
  83 #else /* pre-3.03 GHC with old IO system */
  84
  85 void
  86 ErrorHdrHook (FILE *where)
  87 {
  88     fprintf(where, "\n"); /* no "Fail: " */
  89 }
  90
  91 void
  92 PatErrorHdrHook (FILE *where)
  93 {
  94     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: ");
  95 }
  96
  97 void
  98 PreTraceHook (FILE *where)
  99 {
 100     fprintf(where, "\n"); /* not "Trace On" */
 101 }
 102
 103 void
 104 PostTraceHook (FILE *where)
 105 {
 106     fprintf(where, "\n"); /* not "Trace Off" */
 107 }
 108
 109 #endif
 110
 111 #if __GLASGOW_HASKELL__ >= 400
 112 void
 113 OutOfHeapHook (unsigned long request_size, unsigned long heap_size)
 114   /* both in bytes */
 115 {
 116     fprintf(stderr, "GHC's heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse the `-H<size>' option to increase the total heap size.\n",
 117         request_size,
 118         heap_size);
 119 }
 120
 121 void
 122 StackOverflowHook (unsigned long stack_size)    /* in bytes */
 123 {
 124     fprintf(stderr, "GHC stack-space overflow: current size %ld bytes.\nUse the `-K<size>' option to increase it.\n", stack_size);
 125 }
 126
 127 #else /* GHC < 4.00 */
 128
 129 void
 130 OutOfHeapHook (W_ request_size, W_ heap_size)  /* both in bytes */
 131 {
 132     fprintf(stderr, "GHC's heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse the `-H<size>' option to increase the total heap size.\n",
 133         request_size,
 134         heap_size);
 135 }
 136
 137 void
 138 StackOverflowHook (I_ stack_size)    /* in bytes */
 139 {
 140     fprintf(stderr, "GHC stack-space overflow: current size %ld bytes.\nUse the `-K<size>' option to increase it.\n", stack_size);
 141 }
 142
 143 #endif