(FILECREATED " 9-MAR-83 22:24:44" {PHYLUM}<LISPCORE>SYSTEM>BRKDWN.;4 17622
changes to: (VARS BRKDWNCOMS)
(FNS BRKDWNCOMPILE2)
previous date: " 6-APR-82 20:26:04" {PHYLUM}<LISPCORE>SYSTEM>BRKDWN.;3)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT BRKDWNCOMS)
(RPAQQ BRKDWNCOMS [(DECLARE: FIRST (ADDVARS (NOSWAPFNS BRKDWN2)))
(FNS BREAKDOWN BRKDWNINIT BRKDWNSETUP BRKDWN1 BRKDWNFORM BRKDWNCOMPILE2 BRKDWNTIME
BRKDWNCONSES BRKDWNBOXES BRKDWNFBOXES RESULTS BRKDWNRESULTS BRKDWNRESULTS1
BRKDWNRESULTS2 BRKDWNCLEAR)
(DECLARE: EVAL@COMPILE (MACROS BRKDWNMACRO BRKDWNINCA)
(MACROS BRKDWNADDTOA BRKDWNDIFFA CPUTIME IBOXCOUNT FBOXCOUNT BRKDWNELT BRKDWNSETA
BRKDWNARRAY))
[VARS (BRKDWNLENGTH 0)
(BRKDWNCOMPFLG NIL)
BRKDWNARGS BRKDWNTYPES (BRKDWNFLTFMT (NUMFORMATCODE (QUOTE (FLOAT 7 3 NIL NIL 10]
(VARS (BRKDWNTYPE (QUOTE TIME))
(BRKDWNLABELS)
(BRKDWNLST))
(GLOBALVARS BRKDWNARGS BRKDWNLABELS BRKDWNLENGTH BRKDWNLST BRKDWNTOTLST BDLST BDSINK BDPTR)
(BLOCKS (NIL BRKDWNTIME BRKDWNCONSES BRKDWNBOXES (LINKFNS . T))
(BREAKDOWN BREAKDOWN BRKDWNSETUP BRKDWN1 BRKDWNFORM BRKDWNCOMPILE2 (GLOBALVARS
NOSWAPFLG))
(BRKDWNRESULTS BRKDWNRESULTS BRKDWNRESULTS1 BRKDWNRESULTS2))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA BREAKDOWN)
(NLAML BRKDWNFBOXES BRKDWNBOXES BRKDWNCONSES BRKDWNTIME)
(LAMA])
(DECLARE: FIRST
(ADDTOVAR NOSWAPFNS BRKDWN2)
)
(DEFINEQ
(BREAKDOWN
[NLAMBDA FNS (* lmm "14-MAR-80 09:05")
(BRKDWNINIT)
[SETQ BRKDWNLST (SUBSET BRKDWNLST (FUNCTION (LAMBDA (X)
(PROG [(DEF (GETD (CAR X]
(* This enables both adding to and subtracting from the BREAKDOWN list. If functions originally on BRKDWNLST are
still broken, they are kept. Then the new functions are added. The second alternative in the OR is for functions
with open-coded BRKDWN2.)
(RETURN (AND [OR (AND (EXPRP DEF)
(EQ (CAADDR DEF)
(QUOTE BRKDWN2)))
(AND DEF (EQP DEF (CADDDR X]
(NOT (MEMB (CAR X)
FNS]
(COND
(BRKDWNTYPE
(* BRKDWN1 initializes BRKDWNLABELS and BRKDWNLENGTH and compiles a measuring function, when necessary, for the
measurement indicated by BRKDWNTYPE. BRKDWNTYPE is initially set to TIME.)
(BRKDWN1)))
(CONSCOUNT 0)
(BRKDWNCLEAR BDLST (ADD1 BRKDWNLENGTH))
(* BDLST is initialized to point to the first cell of an unboxed array and is used for storing the last values of
the statistics to be measured. BDSINK is a dummy array for accumulating values not charged to any function.)
(SETQ BDPTR BDSINK)
[COND
(FNS
(PROG ((N 1))
(SETQ BRKDWNLST
(NCONC
BRKDWNLST
(MAPCONC FNS
(FUNCTION (LAMBDA (X)
(COND
((NUMBERP X)
(SETQ N X)
NIL)
(T (MAPCONC (BREAK0 X T NIL (QUOTE BRKDWN2))
(FUNCTION (LAMBDA (X)
(COND
((LISTP X)
(PRINT X T T)
NIL)
(T
(* BRKDWNSETUP returns a list of the form (PTR N) or (PTR N CODE DEF) which becomes an element of BRKDWNLST after
adding FN in front.)
(LIST (CONS X (BRKDWNSETUP X (GETD X)
(BRKDWNARRAY
(ADD1 BRKDWNLENGTH)
)
N]
[MAPC BRKDWNLST (FUNCTION (LAMBDA (FNS)
(BRKDWNCLEAR (CADR FNS)
(ADD1 BRKDWNLENGTH]
(* If a completely new BREAKDOWN was done, this isn't really necessary, but it may have been just an additive
BREAKDOWN, so counters for old functions should be zeroed. Note that BREAKDOWN of NIL just zeroes counters without
unbreaking any functions. Note also that BRKDWNTYPE can be changed without unbreaking and rebreaking, since
redefining the function BRKDWN2 will take care of everything, except that if more things are being measured, the
statistic arrays must all be lengthened (BRKDWN1 takes care of this.))
(MAPCAR BRKDWNLST (FUNCTION CAR])
(BRKDWNINIT
[LAMBDA NIL (* lmm "14-MAR-80 09:04")
(COND
((NOT BDPTR)
(SETQ BRKDWNLENGTH 0)
(SETQ BDLST (BRKDWNARRAY 1))
(SETQ BDSINK (BRKDWNARRAY 1))
(SETQ BDPTR BDSINK])
(BRKDWNSETUP
[LAMBDA (FN DEF PTR N) (* lpd "31-MAY-77 16:28")
(PROG ((BDEF (CADDR DEF))
(TEM (LIST PTR N)))
(* Form of brokendown function is BDEF= (BRKDWN2 FORM PTR N) where PTR points to the first cell of an unboxed array:
this cell contains the number of times the function has been called, and following cells contain the
(negative of the) parameter/s being measured. N is number of times FORM is to be evaluated. If N is greater than 1,
FORM should not involve any side effects since it will be performed more than once.)
(COND
(BRKDWNCOMPFLG
(* Compile the BRKDWN2 form open, redefining FN. The PUTD nonsense is so that the compiler doesn't unbreak FN in the
process of redefining it.)
(PUTD (QUOTE BRKDWNFN)
NIL)
[BRKDWNCOMPILE2
(QUOTE BRKDWNFN)
(LIST (CAR DEF)
(CADR DEF)
(LIST (QUOTE PROG)
(CDDDR BRKDWNARGS)
(LIST (QUOTE RETURN)
(BRKDWNFORM BRKDWNLABELS
[LIST (QUOTE SETQ)
(QUOTE BDY)
(COND
((NEQ N 1)
(LIST (QUOTE RPTQ)
N
(CADR BDEF)))
(T (CADR BDEF]
(KWOTE PTR]
(PUTD FN (GETD (QUOTE BRKDWNFN)))
(PUTD (QUOTE BRKDWNFN)
NIL)
(* * Save the address of the code, for checking whether the function is still broken, and the old definition, to
allow rebreaking if BRKDWNTYPE changes.)
(NCONC1 TEM (GETD FN))
(NCONC1 TEM DEF))
(T (RPLACD (CDR BDEF)
TEM)))
(RETURN TEM])
(BRKDWN1
[LAMBDA NIL (* lpd " 1-JUN-77 11:17")
(PROG ((LST (OR (LISTP BRKDWNTYPE)
(LIST BRKDWNTYPE)))
LEN X Y)
(* * Form of each entry on BRKDWNTYPES is (NAME FORM1 FORM2) e.g. (TIME (LAMBDA NIL (CLOCK 2))
(LAMBDA (X) (FQUOTIENT X (TICKPS)))) FORM1 is the parameter being measured, FORM2 (optional) can be used to convert
the value of FORM1 to some other units, e.g. clock ticks to seconds.)
[OR [FGETD (SETQ Y (PACK (CONS (QUOTE BRKDWN)
LST]
(BRKDWNCOMPILE2 Y (LIST (QUOTE NLAMBDA)
BRKDWNARGS
(QUOTE (DECLARE (LOCALVARS . T)))
(BRKDWNFORM LST [QUOTE (PROG NIL BDLP (SETQ BDY (EVAL BDEXP))
(COND
((NEQ BDN 1)
(SUB1VAR BDN)
(GO BDLP]
(CADR BRKDWNARGS]
(PUTD (QUOTE BRKDWN2)
(GETD Y))
(* * The function used for breaking the functions of interest is BRKDWNNAME e.g. BRKDWNTIME, BRKDWNCONSES etc. Its
definition is created, if not already defined, by BRKDWNFORM and then compiled. BRKDWNTIME and BRKDWNCONSES are
already defined in the system since they are used so frequently.)
[COND
((IGREATERP (SETQ LEN (LENGTH LST))
BRKDWNLENGTH) (* More statistics are being measured, so go though all
the broken functions and give them larger statistic
arrays.)
(MAPC BRKDWNLST (FUNCTION (LAMBDA (FNS)
(PROG [(A (BRKDWNARRAY (ADD1 LEN]
(COND
[(CDDDR FNS) (* Function has open-coded BRKDWN2 and must be
recompiled.)
(RPLACD FNS (BRKDWNSETUP (CAR FNS)
(PUTD (CAR FNS)
(CAR (CDDDDR FNS)))
A
(CADDR FNS]
(T (RPLACA [CDDR (CADDR (GETD (CAR FNS]
A)))
(RPLACA (CDR FNS)
A]
[SETQ BRKDWNLENGTH (LENGTH (SETQ BRKDWNLABELS (APPEND LST]
(SETQ BRKDWNTOTLST (CONS NIL (APPEND BRKDWNLABELS)))
(SETQ BDLST (BRKDWNARRAY (ADD1 BRKDWNLENGTH)))
(SETQ BDSINK (BRKDWNARRAY (ADD1 BRKDWNLENGTH)))
(SETQ BRKDWNTYPE NIL])
(BRKDWNFORM
[LAMBDA (LST SETFORM PTR) (* lpd "31-MAY-77 16:29")
(PROG ((I 1)
(LST1 (CONS))
(LST2 (CONS)))
(* Computes the body of the BRKDWNNAME function (closed or open coded) when LST is the list of things being
measured. PTR is the (name of the) pointer to the statistics array.)
[MAPC LST (FUNCTION (LAMBDA (STAT)
(PROG [(X (CADR (ASSOC STAT BRKDWNTYPES]
(OR X (HELP STAT (QUOTE "not found")))
(TCONC LST1 (LIST (QUOTE BRKDWNINCA)
(QUOTE BDPTR)
(QUOTE BDLST)
I X))
(TCONC LST2 (LIST (QUOTE BRKDWNINCA)
(QUOTE BDZ)
(QUOTE BDLST)
I X))
(ADD1VAR I]
(RETURN (LIST (QUOTE BRKDWNMACRO)
(CONS (QUOTE PROGN)
(CAR LST1))
(CONS (QUOTE PROGN)
(CAR LST2))
SETFORM PTR])
(BRKDWNCOMPILE2
[LAMBDA (FN DEF) (* bvm: " 9-MAR-83 22:24")
(DECLARE: (SPECVARS LAPFLG SVFLG LCFIL STRF LSTFIL))
(RESETVARS ((NOSWAPFLG T))
(PROG (LAPFLG SVFLG LCFIL (STRF T)
(LSTFIL T))
(COND
(BYTECOMPFLG (BYTECOMPILE2 FN DEF))
(T (COMPILE2 FN DEF])
(BRKDWNTIME
[NLAMBDA (BDEXP BDX BDN BDY BDZ) (* lpd " 1-JUN-77 14:39")
(DECLARE (LOCALVARS . T))
(BRKDWNMACRO (BRKDWNINCA BDPTR BDLST 1 (CPUTIME))
(BRKDWNINCA BDZ BDLST 1 (CPUTIME))
[PROG NIL
BDLP(SETQ BDY (EVAL BDEXP))
(COND
((NEQ BDN 1)
(SUB1VAR BDN)
(GO BDLP]
BDX])
(BRKDWNCONSES
[NLAMBDA (BDEXP BDX BDN BDY BDZ)
(DECLARE (LOCALVARS . T)) (* lpd "31-MAY-77 16:31")
(BRKDWNMACRO (BRKDWNINCA BDPTR BDLST 1 (CONSCOUNT))
(BRKDWNINCA BDZ BDLST 1 (CONSCOUNT))
[PROG NIL
BDLP(SETQ BDY (EVAL BDEXP))
(COND
((NEQ BDN 1)
(SUB1VAR BDN)
(GO BDLP]
BDX])
(BRKDWNBOXES
[NLAMBDA (BDEXP BDX BDN BDY BDZ)
(DECLARE (LOCALVARS . T)) (* wt: "15-MAR-78 16:31")
(BRKDWNMACRO (BRKDWNINCA BDPTR BDLST 1 (IBOXCOUNT))
(BRKDWNINCA BDZ BDLST 1 (IBOXCOUNT))
[PROG NIL
BDLP(SETQ BDY (EVAL BDEXP))
(COND
((NEQ BDN 1)
(SUB1VAR BDN)
(GO BDLP]
BDX])
(BRKDWNFBOXES
[NLAMBDA (BDEXP BDX BDN BDY BDZ)
(DECLARE (LOCALVARS . T)) (* wt: "15-MAR-78 16:32")
(BRKDWNMACRO (BRKDWNINCA BDPTR BDLST 1 (FBOXCOUNT))
(BRKDWNINCA BDZ BDLST 1 (FBOXCOUNT))
[PROG NIL
BDLP(SETQ BDY (EVAL BDEXP))
(COND
((NEQ BDN 1)
(SUB1VAR BDN)
(GO BDLP]
BDX])
(RESULTS
[LAMBDA (RETURNVALUESFLG) (* wt: "15-MAR-78 19:49")
(BRKDWNRESULTS RETURNVALUESFLG])
(BRKDWNRESULTS
[LAMBDA (RETURNVALUESFLG) (* wt: "15-MAR-78 16:25")
(PROG (VALUES (I 1))
(CONSCOUNT 0)
[MAP BRKDWNTOTLST (FUNCTION (LAMBDA (X)
(RPLACA X 0]
[SETQ VALUES (MAPCAR BRKDWNLST (FUNCTION (LAMBDA (X)
(BRKDWNRESULTS1 (LIST (CAR X))
(CADR X)
(CADDR X]
(COND
(RETURNVALUESFLG (* Return values, don't print.)
(RETURN VALUES)))
(RESETFORM (FLTFMT BRKDWNFLTFMT)
(MAPC BRKDWNLABELS (FUNCTION (LAMBDA (LABEL)
(LISPXTERPRI T)
(PROG [(TOT (CAR (FNTH (CDR BRKDWNTOTLST)
I)))
(TERP (CADDR (ASSOC LABEL BRKDWNTYPES]
(LISPXPRIN1 (QUOTE "FUNCTIONS ")
T)
(LISPXPRIN1 LABEL T)
(LISPXTAB 23 NIL T)
(LISPXPRIN1 (QUOTE "# CALLS")
T)
(LISPXTAB 33 NIL T)
(LISPXPRIN1 (QUOTE "PER CALL")
T)
(LISPXTAB 46 NIL T)
(LISPXPRIN1 (QUOTE "%%
")
T)
[MAPC VALUES (FUNCTION (LAMBDA (X)
(BRKDWNRESULTS2 (CAR X)
(CAR (FNTH (CDDR X)
I))
(CADR X)
TOT TERP]
(BRKDWNRESULTS2 (QUOTE TOTAL)
TOT
(CAR BRKDWNTOTLST)
TOT TERP))
(ADD1VAR I])
(BRKDWNRESULTS1
[LAMBDA (NLST PTR N) (* lpd " 1-JUN-77 14:38")
(* NLST is a list of the form (NAME NCALLS STAT1 ... STATn) which is smashed (and extended if necessary) with the
values from PTR.)
(PROG ((I 0)
(TOT BRKDWNTOTLST)
(LST NLST)
VAL)
LP (SETQ VAL (IMINUS (BRKDWNELT PTR I)))
[RPLACA TOT (PLUS (CAR TOT)
(COND
((OR (EQ N 1)
(EQ I 0))
VAL)
(T (FQUOTIENT VAL N]
[COND
((LISTP (CDR LST))
(RPLACA (SETQ LST (CDR LST))
VAL))
(T (RPLACD LST (SETQ LST (LIST VAL]
(COND
((SETQ TOT (CDR TOT))
(ADD1VAR I)
(GO LP)))
(RETURN NLST])
(BRKDWNRESULTS2
[LAMBDA (NAME X NCALLS TOT TERP) (* lpd " 1-JUN-77 14:36")
(PROG [(TEM (COND
(TERP (APPLY* TERP X))
(T X]
(LISPXPRIN2 NAME T T)
(LISPXTAB 14 NIL T)
(LISPXPRIN2 TEM T T)
(LISPXTAB 26 NIL T)
(LISPXPRIN2 NCALLS T T)
(LISPXTAB 34 NIL T)
(LISPXPRIN2 (FQUOTIENT TEM NCALLS)
T T)
(LISPXTAB 45 NIL T)
(AND (NEQ NAME (QUOTE TOTAL))
(LISPXPRIN2 [FIX (FPLUS .5 (FTIMES 100 (FQUOTIENT X TOT]
T T))
(LISPXTERPRI T])
(BRKDWNCLEAR
[LAMBDA (PTR N)
(PROG ((I N))
LP (COND
((NEQ I 0)
(SUB1VAR I)
(BRKDWNSETA PTR I 0)
(GO LP])
)
(DECLARE: EVAL@COMPILE
(DECLARE: EVAL@COMPILE
(PUTPROPS BRKDWNMACRO MACRO ((FORM1 FORM2 SETFORM PTR)
(PROGN FORM1 (BRKDWNADDTOA PTR 0 -1)
(SETQ BDZ BDPTR)
(SETQ BDPTR PTR)
SETFORM
(SETQ BDZ (PROG1 BDPTR (SETQ BDPTR BDZ)))
FORM2 BDY)))
(PUTPROPS BRKDWNINCA MACRO ((PTR LST I VAL)
(BRKDWNADDTOA PTR I (BRKDWNDIFFA LST I VAL))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS BRKDWNADDTOA 10MACRO [(PTR I VAL)
(LOC (ASSEMBLE NIL (CQ (VAG (FIX VAL)))
(C (COND [(AND (LITATOM (QUOTE PTR))
(NUMBERP (QUOTE I)))
(QUOTE (ASSEMBLE NIL (CQ2 PTR)
(ADDB 1 , I (2]
(T (QUOTE (ASSEMBLE NIL (PUSHN)
[CQ (VAG (IPLUS I (LOC PTR]
(MOVE 2 , 1)
(POPN 1)
(ADDB 1 , 0 (2])
(PUTPROPS BRKDWNADDTOA MACRO (OPENLAMBDA (PTR I VAL)
(SETA PTR (ADD1 I)
(IPLUS (ELT PTR (ADD1 I))
VAL))))
(PUTPROPS BRKDWNDIFFA 10MACRO [(PTR I VAL)
(LOC (ASSEMBLE NIL (CQ (VAG (FIX VAL)))
(C (COND [(AND (LITATOM (QUOTE PTR))
(NUMBERP (QUOTE I)))
(QUOTE (ASSEMBLE NIL (CQ2 PTR)
(EXCH 1 , I (2))
(SUB 1 , I (2]
(T (QUOTE (ASSEMBLE NIL (PUSHN)
[CQ (VAG (IPLUS I (LOC PTR]
(MOVE 2 , 1)
(POPN 1)
(EXCH 1 , 0 (2))
(SUB 1 , 0 (2])
(PUTPROPS BRKDWNDIFFA MACRO (OPENLAMBDA (PTR I VAL)
(IDIFFERENCE (ELT PTR (ADD1 I))
(SETA PTR (ADD1 I)
VAL))))
(PUTPROPS CPUTIME 10MACRO [NIL (LOC (ASSEMBLE NIL (MOVEI 1 , -5)
(JSYS 13)
(SUB 1 , GCTIM])
(PUTPROPS CPUTIME MACRO (NIL (CLOCK 2)))
(PUTPROPS IBOXCOUNT 10MACRO [NIL (LOC (ASSEMBLE NIL (MOVE 1 , IBOXCN])
(PUTPROPS IBOXCOUNT MACRO (NIL (BOXCOUNT)))
(PUTPROPS FBOXCOUNT 10MACRO [NIL (LOC (ASSEMBLE NIL (MOVE 1 , FBOXCN])
(PUTPROPS FBOXCOUNT MACRO (NIL (BOXCOUNT (QUOTE FLOATP))))
(PUTPROPS BRKDWNELT 10MACRO [LAMBDA (PTR I)
(OPENR (IPLUS (LOC PTR)
I])
(PUTPROPS BRKDWNELT MACRO ((ARR I)
(ELT ARR (ADD1 I))))
(PUTPROPS BRKDWNSETA 10MACRO ((PTR I VAL)
(CLOSER (IPLUS (LOC PTR)
I)
VAL)))
(PUTPROPS BRKDWNSETA MACRO ((ARR I VAL)
(SETA ARR (ADD1 I)
VAL)))
(PUTPROPS BRKDWNARRAY 10MACRO ((N)
(VAG (IPLUS (LOC (ARRAY N N))
2))))
(PUTPROPS BRKDWNARRAY MACRO ((N)
(ARRAY N N)))
)
)
(RPAQQ BRKDWNLENGTH 0)
(RPAQQ BRKDWNCOMPFLG NIL)
(RPAQQ BRKDWNARGS (BDEXP BDX BDN BDY BDZ))
(RPAQQ BRKDWNTYPES ((TIME (CPUTIME)
[LAMBDA (X)
(FQUOTIENT X 1000])
(CONSES (CONSCOUNT))
(PAGEFAULTS (PAGEFAULTS))
(BOXES (IBOXCOUNT))
(FBOXES (FBOXCOUNT))))
(RPAQ BRKDWNFLTFMT (NUMFORMATCODE (QUOTE (FLOAT 7 3 NIL NIL 10))))
(RPAQQ BRKDWNTYPE TIME)
(RPAQQ BRKDWNLABELS NIL)
(RPAQQ BRKDWNLST NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS BRKDWNARGS BRKDWNLABELS BRKDWNLENGTH BRKDWNLST BRKDWNTOTLST BDLST BDSINK BDPTR)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL BRKDWNTIME BRKDWNCONSES BRKDWNBOXES (LINKFNS . T))
(BLOCK: BREAKDOWN BREAKDOWN BRKDWNSETUP BRKDWN1 BRKDWNFORM BRKDWNCOMPILE2 (GLOBALVARS NOSWAPFLG))
(BLOCK: BRKDWNRESULTS BRKDWNRESULTS BRKDWNRESULTS1 BRKDWNRESULTS2)
]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA BREAKDOWN)
(ADDTOVAR NLAML BRKDWNFBOXES BRKDWNBOXES BRKDWNCONSES BRKDWNTIME)
(ADDTOVAR LAMA )
)
(PUTPROPS BRKDWN COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1503 13999 (BREAKDOWN 1513 . 4167) (BRKDWNINIT 4169 . 4409) (BRKDWNSETUP 4411 . 6071) (
BRKDWN1 6073 . 8290) (BRKDWNFORM 8292 . 9187) (BRKDWNCOMPILE2 9189 . 9544) (BRKDWNTIME 9546 . 9900) (
BRKDWNCONSES 9902 . 10267) (BRKDWNBOXES 10269 . 10633) (BRKDWNFBOXES 10635 . 11000) (RESULTS 11002 .
11145) (BRKDWNRESULTS 11147 . 12514) (BRKDWNRESULTS1 12516 . 13259) (BRKDWNRESULTS2 13261 . 13848) (
BRKDWNCLEAR 13850 . 13997)))))
STOP