(FILECREATED " 5-Aug-85 22:45:41" {ERIS}<LISPCORE>LIBRARY>PCALLSTATS.;2 58147
changes to: (VARS PCALLSTATSCOMS APSCOMS)
(MACROS .PRINTPCT. BIN2 BIN3 CONVTIMER)
previous date: "18-Jan-85 17:17:57" {ERIS}<LISPCORE>LIBRARY>PCALLSTATS.;1)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PCALLSTATSCOMS)
(RPAQQ PCALLSTATSCOMS [(COMS * APSCOMS)
(VARS PCALLVARS PCALLEVENTS PCALLFORMAT PCALLPARAMS)
(VARS * (PROGN PCALLPARAMS))
(ADDVARS (PARAMNAMES PCALLPARAMS)
(APSVARNAMES PCALLVARS)
(EVENTSNAMES PCALLEVENTS)
(FORMATNAMES PCALLFORMAT))
(DECLARE: DONTCOPY (RECORDS FunctionData FVARSTAT FVAREVENT)
(MACROS .FNHEADEREQUAL. .FNHEADERMEMB. PUNTFNP))
(COMS (* Fns for handling specific stats events)
(FNS CALLEVENT RETURNEVENT FVAREVENT FVAREXITEVENT DISKEVENT)
(* User functions for controlling filtering)
(FNS APSBKDWN APSFLTR)
(* Fns to aid in the stats gathering)
(FNS BEGINWINDOW ENDWINDOW NOTECALLEDINFO INCREMENT.XREF INCREMENT.CALLS FILTERFN
CHECKFILTERFNSWITCH GETFD PRINTPCSKIPFNS ADDSTATTIME))
(COMS (* Fns for nicely printing the results of the stats)
(FNS PRINTPCALLHEADER PRINTFNINFO PRINTFVARINFO PRINTFVARINFO1 PRINTFVARBYFN
PRINTFVARENTRY PRINTCALLINFO PRINTCALLINFOLST SIMPLELISTFROMHASHCOUNTS
FREQLISTFROMHASHCOUNTS FNFROMHEADER SUBR#OF FNHEADEROF FNHEADERSOF
COLLECTFNHEADERS TICKSTOMICROSECONDS))
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP))
(GLOBALVARS * (MAPCAR (APPEND PCALLVARS PCALLPARAMS)
(FUNCTION CAR)))
(GLOBALVARS FNDATASAV \INITSUBRS))
[P (OR (LISTP (EVALV (QUOTE \INITSUBRS)))
(LOADVARS (QUOTE \INITSUBRS)
(QUOTE LLSUBRS]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA APSFLTR APSBKDWN)
(NLAML)
(LAMA])
(RPAQQ APSCOMS ((FNS DOSTATS EMITSTATS APSDOIT READAPS READAPSDATA PRINTAPS SETEVENTARRAY
ALPHANUMERICCODEP)
(FNS OTHERSHORTEVENT OTHERLONGEVENT)
(FNS VERSIONEVENT MISCSTATSEVENT)
(ADDVARS (PARAMNAMES BASEPARAMS)
(APSVARNAMES PBASEVARS)
(EVENTSNAMES PBASEEVENTS)
(FORMATNAMES OTHERFORMAT))
(VARS PBASEVARS DEFAULTEVENTS PBASEEVENTS OTHERFORMAT BASEPARAMS)
(VARS * (PROGN BASEPARAMS))
(VARS APSFILES)
(FNS APSPRINTCONFIG APSPRINTVERS APSPRINTMISCSTATS GETMISCSTAT)
(COMS (FNS PRINTAPSTOFILE APSINITVARS)
(FNS PRINTFREQ CDRGTP PFREQ NOPFN)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS .PRINTPCT.)))
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS BIN2 BIN3 CONVTIMER)
(GLOBALVARS APSDEBUGFLG USWITCHES ALTOVERSION SOURCE NXMPAGES GSWITCHES OTHEREVENTS
ALTOSERIAL EVENTSNAMES FORMATNAMES APSVARNAMES EVENTFNS PUNTEVENTS
RAMVERSION BCPLVERSION LISPVERSION MISCSTATS MISCSTATSLAYOUT APSRDFILE))
))
(DEFINEQ
(DOSTATS
[LAMBDA (FORM TITLE ACCUMLATEDTIME NOCALLINFO DOLISTFLG) (* bvm: "21-OCT-83 15:01")
(* collects stats on FORM and analyzes them.)
(SETQ NOTECALLINFOFLG (NOT NOCALLINFO))
(SETQ TOTALTIMEFLG ACCUMLATEDTIME)
(APSDOIT (EMITSTATS FORM)
(OR DOLISTFLG T)
(COND
(TITLE (CONCAT TITLE "
FORM = " FORM))
(T (CONCAT "evaluation of " FORM])
(EMITSTATS
[LAMBDA (FORM) (* lmm "13-Apr-84 08:59")
(PROG [(STATSFILE (PACKFILENAME (QUOTE HOST)
(QUOTE DSK)
(QUOTE NAME)
(PACKC (for CODE in (DCHCON (CAR FORM)
CHCONLST1)
when (ALPHANUMERICCODEP CODE) collect
(* restrict name to alphanumerics to prevent casualty)
CODE))
(QUOTE EXTENSION)
(QUOTE STATS]
(DECLARE (SPECVARS STATSFILE)) (* collect stats. create and compile function.)
[PROG ((STRF T)
(LCFIL))
(DECLARE (SPECVARS STRF LCFIL))
(COMPILE1 (QUOTE STATSDUMMYFUNCTION)
(BQUOTE (LAMBDA NIL
(RESETLST (RESETSAVE NIL (LIST (FUNCTION GATHERSTATS)))
(GATHERSTATS STATSFILE)
, FORM (GATHERSTATS]
(printout T "------ beginning evaluation of form" T)
(ERSETQ (STATSDUMMYFUNCTION))
(printout T "------ ending evaluation" T)
(RETURN STATSFILE])
(APSDOIT
[LAMBDA (FILE DOLISTFLG TITLE) (* bvm: "21-OCT-83 14:53")
(* creates a data base and prints a summary of a stats
file.)
(PROG (OUTPUTFILE)
[SETQ APSMES (OR TITLE (PROG1 (PROMPTFORWORD "Stats title: " APSMES NIL T NIL NIL
(CHARCODE (CR)))
(TERPRI T]
(READAPS (OR (INFILEP FILE)
(FINDFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE STATS)
(QUOTE BODY)
FILE))
FILE))
[SETQ OUTPUTFILE (PRINTAPS NIL (PACKFILENAME (QUOTE NAME)
(FILENAMEFIELD FILE (QUOTE NAME))
(QUOTE EXTENSION)
(QUOTE PRINTOUT]
(COND
((SELECTQ DOLISTFLG
((NIL ASK)
(EQ (ASKUSER NIL (QUOTE N)
"List? " NIL T T)
(QUOTE Y)))
((N NO)
NIL)
T)
(printout T "------ listing printout file: " OUTPUTFILE T)
(APPLY* (QUOTE LISTFILES)
OUTPUTFILE)))
(RETURN OUTPUTFILE])
(READAPS
[LAMBDA (FILE) (* bvm: " 5-OCT-83 12:56")
(PROG [(INSTREAM (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD)
8
(QUOTE ((SEQUENTIAL T]
(printout T "------ reading stats file " (SETQ APSRDFILE (FULLNAME INSTREAM))
" of length "
(GETFILEINFO INSTREAM (QUOTE LENGTH))
" bytes" T)
(AND (NEQ (GETFILEPTR INSTREAM)
0)
(SETFILEPTR INSTREAM 0))
(APSINITVARS)
(SETEVENTARRAY)
(READAPSDATA INSTREAM)
(RETURN (CLOSEF INSTREAM])
(READAPSDATA
[LAMBDA (INSTREAM) (* bvm: " 5-OCT-83 12:55")
[replace ENDOFSTREAMOP of INSTREAM with (FUNCTION (LAMBDA (STREAM)
(RETFROM (QUOTE READAPSDATA]
(bind EVENT DUMMYEVENT FN ARG (EC ← 0)
ARG2 ARG3 declare (SPECVARS EVENT DUMMYEVENT) while (PROGN
(* Terminated by RETFROM in the ENDOFSTREAMOP)
T)
do (COND
((IGREATERP (ADD1VAR EC)
1000)
(printout T (GETFILEPTR INSTREAM)
", ") (* Blip. 1000 events read)
(SETQ EC 0)))
(SETQ EVENT (\BIN INSTREAM))
(SETQ FN (FASTELT EVENTFNS EVENT))
(COND
(APSDEBUGFLG (printout T "Event #" EVENT " => " FN T)))
(PROG NIL
(SELECTQ (LRSH EVENT 6)
(0 (* one word event)
(SETQ ARG (\BIN INSTREAM)))
(1 (* two word event)
(SETQ ARG (BIN3 INSTREAM)))
[2 (* multi-word event)
(SETQ ARG (ADD1 (\BIN INSTREAM]
[3 (* call/return event)
(SETQ ARG (CONS (\BIN INSTREAM)
(BIN2 INSTREAM)))
(* Function header of fn being called/returned to)
(SETQ ARG2 (BIN2 INSTREAM)) (* time of event)
(SETQ ARG3 (BIN2 INSTREAM))
(RETURN (for F inside FN do (APPLY* F ARG ARG2 ARG3]
(SHOULDNT))
(for F inside FN do (APPLY* F ARG INSTREAM)))
finally (TERPRI T])
(PRINTAPS
[LAMBDA (ONLYPRINT FILE) (* bvm: " 5-OCT-83 16:17")
(printout T "------ making printout file." T)
[AND FILE (OR APSMES (PROGN (printout T T "Statistics file title: ")
(SETQ APSMES (READLINE T (LIST (READ T]
(PRINTAPSTOFILE [MAPCONC (REVERSE FORMATNAMES)
(FUNCTION (LAMBDA (NAME)
(CONS (QUOTE (T))
(APPEND (EVAL NAME]
(COND
((AND ONLYPRINT (LITATOM ONLYPRINT))
(OR (LISTP (GETATOMVAL ONLYPRINT))
(LIST ONLYPRINT)))
(T ONLYPRINT))
FILE])
(SETEVENTARRAY
[LAMBDA NIL (* bvm: "16-FEB-82 13:39")
(for I from 0 to 255 do (FASTSETA EVENTFNS I NIL))
(for NAME in (APPEND EVENTSNAMES (QUOTE (DEFAULTEVENTS)))
do (for X in (EVAL NAME)
do
(* Form of an element of this list: (function first-event# last-event# mode), where the event#'s give range of
events described, function is called when such an event is encountered, with arguments arg, file)
(for I from (CADR X) to (OR (CADDR X)
(CADR X))
bind (MODE ←(CADDDR X))
(FN ←(CAR X))
do (PROG ((OLDFN (FASTELT EVENTFNS I)))
(FASTSETA EVENTFNS I (SELECTQ MODE
(DEFAULT (OR OLDFN FN))
[ADD (COND
((NULL OLDFN)
FN)
((LISTP OLDFN)
(NCONC1 OLDFN FN))
(T (LIST OLDFN FN]
(PROGN (COND
(OLDFN (printout T "Event " .I3.8
(CADR X)
"Q -- " FN
" replaces "
OLDFN T)))
FN])
(ALPHANUMERICCODEP
[LAMBDA (CHCODE) (* bvm: "30-JUN-81 14:39")
(AND (IGEQ CHCODE (CHARCODE 0))
(OR (ILEQ CHCODE (CHARCODE 9))
(AND (IGEQ CHCODE (CHARCODE A))
(OR (ILEQ CHCODE (CHARCODE Z))
(AND (IGEQ CHCODE (CHARCODE a))
(ILEQ CHCODE (CHARCODE z])
)
(DEFINEQ
(OTHERSHORTEVENT
[LAMBDA (ARG) (* lmm "22-JUN-80 16:17")
(pushnew OTHEREVENTS EVENT])
(OTHERLONGEVENT
[LAMBDA (N INX) (* bvm: " 5-OCT-83 16:18")
(OTHERSHORTEVENT N)
(SETFILEPTR INX (IPLUS (GETFILEPTR INX)
(LLSH N 1])
)
(DEFINEQ
(VERSIONEVENT
[LAMBDA (N INX) (* bas: "20-NOV-80 19:51")
(OR (EQ N 6)
(HELP "Stats version mismatch"))
(SETQ ALTOVERSION (BIN2 INX))
(SETQ ALTOSERIAL (BIN2 INX))
(SETQ RAMVERSION (BIN2 INX))
(SETQ BCPLVERSION (BIN2 INX))
(SETQ LISPVERSION (BIN2 INX))
(SETQ NXMPAGES (BIN2 INX])
(MISCSTATSEVENT
[LAMBDA (N INX) (* bvm: " 5-OCT-83 16:26")
(PROG ((ARR (WORDARRAY N))
(J 0))
(FRPTQ N (FASTSETAW ARR J (BIN2 INX))
(ADD1VAR J))
(push MISCSTATS ARR])
)
(ADDTOVAR PARAMNAMES BASEPARAMS)
(ADDTOVAR APSVARNAMES PBASEVARS)
(ADDTOVAR EVENTSNAMES PBASEEVENTS)
(ADDTOVAR FORMATNAMES OTHERFORMAT)
(RPAQQ PBASEVARS ((EVENTFNS (POINTERARRAY 256))
(OTHEREVENTS NIL)
(GSWITCHES NIL)
(USWITCHES NIL)
(NXMPAGES NIL)
(MISCSTATS NIL)))
(RPAQQ DEFAULTEVENTS ((NILL 0)
(NILL 1 NIL DEFAULT)
(OTHERSHORTEVENT 1 127 DEFAULT)
(OTHERLONGEVENT 128 191 DEFAULT)
(OTHERSHORTEVENT 192 255 DEFAULT)))
(RPAQQ PBASEEVENTS ((VERSIONEVENT 136)
(MISCSTATSEVENT 135)))
(RPAQQ OTHERFORMAT (("Statistics from file:" APSRDFILE)
("measuring:" APSMES)
(NIL APSPRINTCONFIG "Computation run on ")
("Unrecognized events:" OTHEREVENTS)
("Values from MiscStats (times in msecs):" APSPRINTMISCSTATS NIL)))
(RPAQQ BASEPARAMS ((APSMES NIL (* Description of statistics printed))
(APSDEBUGFLG NIL (* If true, prints out something for every event seen))))
(RPAQ APSMES NIL (* Description of statistics printed))
(RPAQ APSDEBUGFLG NIL (* If true, prints out something for every event seen))
(RPAQQ APSFILES (APS READSYS PCALLSTATS UPCSTATS PPAGESTATS PMEMSTATS))
(DEFINEQ
(APSPRINTCONFIG
[LAMBDA (S) (* bvm: " 5-OCT-83 16:24")
(printout NIL (OR S "")
(SELECTQ (LRSH ALTOVERSION 12)
(4 "Dolphin")
(5 "Dorado")
(CONCAT "Unknown machine type " (LRSH ALTOVERSION 12)))
" serial #" .I3.8.T (LOGAND ALTOSERIAL 255)
" with " NXMPAGES " pages of memory." T)
(printout NIL "Versions:")
(APSPRINTVERS " Ram" RAMVERSION)
(APSPRINTVERS " Bcpl" BCPLVERSION)
(APSPRINTVERS " Lisp" LISPVERSION)
(TERPRI])
(APSPRINTVERS
[LAMBDA (S V) (* bvm: " 5-OCT-83 16:24")
(* Octal printout of the version number both whole and
in bytes)
(printout NIL S " = " .I6.8 V "(" .I3.8 (fetch HIBYTE of V)
"," .I3.8 (fetch LOBYTE of V)
")"])
(APSPRINTMISCSTATS
[LAMBDA NIL (* bvm: " 5-JAN-83 18:47")
(* prints the information from miscstats. MISCSTATS is a list of the miscstats at the time GATHERSTATS was called
and there should always be 2 of them.)
(SELECTQ (LENGTH MISCSTATS)
[2 (* print calculating difference.)
(for X in [CONSTANT (for QUAD in MISCSTATSLAYOUT bind I (NEXTI ← 0)
when [PROG1 (CADDR QUAD)
(SETQ NEXTI (IPLUS (SETQ I NEXTI)
(SELECTQ (CADR QUAD)
(FIXP 2)
(WORD 1)
(SHOULDNT]
collect (LIST I (CADR QUAD)
(CAR QUAD]
bind VAL
do (* CONSTANT list is a list of entries <offset, type,
name>)
(* GETMISCSTAT is supposed to extract the relevant
value out of the MISCSTATS array)
[SETQ VAL (IDIFFERENCE (GETMISCSTAT (CAR MISCSTATS)
(CAR X)
(CADR X))
(GETMISCSTAT (CADR MISCSTATS)
(CAR X)
(CADR X]
(OR (ZEROP VAL)
(printout NIL 6 (CADDR X)
25 .I10 VAL T]
(printout NIL (LENGTH MISCSTATS)
, "MISCSTATS events." T])
(GETMISCSTAT
[LAMBDA (STATS INDEX TYPE) (* bvm: " 5-JAN-83 16:57")
(SELECTQ TYPE
[FIXP (\MAKENUMBER (FASTELTW STATS INDEX)
(FASTELTW STATS (ADD1 INDEX]
(HELP])
)
(DEFINEQ
(PRINTAPSTOFILE
[LAMBDA (COMMANDS ONLYPRINT FILE) (* bvm: " 4-OCT-83 16:42")
(* perform a set of formatting commands)
(RESETLST (RESETSAVE (RADIX 10))
[COND
(FILE (RESETSAVE (OUTFILE FILE)
(QUOTE (PROGN (CLOSEF (OUTPUT OLDVALUE]
[bind LAST HEADER for CMD in COMMANDS
do (* CMD is either (header varname) or
(header . form-to-eval))
(COND
((EQ (SETQ HEADER (CAR CMD))
T)
(SETQ LAST (CADR CMD)))
[(AND ONLYPRINT (NOT (FMEMB CMD ONLYPRINT))
(NOT (SOME ONLYPRINT (FUNCTION (LAMBDA (A)
(EDITFINDP CMD A]
(T (TERPRI)
(COND
(LAST (EVAL LAST)
(SETQ LAST NIL)))
(COND
((CDDR CMD)
(COND
(HEADER (printout NIL HEADER T)))
(EVAL (CDR CMD)))
(T (printout NIL (OR HEADER (CADR CMD))
,
(EVAL (CADR CMD))
T]
(OUTPUT])
(APSINITVARS
[LAMBDA NIL (* bvm: " 5-OCT-83 15:04")
(for NAME in APSVARNAMES do (for X in (EVAL NAME) do (SETATOMVAL (CAR X)
(EVAL (CADR X)))
when (CAR (LISTP X])
)
(DEFINEQ
(PRINTFREQ
[LAMBDA (L FN MIN PCT) (* lmm "22-JUN-80 21:16")
(PFREQ (SORT L (FUNCTION CDRGTP))
[FUNCTION (LAMBDA (I FLAG)
(COND
(FLAG (APPLY* FN I))
(T 100]
MIN PCT])
(CDRGTP
[LAMBDA (X Y) (* lpd "15-NOV-78 16:50")
(IGREATERP (CDR X)
(CDR Y])
(PFREQ
[LAMBDA (L PRINTFN MINCNT PCT CUM) (* bvm: "23-OCT-83 16:05")
(* L is a list of entries (stuff . count). For each entry, prints count, as well as a percentage that count is of
total if PCT is true, and then, applies PRINTFN to print stuff. PFN's second arg is a flag, which if true should
cause printing, if NIL should just return a character count of what would be printed. PFREQ does not print entries
whose count is less than MIN, or MIN*totalcount if MINCNT is floatp)
(OR PRINTFN (SETQ PRINTFN (FUNCTION NOPFN)))
(PROG ((N (LENGTH L))
(ACTUALTOTAL 0.0)
(TOT 0)
(LL (IPLUS -3 (LINELENGTH)))
(LAST -1)
CUTOFF SEP REST FAKETOTAL)
[for X in L
do (* To reduce chance of overflow, add with floating
point)
(SETQ ACTUALTOTAL (FPLUS ACTUALTOTAL
(COND
((NOT (LESSP (CDR X)
0))
(CDR X))
(T (* Earlier sum overflowed, so compensate)
(CDR (RPLACD X (FTIMES 2.0 (LRSH (CDR X)
1]
(COND
((NUMBERP PCT)
(SETQ FAKETOTAL (FLOAT PCT)))
(T (SETQ FAKETOTAL ACTUALTOTAL)))
[SETQ CUTOFF (OR (FIXP MINCNT)
(IMAX 2 (FIX (COND
((FLOATP MINCNT)
(FTIMES FAKETOTAL MINCNT))
(T (FQUOTIENT FAKETOTAL N]
(for X in L bind NEW CNT FCNT NAME when (IGEQ (SETQ CNT (CDR X))
CUTOFF)
do (SETQ NAME (CAR X))
[SETQ TOT (FPLUS TOT (SETQ FCNT (FLOAT CNT]
(COND
((SETQ NEW (OR (NOT (IEQP CNT LAST))
PCT CUM))
(printout NIL T .I8 (SETQ LAST CNT))
(COND
(PCT (.PRINTPCT. FCNT FAKETOTAL)))
[COND
(CUM (printout NIL .I10 TOT)
(COND
(PCT (.PRINTPCT. TOT FAKETOTAL]
(SETQQ SEP " ")))
(COND
((AND (NOT NEW)
(IGREATERP (IPLUS (POSITION)
(APPLY* PRINTFN NAME NIL))
LL))
(PRIN1 (QUOTE ,))
(TAB 10))
(T (PRIN1 SEP)))
(APPLY* PRINTFN NAME T)
(SETQQ SEP ", ")
(SETQ N (SUB1 N)))
(COND
((NOT (ZEROP N))
(SETQ REST (FDIFFERENCE ACTUALTOTAL TOT))
(printout NIL T .I8 REST)
(COND
(PCT (.PRINTPCT. REST FAKETOTAL)))
(printout NIL " for " N " entries not shown")))
(printout NIL T .F9.0 ACTUALTOTAL 18 "Total for " (LENGTH L)
" entries")
(RETURN ACTUALTOTAL])
(NOPFN
[LAMBDA (NAME FLAG)
(COND
(FLAG (PRIN2 NAME))
(T (NCHARS NAME T])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS .PRINTPCT. MACRO ((PART TOTAL)
(printout NIL , .F6.2 (FTIMES (FQUOTIENT PART TOTAL)
100.0)
(QUOTE %%]
)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS BIN2 MACRO ((INX)
(IPLUS (LLSH (\BIN INX)
8)
(\BIN INX]
[PUTPROPS BIN3 DMACRO ((INX)
(\MAKENUMBER (\BIN INX)
(BIN2 INX]
(PUTPROPS CONVTIMER DMACRO (= . \MAKENUMBER))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS APSDEBUGFLG USWITCHES ALTOVERSION SOURCE NXMPAGES GSWITCHES OTHEREVENTS ALTOSERIAL
EVENTSNAMES FORMATNAMES APSVARNAMES EVENTFNS PUNTEVENTS RAMVERSION BCPLVERSION
LISPVERSION MISCSTATS MISCSTATSLAYOUT APSRDFILE)
)
)
(RPAQQ PCALLVARS ((FNCOUNTMAX 63)
(FNCOUNTS (ARRAY (ADD1 FNCOUNTMAX)
(QUOTE POINTER)
NIL 0))
(FLTCNTS (HASHARRAY 300))
(FNHEADERTABLE NIL)
(CURRENTFN NIL)
(FNDATA NIL)
(LASTFNTIME NIL)
(FVARSTARTED)
(FVAREVENTLST)
(NABL (NOT APSBKDWNFN))
(APSSKIPFNSNUMS (MAPCONC APSSKIPFNS (FUNCTION FNHEADERSOF)))
(APSFLTRFNSNUMS (MAPCONC APSFLTRFNS (FUNCTION FNHEADERSOF)))
(APSBKDWNFNSNUMS (MAPCONC APSBKDWNFNS (FUNCTION FNHEADERSOF)))
(APSBKDWNFNNUM (FNHEADEROF APSBKDWNFN))
(FLTRFLG NIL)
(DISTRIBUTIONLST NIL)
(CALLEDPUNTFN NIL)
(PUNTCOUNTS NIL)
(PARALLELSTACK NIL)
(PSTACKFLAG (OR RETFROMSTACKFLG APSBKDWNFN APSBKDWNFNS))))
(RPAQQ PCALLEVENTS ((CALLEVENT 192 252)
(FVAREVENT 253)
(FVAREXITEVENT 254)
(RETURNEVENT 255)
(DISKEVENT 152 154)))
(RPAQQ PCALLFORMAT [(NIL PRINTPCALLHEADER NIL)
(NIL PRINTFNINFO "" FNCOUNTS FNTSMIN)
(NIL PRINTFNINFO "Filtered out fns" FLTCNTS FNTSMIN)
(NIL PRINTFVARINFO FVAREVENTLST .001)
(NIL PRINTFVARBYFN FVAREVENTLST .001)
(NIL PRINTFNINFO "Alphabetic" FNCOUNTS FNTSMINALL T)
(NIL PRINTCALLINFO FNTSMINALL)
(NIL OR APSTRACEFLG APSDEBUGFLG (SETQ FLTCNTS (SETQ FNCOUNTS NIL])
(RPAQQ PCALLPARAMS ((APSBKDWNFN NIL (* Window function))
(APSBKDWNFNS NIL (* break down time with respect to these functions))
(APSFLTRFNS (QUOTE (\ACTONVMEMPAGES \CLEANUPDISKQUEUE \CLEARCB \DOACTONDISKPAGES
\DODISKCOMMAND \DOWRITEDISKPAGES \FAULTHANDLER \FLUSHPAGE
\GETDISKCB \INSUREVMEMFILE \KEYHANDLER1 \LOADVMEMPAGE
\LOOKUPFMAP \LOOKUPPAGEMAP \M44ACTONVMEMFILE
\MARKPAGEVACANT \NWWInterrupt \PAGEFAULT \PageFault
\REALDISKDA \SELECTREALPAGE \StackOverflow \StatsOverflow
\TRANSFERPAGE \UPDATECHAIN \VIRTUALDISKDA))
(* filter out calls to these functions))
(APSSKIPFNS (QUOTE (\GETKEY WAITFORINPUT DISMISS GATHERSTATS \GATHERSTATS RAID))
(* ignore any time attributed to these functions))
(ALTOTICKTIME (FQUOTIENT 1000.0 \RCLKMILLISECOND))
(RETFROMSTACKFLG NIL (* if NIL, won't keep stack to handle RETFROMs))
(APSTRACEFLG NIL (* if T, causes printout of every CALL and RETURN event when read))
(DISTRIBUTIONFN NIL (* if set, this is the function whose time distribution is analyzed))
(TOTALTIMEFLG NIL (* if T, total time is analyzed rather than time per function))
(NOTECALLINFOFLG T (* if T, prints out a table of who calls who))
(FNTSMIN .001 (* threshold for function listing))
(FNTSMINALL 0 (* threshold for alphabetic listing))))
(RPAQ APSBKDWNFN NIL (* Window function))
(RPAQ APSBKDWNFNS NIL (* break down time with respect to these functions))
(RPAQQ APSFLTRFNS (\ACTONVMEMPAGES \CLEANUPDISKQUEUE \CLEARCB \DOACTONDISKPAGES \DODISKCOMMAND
\DOWRITEDISKPAGES \FAULTHANDLER \FLUSHPAGE \GETDISKCB
\INSUREVMEMFILE \KEYHANDLER1 \LOADVMEMPAGE \LOOKUPFMAP
\LOOKUPPAGEMAP \M44ACTONVMEMFILE \MARKPAGEVACANT \NWWInterrupt
\PAGEFAULT \PageFault \REALDISKDA \SELECTREALPAGE \StackOverflow
\StatsOverflow \TRANSFERPAGE \UPDATECHAIN \VIRTUALDISKDA))
(RPAQQ APSSKIPFNS (\GETKEY WAITFORINPUT DISMISS GATHERSTATS \GATHERSTATS RAID))
(RPAQ ALTOTICKTIME (FQUOTIENT 1000.0 \RCLKMILLISECOND))
(RPAQ RETFROMSTACKFLG NIL (* if NIL, won't keep stack to handle RETFROMs))
(RPAQ APSTRACEFLG NIL (* if T, causes printout of every CALL and RETURN event when read))
(RPAQ DISTRIBUTIONFN NIL (* if set, this is the function whose time distribution is analyzed))
(RPAQ TOTALTIMEFLG NIL (* if T, total time is analyzed rather than time per function))
(RPAQ NOTECALLINFOFLG T (* if T, prints out a table of who calls who))
(RPAQ FNTSMIN .001 (* threshold for function listing))
(RPAQ FNTSMINALL 0 (* threshold for alphabetic listing))
(ADDTOVAR PARAMNAMES PCALLPARAMS)
(ADDTOVAR APSVARNAMES PCALLVARS)
(ADDTOVAR EVENTSNAMES PCALLEVENTS)
(ADDTOVAR FORMATNAMES PCALLFORMAT)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD FunctionData ((#OfCalls . TotalTime)
CalledFns CallingFns FnName . CallInfoList)
[ACCESSFNS FunctionData (ExternalTime (FIXR (FTIMES (fetch TotalTime
of DATUM)
ALTOTICKTIME]
CalledFns ←(CONS)
CallingFns ←(CONS))
(RECORD FVARSTAT (FVARNAME . FVAREVENTS))
(RECORD FVAREVENT (FVARCALLEDBY FVARTIME . FVARCOUNTS))
]
(DECLARE: EVAL@COMPILE
[PUTPROPS .FNHEADEREQUAL. MACRO (OPENLAMBDA (X Y)
(AND (EQ (CDR X)
(CDR Y))
(EQ (CAR X)
(CAR Y]
[PUTPROPS .FNHEADERMEMB. MACRO ((HEADER LST)
(find H in LST suchthat (.FNHEADEREQUAL. H HEADER]
(PUTPROPS PUNTFNP MACRO ((FNHEADER)
(EQ (CAR FNHEADER)
0)))
)
)
(* Fns for handling specific stats events)
(DEFINEQ
(CALLEVENT
[LAMBDA (ARG ARG2 ARG3) (* lmm "26-MAR-82 13:43")
(DECLARE (USEDFREE APSTRACEFLG PSTACKFLAG APSBKDWNFNNUM EVENT NABL FNDATA CURRENTFN PARALLELSTACK)
)
(COND
([OR NABL (COND
((EQUAL ARG APSBKDWNFNNUM) (* turning on analysis.)
(BEGINWINDOW ARG)
(SETQ NABL T] (* a call has been made to the function CALLEDFN at
NOWTIME.)
(PROG ((CALLEDFN ARG)
(NARGS (LOGAND EVENT 77Q))
NEWDATA
(NOWTIME (CONVTIMER ARG2 ARG3)))
(COND
(APSTRACEFLG (printout T "called " (FNFROMHEADER CALLEDFN)
" at " 36Q NOWTIME T)))
(* note the function left by this call on the stack. So that CURRENTFN is the function being run and the top of
the stack is the one that called it.)
(COND
((FILTERFN CALLEDFN)
(ADDSTATTIME FNDATA NOWTIME)
(INCREMENT.CALLS (SETQ NEWDATA (GETFD CALLEDFN NARGS))
NARGS)
(NOTECALLEDINFO FNDATA (SETQ FNDATA NEWDATA)))
(T (* if the guy who is being called is not being filtered,
don't change FNDATA)
NIL))
(COND
(PSTACKFLAG (push PARALLELSTACK CURRENTFN)))
(SETQ CURRENTFN CALLEDFN)
(RETURN])
(RETURNEVENT
[LAMBDA (ARG ARG2 ARG3) (* lmm "13-FEB-83 15:28")
(COND
(NABL
(* a function (unknown by the event but known to us as CURRENTFN) has returned to the function TOFN.
Charge the time interval between LASTFNTIME and now to CURRENTFN and reset some variable.)
(PROG ((NOWTIME (CONVTIMER ARG2 ARG3))
(TOFN ARG))
(DECLARE (SPECVARS NOWTIME))
(COND
(APSTRACEFLG (printout T "Returnto" , (FNFROMHEADER TOFN)
, "at" 36Q NOWTIME T)))
(* if the function being returned to is not the top of PARALLELSTACK, this is a
RETFROM.)
[COND
((OR (NOT PSTACKFLAG)
(EQUAL (CAR PARALLELSTACK)
TOFN))
(* everything is ok)
(CHECKFILTERFNSWITCH CURRENTFN TOFN)
(* the TOFN is left on the stack during the CHECKFILTERSWITCH so that it can get time added to it by ADDSTATTIME if
keeping track of total time.)
(AND PSTACKFLAG (pop PARALLELSTACK)))
[(EQUAL CURRENTFN APSBKDWNFNNUM)
(* leaving the window function. TOFN is not the top of stack because analysis was turned off when window fn was
entered so we don't know who called it. Stack should be empty)
(CHECKFILTERFNSWITCH CURRENTFN TOFN)
(COND
((SETQ PARALLELSTACK (CDR PARALLELSTACK))
(HELP "ITEMS STILL ON PARALLELSTACK"]
(T (* retfrom event)
(PROG (TOSTACK)
(* find location on stack to return to.)
(COND
((SETQ TOSTACK (MEMBER TOFN (CDDR PARALLELSTACK)))
(* CDDR is to get out of the frame that did the call to RETFROM. ie. CAR is RETTO0, and CADR should be the caller
who cannot be RETTOed.)
(* leave TOSTACK pointing to the fn being returned to so that we can distinquish the return to top of stack from the
return off stack cases.)
NIL)
(T
(* fn not on stack: assume it is a return to a function whose call was not logged. That is clear the parallel stack
if there is one, if not, switch functions.)
(SETQ TOSTACK NIL)))
(* check for another possible place to return to and print warning.)
(COND
((MEMBER TOFN (CDR TOSTACK))
(printout T "WARNING: " (FNFROMHEADER TOFN)
" HAS BEEN RETTOed WITHIN A RECURSIVE CALL." T)))
(* simulate return events for all skipped entries on the stack. Since NOWTIME and LASTFNTIME are global, these
should add 0 to stats of all except the first skipped one to being monitored. This is necessary to allow
CHECKFILTERFNSWITCH to check for breakdown function, filtering functions and to reset the APSTK.)
(for X on (LDIFF PARALLELSTACK (CDR TOSTACK))
do (CHECKFILTERFNSWITCH (CAR X)
(CADR X))
when (CADR X))
(* update the parallel stack)
(COND
(TOSTACK (SETQ PARALLELSTACK (CDR TOSTACK)))
(T
(* if ran off stack, switch from top of stack to new TO function.)
(CHECKFILTERFNSWITCH CURRENTFN TOFN)
(SETQ PARALLELSTACK NIL)))
(RETURN]
(RETURN])
(FVAREVENT
[LAMBDA (ARG ARG2 ARG3) (* bvm: "21-OCT-83 15:03")
(PROG ((FVARTIME (CONVTIMER ARG2 ARG3)))
(COND
(APSTRACEFLG (printout T "Fvar looked up from " (FNFROMHEADER ARG)
" at " FVARTIME T)))
(SETQ FVARSTARTED (CONS FVARTIME ARG])
(FVAREXITEVENT
[LAMBDA (ARG ARG2 ARG3) (* bvm: "21-OCT-83 16:55")
(PROG ((FVARTIME (CONVTIMER ARG2 ARG3))
(NAME (\INDEXATOMVAL (CDR ARG)))
(HIBINDING (CAR ARG))
TIM ENTRY EVENT)
(OR FVARSTARTED (HELP "Fvar exit with no Fvar start"))
(SETQ TIM (IDIFFERENCE FVARTIME (CAR FVARSTARTED)))
[OR (SETQ ENTRY (find X in FVAREVENTLST suchthat (EQ (fetch FVARNAME of X)
NAME)))
(push FVAREVENTLST (SETQ ENTRY (create FVARSTAT
FVARNAME ← NAME]
[COND
([SETQ EVENT (find X in (fetch FVAREVENTS of ENTRY) suchthat (.FNHEADEREQUAL.
(fetch FVARCALLEDBY
of X)
(CDR FVARSTARTED]
(add (fetch FVARTIME of EVENT)
TIM))
(T (push (fetch FVAREVENTS of ENTRY)
(SETQ EVENT (create FVAREVENT
FVARCALLEDBY ←(CDR FVARSTARTED)
FVARTIME ← TIM]
(for X in (fetch FVARCOUNTS of EVENT) when (EQ (CAR X)
HIBINDING)
do (add (CDR X)
1)
(RETURN)
finally (push (fetch FVARCOUNTS of EVENT)
(CONS HIBINDING 1)))
(SETQ FVARSTARTED)
(COND
(APSTRACEFLG (printout T "Fvar lookup of " NAME " took " (TICKSTOMICROSECONDS TIM)
" usecs, found hiloc " HIBINDING T])
(DISKEVENT
[LAMBDA (N INX) (* bvm: "22-FEB-82 14:56")
(* there has been a disk operation for Swap reading, writing or buffer dumping from the BCPL code.
note stats and change the LASTFNTIME to filter time from function call stats)
(DECLARE (SPECVARS DUMMYEVENT))
(PROG ((DUMMYEVENT T)
[DISKEVENTTYPE (CONS 0 (SUBR#OF (SELECTQ (LOGAND EVENT 2)
((0 1)
(QUOTE \PageFault))
(2 (QUOTE \StatsOverflow))
(ERROR "Unknown disk swap event" EVENT]
END FD BEG)
[ADDSTATTIME FNDATA (SETQ BEG (CONVTIMER (BIN2 INX)
(BIN2 INX]
(COND
(APSTRACEFLG (printout T 6 (FNFROMHEADER DISKEVENTTYPE)
, "began at" 40 BEG T)))
(* charge to the current fn the time before the disk
event and charge the interval now to disk type.)
[ADDSTATTIME (SETQ FD (GETFD DISKEVENTTYPE 0))
(SETQ END (CONVTIMER (BIN2 INX)
(BIN2 INX]
(INCREMENT.CALLS FD 0)
(COND
(APSTRACEFLG (printout T 6 (FNFROMHEADER DISKEVENTTYPE)
" ended at" 40 END T])
)
(* User functions for controlling filtering)
(DEFINEQ
(APSBKDWN
[NLAMBDA X (* lmm " 3-DEC-80 15:44")
(* modified by rrb to allow the breakdown functions to
be unnumbered at the time of specification.)
(COND
((MEMB (QUOTE ERRORSET)
X)
(printout T "WARNING: Cannot breakdown on ERRORSET" T)))
(SETQ APSBKDWNFN (OR (CAR X)
(AND (CDR X)
APSBKDWNFN)))
(SETQ APSBKDWNFNS (COND
((CDR X)
(NCONC (AND APSBKDWNFN (LIST APSBKDWNFN))
(CDR X])
(APSFLTR
[NLAMBDA X (* lmm " 3-DEC-80 13:45")
(* modified by rrb to allow filter breakdown functions
to be unnumbered at the time of specification.)
(SETQ APSFLTRFNS X])
)
(* Fns to aid in the stats gathering)
(DEFINEQ
(BEGINWINDOW
[LAMBDA (WINDOWFN) (* bvm: "16-FEB-82 14:10")
(* debugging fn which marks the entering of the window
function.)
(COND
(APSDEBUGFLG (PRIN1 "Beginning to analyse ")
(PRINT (FNFROMHEADER WINDOWFN])
(ENDWINDOW
[LAMBDA (WINDOWFN) (* bvm: "16-FEB-82 14:10")
(* debugging fn which marks the exit from the window
function.)
(COND
(APSDEBUGFLG (printout NIL "No longer analysing " (FNFROMHEADER WINDOWFN])
(NOTECALLEDINFO
[LAMBDA (CALLINGDATA CALLEDDATA) (* bvm: "22-FEB-82 14:55")
(* notes the fact that one function called another.)
(COND
((AND NOTECALLINFOFLG (fetch CallingFns of CALLEDDATA))
(* Don't record punt calls (their CALLINGFNS start out
NIL instead of (NIL)))
(INCREMENT.XREF (fetch CalledFns of CALLINGDATA)
CALLEDDATA)
(INCREMENT.XREF (fetch CallingFns of CALLEDDATA)
CALLINGDATA])
(INCREMENT.XREF
[LAMBDA (ALST KEY) (* bvm: "22-FEB-82 14:43")
(* increments a field in an alist.
KEY is a GETFD value. Assumes the alist has at least one
element.)
(COND
((LISTP ALST)
(PROG ((D (FASSOC KEY ALST)))
(COND
(D (* bucket already exists, add to it.)
(add (CDR D)
1))
(T (* first call with KEY, create a new bucket.)
(FRPLACD ALST (CONS (CONS KEY 1)
(CDR ALST])
(INCREMENT.CALLS
[LAMBDA (FNNODE NARGS) (* lmm "22-JUN-80 16:10")
(* updates the fields in the FunctionData record which
keep track of calls.)
(PROG (D) (* increment the number of times called with NARGS
arguments)
(COND
([NULL (SETQ D (FASSOC NARGS (fetch CallInfoList of FNNODE]
(* first call with NARGS, create a new bucket.)
(ATTACH (CONS NARGS 1)
(fetch CallInfoList of FNNODE)))
(T (* bucket already exists, add to it.)
(add (CDR D)
1))) (* add to total number of calls.)
(add (fetch #OfCalls of FNNODE)
1])
(FILTERFN
[LAMBDA (FNN) (* bvm: " 5-OCT-83 12:39")
(* is FNN a function of interest? Interesting functions are either those being broken down on or those being
filtered on. If filtering function, set up to stop adding events and look for end of filtering.)
(COND
(FLTRFLG (* if we are filtering, ignore all except the function
that started the filtering.)
(.FNHEADEREQUAL. FNN FLTRFLG))
[(.FNHEADERMEMB. FNN APSSKIPFNSNUMS) (* begin filtering the events, save the current function
data record so that after filtering stops, it can be
reinstalled by CHECKFILTERFWSWITCH)
(SETQ FLTRFLG FNN)
(SETQ FNDATASAV FNDATA)
(COND
(APSTRACEFLG (printout T "Starting to ignore events. Called " (FNFROMHEADER FNN)
" at " NOWTIME T]
(T (OR (NULL APSBKDWNFNSNUMS)
(.FNHEADERMEMB. FNN APSBKDWNFNSNUMS])
(CHECKFILTERFNSWITCH
[LAMBDA (FROMFN TOFN) (* bvm: " 5-OCT-83 12:41")
(* A switch is being made from FROMFN to TOFN. This checks to see if FROMFN is being monitored for filtering or
breakdown and If FROMFN is, the appropriate special variables are changed to close out and add in its time.
CURRENTFN is the function now being executed regardless of breakinf down or filtering, FNDATA is the data record
of the function to whom time is being charged If FLTRFLG is non-NIL, time is being disguarded and FLTRFN is the
function which started the filtering.)
(* This fn was created by rrb to apply it to the elements that were skipped by a retfrom. It is only called from
RETURNEVENT.)
(DECLARE (USEDFREE CURRENTFN FNDATA FNDATASAV NOWTIME FLTRFLG DISTRIBUTIONFN NABL LASTFNTIME))
[PROG NIL
[COND
((AND DISTRIBUTIONFN FNDATA LASTFNTIME (.FNHEADEREQUAL. DISTRIBUTIONFN FROMFN))
(* check for the one function to get a distribution on.)
(push DISTRIBUTIONLST (IDIFFERENCE NOWTIME LASTFNTIME]
(COND
[FLTRFLG (COND
[(.FNHEADEREQUAL. FROMFN FLTRFLG)
(* the only function of interest is the function that started filtering and it is just now being returned from.
reset time and return to monitoring state.)
(SETQ FLTRFLG NIL)
(SETQ LASTFNTIME NOWTIME) (* restore FNDATA to value before began filtering.)
(SETQ FNDATA FNDATASAV)
(COND
(APSTRACEFLG (printout T "Resuming looking at events. Left " (FNFROMHEADER
FROMFN)
, "at" , LASTFNTIME T]
(T (RETURN]
(T (ADDSTATTIME FNDATA NOWTIME)))
(COND
((.FNHEADEREQUAL. FROMFN APSBKDWNFNNUM)
(ENDWINDOW FROMFN) (* returning from bkdwn fn, turn off stats)
(SETQ NABL NIL)
(SETQ FNDATA NIL)
(SETQ LASTFNTIME NIL))
((FILTERFN TOFN)
(SETQ FNDATA (GETFD TOFN]
(SETQ CURRENTFN TOFN])
(GETFD
[LAMBDA (FN NARGS) (* rmk: "14-Mar-84 22:55")
(* retrieves or creates the function data record for
function FN. FN is a dotted pair representing a function
header. Two-level hash scheme here)
(PROG [(BUCKET (FASTELT FNCOUNTS (CAR FN]
[OR BUCKET (FASTSETA FNCOUNTS (CAR FN)
(SETQ BUCKET (HASHARRAY 100]
(RETURN (OR (GETHASH (CDR FN)
BUCKET)
(AND (NEQ NARGS T)
(PUTHASH (CDR FN)
(create FunctionData
#OfCalls ← 0
TotalTime ← 0
CallInfoList ←(AND NARGS (LIST (CONS NARGS 0)))
CallingFns ←(AND (NOT (PUNTFNP FN))
(CONS)))
BUCKET])
(PRINTPCSKIPFNS
[LAMBDA (MSG LST) (* rrb "16-JAN-81 15:38")
(COND
(LST (MAPRINT LST NIL MSG NIL ", ")
(TERPRI])
(ADDSTATTIME
[LAMBDA (FNNODE NTIME) (* lmm "22-JUN-80 16:08")
(* adds the current time interval to NTIME and resets
the variable LASTFNTIME to hold the new time.)
(* most of this COND checks for initialization.
All of the work is done by add and replace.)
[COND
(FNNODE (COND
(LASTFNTIME
(COND
[(ILESSP NTIME LASTFNTIME)
(COND
((AND (IGREATERP LASTFNTIME 67104768)
(ILESSP NTIME 4095)) (* assume the clock has wrapped around charge only the
ntime.)
(add (fetch TotalTime of FNNODE)
NTIME))
(T (* check for monotone time)
(HELP "non-increasing time" NTIME]
(T (* if flag on, add time interval to everybody who is on
the stack.)
[AND TOTALTIMEFLG (NULL DUMMYEVENT)
(PROG ((INTERVALTIME (IDIFFERENCE NTIME LASTFNTIME)))
(OR (ZEROP INTERVALTIME)
(for INFNTAIL on PARALLELSTACK
do (* check for the NIL which is on top of the stack and
recursive calls.)
(AND (CAR INFNTAIL)
(NOT (MEMBER (CAR INFNTAIL)
(CDR INFNTAIL)))
(add (fetch TotalTime of (GETFD (CAR INFNTAIL)))
INTERVALTIME]
(add (fetch TotalTime of FNNODE)
(IDIFFERENCE NTIME LASTFNTIME]
(SETQ LASTFNTIME NTIME])
)
(* Fns for nicely printing the results of the stats)
(DEFINEQ
(PRINTPCALLHEADER
[LAMBDA NIL (* bvm: " 6-OCT-83 14:59")
(COND
(APSBKDWNFN (printout NIL "Windowing on " APSBKDWNFN T))
(T (printout NIL "Not Windowing" T))) (* move all of the data about filtered functions into
another array.)
(COLLECTFNHEADERS)
(PROG (SKIPPEDFNS FILTEREDFNS)
(DECLARE (SPECVARS I SKIPPEDFNS FILTEREDFNS))
(for I from 0 to FNCOUNTMAX bind BUCKET when (SETQ BUCKET (FASTELT FNCOUNTS I))
do [MAPHASH BUCKET (FUNCTION (LAMBDA (ENTRY KEY DUMMY)
(DECLARE (USEDFREE I SKIPPEDFNS FILTEREDFNS))
(SETQ DUMMY (CONS I KEY))
(OR (fetch FnName of ENTRY)
(replace FnName of ENTRY with (FNFROMHEADER DUMMY T)))
(COND
((OR (AND (.FNHEADERMEMB. DUMMY APSFLTRFNSNUMS)
(PROGN (pushnew FILTEREDFNS (fetch FnName of ENTRY))
T))
(AND (.FNHEADERMEMB. DUMMY APSSKIPFNSNUMS)
(PROGN (pushnew SKIPPEDFNS (fetch FnName of ENTRY))
T)))
(PUTHASH KEY NIL BUCKET)
(PUTHASH DUMMY ENTRY FLTCNTS]
finally (SETQ FLTCNTS (ARRAY 1 (QUOTE POINTER)
FLTCNTS 0)))
(PRINTPCSKIPFNS "Breaking down wrt " APSBKDWNFNS)
(PRINTPCSKIPFNS "Filtering out " FILTEREDFNS)
(PRINTPCSKIPFNS "Ignoring time for " SKIPPEDFNS])
(PRINTFNINFO
[LAMBDA (STR COUNTS MIN ALPHFLG) (* bvm: "21-OCT-83 17:39")
(printout NIL "Function timings" (COND
(STR ": ")
(T ""))
STR 43 "#ofCalls PerCall" T)
(PROG ((TOTAL#OFCALLS 0)
TOTALTIME)
(SETQ TOTALTIME (PFREQ [SORT (FREQLISTFROMHASHCOUNTS COUNTS)
(COND
[ALPHFLG (FUNCTION (LAMBDA (X Y)
(ALPHORDER (fetch FnName of (CAR X))
(fetch FnName of (CAR Y]
(T (FUNCTION CDRGTP]
[FUNCTION (LAMBDA (FDATA FLAG)
(COND
(FLAG (COND
((STRINGP (SETQ FLAG (fetch FnName of FDATA)))
(PRIN1 FLAG))
(T (PRIN2 FLAG)))
(* print number of calls and the time per call.)
[for D in (SETQ FLAG (SORT (fetch CallInfoList
of FDATA)
(FUNCTION CDRGTP)))
do (printout NIL " [" (CAR D)
(QUOTE %]))
(COND
((CDR FLAG)
(PRIN2 (CDR D]
[printout NIL 45 .I6 (fetch #OfCalls of FDATA)
53 .I8
(IQUOTIENT (fetch ExternalTime of FDATA)
(COND
((ZEROP (SETQ FDATA
(fetch #OfCalls
of FDATA)))
1)
(T FDATA]
(add TOTAL#OFCALLS FDATA))
(T 100]
MIN
(OR [AND TOTALTIMEFLG
(PROGN (* if keeping track of total time under each fn and
there is a breakdown function, use it's time as the
total.)
(COND
(APSBKDWNFN (fetch ExternalTime
of (GETFD APSBKDWNFNNUM)))
((GETD (QUOTE STATSDUMMYFUNCTION))
(* no top level function, use STATSDUMMYFUNCTION if it
has a definition.)
(PROG ((DATA (GETFD (FNHEADEROF (QUOTE
STATSDUMMYFUNCTION))
T)))
(RETURN (AND DATA (fetch ExternalTime
of DATA]
T)))
(printout NIL 45 .I6 TOTAL#OFCALLS T)
(COND
((AND (NOT ALPHFLG)
(EQ COUNTS FNCOUNTS))
(SETQ TOTALFNTIME TOTALTIME])
(PRINTFVARINFO
[LAMBDA (COUNTS MINCNT) (* bvm: "23-OCT-83 16:27")
(COND
(COUNTS (printout NIL T "Free Variable Lookup Times" 40 "Looked Up By" 68
" uSecs [number of lookups]"
T)
(PRINTFVARINFO1 COUNTS MINCNT])
(PRINTFVARINFO1
[LAMBDA (COUNTS MINCNT) (* bvm: "23-OCT-83 16:27")
(PFREQ (SORT [for FV in COUNTS collect (CONS FV (TICKSTOMICROSECONDS (for EVENT
in (fetch FVAREVENTS
of FV)
sum (fetch FVARTIME
of EVENT]
(FUNCTION CDRGTP))
(FUNCTION PRINTFVARENTRY)
MINCNT TOTALFNTIME)
(TERPRI])
(PRINTFVARBYFN
[LAMBDA (COUNTS MINCNT) (* bvm: "23-OCT-83 16:27")
(COND
(COUNTS (printout NIL T "Free Variable Lookup by Function" 40 "Variable Name" 68
" uSecs [number of lookups]"
T)
(PROG (NEWCOUNTS)
[for FV in COUNTS
do (for EVENT in (fetch FVAREVENTS of FV) bind FN
do (SETQ FN (fetch FVARCALLEDBY of EVENT))
(push [fetch FVAREVENTS
of (OR (find ENTRY in NEWCOUNTS
suchthat (.FNHEADEREQUAL. (fetch FVARNAME
of ENTRY)
FN))
(PROGN (push NEWCOUNTS (create FVARSTAT
FVARNAME ← FN))
(CAR NEWCOUNTS]
(create FVAREVENT using EVENT FVARCALLEDBY ←(fetch FVARNAME
of FV]
(PRINTFVARINFO1 NEWCOUNTS MINCNT])
(PRINTFVARENTRY
[LAMBDA (FDATA FLG) (* bvm: "18-Jan-85 14:24")
(COND
((NULL FLG)
100)
(T (PROG ((EVENTS (fetch FVAREVENTS of FDATA)))
[printout NIL .P2 (COND
((LITATOM (fetch FVARNAME of FDATA))
(fetch FVARNAME of FDATA))
(T (FNFROMHEADER (fetch FVARNAME of FDATA]
[COND
((CDR EVENTS)
(SORT EVENTS (FUNCTION (LAMBDA (X Y)
(IGREATERP (fetch FVARTIME of X)
(fetch FVARTIME of Y]
(for EVENT in EVENTS bind (VALHI ←(\HILOC \VALSPACE))
do (printout NIL 40 .P2 [COND
((LITATOM (fetch FVARCALLEDBY of EVENT))
(fetch FVARCALLEDBY of EVENT))
(T (FNFROMHEADER (fetch FVARCALLEDBY of EVENT]
68 .I6 (TICKSTOMICROSECONDS (fetch FVARTIME of EVENT)))
(for CNT in (fetch FVARCOUNTS of EVENT)
do (printout NIL " [" (CDR CNT)
"]")
(COND
((OR (NEQ (CAR CNT)
\STACKHI)
(CDR (fetch FVARCOUNTS of EVENT)))
(printout NIL (COND
((EQ (CAR CNT)
\STACKHI)
"Stack")
((EQ (FLOOR (CAR CNT)
2)
VALHI)
"Global")
(T "OffStack"])
(PRINTCALLINFO
[LAMBDA NIL (* bvm: "20-FEB-82 00:11")
(* prints the called/calling info from FNCOUNTS hash
array)
(COND
(NOTECALLINFOFLG (printout NIL "Call Information:" T T)
(for FDATA in [SORT (SIMPLELISTFROMHASHCOUNTS FNCOUNTS)
(FUNCTION (LAMBDA (A B)
(ALPHORDER (fetch FnName of A)
(fetch FnName of B]
when (OR (fetch CallingFns of FDATA)
(fetch CalledFns of FDATA))
do (* FDATA is of the form (fname . FunctionDataRec))
(PRINT (fetch FnName of FDATA))
(PRINTCALLINFOLST "Calls:" (fetch CalledFns of FDATA))
(PRINTCALLINFOLST "Callers:" (fetch CallingFns of FDATA])
(PRINTCALLINFOLST
[LAMBDA (SCR L) (* bvm: "22-FEB-82 15:17")
(* Prints the list of callers or callees)
(COND
((SORT L (FUNCTION CDRGTP))
(printout NIL 10 SCR 19) (* Print the passed in heading)
[for X on L bind (EOLPOS ←(LINELENGTH)) do (SETQ SCR (fetch FnName of (CAAR X)))
(COND
((ILESSP EOLPOS (IPLUS (POSITION)
(NCHARS SCR)
(NCHARS (CDAR X))
3))
(printout NIL .TAB0 19)
(* New line if this wont fit)
))
(printout NIL SCR " (" (CDAR X)
")")
(COND
((CDR X)
(* More to come so sneak in as much punctuation as we
have room for)
(PRIN1 (SELECTQ (IDIFFERENCE EOLPOS (POSITION))
(0 "")
(1 ",")
", "]
(TERPRI)
L])
(SIMPLELISTFROMHASHCOUNTS
[LAMBDA (COUNTARRAY) (* bvm: " 6-OCT-83 14:54")
(* creates a list of the FunctionData records that are
stored in COUNTARRAY)
(COND
((EQ (CAR (LISTP (FASTELT COUNTARRAY 0)))
(QUOTE RESULT)) (* Result was cached)
(CDR (FASTELT COUNTARRAY 0)))
(COUNTARRAY (for I from 0 to (SUB1 (ARRAYSIZE COUNTARRAY)) bind L BUCKET declare (SPECVARS
L)
when (SETQ BUCKET (FASTELT COUNTARRAY I))
do [MAPHASH BUCKET (FUNCTION (LAMBDA (ENTRY KEY)
(DECLARE (USEDFREE L))
(replace CalledFns of ENTRY with (DREMOVE NIL
(fetch CalledFns
of ENTRY)))
(replace CallingFns of ENTRY
with (DREMOVE NIL (fetch CallingFns of ENTRY)))
(push L ENTRY]
finally (* Cache result)
(FASTSETA COUNTARRAY 0 (CONS (QUOTE RESULT)
L))
(RETURN L])
(FREQLISTFROMHASHCOUNTS
[LAMBDA (COUNTS) (* bvm: " 5-OCT-83 15:10")
(* creates a list of the FunctionData records that are
stored in COUNTS, paired with their totaltimes)
(for ENTRY in (SIMPLELISTFROMHASHCOUNTS COUNTS) collect (CONS ENTRY (fetch ExternalTime
of ENTRY])
(FNFROMHEADER
[LAMBDA (FNHEADER CAREFUL) (* bvm: "23-OCT-83 16:02")
(* FNHEADER is dotted pair hiloc,loloc. Returns name of frame. Normally the names are determined by a MAPATOMS
after the analysis, at which time CAREFUL is set, in which case this function just returns an octal string.
If CAREFUL is NIL, we try looking inside the indicated FNHEADER for a framename, and verify that the name's
definition cell matches)
(COND
[(ZEROP (CAR FNHEADER))
(CONCAT "Subr." (CAR (NTH \INITSUBRS (ADD1 (CDR FNHEADER]
(T (PROG ((FD (AND (NOT CAREFUL)
(GETFD FNHEADER T)))
FRAMENAME)
(RETURN (COND
((AND FD (fetch FnName of FD)))
((COND
[(AND (NOT CAREFUL)
(PROG1 (ILESSP [\HILOC (SETQ FRAMENAME (fetch (FNHEADER FRAMENAME)
of (\VAG2 (CAR FNHEADER)
(CDR FNHEADER]
64) (* Need this test until such time as Dolphin and Dorado
microcode filters out invalid vp's in NTYPX)
)
(LITATOM FRAMENAME))
(EQ (fetch (LITATOM DEFPOINTER) of FRAMENAME)
(\VAG2 (CAR FNHEADER)
(CDR FNHEADER]
(T (SETQ FRAMENAME "")
NIL))
(AND FD (replace FnName of FD with FRAMENAME))
FRAMENAME)
(T (CONCAT (QUOTE #)
(OCTALSTRING (CAR FNHEADER))
(QUOTE ,)
(OCTALSTRING (CDR FNHEADER))
(COND
((LITATOM FRAMENAME)
(CONCAT (QUOTE /)
FRAMENAME))
(T ""])
(SUBR#OF
[LAMBDA (SUBRNAME) (* bvm: "13-APR-82 11:41")
(for S in \INITSUBRS as CNT from 0 do (COND
((EQ S SUBRNAME)
(RETURN CNT])
(FNHEADEROF
[LAMBDA (FN) (* bvm: "16-FEB-82 16:24")
(PROG ((SB (SUBR#OF FN)))
(RETURN (COND
(SB (CONS 0 SB))
(T (LOC (fetch (LITATOM DEFPOINTER) of (\DTEST FN (QUOTE LITATOM])
(FNHEADERSOF
[LAMBDA (FN) (* bvm: "18-FEB-82 16:33")
(PROG ((SB (SUBR#OF FN)))
(RETURN (CONS [LOC (fetch (LITATOM DEFPOINTER) of (\DTEST FN (QUOTE LITATOM]
(AND SB (LIST (CONS 0 SB])
(COLLECTFNHEADERS
[LAMBDA NIL (* bvm: "16-FEB-82 14:58")
(MAPATOMS (FUNCTION (LAMBDA (ATM CELL)
(SETQ CELL (fetch (LITATOM DEFINITIONCELL) of ATM))
(COND
((AND (fetch CCODEP of CELL)
(SETQ CELL (GETFD (LOC (fetch DEFPOINTER of CELL))
T)))
(replace FnName of CELL with ATM])
(TICKSTOMICROSECONDS
[LAMBDA (TICKS) (* bvm: "21-OCT-83 16:53")
(FIXR (FTIMES TICKS ALTOTICKTIME])
)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(FILESLOAD (LOADCOMP))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FNCOUNTMAX FNCOUNTS FLTCNTS FNHEADERTABLE CURRENTFN FNDATA LASTFNTIME FVARSTARTED
FVAREVENTLST NABL APSSKIPFNSNUMS APSFLTRFNSNUMS APSBKDWNFNSNUMS APSBKDWNFNNUM FLTRFLG
DISTRIBUTIONLST CALLEDPUNTFN PUNTCOUNTS PARALLELSTACK PSTACKFLAG APSBKDWNFN APSBKDWNFNS
APSFLTRFNS APSSKIPFNS ALTOTICKTIME RETFROMSTACKFLG APSTRACEFLG DISTRIBUTIONFN
TOTALTIMEFLG NOTECALLINFOFLG FNTSMIN FNTSMINALL)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FNDATASAV \INITSUBRS)
)
)
(OR (LISTP (EVALV (QUOTE \INITSUBRS)))
(LOADVARS (QUOTE \INITSUBRS)
(QUOTE LLSUBRS)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA APSFLTR APSBKDWN)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS PCALLSTATS COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2858 10516 (DOSTATS 2868 . 3357) (EMITSTATS 3359 . 4566) (APSDOIT 4568 . 5779) (READAPS
5781 . 6435) (READAPSDATA 6437 . 8254) (PRINTAPS 8256 . 8911) (SETEVENTARRAY 8913 . 10115) (
ALPHANUMERICCODEP 10117 . 10514)) (10517 10900 (OTHERSHORTEVENT 10527 . 10679) (OTHERLONGEVENT 10681
. 10898)) (10901 11583 (VERSIONEVENT 10911 . 11306) (MISCSTATSEVENT 11308 . 11581)) (12790 15554 (
APSPRINTCONFIG 12800 . 13389) (APSPRINTVERS 13391 . 13777) (APSPRINTMISCSTATS 13779 . 15301) (
GETMISCSTAT 15303 . 15552)) (15555 17060 (PRINTAPSTOFILE 15565 . 16757) (APSINITVARS 16759 . 17058)) (
17061 20390 (PRINTFREQ 17071 . 17332) (CDRGTP 17334 . 17488) (PFREQ 17490 . 20280) (NOPFN 20282 .
20388)) (25979 33838 (CALLEVENT 25989 . 27381) (RETURNEVENT 27383 . 30810) (FVAREVENT 30812 . 31136) (
FVAREXITEVENT 31138 . 32578) (DISKEVENT 32580 . 33836)) (33892 34784 (APSBKDWN 33902 . 34467) (APSFLTR
34469 . 34782)) (34831 43682 (BEGINWINDOW 34841 . 35199) (ENDWINDOW 35201 . 35552) (NOTECALLEDINFO
35554 . 36179) (INCREMENT.XREF 36181 . 36841) (INCREMENT.CALLS 36843 . 37810) (FILTERFN 37812 . 38854)
(CHECKFILTERFNSWITCH 38856 . 41015) (GETFD 41017 . 41824) (PRINTPCSKIPFNS 41826 . 42002) (ADDSTATTIME
42004 . 43680)) (43744 57205 (PRINTPCALLHEADER 43754 . 45224) (PRINTFNINFO 45226 . 47545) (
PRINTFVARINFO 47547 . 47833) (PRINTFVARINFO1 47835 . 48273) (PRINTFVARBYFN 48275 . 49184) (
PRINTFVARENTRY 49186 . 50620) (PRINTCALLINFO 50622 . 51544) (PRINTCALLINFOLST 51546 . 52686) (
SIMPLELISTFROMHASHCOUNTS 52688 . 53846) (FREQLISTFROMHASHCOUNTS 53848 . 54291) (FNFROMHEADER 54293 .
55869) (SUBR#OF 55871 . 56094) (FNHEADEROF 56096 . 56365) (FNHEADERSOF 56367 . 56634) (
COLLECTFNHEADERS 56636 . 57046) (TICKSTOMICROSECONDS 57048 . 57203)))))
STOP