From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  7-NOV-1988 01:44
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: Need to monitor internal program cpu usage


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Sun,  6 NOV 88 16:25:27 PDT
Received: from Venus.YCC.Yale.Edu by KL.SRI.COM with TCP; Sun, 6 Nov 88 16:05:59 PST
Date: Sun, 6 Nov 88 18:43 EST
From: "Jerry Leichter (LEICHTER-JERRY@CS.YALE.EDU)"
 <LEICHTER@Venus.YCC.Yale.Edu>
Subject: Re: Need to monitor internal program cpu usage
To: GG.SPY@ISUMVS.BITNET, ROBERTS@UORNSRL.BITNET, INFO-VAX@KL.SRI.COM
X-VMS-To: IN%"GG.SPY@ISUMVS.BITNET",IN%"ROBERTS@UORNSRL.BITNET",INFOVAX

	> I need to examine the internal CPU time used by a simulation I've
	> written.  I'd like something that will run along with the
	> simulation, or perhaps run the simulation under it, and
	> occassionally peak to find where the program is at and use the info
	> to build a histogram of time usage vs. location.
	...
	It seems the simplest method would be to uses $SETIMR to request an
	AST at some interval, then have the AST routine examine the time, and
	the call frame (to find the return address).  It would seem that this
	routine would have to be in MACRO or (heaven forbid, BLISS).

Yes, using $SETIMR is the way to do this; no, you don't need to use MACRO or
BLISS.  Attached below is a simple routine routine to do this kind of pro-
filing.  Simply call ProfStart when you want profiling to start, ProfPrint
to stop profiling and print results.  If you don't call ProfPrint, it will
be called automatically when the program exits.

I wrote this for use with a particular piece of code I was working on so it
may not be completely general.  I've included one .h file it uses (vms.h,
which provides handy definitions for dealing with VMS), but not a .h file
that is specific to the larger piece of code.  Among other things, it
#include's vms.h, and defines a FILE * named Logger to which output is written
(and a symbol name LOGGER to indicate that the debug code is enabled).  So,
view this as a sketch of how to write this kind of code.

