X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgMonad.lhs;h=937c879758dfb4da50fe179c44860d8fea995763;hb=67944e157c667338e206f0cca6c48319ebc256d0;hp=cb01374ad974eb7f080d96d4d63d49fb682bb21f;hpb=c31a55d1d200e9d1d72d0f09fce5204c425b801d;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index cb01374..937c879 100644
--- 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.27 2001/08/29 14:20:14 rje Exp $
+% $Id: CgMonad.lhs,v 1.35 2002/09/13 15:02:28 simonpj Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -23,12 +23,12 @@ module CgMonad (
 	EndOfBlockInfo(..),
 	setEndOfBlockInfo, getEndOfBlockInfo,
 
-	setSRTLabel, getSRTLabel,
+	setSRTLabel, getSRTLabel, getSRTInfo,
 	setTickyCtrLabel, getTickyCtrLabel,
 
 	StackUsage, Slot(..), HeapUsage,
 
-	profCtrC, profCtrAbsC,
+	profCtrC, profCtrAbsC, ldvEnter,
 
 	costCentresC, moduleName,
 
@@ -53,6 +53,7 @@ import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
 import {-# SOURCE #-} CgUsages  ( getSpRelOffset )
 
 import AbsCSyn
+import StgSyn		( SRT(..) )
 import AbsCUtils	( mkAbsCStmts )
 import CmdLineOpts	( opt_SccProfilingOn, opt_DoTickyProfiling )
 import CLabel           ( CLabel, mkUpdInfoLabel, mkTopTickyCtrLabel )
@@ -61,6 +62,7 @@ import DataCon		( ConTag )
 import Id		( Id )
 import VarEnv
 import PrimRep		( PrimRep(..) )
+import FastString
 import Outputable
 
 infixr 9 `thenC`	-- Right-associative!
@@ -279,7 +281,7 @@ initC :: CompilationInfo -> Code -> AbstractC
 initC cg_info (FCode code)
   = case (code (MkCgInfoDown 
 			cg_info 
-			(error "initC: statics")
+			emptyVarEnv -- (error "initC: statics")
 			(error "initC: srt")
 			(mkTopTickyCtrLabel)
 			initEobInfo)
@@ -293,7 +295,7 @@ returnFC val = FCode (\info_down state -> (val, state))
 \begin{code}
 thenC :: Code -> FCode a -> FCode a
 thenC (FCode m) (FCode k) = 
-  	FCode (\info_down state -> let ((),new_state) = m info_down state in 
+  	FCode (\info_down state -> let (_,new_state) = m info_down state in 
   		k info_down new_state)
 
 listCs :: [Code] -> Code
@@ -548,30 +550,23 @@ info (whether SCC profiling or profiling-ctrs going) and possibly emit
 nothing.
 
 \begin{code}
-costCentresC :: FAST_STRING -> [CAddrMode] -> Code
+costCentresC :: FastString -> [CAddrMode] -> Code
+costCentresC macro args
+ | opt_SccProfilingOn  = absC (CCallProfCCMacro macro args)
+ | otherwise           = nopC
 
-costCentresC macro args = 
-	if opt_SccProfilingOn then do
-		(MkCgState absC binds usage) <- getState
-		setState $ MkCgState (mkAbsCStmts absC (CCallProfCCMacro macro args)) binds usage
-	else
-		nopC
-
-profCtrC :: FAST_STRING -> [CAddrMode] -> Code
-
-profCtrC macro args = 
-	if not opt_DoTickyProfiling
-    then nopC
-	else do
-		(MkCgState absC binds usage) <- getState
-		setState $ MkCgState (mkAbsCStmts absC (CCallProfCtrMacro macro args)) binds usage
-
-profCtrAbsC :: FAST_STRING -> [CAddrMode] -> AbstractC
+profCtrC :: FastString -> [CAddrMode] -> Code
+profCtrC macro args
+ | opt_DoTickyProfiling = absC (CCallProfCtrMacro macro args)
+ | otherwise            = nopC
 
+profCtrAbsC :: FastString -> [CAddrMode] -> AbstractC
 profCtrAbsC macro args
-  = if not opt_DoTickyProfiling
-    then AbsCNop
-    else CCallProfCtrMacro macro args
+ | opt_DoTickyProfiling = CCallProfCtrMacro macro args
+ | otherwise            = AbsCNop
+
+ldvEnter :: Code
+ldvEnter = costCentresC FSLIT("LDV_ENTER") [CReg node]
 
 {- Try to avoid adding too many special compilation strategies here.
    It's better to modify the header files as necessary for particular
@@ -614,16 +609,24 @@ getEndOfBlockInfo = do
 	return eob_info
 \end{code}
 
+There is just one SRT for each top level binding; all the nested
+bindings use sub-sections of this SRT.  The label is passed down to
+the nested bindings via the monad.
+
 \begin{code}
-getSRTLabel :: FCode CLabel
-getSRTLabel = do 
-	(MkCgInfoDown _ _ srt _ _) <- getInfoDown
-	return srt
+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)
+
+getSRTLabel :: FCode CLabel	-- Used only by cgPanic
+getSRTLabel = do MkCgInfoDown _ _ srt_lbl _ _ <- getInfoDown
+		 return srt_lbl
 
 setSRTLabel :: CLabel -> Code -> Code
-setSRTLabel srt code = do
-	(MkCgInfoDown c_info statics _ ticky eob_info) <- getInfoDown
-	withInfoDown code (MkCgInfoDown c_info statics srt ticky eob_info)
+setSRTLabel srt_lbl code
+  = do  MkCgInfoDown c_info statics _ ticky eob_info <- getInfoDown
+	withInfoDown code (MkCgInfoDown c_info statics srt_lbl ticky eob_info)
 \end{code}
 
 \begin{code}