(FILECREATED "14-Mar-84 22:55:41" {PHYLUM}<LISPCORE>SOURCES>PCALLSTATS.;1 38809
changes to: (VARS PCALLVARS)
(FNS GETFD)
previous date: "31-Dec-83 15:09:55" {PHYLUM}<LISP>SOURCES>PCALLSTATS.;2)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT PCALLSTATSCOMS)
(RPAQQ PCALLSTATSCOMS [(FILES APS)
(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)
APS)
(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])
(FILESLOAD APS)
(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: "23-OCT-83 16:25")
(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 (CAR CNT)
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)
APS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR 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
(ADDTOVAR 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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6747 14606 (CALLEVENT 6757 . 8149) (RETURNEVENT 8151 . 11578) (FVAREVENT 11580 . 11904)
(FVAREXITEVENT 11906 . 13346) (DISKEVENT 13348 . 14604)) (14660 15552 (APSBKDWN 14670 . 15235) (
APSFLTR 15237 . 15550)) (15599 24450 (BEGINWINDOW 15609 . 15967) (ENDWINDOW 15969 . 16320) (
NOTECALLEDINFO 16322 . 16947) (INCREMENT.XREF 16949 . 17609) (INCREMENT.CALLS 17611 . 18578) (FILTERFN
18580 . 19622) (CHECKFILTERFNSWITCH 19624 . 21783) (GETFD 21785 . 22592) (PRINTPCSKIPFNS 22594 .
22770) (ADDSTATTIME 22772 . 24448)) (24512 37854 (PRINTPCALLHEADER 24522 . 25992) (PRINTFNINFO 25994
. 28313) (PRINTFVARINFO 28315 . 28601) (PRINTFVARINFO1 28603 . 29041) (PRINTFVARBYFN 29043 . 29952) (
PRINTFVARENTRY 29954 . 31269) (PRINTCALLINFO 31271 . 32193) (PRINTCALLINFOLST 32195 . 33335) (
SIMPLELISTFROMHASHCOUNTS 33337 . 34495) (FREQLISTFROMHASHCOUNTS 34497 . 34940) (FNFROMHEADER 34942 .
36518) (SUBR#OF 36520 . 36743) (FNHEADEROF 36745 . 37014) (FNHEADERSOF 37016 . 37283) (
COLLECTFNHEADERS 37285 . 37695) (TICKSTOMICROSECONDS 37697 . 37852)))))
STOP