(FILECREATED " 5-JAN-83 18:52:39" {PHYLUM}<LISPCORE>SOURCES>APS.;14 19043
changes to: (FNS PRINTMISC GETMISCSTAT)
previous date: "21-OCT-82 09:56:28" {PHYLUM}<LISPCORE>SOURCES>APS.;12)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT APSCOMS)
(RPAQQ APSCOMS [(FNS DOSTATS EMITSTATS APSDOIT READAPS PRINTAPS SETEVENTARRAY ALPHANUMERICCODEP)
(FNS OTHERMIC OTHERSHORT OTHERLONG DATAIN16)
(FNS VERSIONEVENT MISCSTATSEVENT)
(ADDVARS (PARAMNAMES BASEPARAMS)
(VARNAMES PBASEVARS)
(EVENTSNAMES PBASEEVENTS)
(FORMATNAMES OTHERFORMAT))
(VARS PBASEVARS DEFAULTEVENTS PBASEEVENTS OTHERFORMAT BASEPARAMS)
(VARS * (PROGN BASEPARAMS))
(VARS APSFILES MAXC.APSFILES)
(FNS PRINTCONFIG PRINTVERSION PRINTMISC GETMISCSTAT)
[COMS (FNS PRINTFMT INITVARS)
(FNS PRINTFREQ CDRGTP PFREQ NOPFN PPCT)
(DECLARE: EVAL@COMPILE DONTCOPY (ADDVARS (PRINTOUTMACROS
(.PCT (LAMBDA (COMS)
(CONS (LIST (QUOTE PPCT)
(CADR COMS)
(CADDR COMS)
(CADDDR COMS))
(CDDDDR COMS]
(COMS (FNS BIN3 BIN2 CONVTIMER)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS BIN2 BIN3 CONVTIMER)
(GLOBALVARS APSDEBUGFLG USWITCHES ALTOVERSION SOURCE NXMPAGES GSWITCHES
OTHEREVENTS ALTOSERIAL EVENTSNAMES FORMATNAMES VARNAMES EVENTFNS
PUNTEVENTS RAMVERSION BCPLVERSION LISPVERSION MISCSTATS
MISCSTATSLAYOUT APSRDFILE)
(ADDVARS (DONTCOMPILEFNS BIN3 BIN2 CONVTIMER])
(DEFINEQ
(DOSTATS
[LAMBDA (FORM MSG ACCUMLATEDTIME NOCALLINFO DOLISTFLG) (* bvm: "22-FEB-82 14:27")
(* collects stats on FORM and analyzes them.)
(SETQ NOTECALLINFOFLG (NOT NOCALLINFO))
(SETQ TOTALTIMEFLG ACCUMLATEDTIME)
(APSDOIT (EMITSTATS FORM MSG)
(OR DOLISTFLG T])
(EMITSTATS
[LAMBDA (FORM MSG) (* bvm: "19-FEB-82 22:31")
(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)
(LIST (QUOTE LAMBDA)
NIL
(QUOTE (GATHERSTATS STATSFILE))
FORM
(QUOTE (GATHERSTATS]
(printout T "------ beginning evaluation of form" T)
(STATSDUMMYFUNCTION)
(printout T "------ ending evaluation" T)
(SETQ APSMES (CONCAT (OR MSG "evaluation of")
"
FORM = " FORM))
(RETURN STATSFILE])
(APSDOIT
[LAMBDA (FILE DOLISTFLG) (* bvm: "20-FEB-82 00:34")
(* creates a data base and prints a summary of a stats
file.)
(PROG (OUTPUTFILE)
(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 PTR) (* bvm: "19-FEB-82 23:10")
(PROG ((INF (OPENFILE FILE (QUOTE INPUT)
(QUOTE OLD)
10Q))
INX)
(printout T "------ reading stats file " INF " of length " (GETFILEINFO INF (QUOTE LENGTH))
" bytes" T)
(SETQ INX (GETOFD INF))
[COND
(PTR (SETFILEPTR INF PTR))
(T (AND (RANDACCESSP INF)
(SETFILEPTR INF 0))
(for NAME in VARNAMES do (INITVARS (EVAL NAME)
NIL]
(SETQ APSRDFILE INF)
(SETEVENTARRAY)
[bind EVENT DUMMYEVENT FN ARG EC←0
ARG2 ARG3 declare (SPECVARS EVENT DUMMYEVENT) until (\EOFP INX)
do (COND
((ILESSP 1000Q (ADD1VAR EC))
(printout T " " (GETFILEPTR INF)
",") (* Blip. 1000Q events read)
(SETQ EC 0)))
(SETQ EVENT (\BIN INX))
(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 INX)))
(1 (* two word event)
(SETQ ARG (BIN3 INX)))
[2 (* multi-word event)
(SETQ ARG (ADD1 (\BIN INX]
[3 (* call/return event)
(SETQ ARG (CONS (\BIN INX)
(BIN2 INX)))
(* Function header of fn being called/returned to)
(SETQ ARG2 (BIN2 INX)) (* time of event)
(SETQ ARG3 (BIN2 INX))
(RETURN (for F inside FN do (APPLY* F ARG ARG2 ARG3]
(SHOULDNT))
(for F inside FN do (APPLY* F ARG INX]
(RETURN (PROG1 (GETFILEPTR INF)
(CLOSEF INF)
(TERPRI T])
(PRINTAPS
[LAMBDA (ONLYPRINT FILE) (* bas: "10-MAY-81 00:35")
(printout T "------ making printout file." T)
[AND FILE (OR APSMES (PROGN (printout T T "Statistics file title: ")
(SETQ APSMES (READLINE T (LIST (READ T]
(PRINTFMT [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
(OTHERMIC
[LAMBDA (X) (* ht: "14-JUL-79 11:05")
(OTHERSHORT X])
(OTHERSHORT
[LAMBDA (ARG) (* lmm "22-JUN-80 16:17")
(pushnew OTHEREVENTS EVENT])
(OTHERLONG
[LAMBDA (N INX) (* lmm "22-JUN-80 16:17")
(OTHERSHORT N)
(SETFILEPTR INX (IPLUS (GETFILEPTR INX)
(LLSH N 1])
(DATAIN16
[LAMBDA (ARR N FX I) (* lmm " 2-AUG-80 16:49")
(PROG ((J 0))
(FRPTQ N (FASTSETAW ARR J (BIN2 FX))
(ADD1VAR J])
)
(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) (* rrb "16-JAN-81 16:07")
(SETQ MISCSTATS (CONS (WORDARRAY N)
MISCSTATS))
(DATAIN16 (CAR MISCSTATS)
N INX])
)
(ADDTOVAR PARAMNAMES BASEPARAMS)
(ADDTOVAR VARNAMES 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)
(OTHERSHORT 1 127 DEFAULT)
(OTHERLONG 128 191 DEFAULT)
(OTHERMIC 192 255 DEFAULT)))
(RPAQQ PBASEEVENTS ((VERSIONEVENT 136)
(MISCSTATSEVENT 135)))
(RPAQQ OTHERFORMAT (("Statistics from file:" APSRDFILE)
("measuring:" APSMES)
(NIL PRINTCONFIG "Computation run on ")
("Unrecognized events:" OTHEREVENTS)
("Values from MiscStats (times in msecs):" PRINTMISC 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))
(RPAQQ MAXC.APSFILES (CMACROS DCODEFOR10))
(DEFINEQ
(PRINTCONFIG
[LAMBDA (S) (* bas: "10-MAY-81 01:37")
(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:")
(PRINTVERSION " Ram" RAMVERSION)
(PRINTVERSION " Bcpl" BCPLVERSION)
(PRINTVERSION " Lisp" LISPVERSION)
(TERPRI])
(PRINTVERSION
[LAMBDA (S V) (* bas: "10-MAY-81 01:38")
(* Octal printout of the version number both whole and
in bytes)
(RESETFORM (RADIX 8)
(printout NIL S "=" V "(" (LRSH V 8)
","
(LOGAND V 255)
")"])
(PRINTMISC
[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
(PRINTFMT
[LAMBDA (FMT ONLYPRINT FILE) (* bvm: "30-JUN-81 14:48")
(* perform a set of formatting commands)
(RESETLST (RESETSAVE (RADIX 10))
[COND
(FILE (RESETSAVE (OUTFILE FILE)
(QUOTE (PROGN (CLOSEF (OUTPUT OLDVALUE]
[bind LAST H for Z in FMT do (SETQ H (CAR Z))
(COND
((EQ H T)
(SETQ LAST (CADR Z))
(GO $$ITERATE)))
(OR (NULL ONLYPRINT)
(FMEMB Z ONLYPRINT)
[SOME ONLYPRINT (FUNCTION (LAMBDA (A)
(EDITFINDP Z A]
(GO $$ITERATE))
(TERPRI)
(COND
(LAST (EVAL LAST)
(SETQ LAST NIL)))
(COND
((CDDR Z)
(COND
(H (PRIN1 H)
(TERPRI)))
(EVAL (CDR Z)))
(T (PRIN1 (OR H (CADR Z)))
(SPACES 1)
(PRIN1 (EVAL (CADR Z)))
(TERPRI]
(OUTPUT])
(INITVARS
[LAMBDA (VARS INIT) (* edited: "17-JUL-80 07:46")
(* initialize a list of variables)
(MAPC VARS (FUNCTION (LAMBDA (X)
(AND (LISTP X)
(PROG ((VAR (CAR X))
(EXP (CADR X)))
(AND VAR (SETATOMVAL VAR (EVAL EXP])
)
(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 PFN MIN PCT CUM) (* bvm: "19-FEB-82 23:28")
(* 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 PFN 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 MIN is floatp)
(OR PFN (SETQ PFN (FUNCTION NOPFN)))
(PROG ((N (LENGTH L))
[TOTALCOUNT (OR (NUMBERP PCT)
(for X in L sum (CDR X]
(TOT 0)
(LL (IPLUS -3 (LINELENGTH)))
(LAST -1)
M SEP)
[SETQ M (OR (FIXP MIN)
(IMAX 2 (COND
((FLOATP MIN)
(FIX (FTIMES TOTALCOUNT MIN)))
(T (IQUOTIENT TOTALCOUNT N]
(for X in L bind NEW CNT NAME when (IGEQ (SETQ CNT (CDR X))
M)
do (SETQ NAME (CAR X))
(SETQ TOT (IPLUS TOT CNT))
(COND
((SETQ NEW (OR (NOT (IEQP CNT LAST))
PCT CUM))
(printout NIL T .I8 (SETQ LAST CNT))
[COND
(PCT (printout NIL , .PCT CNT TOTALCOUNT 6 (QUOTE %%]
[COND
(CUM (printout NIL .I10 TOT)
(COND
(PCT (printout NIL .PCT TOT TOTALCOUNT 6 (QUOTE %%]
(SETQQ SEP " ")))
(COND
((AND (NOT NEW)
(IGREATERP (IPLUS (POSITION)
(APPLY* PFN NAME NIL))
LL))
(PRIN1 (QUOTE ,))
(TAB 12Q))
(T (PRIN1 SEP)))
(APPLY* PFN NAME T)
(SETQQ SEP ", ")
(SETQ N (SUB1 N)))
(COND
((NOT (ZEROP N))
(printout NIL T .I8 (IDIFFERENCE TOTALCOUNT TOT))
[COND
(PCT (printout NIL , .PCT (IDIFFERENCE TOTALCOUNT TOT)
TOTALCOUNT 6 (QUOTE %%]
(printout NIL " for " N " entries not shown")))
(printout NIL T .I8 TOTALCOUNT 22Q "Total for " (LENGTH L)
" entries"])
(NOPFN
[LAMBDA (NAME FLAG)
(COND
(FLAG (PRIN2 NAME))
(T (NCHARS NAME T])
(PPCT
[LAMBDA (X TOTAL WIDTH) (* av "11-MAR-81 14:02")
(COND
((NULL X)
(AND WIDTH (SPACES WIDTH)))
(T (PROG [(FACTOR (SELECTQ WIDTH
(4 1)
((NIL 5)
(SETQ WIDTH 5)
10)
(6 100)
(7 1000)
(8 10000)
(EXPT 10 (IDIFFERENCE WIDTH 4]
(printout NIL .I3 (COND
((EQ TOTAL 0)
0)
(T (IQUOTIENT (ITIMES X 100)
TOTAL)))
"." .N (LIST (QUOTE FIX)
(IDIFFERENCE WIDTH 4)
NIL T)
(COND
((EQ TOTAL 0)
0)
(T (IREMAINDER (IQUOTIENT (ITIMES X 100)
(IQUOTIENT TOTAL FACTOR))
FACTOR])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(ADDTOVAR PRINTOUTMACROS [.PCT (LAMBDA (COMS)
(CONS (LIST (QUOTE PPCT)
(CADR COMS)
(CADDR COMS)
(CADDDR COMS))
(CDDDDR COMS])
)
(DEFINEQ
(BIN3
[LAMBDA (INX) (* lmm "16-MAY-81 16:48")
(IPLUS (LLSH (\BIN INX)
16)
(LLSH (\BIN INX)
8)
(\BIN INX])
(BIN2
[LAMBDA (INX) (* lmm "16-MAY-81 16:48")
(IPLUS (LLSH (\BIN INX)
10Q)
(\BIN INX])
(CONVTIMER
[LAMBDA (X Y) (* edited: "14-JUL-80 15:16")
(* Converts the log time stamp format into a number.)
(IPLUS (LLSH X 16)
Y])
)
(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
(ADDTOVAR GLOBALVARS APSDEBUGFLG USWITCHES ALTOVERSION SOURCE NXMPAGES GSWITCHES OTHEREVENTS
ALTOSERIAL EVENTSNAMES FORMATNAMES VARNAMES EVENTFNS PUNTEVENTS RAMVERSION BCPLVERSION
LISPVERSION MISCSTATS MISCSTATSLAYOUT APSRDFILE)
)
(ADDTOVAR DONTCOMPILEFNS BIN3 BIN2 CONVTIMER)
)
(PUTPROPS APS COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1484 7900 (DOSTATS 1494 . 1858) (EMITSTATS 1860 . 2999) (APSDOIT 3001 . 3958) (READAPS
3960 . 5888) (PRINTAPS 5890 . 6451) (SETEVENTARRAY 6453 . 7567) (ALPHANUMERICCODEP 7569 . 7898)) (7901
8569 (OTHERMIC 7911 . 8039) (OTHERSHORT 8041 . 8184) (OTHERLONG 8186 . 8376) (DATAIN16 8378 . 8567))
(8570 9183 (VERSIONEVENT 8580 . 8963) (MISCSTATSEVENT 8965 . 9181)) (10407 12992 (PRINTCONFIG 10417 .
10983) (PRINTVERSION 10985 . 11352) (PRINTMISC 11354 . 12767) (GETMISCSTAT 12769 . 12990)) (12993
14360 (PRINTFMT 13003 . 13994) (INITVARS 13996 . 14358)) (14361 17519 (PRINTFREQ 14371 . 14612) (
CDRGTP 14614 . 14756) (PFREQ 14758 . 16754) (NOPFN 16756 . 16850) (PPCT 16852 . 17517)) (17734 18339 (
BIN3 17744 . 17922) (BIN2 17924 . 18076) (CONVTIMER 18078 . 18337)))))
STOP