path: root/ghc/includes/CostCentre.lh

%************************************************************************
%*									*
\section[CostCentre.lh]{Definitions for Cost Centre Profiling}
%*									*
%************************************************************************

Multi-slurp protection:
\begin{code}
#ifndef CostCentre_H
#define CostCentre_H
\end{code}

For threaded activity profiling, we need a few bits of the CostCentre
environment to be defined, despite the fact that we don't have CostCentre
fields in closures.

\begin{code}
#if defined(PROFILING) || defined(CONCURRENT)

# define CC_EXTERN(cc_ident) 					\
     extern struct cc CAT2(cc_ident,_struct);			\
     extern CostCentre cc_ident

extern CostCentre CCC;	   	/* the current cost centre */

extern CostCentre Registered_CC;/* registered cost centre list */

CC_EXTERN(CC_MAIN);		/* initial MAIN cost centre */
CC_EXTERN(CC_GC);		/* Garbage Collection cost center */

# ifdef PAR
CC_EXTERN(CC_MSG);		/* Communications cost center */
CC_EXTERN(CC_IDLE);             /* Idle-time cost centre */
# endif

# define REGISTERED_END	(CostCentre)4	/* end of list */
					/* That 4 look likes a HACK, Patrick.
					   (WDP 94/06) */
# define NOT_REGISTERED (CostCentre)0   /* not yet registered */

\end{code}

The compiler declares a static block for each @_scc_@ annotation in the
source using the @CC_DECLARE@ macro where @label@, @module@ and
@group@ are strings and @ident@ the cost centre identifier.

\begin{code}
# define CC_IS_CAF  'C'
# define CC_IS_DICT 'D'
# define CC_IS_SUBSUMED 'S'
# define CC_IS_BORING '\0'

# define STATIC_CC_REF(cc_ident) &CAT2(cc_ident,_struct)
# define DYN_CC_REF(cc_ident)    cc_ident /* unused */

# define CC_DECLARE(cc_ident,name,module,group,subsumed,is_local) \
     is_local struct cc CAT2(cc_ident,_struct)			\
	= {NOT_REGISTERED, UNHASHED, name, module, group,	\
	   subsumed, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};	\
     is_local CostCentre cc_ident = STATIC_CC_REF(cc_ident)

#endif /* defined(PROFILING) || defined(CONCURRENT) */
\end{code}

Definitions relating to the profiling field as a whole.

\begin{code}
#define PROF_FIXED_HDR 			(CC_HDR_SIZE)	
#define PROF_HDR_POSN			AFTER_PAR_HDR
#define AFTER_PROF_HDR			(PROF_FIXED_HDR+PROF_HDR_POSN)
#define SET_PROF_HDR(closure,cc)	SET_CC_HDR(closure,cc)
#define SET_STATIC_PROF_HDR(ident)	SET_STATIC_CC_HDR(ident)
\end{code}

%************************************************************************
%*									*
\subsection[no-cost-centres]{Dummy definitions if no cost centres}
%*									*
%************************************************************************

The cost-centre profiling is only on if the driver turns on
@PROFILING@.

These are the {\em dummy} definitions in force if we do {\em NOT}
turn on @PROFILING@.  Get them out of the way....

\begin{code}
#if !defined(PROFILING)

/*** Declaration Definitions ***/

# define CAT_DECLARE(base_name, kind, descr, type)

# define CC_HDR_SIZE 0	  		/* No CC in fixed header */

# define SET_CC_HDR(closure, cc)	/* Dont set CC header */
# define SET_STATIC_CC_HDR(cc)		/* No static CC header */

# define SET_CCC(cc_ident,is_dupd)

# define RESTORE_CCC(cc)

# define ENTER_CC_T(cc)
# define ENTER_CC_TCL(closure)
# define ENTER_CC_F(cc)
# define ENTER_CC_FCL(closure)
# define ENTER_CC_PAP(cc)
# define ENTER_CC_PAP_CL(closure)

