[project @ 2003-05-29 14:39:26 by sof]

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

diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 2a7e3ea..99c776e 100644 (file)
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ b/ghc/compiler/codeGen/CgMonad.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgMonad.lhs,v 1.36 2002/12/11 15:36:26 simonmar Exp $
+% $Id: CgMonad.lhs,v 1.38 2003/05/14 09:13:56 simonmar Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -60,8 +60,10 @@ import CmdLineOpts   ( opt_SccProfilingOn, opt_DoTickyProfiling )
 import Module          ( Module )
 import DataCon         ( ConTag )
 import Id              ( Id )
+import Name            ( Name )
 import VarEnv
 import PrimRep         ( PrimRep(..) )
+import SMRep           ( StgHalfWord, hALF_WORD )
 import FastString
 import Outputable
 
@@ -206,6 +208,14 @@ type StackUsage =
         Int,              -- realSp:  Virtual offset of real stack pointer
         Int)              -- hwSp:    Highest value ever taken by virtSp
 
+-- ToDo (SDM, 7 Jan 2003): I'm not sure that the distinction between
+-- Free and NonPointer in the free list is needed any more.  It used
+-- to be needed because we constructed bitmaps from the free list, but
+-- now we construct bitmaps by finding all the live pointer bindings
+-- instead.  Non-pointer stack slots (i.e. saved cost centres) can
+-- just be removed from the free list instead of being recorded as a
+-- NonPointer.
+
 type HeapUsage =
        (HeapOffset,    -- virtHp: Virtual offset of highest-allocated word
         HeapOffset)    -- realHp: Virtual offset of real heap ptr
@@ -597,16 +607,25 @@ bindings use sub-sections of this SRT.  The label is passed down to
 the nested bindings via the monad.
 
 \begin{code}
-getSRTInfo :: SRT -> FCode C_SRT
-getSRTInfo NoSRT        = return NoC_SRT
-getSRTInfo (SRT off len) = do srt_lbl <- getSRTLabel
-                             return (C_SRT srt_lbl off len)
+getSRTInfo :: Name -> SRT -> FCode C_SRT
+getSRTInfo id NoSRT = return NoC_SRT
+getSRTInfo id (SRT off len bmp)
+  | len > hALF_WORD || bmp == [fromIntegral srt_escape] = do 
+       srt_lbl <- getSRTLabel
+       let srt_desc_lbl = mkSRTDescLabel id
+       absC (CSRTDesc srt_desc_lbl srt_lbl off len bmp)
+       return (C_SRT srt_desc_lbl 0 srt_escape)
+  | otherwise = do
+       srt_lbl <- getSRTLabel
+       return (C_SRT srt_lbl off (fromIntegral (head bmp)))
+
+srt_escape = (-1) :: StgHalfWord
 
 getSRTLabel :: FCode CLabel    -- Used only by cgPanic
 getSRTLabel = do MkCgInfoDown _ _ srt_lbl _ _ <- getInfoDown
                 return srt_lbl
 
-setSRTLabel :: CLabel -> Code -> Code
+setSRTLabel :: CLabel -> FCode a -> FCode a
 setSRTLabel srt_lbl code
   = do  MkCgInfoDown c_info statics _ ticky eob_info <- getInfoDown
        withInfoDown code (MkCgInfoDown c_info statics srt_lbl ticky eob_info)