(FILECREATED "12-Feb-87 23:13:02" {FIREFS:CS:UNIV% ROCHESTER}<KOOMEN>LISP>BRKDWNREPORT.;1 8063
changes to: (VARS BRKDWNREPORTCOMS)
(FNS BRKDWNFORM BDR-TYPE BRKDWN BRKDWNREPORT)
previous date: "12-Feb-87 23:07:23" {FIREFS:CS:UNIV% ROCHESTER}<KOOMEN>LISP>BRKDWNREPORT.;1)
(* Copyright (c) 1987 by Johannes A. G. M. Koomen. All rights reserved.)
(PRETTYCOMPRINT BRKDWNREPORTCOMS)
(RPAQQ BRKDWNREPORTCOMS ((FNS BRKDWNREPORT BRKDWNFORM BDR-TYPE BDR-TYPE-SORTED BDR-COL BDR-RPT)))
(DEFINEQ
(BRKDWNREPORT
[LAMBDA (TITLE BRKDWNSTREAM) (* Koomen "18-Dec-86 16:11")
(DECLARE (GLOBALVARS BRKDWNLABELS))
(if (NOT (OPENP BRKDWNSTREAM (QUOTE OUTPUT)))
then (RESETLST (SETQ BRKDWNSTREAM (OPENSTREAM BRKDWNSTREAM (QUOTE OUTPUT)))
[RESETSAVE NIL (BQUOTE (CLOSEF? (\, BRKDWNSTREAM]
(BRKDWNREPORT TITLE BRKDWNSTREAM))
else (PROG [ENTRYCNT (FIRSTCOL 0)
(TYPE-ENTRIES (for BDTYPE inside BRKDWNLABELS
collect
(* * Each entry is a list of three elements: total frequency of calls, total quantity measured, and list of
individual contributors, each of which is a 3-element list containing name, frequency and quantity measured.)
(LIST 0 0 NIL]
[for RESULT in (BRKDWNRESULTS T) as old ENTRYCNT from 0
bind NAME FREQUENCY unless (ZEROP (SETQ FREQUENCY (CADR RESULT)))
do (SETQ NAME (CAR RESULT))
(for QUANTITY in (CDDR RESULT) as TYPE-ENTRY in TYPE-ENTRIES
unless (ZEROP QUANTITY)
do (add (CAR TYPE-ENTRY)
FREQUENCY)
(add (CADR TYPE-ENTRY)
QUANTITY)
(push (CADDR TYPE-ENTRY)
(LIST NAME FREQUENCY QUANTITY)))
(SETQ FIRSTCOL (MAX FIRSTCOL (NCHARS NAME]
(SETQ FIRSTCOL (IPLUS FIRSTCOL 2))
(printout BRKDWNSTREAM "Breakdown Report:" 24 (OR TITLE ""))
(printout BRKDWNSTREAM T T "Breakdown Date:" 24 (DATE))
(printout BRKDWNSTREAM T T "Functions measured:" 24 ENTRYCNT)
(printout BRKDWNSTREAM T T "Non-zero entries:" T)
(for BDTYPE inside BRKDWNLABELS as TYPE-ENTRY in TYPE-ENTRIES
bind N
do (SETQ N (LENGTH (CADDR TYPE-ENTRY)))
(printout BRKDWNSTREAM 6 BDTYPE 24 .I6 N (if (EQP N 1)
then " function"
else " functions")))
(printout BRKDWNSTREAM T T T)
(for BDTYPE inside BRKDWNLABELS as TYPE-ENTRY in TYPE-ENTRIES
do (BDR-TYPE BRKDWNSTREAM FIRSTCOL (L-CASE BDTYPE)
(CAR TYPE-ENTRY)
(CADR TYPE-ENTRY)
(CADDR TYPE-ENTRY)))
(TERPRI BRKDWNSTREAM])
(BRKDWNFORM
[LAMBDA (BRKDWNFORM BRKDWNFNS BRKDWNSTREAM NEWBRKDWNTYPE)
(* Koomen "12-Feb-87 22:58")
(DECLARE (GLOBALVARS BRKDWNTYPE BRKDWNTYPES)
(LOCALVARS BRKDWNFORM BRKDWNFNS BRKDWNSTREAM NEWBRKDWNTYPE))
(RESETLST (APPLY (FUNCTION UNBREAK)
BRKDWNFNS)
(if NEWBRKDWNTYPE
then (RESETSAVE BRKDWNTYPE (if (EQ NEWBRKDWNTYPE T)
then (for BDT in BRKDWNTYPES
collect (CAR BDT))
else NEWBRKDWNTYPE)))
(BREAKDOWN)
[RESETSAVE (APPLY (FUNCTION BREAKDOWN)
BRKDWNFNS)
(BQUOTE (UNBREAK (\,@ BRKDWNFNS]
(EVAL BRKDWNFORM)
(BRKDWNREPORT BRKDWNFORM BRKDWNSTREAM])
(BDR-TYPE
[LAMBDA (OUTSTREAM FIRSTCOL BDTYPE TOTAL-FREQUENCY TOTAL-QUANTITY ENTRIES)
(* Koomen "12-Feb-87 23:06")
(if ENTRIES
then [SORT ENTRIES (FUNCTION (LAMBDA (x y)
(GEQ (CADDR x)
(CADDR y]
(printout OUTSTREAM T (U-CASE BDTYPE)
" -- sorted by cummulative " BDTYPE ":" T)
(BDR-TYPE-SORTED OUTSTREAM FIRSTCOL BDTYPE TOTAL-FREQUENCY TOTAL-QUANTITY ENTRIES)
(if (CDR ENTRIES)
then (SORT ENTRIES T)
(printout OUTSTREAM T (U-CASE BDTYPE)
" -- alphabetic sort:" T)
(BDR-TYPE-SORTED OUTSTREAM FIRSTCOL BDTYPE TOTAL-FREQUENCY TOTAL-QUANTITY
ENTRIES])
(BDR-TYPE-SORTED
[LAMBDA (OUTSTREAM FIRSTCOL BDTYPE TOTAL-FREQUENCY TOTAL-QUANTITY ENTRIES)
(* Koomen "17-Dec-86 15:10")
(PROG (COL1-START COL1-WIDTH COL1-FORMAT COL2-START COL2-WIDTH COL2-FORMAT COL3-START
COL3-WIDTH COL3-FORMAT COL4-START COL4-WIDTH COL4-FORMAT LINE-END)
(SETQ COL1-START FIRSTCOL)
(SETQ COL1-WIDTH 11)
[SETQ COL1-FORMAT (BQUOTE (FIX (\, COL1-WIDTH]
(SETQ COL2-START (PLUS COL1-START COL1-WIDTH 4))
(SETQ COL2-WIDTH 7)
[SETQ COL2-FORMAT (BQUOTE (FIX (\, COL2-WIDTH]
(SETQ COL3-START (PLUS COL2-START COL2-WIDTH 4))
(SETQ COL3-WIDTH 9)
(SETQ COL3-FORMAT (BQUOTE (FLOAT (\, COL3-WIDTH)
3)))
(SETQ COL4-START (PLUS COL3-START COL3-WIDTH 4))
(SETQ COL4-WIDTH 3)
[SETQ COL4-FORMAT (BQUOTE (FIX (\, COL4-WIDTH]
(SETQ LINE-END (PLUS COL4-START COL4-WIDTH))
(BDR-RPT "=" LINE-END OUTSTREAM)
(TERPRI OUTSTREAM)
(PRIN1 "Function:" OUTSTREAM)
(BDR-COL OUTSTREAM COL1-START COL1-WIDTH BDTYPE)
(BDR-COL OUTSTREAM COL2-START COL2-WIDTH "#calls")
(BDR-COL OUTSTREAM COL3-START COL3-WIDTH "per call")
(BDR-COL OUTSTREAM COL4-START COL4-WIDTH "%%")
(TERPRI OUTSTREAM)
(BDR-RPT "-" LINE-END OUTSTREAM)
(TERPRI OUTSTREAM)
(for ENTRY in ENTRIES as NLINES from 1 bind NAME FREQUENCY QUANTITY
(LASTLINE ← (IDIFFERENCE
(LENGTH ENTRIES)
4))
do (SETQ NAME (CAR ENTRY))
(SETQ FREQUENCY (CADR ENTRY))
(SETQ QUANTITY (CADDR ENTRY))
(PRIN1 NAME OUTSTREAM)
(BDR-COL OUTSTREAM COL1-START COL1-WIDTH QUANTITY COL1-FORMAT)
(BDR-COL OUTSTREAM COL2-START COL2-WIDTH FREQUENCY COL2-FORMAT)
(BDR-COL OUTSTREAM COL3-START COL3-WIDTH (FQUOTIENT QUANTITY FREQUENCY)
COL3-FORMAT)
(BDR-COL OUTSTREAM COL4-START COL4-WIDTH (FQUOTIENT (FTIMES 100.0 QUANTITY)
TOTAL-QUANTITY)
COL4-FORMAT)
(TERPRI OUTSTREAM)
(if (AND (ZEROP (IREMAINDER NLINES 10))
(ILESSP NLINES LASTLINE))
then (BDR-RPT "-" LINE-END OUTSTREAM)
(TERPRI OUTSTREAM)))
(BDR-RPT "-" LINE-END OUTSTREAM)
(TERPRI OUTSTREAM)
(PRIN1 "Total:" OUTSTREAM)
(BDR-COL OUTSTREAM COL1-START COL1-WIDTH TOTAL-QUANTITY COL1-FORMAT)
(BDR-COL OUTSTREAM COL2-START COL2-WIDTH TOTAL-FREQUENCY COL2-FORMAT)
(BDR-COL OUTSTREAM COL3-START COL3-WIDTH (FQUOTIENT TOTAL-QUANTITY TOTAL-FREQUENCY)
COL3-FORMAT)
(TERPRI OUTSTREAM)
(BDR-RPT "=" LINE-END OUTSTREAM)
(TERPRI OUTSTREAM)
(TERPRI OUTSTREAM])
(BDR-COL
[LAMBDA (OUTSTREAM START WIDTH VALUE FORMAT) (* Koomen "16-Dec-86 17:24")
(if FORMAT
then (TAB START 1 OUTSTREAM)
(PRINTNUM FORMAT VALUE OUTSTREAM)
else (SETQ START (IDIFFERENCE (IPLUS START WIDTH)
(NCHARS VALUE)))
(TAB START 1 OUTSTREAM)
(PRIN1 VALUE OUTSTREAM])
(BDR-RPT
[LAMBDA (STR N OUTSTREAM) (* Koomen "17-Dec-86 14:50")
(for I from 1 to N do (PRIN1 STR OUTSTREAM])
)
(PUTPROPS BRKDWNREPORT COPYRIGHT ("Johannes A. G. M. Koomen" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (512 7973 (BRKDWNREPORT 522 . 2895) (BRKDWNFORM 2897 . 3703) (BDR-TYPE 3705 . 4464) (
BDR-TYPE-SORTED 4466 . 7414) (BDR-COL 7416 . 7794) (BDR-RPT 7796 . 7971)))))
STOP