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