[project @ 1999-01-21 10:31:41 by simonm]

Resurrect ticky-ticky profiling.  Not quite polished yet, but it
compiles and produces some reasonable-looking stats.

4 files changed, 17 insertions, 34 deletions

diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 12bbf021ad..6721172474 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.22 1999/01/15 15:57:36 simonm Exp $
+% $Id: CgClosure.lhs,v 1.23 1999/01/21 10:31:55 simonm Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -371,12 +371,15 @@ closureCodeBody binder_info srt closure_info cc all_args body
 
 	fast_entry_code
 	  = profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
-		    CLbl (mkRednCountsLabel name) PtrRep,
+		    mkIntCLit stg_arity		-- total # of args
+
+		{-  CLbl (mkRednCountsLabel name) PtrRep,
 		    CString (_PK_ (showSDoc (ppr name))),
 		    mkIntCLit stg_arity,	-- total # of args
 		    mkIntCLit sp_stk_args,	-- # passed on stk
 		    CString (_PK_ (map (showTypeCategory . idType) all_args)),
 		    CString SLIT(""), CString SLIT("")
+		-}
 
 -- Nuked for now; see comment at end of file
 --		    CString (_PK_ (show_wrapper_name wrapper_maybe)),
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 1d71cd03f4..0a9a76dc7f 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -344,6 +344,7 @@ cgReturnDataCon con amodes all_zero_size_args
 			ASSERT(not (isUnboxedTupleCon con))
 			buildDynCon binder currentCCS con amodes all_zero_size_args
 								`thenFC` \ idinfo ->
+		  	profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
 			idInfoToAmode PtrRep idinfo		`thenFC` \ amode ->
 			performReturn (move_to_reg amode node)  jump_to_join_point
 
@@ -361,6 +362,9 @@ cgReturnDataCon con amodes all_zero_size_args
 		  let (ret_regs, leftovers) = 
 			 assignRegs [] (map getAmodeRep amodes)
 		  in
+		  profCtrC SLIT("TICK_RET_UNBOXED_TUP") 
+				[mkIntCLit (length amodes)] `thenC`
+
 		  doTailCall amodes ret_regs 
 			mkUnboxedTupleReturnCode
 			(length leftovers)  {- fast args arity -}
@@ -385,7 +389,7 @@ cgReturnDataCon con amodes all_zero_size_args
 
 
 			-- RETURN
-		  profCtrC SLIT("TICK_RET_CON") [mkIntCLit (length amodes)] `thenC`
+		  profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
 		  -- could use doTailCall here.
 		  performReturn (move_to_reg amode node) 
 			(mkStaticAlgReturnCode con)
diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs
index 6209ac615d..f1a0ef25c9 100644
--- a/ghc/compiler/codeGen/CgHeapery.lhs
+++ b/ghc/compiler/codeGen/CgHeapery.lhs
@@ -1,14 +1,14 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgHeapery.lhs,v 1.11 1998/12/18 17:40:51 simonpj Exp $
+% $Id: CgHeapery.lhs,v 1.12 1999/01/21 10:31:56 simonm Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
 \begin{code}
 module CgHeapery (
 	fastEntryChecks, altHeapCheck, thunkChecks,
-	allocHeap, allocDynClosure
+	allocDynClosure
 
         -- new functions, basically inserting macro calls into Code -- HWL
         ,fetchAndReschedule, yield
@@ -436,10 +436,8 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
     in
 	-- SAY WHAT WE ARE ABOUT TO DO
     profCtrC (allocProfilingMsg closure_info)
-			   [mkIntCLit fixedHdrSize,
-			    mkIntCLit (closureGoodStuffSize closure_info),
-			    mkIntCLit slop_size,
-			    mkIntCLit closure_size]	`thenC`
+			   [mkIntCLit (closureGoodStuffSize closure_info),
+			    mkIntCLit slop_size]	`thenC`
 
 	-- GENERATE THE CODE
     absC ( mkAbstractCs (
@@ -468,27 +466,3 @@ cInitHdr closure_info amode cc
   | otherwise          = CInitHdr closure_info amode (panic "absent cc")
 	
 \end{code}
-
-%************************************************************************
-%*									*
-\subsection{Allocate uninitialized heap space}
-%*									*
-%************************************************************************
-
-\begin{code}
-allocHeap :: HeapOffset		-- Size of the space required
-	  -> FCode CAddrMode	-- Addr mode for first word of object
-
-allocHeap space
-  = getVirtAndRealHp				`thenFC` \ (virtHp, realHp) ->
-    let block_start = virtHp + 1
-    in
-    	-- We charge the allocation to "PRIM" (which is probably right)
-    profCtrC SLIT("ALLOC_PRIM2") [mkIntCLit space]	`thenC`
-
-	-- BUMP THE VIRTUAL HEAP POINTER
-    setVirtHp (virtHp + space)	 		`thenC`
-
-	-- RETURN PTR TO START OF OBJECT
-    returnFC (CAddr (hpRel realHp block_start))
-\end{code}
diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
index 772d2fef7c..b6953b1ce0 100644
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ b/ghc/compiler/codeGen/CgTailCall.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgTailCall.lhs,v 1.17 1998/12/18 17:40:53 simonpj Exp $
+% $Id: CgTailCall.lhs,v 1.18 1999/01/21 10:31:57 simonm Exp $
 %
 %********************************************************
 %*							*
@@ -307,6 +307,8 @@ returnUnboxedTuple amodes before_jump
     let (ret_regs, leftovers) = assignRegs [] (map getAmodeRep amodes)
     in
 
+    profCtrC SLIT("TICK_RET_UNBOXED_TUP") [mkIntCLit (length amodes)] `thenC`
+
     doTailCall amodes ret_regs
 		mkUnboxedTupleReturnCode
 		(length leftovers)  {- fast args arity -}