Note that, because the timer AST's are requested in user mode, you will get
distorted readings around system calls.  Still, this will give you some
picture of where your code is spending your time.  (In VMS V5, you can
request that $SETIMR measure CPU time, not elapsed time.  This could give
you more useful information; it's left as an exercise to the reader....)

DEC has a product called PCA (Performance and Coverage Analyzer) that takes
this basic idea and expands it into something much more generally usable -
this profiler requires some wizardry to use.  You might want to look into it.

							-- Jerry

----------------PROFILE.C--------------
/*
 * Simple CPU profile module
 */
#include stdio
#include "common.h"
#include "profile.h"

#ifndef LOGGER
#include "==> LOGGER must be defined for this to work <=="
#endif

/*
 * For each of P0, P1 and S0, we have bins of counts which represent counts
 * between between the base in that space and the limit (maxBin), a shift
 * value that is the number of bits of the PC to discard to calculate a bin
 * (hence determining the resolution of each bin), and a count of PC values
 * above and below the limits.  There is also a total count.
 */
static ULONG	*S0bins, *P0bins, *P1bins;
static ULONG	S0under, P0under, P1under;
static ULONG	S0shift, S0maxBin;
static ADDR	S0base;
static ULONG	P0shift, P0maxBin;
static ADDR	P0base;
static ULONG	P1shift, P1maxBin;
static ADDR	P1base;
static ULONG	S0count, P0count, P1count;
static ULONG	S0over, P0over, P1over;
static ULONG	total;

static void timeast();

/*
 * profStop is set to TRUE to cause the timer AST routine to exit at the
 * next interrupt.  profOn is TRUE if ProfStart started profiling.
 */
static BOOLEAN	profOn = FALSE;
static BOOLEAN	profStop;

static DATE_TIME tick = {0 , 0};

/*
 * An exit handler block so that we always print our results on exit.
 */
static LONG		exhCond;
static EXH_BLOCK	exhBlock = {EXH_FILL(0)};

/*
 * Possibly start profiling - queries the user for parameters.
 */
void
ProfStart()
{	char	ans[100];

	fprintf(stderr,"Profile? ");
	gets(ans);
	if (ans[0] == 'y' || ans[0] == 'Y')
	{	profOn = TRUE;
		profStop = FALSE;

P0again:
		fprintf(stderr,"Enter:  P0-base(hex) shift maxBin: ");
		gets(ans);
		if (sscanf(ans,"%x %d %d",&P0base,&P0shift,&P0maxBin) != 3)
		{	fprintf(stderr,"Values didn't scan, try again\n");
			goto P0again;
		}
		P0bins = (ULONG *)calloc(P0maxBin,sizeof(*P0bins));
		if (P0bins == NULL)
			error("Can't allocate P0bins");

P1again:
		fprintf(stderr,"Enter:  P1-base(hex) shift maxBin: ");
		gets(ans);
		if (sscanf(ans,"%x %d %d",&P1base,&P1shift,&P1maxBin) != 3)
		{	fprintf(stderr,"Values didn't scan, try again\n");
			goto P1again;
		}
		if (((ULONG)P1base & 0x40000000) == 0)
			P1base = 0x7FFFFFFF - (ULONG)P1base;
		P1bins = (ULONG *)calloc(P1maxBin,sizeof(*P1bins));
		if (P1bins == NULL)
			error("Can't allocate P1bins");

S0again:
		fprintf(stderr,"Enter:  S0-base(hex) shift maxBin: ");
		gets(ans);
		if (sscanf(ans,"%x %d %d",&S0base,&S0shift,&S0maxBin) != 3)
		{	fprintf(stderr,"Values didn't scan, try again\n");
			goto S0again;
		}
		if (((ULONG)S0base & 0x80000000) == 0)
			S0base += 0x80000000;
		S0bins = (ULONG *)calloc(S0maxBin,sizeof(*S0bins));
		if (S0bins == NULL)
			error("Can't allocate S0bins");

		TEST(SYS$SETIMR(0,&tick,&timeast,0));

		SYS$CANEXH(&exhBlock);
		exhBlock.EXH_addr = &ProfPrint;
		exhBlock.EXH_cond = &exhCond;
		TEST(SYS$DCLEXH(&exhBlock));
	}
	else 	profOn = FALSE;
}

static void
timeast(parm,r0,r1,pc,psl)
LONG	parm;
LONG	r0;
LONG	r1;
ADDR	pc;
LONG	psl;
{	ULONG	adj_pc;

	if_T (profStop)
		return;
	++total;
	if ((ULONG)pc & 0x80000000)		/* In S0?		*/
	{	++S0count;
		if (pc < S0base)
			++S0under;
		else
		{	adj_pc = (ULONG)(pc - S0base) >> S0shift;
			if (adj_pc < S0maxBin)
				++S0bins[adj_pc];
			else	++S0over;
		}
	}
	else if ((ULONG)pc & 0x40000000)	/* In P1?		*/
	{	++P1count;
		if (pc < P1base)
			++P1under;
		else
		{	adj_pc = (ULONG)(pc - P1base) >> P1shift;
			if (adj_pc < P1maxBin) 
				++P1bins[adj_pc];
			else	++P1over;
		}
	}
	else					/* Not S0 or P1, so P0	*/
	{	++P0count;
		if (pc < P0base)
			++P0under;
		else
		{	adj_pc = (ULONG)(pc - P0base) >> P0shift;
			if (adj_pc < P0maxBin) 
				++P0bins[adj_pc];
			else	++P0over;
		}
	}
	TEST(SYS$SETIMR(0,&tick,&timeast,0));
}

void
ProfPrint()
{	BOOLEAN	dot;
	ULONG	index;

	SYS$CANEXH(&exhBlock);
	profStop = TRUE;
	if (!profOn)
	{	fprintf(Logger,
			"Profiling not enabled, no statistics to print\n");
		return;
	}
	profOn = FALSE;

	fprintf(Logger,
	"\nProfile data based on a total of %u counts\n",
		total);
	fprintf(Logger,
		"P0 table parameters BASE %08X, SHIFT %d, maxBin %d.\n",
		P0base,P0shift,P0maxBin);
	fprintf(Logger," Total count %u\toverflow %u underflow %u\n",
		P0count,P0over,P0under);

	dot = FALSE;
	for (index = 0; index < P0maxBin; ++index)
	{	if (P0bins[index] != 0)
		{	fprintf(Logger,"%08X:%08X: %u\n",
				(index << P0shift) + P0base,
				((index+1) << P0shift) + P0base - 1,
				P0bins[index]);
			dot = FALSE;
		}
		else
		{	if (!dot)
			{	fprintf(Logger,"........\n");
				dot = TRUE;
			}
		}
	}
	fprintf(Logger,
		"P1 table parameters BASE %08X, SHIFT %d, maxBin %d.\n",
		P1base,P1shift,P1maxBin);
	fprintf(Logger," Total count %u\toverflow %u underflow %u\n",
		P1count,P1over,P1under);

	dot = FALSE;
	for (index = 0; index < P1maxBin; ++index)
	{	if (P1bins[index] != 0)
		{	fprintf(Logger,"%08X:%08X: %u\n",
				(index << P1shift) + P1base,
				((index+1) << P1shift) + P1base - 1,
				P1bins[index]);
			dot = FALSE;
		}
		else
		{	if (!dot)
			{	fprintf(Logger,"........\n");
				dot = TRUE;
			}
		}
	}
	fprintf(Logger,
		"\nS0 table parameters BASE %08X, SHIFT %d, maxBin %d.\n",
		S0base, S0shift, S0maxBin);
	fprintf(Logger," count %u\toverflow %u underflow %u\n",
		S0count,S0over,S0under);

	dot = FALSE;
	for (index = 0; index < S0maxBin; ++index)
	{	if (S0bins[index] != 0)
		{	fprintf(Logger,"%08X:%08X: %u\n",
				(index << S0shift) + S0base,
				((index+1) << S0shift) + S0base - 1,
				S0bins[index]);
			dot = FALSE;
		}
		else
		{	if (!dot)
			{	fprintf(Logger,"........\n");
				dot = TRUE;
			}
		}
	}
	free(P0bins);
	free(P1bins);
	free(S0bins);
}
----------------VMS.H--------------
/*
 * VMS-related definitions.  #include's descrip, ssdef.
 *
 * EDITLEVEL=29
 */
#ifndef VMS_INCLUDED
#define VMS_INCLUDED

#include descrip
#include ssdef

/*
 * Fundamental datatypes
 */
typedef int		INT_32;
typedef short		INT_16;
typedef char		INT_8;
typedef char		*ADDR;
typedef char		BYTE;
typedef short		WORD;
typedef int		LONG;
typedef unsigned char	UBYTE;
typedef unsigned short	UWORD;
typedef unsigned int	ULONG;
typedef BYTE		QUADWORD[8];
typedef BYTE		OCTAWORD[16];

typedef LONG		RADDR;			/* Relative address	*/
typedef struct aqueue				/* Absolute queue	*/
{	struct aqueue	*next;
	struct aqueue	*last;
} AQUEUE;

typedef struct rqueue				/* Relative queue	*/
{	RADDR		next;
	RADDR		last;
} RQUEUE;
/*
 * Next and previous entries in a relative queue - r is an RQUEUE (or any
 * type of memory block that starts of with an RQUEUE.)
 */
#define RQNEXT(r)  ((ADDR)&(r) + ((RQUEUE *)&(r))->next)
#define RQLAST(r)  ((ADDR)&(r) + ((RQUEUE *)&(r))->last)

typedef struct arglist				/* Argument list	*/
{	UBYTE		count;
	BYTE		mbz[3];
	LONG		args[];
} ARGLIST;

typedef struct frame				/* Stack frame		*/
{	ADDR		handler;
	WORD		psw;
	WORD		spa_mask;
	ARGLIST		*ap;
	struct frame	*fp;
	LONG		pc;
	LONG		regs[];
} FRAME;

/*
 * The following are useful for picking individual pieces out of objects
 * up to a quadword in size.
 */
typedef struct longs
{	LONG	l0;
	LONG	l1;
} LONGS;

typedef struct words
{	WORD	w0;
	WORD	w1;
	WORD	w2;
	WORD	w3;
} WORDS;

typedef struct bytes
{	BYTE	b0;
	BYTE	b1;
	BYTE	b2;
	BYTE	b3;
	BYTE	b4;
	BYTE	b5;
	BYTE	b6;
	BYTE	b7;
} BYTES;

/*
 * VMS data structures; refer to the System Services Reference Manual.
 * The names used here are the same as those in that manual except when
 * those are too bulky.
 *
 * This list is not complete; only things that have been useful at one
 * time or another are included.
 */
typedef struct addr_range
{	ADDR start;
	ADDR end;
}			ADDR_RANGE;

typedef void		(*ASTADR)();		/* AST routine address	*/
typedef LONG		BOOLEAN;		/* Truth value		*/
typedef WORD		CHANNEL;		/* Channel number	*/
typedef LONG		COND;			/* Condition value	*/
typedef LONG		CONTEXT;		/* Search context	*/

/*
 * The date and time is a quadword, but defining it as a pair of longs
 * makes it easier to do static initializations of date-times that are
 * short enough - less than 7 minutes is safe - to fit in just the low-
 * order word.  The DELTA_TIME macro creates an appropriate initializer -
 * DELTA_TIME(n) creates a VMS delta time of n hundreds of seconds.  No check
 * is made to ensure that n is in range (less than 42000 is safe).
 *
 * The units for data-times are 100-nanoseconds (1e-7); the input is in
 * hundreds (1e-2); so we must multiply by 1e5, and negate since delta
 * times are represented that way....
 */
typedef struct date_time
{	LONG	low;
	LONG	high;
}			DATE_TIME;		/* VMS date-time	*/
#define DELTA_TIME(n)	{ -100000*(n), -1 }

typedef struct dsc$descriptor_s
			DESCR;			/* (String) descriptor	*/

typedef LONG		EF;			/* Event flag number	*/
typedef BYTE		EFB;			/* Event flag in a byte	*/

typedef LONG		EXH_BLOCK[];		/* exit_handler_block	*/
typedef struct exh_block_i
{	ADDR	EXH_flink;
	ADDR	EXH_addr;
	UBYTE	EXH_argc;
	BYTE	mbz[3];
	COND	*EXH_cond;
	LONG	EXH_args[];
} EXH_BLOCK_I;
#define EXH_FILL(n) 0,0,n+1,0
/*
 * Use as:
 *
 *	EXH_BLOCK exh = {EXH_FILL(n),<n> longword args};
 *
 * where n>=0 is the number of arguments to be passed (not counting the con-
 * dition value),  and cond is someplace a condition value can be passed.
 * EXH_BLOCK_I is for access to the internal structure.  Thus, the next
 * step is likely to be:
 *
 *	exh.EXH_addr = &exh-routine;
 *	exh.EXH_cond = &cond-location;
 */

typedef WORD		FILE_PROT;		/* File protection	*/
typedef struct file_prot_i
{	variant_union
	{   variant_struct
	    {	unsigned system:4;		/* System bits		*/
		unsigned owner:4;		/* Owner bits		*/
		unsigned group:4;		/* Group bits		*/
		unsigned world:4;		/* World bits		*/
	    } wholes;

	    variant_struct
	    { 	unsigned sr:1;			/* System read		*/
		unsigned sw:1;			/* System write		*/
		unsigned se:1;			/* System execute	*/
		unsigned sd:1;			/* System delete	*/

	     	unsigned or:1;			/* Owner read		*/
		unsigned ow:1;			/* Owner write		*/
		unsigned oe:1;			/* Owner execute	*/
		unsigned od:1;			/* Owner delete		*/

	     	unsigned gr:1;			/* Group read		*/
		unsigned gw:1;			/* Group write		*/
		unsigned ge:1;			/* Group execute	*/
		unsigned gd:1;			/* Group delete		*/

	     	unsigned wr:1;			/* World read		*/
		unsigned ww:1;			/* World write		*/
		unsigned we:1;			/* World execute	*/
		unsigned wd:1;			/* World delete		*/
	     } bits;
	} whatever;
} FILE_PROT_I;

typedef struct iosb
{	UWORD status;
	UWORD count;
	LONG device_data;
} IOSB;						/* I/O status block	*/

typedef struct item_list_2
{	WORD len;				/* ?UWORD		*/
	WORD code;
	ADDR addr;
} ITEM_LIST_2;					/* Item list element	*/

typedef struct item_list_3
{	WORD len;				/* ?UWORD		*/
	WORD code;
	ADDR addr;
	ADDR retlen;
} ITEM_LIST_3;					/* Item list element	*/

typedef LONG		PROCESS_ID;		/* Process ID		*/

/*
 * Define the standard BOOLEAN values, and test a VMS-standard condition for
 * success or failure.  Note:  TRUE and FALSE should really be cast to type
 * BOOLEAN, but that would lead to conflicts with stdio.h, which uses just 0
 * and 1.  The main reason the definitions are here at all is to be sure that
 * some incompatible value - say ~0 for TRUE - isn't used.
 */
#define TRUE		1
#define FALSE		0
#define OK(x)		(((x)&1) != 0)
#define FAILED(x)	(((x)&1) == 0)

/*
 * If-statement versions of the VMS-standard truth tests.  For expressions
 * that can only be 0 or 1, we get better code if we just test the bottom bit.
 */
#define if_F(x)		if (FAILED(x))
#define if_T(x)		if (OK(x))

/*
 * Test a VMS-standard status for success.  Any non-success code is signalled.
 * The macro is defined so that it can be used even as a single statement in
 * an if with an else clause.
 */
#define TEST(x) do {	COND TEST_;			\
							\
			if_F ((TEST_ = (x)))		\
				LIB$SIGNAL(TEST_);	\
		   } while (FALSE)

