X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgClosure.lhs;h=e7d70e4fa56d7fadc1af55e8f07bf26969a4d386;hb=e3b49acc7f2bdb14bfb59886877a0c639ea71c71;hp=8aca152e894eb9d455202c5cb6460e9811657273;hpb=ffa647ba054966f3d8dea4032ff225097fe5b3e6;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 8aca152..e7d70e4f 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.52 2001/11/06 11:02:05 simonmar Exp $
+% $Id: CgClosure.lhs,v 1.56 2002/03/14 15:27:17 simonpj Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -46,7 +46,7 @@ import ClosureInfo	-- lots and lots of stuff
 import CmdLineOpts	( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
 import CostCentre	
 import Id		( Id, idName, idType, idPrimRep )
-import Name		( Name, isLocalName )
+import Name		( Name, isInternalName )
 import Module		( Module, pprModule )
 import ListSetOps	( minusList )
 import PrimRep		( PrimRep(..) )
@@ -86,30 +86,18 @@ cgTopRhsClosure id ccs binder_info srt args body lf_info
     let
     	name          = idName id
 	closure_info  = layOutStaticNoFVClosure name lf_info srt_info
-    	closure_label = mkClosureLabel name
+	closure_label = mkClosureLabel name
     	cg_id_info    = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
     in
 
 	-- BUILD THE OBJECT (IF NECESSARY)
-    ({- if staticClosureRequired name binder_info lf_info
-     then -}
-	(if opt_SccProfilingOn 
-	  then
-	     absC (CStaticClosure
-		closure_label	-- Labelled with the name on lhs of defn
-		closure_info
-	    	(mkCCostCentreStack ccs)
-		[])		-- No fields
-	  else
-	     absC (CStaticClosure
-		closure_label	-- Labelled with the name on lhs of defn
-		closure_info
-	    	(panic "absent cc")
-		[])		-- No fields
-	)
-
-     {- else
+    (
+     ({- if staticClosureRequired name binder_info lf_info
+      then -}
+	absC (mkStaticClosure closure_info ccs [] True)
+      {- else
 	nopC -}
+     )
     							`thenC`
 
 	-- GENERATE THE INFO TABLE (IF NECESSARY)
@@ -273,13 +261,22 @@ closureCodeBody binder_info closure_info cc [] body
     
     is_box  = case body of { StgApp fun [] -> True; _ -> False }
 
-    body_code   = profCtrC SLIT("TICK_ENT_THK") []		`thenC`
+    ticky_ent_lit = if (isStaticClosure closure_info)
+                    then SLIT("TICK_ENT_STATIC_THK")
+                    else SLIT("TICK_ENT_DYN_THK")
+
+    body_code   = profCtrC ticky_ent_lit []			`thenC`
+		  -- node always points when profiling, so this is ok:
+		  ldvEnter					`thenC`
 		  thunkWrapper closure_info body_label (
-			-- We only enter cc after setting up update so that cc
-			-- of enclosing scope will be recorded in update frame
-			-- CAF/DICT functions will be subsumed by this enclosing cc
+			-- We only enter cc after setting up update so
+			-- that cc of enclosing scope will be recorded
+			-- in update frame CAF/DICT functions will be
+			-- subsumed by this enclosing cc
 		    enterCostCentreCode closure_info cc IsThunk	is_box `thenC`
-		    cgExpr body)
+		    cgExpr body
+		  )
+
 \end{code}
 
 If there is {\em at least one argument}, then this closure is in
@@ -341,7 +338,7 @@ closureCodeBody binder_info closure_info cc all_args body
 	--slow_entry_code = forceHeapCheck [] True slow_entry_code'
 
     	slow_entry_code
-	  = profCtrC SLIT("TICK_ENT_FUN_STD") [
+	  = profCtrC slow_ticky_ent_lit [
 		    CLbl ticky_ctr_label DataPtrRep
 	    ] `thenC`
 
@@ -383,7 +380,7 @@ closureCodeBody binder_info closure_info cc all_args body
 			mkCString (_PK_ (map (showTypeCategory . idType) all_args))
 			] 
 		let prof = 
-			profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
+			profCtrC fast_ticky_ent_lit [
 				CLbl ticky_ctr_label DataPtrRep
 			] 
 
@@ -432,6 +429,11 @@ closureCodeBody binder_info closure_info cc all_args body
   where
     ticky_ctr_label = mkRednCountsLabel name
 
+    (slow_ticky_ent_lit, fast_ticky_ent_lit) = 
+        if (isStaticClosure closure_info)
+        then (SLIT("TICK_ENT_STATIC_FUN_STD"), SLIT("TICK_ENT_STATIC_FUN_DIRECT"))
+        else (SLIT("TICK_ENT_DYN_FUN_STD"), SLIT("TICK_ENT_DYN_FUN_DIRECT"))
+        
     stg_arity = length all_args
     lf_info = closureLFInfo closure_info
 
@@ -447,7 +449,7 @@ closureCodeBody binder_info closure_info cc all_args body
 -- give the module name even for *local* things.   We print
 -- just "x (M)" rather that "M.x" to distinguish them from the global kind.
 ppr_for_ticky_name mod_name name
-  | isLocalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
+  | isInternalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
   | otherwise	     = showSDocDebug (ppr name)
 \end{code}
 
@@ -481,7 +483,7 @@ enterCostCentreCode closure_info ccs is_thunk is_box
 	    ASSERT(is_thunk == IsFunction)
 	    costCentresC SLIT("ENTER_CCS_FSUB") []
  
-	else if isCurrentCCS ccs then 
+	else if isDerivedFromCurrentCCS ccs then 
 	    if re_entrant && not is_box
 		then costCentresC SLIT("ENTER_CCS_FCL") [CReg node]
 		else costCentresC SLIT("ENTER_CCS_TCL") [CReg node]
@@ -593,11 +595,14 @@ funWrapper :: ClosureInfo 	-- Closure whose code body this is
 	   -> Code
 funWrapper closure_info arg_regs stk_tags info_label fun_body
   = 	-- Stack overflow check
-    nodeMustPointToIt (closureLFInfo closure_info)  	`thenFC` \ node_points ->
-    -- HWL   chu' ngoq:
+    nodeMustPointToIt (closureLFInfo closure_info)  `thenFC` \ node_points ->
+
+    -- enter for Ldv profiling
+    (if node_points then ldvEnter else nopC)	    `thenC`
+
     (if opt_GranMacros
        then yield arg_regs node_points
-       else absC AbsCNop)                                 `thenC`
+       else absC AbsCNop)                           `thenC`
 
         -- heap and/or stack checks
     fastEntryChecks arg_regs stk_tags info_label node_points (