/*** Timer and Heap Definitions ***/

# define OR_INTERVAL_EXPIRED	/* No || as it is false */

# define CC_ALLOC(cc, size, kind)
# define HEAP_PROFILE_CLOSURE(closure,size)

# ifndef PAR
#  define START_TIME_PROFILER
#  define RESTART_TIME_PROFILER
#  define STOP_TIME_PROFILER
# endif

#endif /* !defined(PROFILING) */
\end{code}

%************************************************************************
%*									*
\subsection[declaring-cost-centres]{Declaring Cost Centres}
%*									*
%************************************************************************

Now for the cost-centre profiling stuff.

%************************************************************************
%*									*
\subsection[cost-centres]{Location of Cost Centres}
%*									*
%************************************************************************

We have a current cost centre, a list of registered cost centres, and
an additional cost centre field within the fixed header of all
closures. This is adjacent to the info pointer.

\begin{code}
#if defined(PROFILING)

CC_EXTERN(CC_SUBSUMED);  	/* top level fns SUBSUMED cost centre */
CC_EXTERN(CC_OVERHEAD);  	/* costs due only to profiling machinery */
CC_EXTERN(CC_DONTZuCARE);  	/* placeholder only */

CC_EXTERN(CC_CAFs);		/* prelude cost centre (CAFs  only) */
CC_EXTERN(CC_DICTs);		/* prelude cost centre (DICTs only) */

# define IS_CAF_OR_DICT_CC(cc) \
    (((cc)->is_subsumed == CC_IS_CAF) || ((cc)->is_subsumed == CC_IS_DICT))

# define IS_SUBSUMED_CC(cc) ((cc)->is_subsumed == CC_IS_SUBSUMED)

\end{code}

Definitions referring to the Cost Centre sub-field of the fixed header.
\begin{code}

# define CC_HDR_SIZE 		1	/* words of header */
					/*R SMinterface.lh */

# define CC_HDR_POSN 	    	PROF_HDR_POSN  	/* position in header */

# define CC_HDR(closure)	(((P_)(closure))[CC_HDR_POSN])

# define SET_CC_HDR(closure, cc) \
	CC_HDR(closure) = (W_)(cc)	/* Set closures cost centre */
					/*R SMinterface.lh (CCC) */
\end{code}

For static closures ...
\begin{code}
# define SET_STATIC_CC_HDR(cc_ident) \
	,  (W_) STATIC_CC_REF(cc_ident)	    	/* static initialisation */
						/*R SMinterface.lh */
\end{code}

The @/*R @{\em file}@ */@ comments indicate that the macro is used
regardless in {\em file} so we need a null definition if cost centres
are not being used.

%************************************************************************
%*									*
\subsection{Setting the Current Cost Centre}
%*									*
%************************************************************************

On execution of an @_scc_@ expression a new cost centre is set.

If the new cost centre is different from the CCC we set the CCC and
count the entry.

If the cost centre is the same as the CCC no action is required. We do
not count the entry to avoid large counts arising from simple
recursion.  (Huh?  WDP 94/07)

\begin{code}
# define SET_CCC_X(cc,is_dupd)	 						\
	do {									\
	if (!(is_dupd)) { CCC->sub_scc_count++; } /* inc subcc count of CCC */	\
	CCC = (CostCentre)(cc);		/* set CCC to ident cc */		\
	if (!(is_dupd)) { CCC->scc_count++; }	 /* inc scc count of new CCC*/	\
	} while(0)

# define SET_CCC(cc_ident,is_dupd) SET_CCC_X(STATIC_CC_REF(cc_ident),is_dupd)
\end{code}

We have this @RESTORE_CCC@ macro, rather than just an assignment,
in case we want to do any paranoia-checking here.
\begin{code}
# define RESTORE_CCC(cc)		\
	do {				\
	CCC = (CostCentre) (cc);	\
	ASSERT_IS_REGISTERED(CCC,1);	\
	} while(0)
