[project @ 2001-12-12 12:19:11 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 be8e4e0..f270795 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.24 2000/10/24 08:40:10 simonpj Exp $
+% $Id: CgHeapery.lhs,v 1.29 2001/12/12 12:19:11 simonmar Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -26,13 +26,11 @@ 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
 
@@ -73,9 +71,7 @@ fastEntryChecks regs tags ret node_points code
      getFinalStackHW                            (\ spHw -> 
      getRealSp                                  `thenFC` \ sp ->
      let stk_words = spHw - sp in
-     initHeapUsage                              (\ hp_words  ->
-
-     let hHw = if hp_words > bLOCK_SIZE_W then hpChkTooBig else hp_words in
+     initHeapUsage                              (\ hHw  ->
 
      getTickyCtrLabel `thenFC` \ ticky_ctr ->
 
@@ -113,7 +109,7 @@ fastEntryChecks regs tags ret node_points code
 
       ) `thenC`
 
-      setRealHp hp_words `thenC`
+      setRealHp hHw `thenC`
       code))
 
   where
@@ -254,9 +250,7 @@ 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 (if hHw > bLOCK_SIZE_W then hpChkTooBig else hHw) tag_assts 
-               `thenC` code)
+    initHeapUsage (\ hHw -> do_heap_chk hHw tag_assts `thenC` code)
   where
     do_heap_chk words_required tag_assts
       = getTickyCtrLabel `thenFC` \ ctr ->
@@ -314,10 +308,7 @@ 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 (if hHw > bLOCK_SIZE_W then hpChkTooBig else hHw) 
-               `thenC` code)
-                     
+  = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
   where
     do_heap_chk :: HeapOffset -> Code
     do_heap_chk words_required
@@ -386,10 +377,16 @@ altHeapCheck is_fun regs [] AbsCNop Nothing code
 
 -- build up a bitmap of the live pointer registers
 
+#if __GLASGOW_HASKELL__ >= 503
+shiftL = uncheckedShiftL#
+#else
+shiftL = shiftL#
+#endif
+
 mkRegLiveness :: [MagicId] -> Word#
 mkRegLiveness []  =  int2Word# 0#
 mkRegLiveness (VanillaReg rep i : regs) | isFollowableRep rep 
-  =  ((int2Word# 1#) `shiftL#` (i -# 1#)) `or#` mkRegLiveness regs
+  =  ((int2Word# 1#) `shiftL` (i -# 1#)) `or#` mkRegLiveness regs
 mkRegLiveness (_ : regs)  =  mkRegLiveness regs
 
 -- The two functions below are only used in a GranSim setup
@@ -443,10 +440,6 @@ yield regs node_reqd =
                           [mkIntCLit (I# (word2Int# liveness_mask))])
 \end{code}
 
-\begin{code}
-hpChkTooBig = panic "Oversize heap check detected.  Please try compiling with -O."
-\end{code}
-
 %************************************************************************
 %*                                                                     *
 \subsection[initClosure]{Initialise a dynamic closure}
@@ -489,13 +482,11 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
 
        -- GENERATE THE CODE
     absC ( mkAbstractCs (
-          [ cInitHdr closure_info (hpRel realHp info_offset) use_cc ]
+          [ CInitHdr closure_info 
+               (CAddr (hpRel realHp info_offset)) 
+               use_cc closure_size ]
           ++ (map do_move amodes_with_offsets)))       `thenC`
 
-       -- GENERATE CC PROFILING MESSAGES
-    costCentresC SLIT("CCS_ALLOC") [blame_cc, mkIntCLit closure_size]
-                                                       `thenC`
-
        -- BUMP THE VIRTUAL HEAP POINTER
     setVirtHp (virtHp + closure_size)                  `thenC`
 
@@ -533,13 +524,6 @@ inPlaceAllocDynClosure closure_info head use_cc amodes_with_offsets
     in
        -- GENERATE THE CODE
     absC ( mkAbstractCs (
-          [ CInitHdr closure_info head use_cc ]
+          [ CInitHdr closure_info head use_cc 0{-no alloc-} ]
           ++ (map do_move amodes_with_offsets)))
-
--- Avoid hanging on to anything in the CC field when we're not profiling.
-
-cInitHdr closure_info amode cc 
-  | opt_SccProfilingOn = CInitHdr closure_info (CAddr amode) cc
-  | otherwise          = CInitHdr closure_info (CAddr amode) (panic "absent cc")
-       
 \end{code}