extern DESCR *descr();				/* Create a descriptor	*/

/*
 * Macros to compute a bit value from a bit number, bit number from bit value,
 * and the bit count (number of bits on) for 32-bit quantities.  The results
 * are compile-time constants if the arguments are.
 *
 * The definition of BITCOUNT is based on an algorithm condensed from one
 * extracted from a graph coloring register allocator which manipulates
 * bitvectors.  It was inspired by an analogous algorithm for counting bits in
 * 36 bit words in MIT's HAKMEM, designed by Chris Smith, and written by Jane
 * Hoffman.  The original conversion to a form suitable for C on a VAX was by
 * Brad Merrill; that code was fixed and re-written by Jerry Leichter.  It
 * assumes a 32-bit word.  Note that the argument is evaluated multiple times,
 * so should not have side-effects.  A full explanation of the algorithm is
 * too long to include here; in summary, BX_(x) replaces each 4-bit sequence
 * in x by the number of bits in that sequence (which will, of course, fit in
 * 4 bits).  BITCOUNT folds the 4-bit sequences into 8-bit sequences.  The
 * 8-bit sequences are then added up by recognizing that they can be viewed as
 * a base 256 number, and the sum of the digits of a base b number is the same
 * mod b-1 as the number mod b-1.
 *
 * The original implementation produce results in groups of 3, then 6 bits.
 * While natural on a PDP-10's 36-bit word, this requires special case
 * handling of the sign bit on a VAX, since the top 3-bit sequence is really
 * only 2 bits long. 
 */
#define BITVAL(n)	(1 << (n))
#define BITNUM(b)	BITCOUNT((b)-1)
#define BITCOUNT(x)	(((BX_(x)+(BX_(x)>>4)) & 0x0F0F0F0F) % 255)
#define  BX_(x)		((x) - (((x)>>1)&0x77777777)			\
			     - (((x)>>2)&0x33333333)			\
			     - (((x)>>3)&0x11111111))

#endif

