X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgHeapery.lhs;h=a48079efbaa44f26f57e77d219c91fa6977919a6;hb=48081b06ec1aeb42c7d98d2dfa83e3df53ffb7a6;hp=31cb2378911cb7d81304a76fb2eabc81f3cfa7b0;hpb=8d873902b0ba7e267089f9e1faf690368670fe62;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index 31cb237..a48079e 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgHeapery.lhs,v 1.22 2000/07/14 08:14:53 simonpj Exp $ +% $Id: CgHeapery.lhs,v 1.25 2000/11/06 08:15:21 simonpj Exp $ % \section[CgHeapery]{Heap management functions} @@ -26,12 +26,12 @@ import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp, initHeapUsage ) import ClosureInfo ( closureSize, closureGoodStuffSize, - slopSize, allocProfilingMsg, ClosureInfo, - closureSMRep + slopSize, allocProfilingMsg, ClosureInfo ) import PrimRep ( PrimRep(..), isFollowableRep ) import Unique ( Unique ) import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros ) +import Constants ( bLOCK_SIZE_W ) import GlaExts import Outputable @@ -74,6 +74,8 @@ fastEntryChecks regs tags ret node_points code let stk_words = spHw - sp in initHeapUsage (\ hp_words -> + let hHw = if hp_words > bLOCK_SIZE_W then hpChkTooBig else hp_words in + getTickyCtrLabel `thenFC` \ ticky_ctr -> ( if all_pointers then -- heap checks are quite easy @@ -81,7 +83,7 @@ fastEntryChecks regs tags ret node_points code --(if node `elem` regs -- then yield regs True -- else absC AbsCNop ) `thenC` - absC (checking_code stk_words hp_words tag_assts + absC (checking_code stk_words hHw tag_assts free_reg (length regs) ticky_ctr) else -- they are complicated @@ -103,7 +105,7 @@ fastEntryChecks regs tags ret node_points code let adjust_sp = CAssign (CReg Sp) (CAddr (spRel sp new_sp)) in - absC (checking_code real_stk_words hp_words + absC (checking_code real_stk_words hHw (mkAbstractCs [tag_assts, stk_assts, more_tag_assts, adjust_sp]) (CReg node) 0 ticky_ctr) @@ -194,7 +196,7 @@ fastEntryChecks regs tags ret node_points code tag_assts free_reg = case length regs + 1 of - IBOX(x) -> CReg (VanillaReg PtrRep x) + I# x -> CReg (VanillaReg PtrRep x) all_pointers = all pointer regs pointer (VanillaReg rep _) = isFollowableRep rep @@ -251,7 +253,9 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) code = mkTagAssts tags `thenFC` \tag_assts1 -> let tag_assts = mkAbstractCs [fail_code, tag_assts1] in - initHeapUsage (\ hHw -> do_heap_chk hHw tag_assts `thenC` code) + initHeapUsage (\ hHw -> + do_heap_chk (if hHw > bLOCK_SIZE_W then hpChkTooBig else hHw) tag_assts + `thenC` code) where do_heap_chk words_required tag_assts = getTickyCtrLabel `thenFC` \ ctr -> @@ -278,19 +282,19 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) code tag_assts -} -- this will cover all cases for x86 - [VanillaReg rep ILIT(1)] + [VanillaReg rep 1#] | isFollowableRep rep -> CCheck HP_CHK_UT_ALT [mkIntCLit words_required, mkIntCLit 1, mkIntCLit 0, - CReg (VanillaReg RetRep ILIT(2)), + CReg (VanillaReg RetRep 2#), CLbl (mkReturnInfoLabel ret_addr) RetRep] tag_assts | otherwise -> CCheck HP_CHK_UT_ALT [mkIntCLit words_required, mkIntCLit 0, mkIntCLit 1, - CReg (VanillaReg RetRep ILIT(2)), + CReg (VanillaReg RetRep 2#), CLbl (mkReturnInfoLabel ret_addr) RetRep] tag_assts @@ -299,7 +303,7 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) code in CCheck HP_CHK_GEN [mkIntCLit words_required, - mkIntCLit (IBOX(word2Int# liveness)), + mkIntCLit (I# (word2Int# liveness)), -- HP_CHK_GEN needs a direct return address, -- not an info table (might be different if -- we're not assembly-mangling/tail-jumping etc.) @@ -309,7 +313,9 @@ altHeapCheck is_fun regs tags fail_code (Just ret_addr) code -- normal algebraic and primitive case alternatives: altHeapCheck is_fun regs [] AbsCNop Nothing code - = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code) + = initHeapUsage (\ hHw -> + do_heap_chk (if hHw > bLOCK_SIZE_W then hpChkTooBig else hHw) + `thenC` code) where do_heap_chk :: HeapOffset -> Code @@ -339,7 +345,7 @@ altHeapCheck is_fun regs [] AbsCNop Nothing code -- We need this case because the closure in Node won't return -- directly when we enter it (it could be a function), so the -- heap check code needs to push a seq frame on top of the stack. - [VanillaReg rep ILIT(1)] + [VanillaReg rep 1#] | rep == PtrRep && is_fun -> CCheck HP_CHK_SEQ_NP @@ -347,7 +353,7 @@ altHeapCheck is_fun regs [] AbsCNop Nothing code AbsCNop -- R1 is lifted (the common case) - [VanillaReg rep ILIT(1)] + [VanillaReg rep 1#] | rep == PtrRep -> CCheck HP_CHK_NP [mkIntCLit words_required, mkIntCLit 1{-regs live-}] @@ -362,15 +368,15 @@ altHeapCheck is_fun regs [] AbsCNop Nothing code CCheck HP_CHK_UNBX_R1 [mkIntCLit words_required] AbsCNop -- FloatReg1 - [FloatReg ILIT(1)] -> + [FloatReg 1#] -> CCheck HP_CHK_F1 [mkIntCLit words_required] AbsCNop -- DblReg1 - [DoubleReg ILIT(1)] -> + [DoubleReg 1#] -> CCheck HP_CHK_D1 [mkIntCLit words_required] AbsCNop -- LngReg1 - [LongReg _ ILIT(1)] -> + [LongReg _ 1#] -> CCheck HP_CHK_L1 [mkIntCLit words_required] AbsCNop #ifdef DEBUG @@ -399,7 +405,7 @@ fetchAndReschedule regs node_reqd = where liveness_mask = mkRegLiveness regs reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [ - mkIntCLit (IBOX(word2Int# liveness_mask)), + mkIntCLit (I# (word2Int# liveness_mask)), mkIntCLit (if node_reqd then 1 else 0)]) --HWL: generate GRAN_FETCH macro for GrAnSim @@ -433,7 +439,11 @@ yield regs node_reqd = liveness_mask = mkRegLiveness regs yield_code = absC (CMacroStmt GRAN_YIELD - [mkIntCLit (IBOX(word2Int# liveness_mask))]) + [mkIntCLit (I# (word2Int# liveness_mask))]) +\end{code} + +\begin{code} +hpChkTooBig = panic "Oversize heap check detected. Please try compiling with -O." \end{code} %************************************************************************