[project @ 2000-09-06 12:21:15 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgHeapery.lhs

diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs
index a4f6bc2..6ec7c84 100644 (file)
--- 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.19 1999/10/13 16:39:15 simonmar Exp $
+% $Id: CgHeapery.lhs,v 1.23 2000/07/26 14:48:16 simonmar Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -21,7 +21,6 @@ import CLabel
 import CgMonad
 
 import CgStackery      ( getFinalStackHW, mkTaggedStkAmodes, mkTagAssts )
-import SMRep           ( fixedHdrSize )
 import AbsCUtils       ( mkAbstractCs, getAmodeRep )
 import CgUsages                ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp,
                          initHeapUsage
@@ -32,7 +31,8 @@ import ClosureInfo    ( closureSize, closureGoodStuffSize,
                        )
 import PrimRep         ( PrimRep(..), isFollowableRep )
 import Unique          ( Unique )
-import CmdLineOpts     ( opt_SccProfilingOn )
+import CmdLineOpts     ( opt_SccProfilingOn, opt_GranMacros )
+import Constants       ( bLOCK_SIZE_W )
 import GlaExts
 import Outputable
 
@@ -75,10 +75,16 @@ 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
-         absC (checking_code stk_words hp_words tag_assts 
+          -- HWL: gran-yield immediately before heap check proper
+          --(if node `elem` regs
+          --   then yield regs True
+          --   else absC AbsCNop ) `thenC`
+         absC (checking_code stk_words hHw tag_assts 
                        free_reg (length regs) ticky_ctr)
 
        else -- they are complicated
@@ -100,7 +106,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)
@@ -248,7 +254,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 ->
@@ -306,7 +314,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
@@ -382,22 +392,21 @@ mkRegLiveness (VanillaReg rep i : regs) | isFollowableRep rep
   =  ((int2Word# 1#) `shiftL#` (i -# 1#)) `or#` mkRegLiveness regs
 mkRegLiveness (_ : regs)  =  mkRegLiveness regs
 
+-- The two functions below are only used in a GranSim setup
 -- Emit macro for simulating a fetch and then reschedule
 
 fetchAndReschedule ::   [MagicId]               -- Live registers
                        -> Bool                 -- Node reqd?
                        -> Code
 
-fetchAndReschedule regs node_reqd  =
+fetchAndReschedule regs node_reqd  = 
       if (node `elem` regs || node_reqd)
        then fetch_code `thenC` reschedule_code
        else absC AbsCNop
       where
-       all_regs = if node_reqd then node:regs else regs
-       liveness_mask = 0 {-XXX: mkLiveRegsMask all_regs-}
-
+        liveness_mask = mkRegLiveness regs
        reschedule_code = absC  (CMacroStmt GRAN_RESCHEDULE [
-                                mkIntCLit liveness_mask,
+                                 mkIntCLit (IBOX(word2Int# liveness_mask)), 
                                 mkIntCLit (if node_reqd then 1 else 0)])
 
         --HWL: generate GRAN_FETCH macro for GrAnSim
@@ -423,15 +432,19 @@ yield ::   [MagicId]               -- Live registers
              -> Bool                 -- Node reqd?
              -> Code 
 
-yield regs node_reqd =
-      -- NB: node is not alive; that's why we use DO_YIELD rather than 
-      --     GRAN_RESCHEDULE 
-      yield_code
-      where
-        all_regs = if node_reqd then node:regs else regs
-        liveness_mask = 0 {-XXX: mkLiveRegsMask all_regs-}
+yield regs node_reqd = 
+   if opt_GranMacros && node_reqd
+     then yield_code
+     else absC AbsCNop
+   where
+     liveness_mask = mkRegLiveness regs
+     yield_code = 
+       absC (CMacroStmt GRAN_YIELD 
+                          [mkIntCLit (IBOX(word2Int# liveness_mask))])
+\end{code}
 
-        yield_code = absC (CMacroStmt GRAN_YIELD [mkIntCLit liveness_mask])
+\begin{code}
+hpChkTooBig = panic "Oversize heap check detected.  Please try compiling with -O."
 \end{code}
 
 %************************************************************************