diff options
author | Simon Marlow <marlowsd@gmail.com> | 2011-12-12 14:18:30 +0000 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2011-12-13 08:58:58 +0000 |
commit | d95a7f1311578cf37c0889098d32cbcb8964d906 (patch) | |
tree | c5605dbe16c36c16cfe0f26faeb0ad66e41d1b33 | |
parent | a02eb298d3f6089e51a43307ffb37e3a8076c8fd (diff) | |
download | haskell-d95a7f1311578cf37c0889098d32cbcb8964d906.tar.gz |
Avoid integer overflow when calling allocGroup() (#5071)
-rw-r--r-- | rts/hooks/OutOfHeap.c | 8 | ||||
-rw-r--r-- | rts/sm/Storage.c | 7 |
2 files changed, 11 insertions, 4 deletions
diff --git a/rts/hooks/OutOfHeap.c b/rts/hooks/OutOfHeap.c index 1945c51802..30c492dd16 100644 --- a/rts/hooks/OutOfHeap.c +++ b/rts/hooks/OutOfHeap.c @@ -14,7 +14,11 @@ OutOfHeapHook (lnat request_size, lnat 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 */ - 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 (heap_size > 0) { + errorBelch("Heap exhausted;\nCurrent maximum heap size is %lu bytes (%lu MB);\nuse `+RTS -M<size>' to increase it.", + heap_size, heap_size / (1024*1024)); + } else { + errorBelch("out of memory"); + } } diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index fe7bf435eb..dc887c3147 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -627,8 +627,11 @@ allocate (Capability *cap, lnat n) // Attempting to allocate an object larger than maxHeapSize // should definitely be disallowed. (bug #1791) - if (RtsFlags.GcFlags.maxHeapSize > 0 && - req_blocks >= RtsFlags.GcFlags.maxHeapSize) { + if ((RtsFlags.GcFlags.maxHeapSize > 0 && + req_blocks >= RtsFlags.GcFlags.maxHeapSize) || + req_blocks >= HS_INT32_MAX) // avoid overflow when + // calling allocGroup() below + { heapOverflow(); // heapOverflow() doesn't exit (see #2592), but we aren't // in a position to do a clean shutdown here: we |