rts: add "-no-rtsopts-suggestions" option
[ghc.git] / rts / hooks / OutOfHeap.c
index 1945c51..5e68750 100644 (file)
@@ -6,15 +6,31 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
+#include "Hooks.h"
+#include "RtsFlags.h"
 #include <stdio.h>
 
 void
-OutOfHeapHook (lnat request_size, lnat heap_size) /* both sizes in bytes */
+OutOfHeapHook (W_ request_size, W_ heap_size) /* both sizes in bytes */
 {
-  /*    fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n", */
+    (void)request_size;   /* keep gcc -Wall happy */
+    if (heap_size > 0) {
+        errorBelch("Heap exhausted;");
+        errorBelch("Current maximum heap size is %" FMT_Word
+                   " bytes (%" FMT_Word " MB).",
+                   heap_size, heap_size / (1024*1024));
 
-  (void)request_size;   /* keep gcc -Wall happy */
-  fprintf(stderr, "Heap exhausted;\nCurrent maximum heap size is %lu bytes (%lu MB);\nuse `+RTS -M<size>' to increase it.\n",
-         heap_size, heap_size / (1024*1024));
-}
+        if (rtsConfig.rts_opts_suggestions == rtsTrue) {
+
+            if (rtsConfig.rts_opts_enabled == RtsOptsAll) {
+                errorBelch("Use `+RTS -M<size>' to increase it.");
+            } else {
+                errorBelch("Relink with -rtsopts and "
+                           "use `+RTS -M<size>' to increase it.");
+            }
 
+        }
+    } else {
+        errorBelch("Out of memory.\n");
+    }
+}