\end{code}

On entry to top level CAFs we count the scc ...
\begin{code}
# define ENTER_CC_CAF_X(cc)						\
	do {								\
	CCC->sub_cafcc_count++; /* inc subcaf count of CCC */		\
	CCC = (CostCentre)(cc);		/* set CCC to ident cc */	\
	ASSERT_IS_REGISTERED(CCC,1);					\
	CCC->cafcc_count++; /* inc cafcc count of CCC */		\
	} while(0)

# define ENTER_CC_CAF(cc_ident)   ENTER_CC_CAF_X(STATIC_CC_REF(cc_ident))
# define ENTER_CC_CAF_CL(closure) ENTER_CC_CAF_X((CostCentre)CC_HDR(closure))
\end{code}

On entering a closure we only count the enter to thunks ...
\begin{code}
# define ENTER_CC_T(cc)						\
	do {							\
	CCC = (CostCentre)(cc);		 			\
	ASSERT_IS_REGISTERED(CCC,1);				\
	CCC->thunk_count++; /* inc thunk count of new CCC */	\
	} while(0)	

# define ENTER_CC_TCL(closure)					\
	ENTER_CC_T(CC_HDR(closure))

/* Here is our special "hybrid" case when we do *not* set the CCC.
   (a) The closure is a function, not a thunk;
   (b) The CC is CAF/DICT-ish.
*/
# define ENTER_CC_F(centre)				\
	do {						\
	CostCentre cc = (CostCentre) (centre);		\
	ASSERT_IS_REGISTERED(cc,1);			\
	if ( ! IS_CAF_OR_DICT_CC(cc) ) {		\
	    CCC = cc;					\
	}						\
	CCC->function_count++;				\
	} while(0)

# define ENTER_CC_FCL(closure)				\
	ENTER_CC_F(CC_HDR(closure))

/* These ENTER_CC_PAP things are only used in the RTS */

# define ENTER_CC_PAP(centre)				\
	do {						\
	CostCentre cc = (CostCentre) (centre);		\
	ASSERT_IS_REGISTERED(cc,1);			\
	if ( ! IS_CAF_OR_DICT_CC(cc) ) {		\
	    CCC = cc;					\
	}						\
	CCC->pap_count++;				\
	} while(0)			
					
# define ENTER_CC_PAP_CL(closure)			\
	ENTER_CC_PAP(CC_HDR(closure))

#endif /* PROFILING */
\end{code}

%************************************************************************
%*									*
\subsection{``Registering'' cost-centres}
%*									*
%************************************************************************

Cost centres are registered at startup by calling a registering
routine in each module. Each module registers its cost centres and
calls the registering routine for all imported modules. The RTS calls
the registering routine for the module Main. This registering must be
done before initialisation since the evaluation required for
initialisation may use the cost centres.

As the code for each module uses tail calls we use an auxiliary stack
(in the heap) to record imported modules still to be registered. At
the bottom of the stack is NULL which indicates that
@miniInterpretEnd@ should be resumed.

@START_REGISTER@ and @END_REGISTER@ are special macros used to
delimit the function. @END_REGISTER@ pops the next registering
routine off the stack and jumps to it. @REGISTER_CC@ registers a cost
centre. @REGISTER_IMPORT@ pushes a modules registering routine onto
the register stack.

\begin{code}
#if defined(PROFILING)

extern F_ _regMain (STG_NO_ARGS);
extern F_ *register_stack;

# define PUSH_REGISTER_STACK(reg_function)				\
	*(register_stack++) = (F_)reg_function

# define POP_REGISTER_STACK						\
	*(--register_stack)

