(FILECREATED "23-OCT-83 16:36:35" {PHYLUM}<LISPCORE>SOURCES>APS.;19 18299
changes to: (FNS PFREQ DOSTATS EMITSTATS APSDOIT)
previous date: "16-OCT-83 23:47:08" {PHYLUM}<LISPCORE>SOURCES>APS.;15)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT APSCOMS)
(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 MAXC.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) (* bvm: "21-OCT-83 15:01")
(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)
(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))
(RPAQQ MAXC.APSFILES (CMACROS DCODEFOR10))
(DEFINEQ
(APSPRINTCONFIG
[LAMBDA (S) (* bvm: " 5-OCT-83 16:24")
(printout NIL (OR S "")
(SELECTQ (LRSH ALTOVERSION 14Q)
(4 "Dolphin")
(5 "Dorado")
(CONCAT "Unknown machine type " (LRSH ALTOVERSION 14Q)))
" serial #" .I3.8.T (LOGAND ALTOSERIAL 377Q)
" 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)
31Q .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 12Q))
[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
(ADDTOVAR GLOBALVARS APSDEBUGFLG USWITCHES ALTOVERSION SOURCE NXMPAGES GSWITCHES OTHEREVENTS
ALTOSERIAL EVENTSNAMES FORMATNAMES APSVARNAMES EVENTFNS PUNTEVENTS RAMVERSION BCPLVERSION
LISPVERSION MISCSTATS MISCSTATSLAYOUT APSRDFILE)
)
)
(PUTPROPS APS COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1258 8204 (DOSTATS 1268 . 1729) (EMITSTATS 1731 . 2786) (APSDOIT 2788 . 3883) (READAPS
3885 . 4483) (READAPSDATA 4485 . 6174) (PRINTAPS 6176 . 6755) (SETEVENTARRAY 6757 . 7871) (
ALPHANUMERICCODEP 7873 . 8202)) (8205 8568 (OTHERSHORTEVENT 8215 . 8363) (OTHERLONGEVENT 8365 . 8566))
(8569 9219 (VERSIONEVENT 8579 . 8962) (MISCSTATSEVENT 8964 . 9217)) (10474 13097 (APSPRINTCONFIG
10484 . 11056) (APSPRINTVERS 11058 . 11448) (APSPRINTMISCSTATS 11450 . 12872) (GETMISCSTAT 12874 .
13095)) (13098 14432 (PRINTAPSTOFILE 13108 . 14157) (APSINITVARS 14159 . 14430)) (14433 17433 (
PRINTFREQ 14443 . 14684) (CDRGTP 14686 . 14828) (PFREQ 14830 . 17335) (NOPFN 17337 . 17431)))))
STOP