From a278f3f02d09bc32b0a75d4a04d710090cde250f Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 9 Dec 2010 11:40:05 +0000 Subject: [PATCH] Catch too-large allocations and emit an error message (#4505) This is a temporary measure until we fix the bug properly (which is somewhat tricky, and we think might be easier in the new code generator). For now we get: ghc-stage2: sorry! (unimplemented feature or known bug) (GHC version 7.1 for i386-unknown-linux): Trying to allocate more than 1040384 bytes. See: http://hackage.haskell.org/trac/ghc/ticket/4550 Suggestion: read data from a file instead of having large static data structures in the code. --- compiler/codeGen/CgHeapery.lhs | 10 ++++++++++ includes/HaskellConstants.hs | 5 +++++ includes/mkDerivedConstants.c | 2 ++ rts/Schedule.c | 4 ++++ 4 files changed, 21 insertions(+) diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index 23d8852..bc3e108 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -433,6 +433,16 @@ do_checks :: WordOff -- Stack headroom -> CmmExpr -- Rts address to jump to on failure -> Code do_checks 0 0 _ _ = nopC + +do_checks _ hp _ _ + | hp > bLOCKS_PER_MBLOCK * bLOCK_SIZE_W + = sorry (unlines [ + "Trying to allocate more than " ++ show (bLOCKS_PER_MBLOCK * bLOCK_SIZE) ++ " bytes.", + "", + "See: http://hackage.haskell.org/trac/ghc/ticket/4550", + "Suggestion: read data from a file instead of having large static data", + "structures in the code."]) + do_checks stk hp reg_save_code rts_lbl = do_checks' (CmmLit (mkIntCLit (stk*wORD_SIZE))) (CmmLit (mkIntCLit (hp*wORD_SIZE))) diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs index 4555b47..51cdcaf 100644 --- a/includes/HaskellConstants.hs +++ b/includes/HaskellConstants.hs @@ -183,6 +183,11 @@ bLOCK_SIZE = BLOCK_SIZE bLOCK_SIZE_W :: Int bLOCK_SIZE_W = bLOCK_SIZE `quot` wORD_SIZE +-- blocks that fit in an MBlock, leaving space for the block descriptors + +bLOCKS_PER_MBLOCK :: Int +bLOCKS_PER_MBLOCK = BLOCKS_PER_MBLOCK + -- Number of bits to shift a bitfield left by in an info table. bITMAP_BITS_SHIFT :: Int diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c index f0e514b..ade104a 100644 --- a/includes/mkDerivedConstants.c +++ b/includes/mkDerivedConstants.c @@ -195,6 +195,8 @@ main(int argc, char *argv[]) printf("#define BLOCK_SIZE %u\n", BLOCK_SIZE); printf("#define MBLOCK_SIZE %u\n", MBLOCK_SIZE); + printf("#define BLOCKS_PER_MBLOCK %lu\n", (lnat)BLOCKS_PER_MBLOCK); + // could be derived, but better to save doing the calculation twice printf("\n\n"); #endif diff --git a/rts/Schedule.c b/rts/Schedule.c index 5169895..bf39c0a 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1025,6 +1025,10 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t ) blocks = (lnat)BLOCK_ROUND_UP(cap->r.rHpAlloc) / BLOCK_SIZE; + if (blocks > BLOCKS_PER_MBLOCK) { + barf("allocation of %ld bytes too large (GHC should have complained at compile-time)", (long)cap->r.rHpAlloc); + } + debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n", (long)t->id, what_next_strs[t->what_next], blocks); -- 1.7.10.4