# define START_REGISTER_CCS(reg_mod_name)				\
	static int _module_registered = 0;				\
	STGFUN(reg_mod_name) {						\
	    FUNBEGIN;							\
	    if (! _module_registered) { 				\
		_module_registered = 1

# define START_REGISTER_PRELUDE(reg_mod_name)				\
	static int CAT2(reg_mod_name,_done) = 0;			\
	STGFUN(reg_mod_name) {						\
	    FUNBEGIN;							\
	    if (! CAT2(reg_mod_name,_done)) {	 			\
		CAT2(reg_mod_name,_done) = 1

# define REGISTER_IMPORT(reg_mod_name)					\
	do { extern F_ reg_mod_name (STG_NO_ARGS) ;			\
	  PUSH_REGISTER_STACK(reg_mod_name) ;				\
	} while (0)
	
# define END_REGISTER_CCS()						\
        };								\
        do {								\
            F_ cont = POP_REGISTER_STACK;				\
            if (cont == NULL) {						\
	        RESUME_(miniInterpretEnd);				\
            } else {							\
		JMP_(cont);						\
            }								\
	} while(0);							\
	FUNEND; }

#endif  /* PROFILING */
\end{code}

We don't want to attribute costs to an unregistered cost-centre:
\begin{code}
#if !defined(PROFILING) || !defined(DEBUG)
# define ASSERT_IS_REGISTERED(cc,chk_not_overhead) /*nothing*/
#else
# define ASSERT_IS_REGISTERED(cc,chk_not_overhead)				\
	do {									\
	CostCentre c_c = (CostCentre) (cc);					\
	if (c_c->registered == NOT_REGISTERED) { 				\
	    fprintf(stderr,"Entering unregistered CC: %s\n",c_c->label);	\
	    /* unsafe c-call, BTW */						\
	}									\
	if ( (chk_not_overhead) && c_c == STATIC_CC_REF(CC_OVERHEAD) ) {	\
	    fprintf(stderr,"CC should not be OVERHEAD!: %s\n",c_c->label);	\
	    /* unsafe c-call, BTW */						\
	} } while(0)
#endif

#define REGISTER_CC(cc)							\
	do {								\
	extern CostCentre cc;						\
	if (((CostCentre)(cc))->registered == NOT_REGISTERED) { 	\
	    ((CostCentre)(cc))->registered = Registered_CC;		\
	    Registered_CC = (CostCentre)(cc);				\
	}} while(0)

\end{code}

%************************************************************************
%*									*
\subsection[declaring-closure-categories]{Declaring Closure Categories}
%*									*
%************************************************************************

Closure category records are attached to the info table of the
closure. They are declared with the info table. Hashing will map
similar categories to the same hash value allowing statistics to be
grouped by closure category.

The declaration macros expand to nothing if cost centre profiling is
not required.

Note from ADR: Very dubious Malloc Ptr addition -- should probably just
reuse @CON_K@ (or something) in runtime/main/StgStartup.lhc.
Similarily, the SP stuff should probably be the highly uninformative
@INTERNAL_KIND@.

\begin{code}
#if defined(PROFILING)

# define CON_K		1
# define FN_K		2
# define PAP_K		3
# define THK_K		4
# define BH_K		5
# define ARR_K		6

# ifndef PAR
#  define MallocPtr_K	7  /* Malloc Pointer */
#  define SPT_K		8  /* Stable Pointer Table */
# endif /* !PAR */

# define INTERNAL_KIND	10

typedef struct ClCat {
   hash_t index_val;	/* hashed value */
   I_    selected; /* is this category selected (-1 == not memoised, selected? 0 or 1) */
   I_    kind;     /* closure kind -- as above */
   char *descr;    /* source derived string detailing closure description */
   char *type;	    /* source derived string detailing closure type */
} *ClCategory;

/* We put pointers to these ClCat things in info tables.
   We need these ClCat things because they are mutable,
   whereas info tables are immutable.  (WDP 94/11)

   We really should not make funny names by appending _CAT.
*/

# define MK_CAT_IDENT(i)   CAT2(i,_CAT)
# define REF_CAT_IDENT(i)  (&MK_CAT_IDENT(i))

# define CAT_DECLARE(base_name, kind, descr, type) \
	static struct ClCat MK_CAT_IDENT(base_name) = {UNHASHED,-1,kind,descr,type};

#endif /* PROFILING */
\end{code}

%************************************************************************
%*									*
\subsection[timer-interupts]{Processing of Timer Signals}
%*									*
%************************************************************************

Stuff to do with timer signals:
\begin{code}
#if defined(PROFILING) || defined(PAR)

extern I_ time_profiling;	/* Flag indicating if timer/serial profiling is required */

extern I_ interval_expired;	/* Flag set by signal handler */
extern I_ current_interval;	/* Current interval number -- used as time stamp */
extern I_ interval_ticks;	/* No of ticks in an interval */

extern I_ previous_ticks;	/* ticks in previous intervals */
extern I_ current_ticks;	/* ticks in current interval */

extern void set_time_profile_handler(STG_NO_ARGS);
extern void start_time_profiler(STG_NO_ARGS);
extern void restart_time_profiler(STG_NO_ARGS);
extern void stop_time_profiler(STG_NO_ARGS);

# define TICK_FREQUENCY		50		  	/* ticks per second */
# define TICK_MILLISECS		(1000/TICK_FREQUENCY)	/* milli-seconds per tick */

# define DEFAULT_INTERVAL	TICK_FREQUENCY		/* 1 second */

/* These are never called directly from threaded code */
# define START_TIME_PROFILER	ULTRASAFESTGCALL0(void,(void *),start_time_profiler)		/*R StgOverflow.lc */
# define RESTART_TIME_PROFILER	ULTRASAFESTGCALL0(void,(void *),restart_time_profiler)		/*R StgOverflow.lc */
# define STOP_TIME_PROFILER	ULTRASAFESTGCALL0(void,(void *),stop_time_profiler)		/*R StgOverflow.lc */

# if defined(PROFILING)
#  define OR_INTERVAL_EXPIRED	|| (interval_expired)		/*R StgMacros.h */
# endif
\end{code}


%************************************************************************
%*									*
\subsection[indexing]{Indexing of Cost Centres and Categories}
%*									*
%************************************************************************

Cost Centres and Closure Categories are hashed to provide indexes
against which arbitrary information can be stored. These indexes are
memoised in the appropriate cost centre or category record and
subsequent hashes avoided by the index routine (it simply returns the
memoised index).

There are different features which can be hashed allowing information
to be stored for different groupings. Cost centres have the cost
centre recorded (using the pointer), module and group. Closure
categories have the closure description and the type
description. Records with the same feature will be hashed to the same
index value.

The initialisation routines, @init_index_<feature>@, allocate a hash
table in which the cost centre / category records are stored. The
lower bound for the table size is taken from @max_<feature>_no@. They
return the actual table size used (the next power of 2). Unused
locations in the hash table are indicated by a 0 entry. Successive
@init_index_<feature>@ calls just return the actual table size.

Calls to @index_<feature>@ will insert the cost centre / category
record in the <feature> hash table, if not already inserted. The hash
index is memoised in the record and returned. 

CURRENTLY ONLY ONE MEMOISATION SLOT IS AVILABLE IN EACH RECORD SO
HASHING CAN ONLY BE DONE ON ONE FEATURE FOR EACH RECORD. This can be
easily relaxed at the expense of extra memoisation space or continued
rehashing.

The initialisation routines must be called before initialisation of
the stacks and heap as they require to allocate storage. It is also
expected that the caller may want to allocate additional storage in
which to store profiling information based on the return table size
value(s).

\begin{code}
# if defined(PROFILING)

#  define DEFAULT_MAX_CC     4096
#  define DEFAULT_MAX_MOD     256
#  define DEFAULT_MAX_GRP     128
#  define DEFAULT_MAX_DESCR  4096
#  define DEFAULT_MAX_TYPE   1024

extern hash_t max_cc_no;			/* Hash on CC ptr */
extern CostCentre *index_cc_table;
extern hash_t init_index_cc(STG_NO_ARGS);
extern hash_t index_cc PROTO((CostCentre cc));

extern hash_t max_mod_no;			/* Hash on CC module */
extern CostCentre *index_mod_table;
extern hash_t init_index_mod(STG_NO_ARGS);
extern hash_t index_mod PROTO((CostCentre cc));

extern hash_t max_grp_no;			/* Hash on CC group */
extern CostCentre *index_grp_table;
extern hash_t init_index_grp(STG_NO_ARGS);
extern hash_t index_grp PROTO((CostCentre cc));

extern hash_t max_descr_no;			/* Hash on closure description */
extern ClCategory *index_descr_table;
extern hash_t init_index_descr(STG_NO_ARGS);
extern hash_t index_descr PROTO((ClCategory clcat));

extern hash_t max_type_no;			/* Hash on type description */
extern ClCategory *index_type_table;
extern hash_t init_index_type(STG_NO_ARGS);
extern hash_t index_type PROTO((ClCategory clcat));

# endif /* PROFILING */
\end{code}


%************************************************************************
%*									*
\subsection[metering]{Metering of Statistics}
%*									*
%************************************************************************

@scc_count@ is incremented by the @SetCC@ macro in section
\ref{manipulating-cost-centres} above. Below we have the time tick and
memory alloc macros.

\begin{code}
# define CC_TICK(cc)							\
	do { CostCentre centre = (CostCentre) (cc);			\
	ASSERT_IS_REGISTERED(centre,1);					\
	centre->time_ticks += 1;					\
	} while(0)

# if defined(PROFILING)
#  define CC_ALLOC(cc, size, kind) 					\
	do { CostCentre cc_ = (CostCentre) (cc);			\
	ASSERT_IS_REGISTERED(cc_,0/*OK if OVERHEAD*/);			\
	cc_->mem_allocs	+= 1;						\
	cc_->mem_alloc	+= (size) - (PROF_FIXED_HDR + TICKY_FIXED_HDR);	\
	} while(0) /* beware name-capture by ASSERT_IS...! */
# endif
\end{code}


%************************************************************************
%*									*
\subsection[cost-centre-profiling]{Cost Centre Profiling}
%*									*
%************************************************************************

\begin{code}
I_	init_cc_profiling PROTO((I_ rts_argc, char *rts_argv[], char *prog_argv[]));
void	report_cc_profiling PROTO((I_ final));

void	cc_register(STG_NO_ARGS);
void	cc_sort PROTO((CostCentre *sort, char sort_on));
rtsBool cc_to_ignore PROTO((CostCentre));
\end{code}

%************************************************************************
%*									*
\subsection[heap-profiling]{Heap Profiling}
%*									*
%************************************************************************

\begin{code}
# if defined(PROFILING)

extern I_ heap_profile_init PROTO((char *select_cc_str,
				   char *select_mod_str,
				   char *select_grp_str,
				   char *select_descr_str,
				   char *select_typ_str,
				   char *select_kind_str,
				   char *argv[]));

extern void heap_profile_finish(STG_NO_ARGS);

extern void heap_profile_setup(STG_NO_ARGS);      /* called at start of heap profile */
extern void heap_profile_done(STG_NO_ARGS);	  /* called at end of heap profile */

extern void (* heap_profile_fn) PROTO((P_ closure,I_ size));

extern I_ earlier_ticks;	        /* no. of earlier ticks grouped */
extern hash_t time_intervals;		/* no. of time intervals reported -- 18 */

#  define HEAP_PROFILE_CLOSURE(closure,size) \
	STGCALL2(void,(void *, P_, I_),(*heap_profile_fn),closure,size)			/*R SM2s.lh */

# endif	/* PROFILING */
\end{code}

End multi-slurp protection:
\begin{code}
#endif /* PROFILING || PAR */

#endif /* CostCentre_H */
\end{code}