(FILECREATED "13-FEB-83 15:28:54" <BLISP>PCALLSTATS.;95 30232
changes to: (FNS RETFROMEVENT RETURNEVENT)
(VARS PCALLSTATSCOMS)
previous date: "13-APR-82 11:45:20" <BLISP>PCALLSTATS.;94)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT PCALLSTATSCOMS)
(RPAQQ PCALLSTATSCOMS [(VARS PCALLVARS PCALLEVENTS PCALLFORMAT PCALLPARAMS)
(VARS * (PROGN PCALLPARAMS))
(ADDVARS (PARAMNAMES PCALLPARAMS)
(VARNAMES PCALLVARS)
(EVENTSNAMES PCALLEVENTS)
(FORMATNAMES PCALLFORMAT))
(DECLARE: DONTCOPY (RECORDS FunctionData))
(FNS CALLEVENT RETURNEVENT DISKEVENT)
(FNS APSBKDWN APSFLTR NOTECALLEDINFO INCREMENT.XREF INCREMENT.CALLS FILTERFN
CHECKFILTERFNSWITCH GETFD PVLEV ADDSTATTIME)
(FNS PRINTAPSST PRINTFNINFO FFTS PRINTCALLINFO PRINTCALLINFOLST
SIMPLELISTFROMHASHCOUNTS FREQLISTFROMHASHCOUNTS FNFROMHEADER PUNTFNP
SUBR#OF FNHEADEROF FNHEADERSOF COLLECTFNHEADERS)
(FNS ENDWINDOW BEGINWINDOW)
(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])
(RPAQQ PCALLVARS ((FNCOUNTS NIL)
(FLTCNTS (LIST (HARRAY 454Q)))
(FNHEADERTABLE NIL)
(CURRENTFN NIL)
(FNDATA NIL)
(LASTFNTIME NIL)
(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 300Q 376Q)
(RETURNEVENT 377Q)
(DISKEVENT 230Q 232Q)))
(RPAQQ PCALLFORMAT [(NIL PRINTAPSST NIL)
(NIL PRINTFNINFO "" FNCOUNTS FNTSMIN)
(NIL PRINTFNINFO "Filtered out fns" FLTCNTS FNTSMIN)
(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 (\StackOverflow \NWWInterrupt \PageFault \StatsOverflow))
(* filter out calls to these functions))
(APSSKIPFNS (QUOTE (GETKEYS \GETKEY WAITFORINPUT DISMISS GATHERSTATS \GATHERSTATS
RAID))
(* ignore any time attributed to these functions))
(ALTOTICKTIME (FQUOTIENT 38.09 100Q))
(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 (\StackOverflow \NWWInterrupt \PageFault \StatsOverflow))
(RPAQQ APSSKIPFNS (GETKEYS \GETKEY WAITFORINPUT DISMISS GATHERSTATS \GATHERSTATS RAID))
(RPAQ ALTOTICKTIME (FQUOTIENT 38.09 100Q))
(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 VARNAMES PCALLVARS)
(ADDTOVAR EVENTSNAMES PCALLEVENTS)
(ADDTOVAR FORMATNAMES PCALLFORMAT)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD FunctionData ((#OfCalls . TotalTime)
CalledFns CallingFns FnName . CallInfoList)
CalledFns ←(CONS)
CallingFns ←(CONS))
]
)
(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])
(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])
)
(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])
(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) (* lmm "26-MAR-82 13:36")
(* 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.)
(EQUAL FNN FLTRFLG))
[(MEMBER 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)
(MEMBER FNN APSBKDWNFNSNUMS])
(CHECKFILTERFNSWITCH
[LAMBDA (FROMFN TOFN) (* lmm "26-MAR-82 13:38")
(* 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 (EQUAL DISTRIBUTIONFN FROMFN))
(* check for the one function to get a distribution on.)
(push DISTRIBUTIONLST (IDIFFERENCE NOWTIME LASTFNTIME]
(COND
[FLTRFLG (COND
[(EQUAL 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
((EQUAL 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) (* bvm: "22-FEB-82 14:47")
(* 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 (OR (CDR (ASSOC (CAR FN)
FNCOUNTS))
(CDAR (SETQ FNCOUNTS (CONS (LIST (CAR FN)
(HARRAY 100))
FNCOUNTS]
(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])
(PVLEV
[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])
)
(DEFINEQ
(PRINTAPSST
[LAMBDA NIL (* bvm: "16-FEB-82 15:50")
(COND
(APSBKDWNFN (printout NIL "Windowing on " APSBKDWNFN T))
(T (printout NIL "Not Windowing" T)))
(PVLEV "Breaking down wrt " APSBKDWNFNS)
(PVLEV "Filtering out " APSFLTRFNS)
(PVLEV "Ignoring time for " APSSKIPFNS) (* move all of the data about filtered functions into
another array.)
(COLLECTFNHEADERS)
(for BUCKET in FNCOUNTS do [MAPHASH (CDR BUCKET)
(FUNCTION (LAMBDA (Y X DUMMY)
(COND
((OR (MEMBER (SETQ DUMMY (CONS (CAR BUCKET)
X))
APSFLTRFNSNUMS)
(MEMBER DUMMY APSSKIPFNSNUMS))
(PUTHASH X NIL (CDR BUCKET))
(PUTHASH DUMMY Y FLTCNTS]
finally (SETQ FLTCNTS (LIST (CONS NIL FLTCNTS])
(PRINTFNINFO
[LAMBDA (STR COUNTS MIN ALPHFLG) (* bvm: "18-FEB-82 17:48")
(printout NIL "Function timings" (COND
(STR ": ")
(T ""))
STR 43 "#ofCalls PerCall" T)
(PROG ((TOTAL#OFCALLS 0))
(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 (FFTS 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 (FFTS (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 (FFTS DATA]
T))
(printout NIL 45 .I6 TOTAL#OFCALLS T])
(FFTS
[LAMBDA (ENT) (* lmm " 9-APR-80 11:46")
(* gets the total function time for a function data
entry. It is corrected to microseconds)
(FIXR (FTIMES (fetch TotalTime of ENT)
ALTOTICKTIME])
(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 (COUNTS) (* bvm: "20-FEB-82 00:14")
(* creates a list of the FunctionData records that are
stored in COUNTS)
(PROG (L)
(RETURN (COND
((EQ (CAR (LISTP (CAR COUNTS)))
(QUOTE RESULT)) (* Result was cached)
(CDAR COUNTS))
(COUNTS [for BUCKET in COUNTS
do (MAPHASH (CDR BUCKET)
(FUNCTION (LAMBDA (ENTRY KEY)
[OR (fetch FnName of ENTRY)
(replace FnName of ENTRY
with (FNFROMHEADER (OR (LISTP KEY)
(CONS (CAR BUCKET)
KEY]
(replace CalledFns of ENTRY
with (DREMOVE NIL (fetch CalledFns of ENTRY)))
(replace CallingFns of ENTRY
with (DREMOVE NIL (fetch CallingFns of ENTRY)))
(SETQ L (CONS ENTRY L]
(* Cache result)
(ATTACH (CONS (QUOTE RESULT)
L)
COUNTS)
L])
(FREQLISTFROMHASHCOUNTS
[LAMBDA (COUNTS) (* bvm: "20-FEB-82 00:15")
(* creates a list of the FunctionData records that are
stored in COUNTS, paired with their totaltimes)
(for ENTRY in (SIMPLELISTFROMHASHCOUNTS COUNTS) collect (CONS ENTRY (FFTS ENTRY])
(FNFROMHEADER
[LAMBDA (FNHEADER) (* bvm: "13-APR-82 11:41")
(COND
[(ZEROP (CAR FNHEADER))
(CONCAT "Subr." (CAR (NTH \INITSUBRS (ADD1 (CDR FNHEADER]
(T (PROG [(FRAMENAME (fetch (FNHEADER FRAMENAME) of (VAG FNHEADER]
(RETURN (COND
((NOT (LITATOM FRAMENAME))
(CONCAT (VAG FNHEADER)))
((EQ (fetch (LITATOM DEFPOINTER) of FRAMENAME)
(VAG FNHEADER))
FRAMENAME)
(T (CONCAT (VAG FNHEADER)
(QUOTE /)
FRAMENAME])
(PUNTFNP
[LAMBDA (FNHEADER) (* bvm: "16-FEB-82 15:27")
(EQ (CAR FNHEADER)
0])
(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])
)
(DEFINEQ
(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])
(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])
)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(FILESLOAD (LOADCOMP)
APS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS FNCOUNTS FLTCNTS FNHEADERTABLE CURRENTFN FNDATA LASTFNTIME 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" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4805 10896 (CALLEVENT 4815 . 6207) (RETURNEVENT 6209 . 9636) (DISKEVENT 9638 . 10894))
(10897 19880 (APSBKDWN 10907 . 11472) (APSFLTR 11474 . 11787) (NOTECALLEDINFO 11789 . 12414) (
INCREMENT.XREF 12416 . 13076) (INCREMENT.CALLS 13078 . 14045) (FILTERFN 14047 . 15070) (
CHECKFILTERFNSWITCH 15072 . 17200) (GETFD 17202 . 18031) (PVLEV 18033 . 18200) (ADDSTATTIME 18202 .
19878)) (19881 28592 (PRINTAPSST 19891 . 20779) (PRINTFNINFO 20781 . 22729) (FFTS 22731 . 23075) (
PRINTCALLINFO 23077 . 23999) (PRINTCALLINFOLST 24001 . 25141) (SIMPLELISTFROMHASHCOUNTS 25143 . 26323)
(FREQLISTFROMHASHCOUNTS 26325 . 26735) (FNFROMHEADER 26737 . 27279) (PUNTFNP 27281 . 27413) (SUBR#OF
27415 . 27638) (FNHEADEROF 27640 . 27909) (FNHEADERSOF 27911 . 28178) (COLLECTFNHEADERS 28180 . 28590)
) (28593 29316 (ENDWINDOW 28603 . 28954) (BEGINWINDOW 28956 . 29314)))))
STOP
Q (ENDWINDOW 71163Q .
71727Q) (BEGINWINDOW 71733Q . 72507Q)))))
STOP