(FILECREATED "12-NOV-82 12:47:49" {PHYLUM}<LISPCORE>SOURCES>UPCSTATS.;7 9111   

      changes to:  (FNS GATHERUPCSTATS UPCSTATS READMBFILE PLOTPCS PRINTUPC)
		   (VARS UPCSTATSCOMS)
		   (MACROS BIN2 UPCCOUNT)

      previous date: " 8-OCT-81 09:17:39" {PHYLUM}<LISPCORE>SOURCES>UPCSTATS.;1)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT UPCSTATSCOMS)

(RPAQQ UPCSTATSCOMS ((VARS IMSIZE)
		     (FNS GATHERUPCSTATS PRINTCUMULATIVEPERCENT PRINTUPC UPCSTATS)
		     (FNS READMBFILE READNAME)
		     (FNS PLOTPCS)
		     (INITVARS (STATSBUFFER)
			       (VIRTOREAL)
			       (VIRTONAME))
		     (VARS (UPCTHRESHOLD 0 (* lower threshold for percentage to show up on Microcode 
					      PC Sample histogram)))
		     (MACROS BIN2 UPCCOUNT)))

(RPAQQ IMSIZE 4096)
(DEFINEQ

(GATHERUPCSTATS
  [LAMBDA (FORM)                                             (* lmm "12-NOV-82 12:45")
    (DECLARE (GLOBALVARS STATSBUFFER))
    (OR STATSBUFFER (SETQ STATSBUFFER (\ALLOCLOCKED IMSIZE)))
    [\ZEROWORDS STATSBUFFER (\ADDBASE STATSBUFFER (SUB1 (ITIMES IMSIZE (PROG1 2 
                                                             (* words per fixp)]
    [RESETVARS ((STRF T)
		(LCFIL))
	       (COMPILE1 (QUOTE STATSDUMMYFUNCTION)
			 (BQUOTE (LAMBDA NIL ((OPCODES UPCTRACE)
					  STATSBUFFER)
					 , FORM ((OPCODES UPCTRACE)
					  NIL]
    (STATSDUMMYFUNCTION])

(PRINTCUMULATIVEPERCENT
  [LAMBDA NIL                      (* lmm "29-SEP-80 15:56")
    (PROGN (PRIN1 "(" NIL)
	   (PRIN1 (FQUOTIENT (FPLUS (FTIMES 65536. CUHI)
				    CULO)
			     TOTAL)
		  NIL)
	   (PRIN1 ")" NIL])

(PRINTUPC
  [LAMBDA NIL                                                (* lmm "12-NOV-82 11:40")
    (COND
      (UPCSEEN (do (PRIN1 "Use .MB file: " T)
		   (SETQ MBFILE (READ T T)) repeatuntil (OR (EQ (NTHCHAR MBFILE 1)
								(QUOTE {))
							    (EQ MBFILE (QUOTE NIL:))
							    (INFILEP MBFILE)))
	       (READMBFILE MBFILE)
	       (PRIN1 "Microcode PC Sample: ")
	       (PLOTPCS)))
    (STATSDUMMYFUNCTION])

(UPCSTATS
  [LAMBDA (FORM DOLISTFLG)                                   (* lmm "12-NOV-82 12:31")
    (PROG ((STRF T)
	   (LCFIL))
          (DECLARE (SPECVARS STRF LCFIL))
          (GATHERUPCSTATS FORM)
          (READMBFILE)
          (PLOTPCS])
)
(DEFINEQ

(READMBFILE
  [LAMBDA (MBFILE)                                           (* lmm "12-NOV-82 12:31")
    (OR MBFILE (do (PRIN1 "Use .MB file: " T)
		   (SETQ MBFILE (READ T T)) repeatuntil (INFILEP MBFILE)))
    (PROG ((INX (GETOFD (SETQ MBFILE (OPENFILE MBFILE (QUOTE INPUT)
					       (QUOTE OLD)
					       8))
			(QUOTE INPUT)))
	   (CURMEMWIDTH 0)
	   (CURMEM 0)
	   (CURLOC 0)
	   IM BLOCKTYPE)
          (SETQ MEMORIES)
          (OR VIRTOREAL (SETQ VIRTOREAL (ARRAY IMSIZE (QUOTE SMALLP)
					       0 0)))
          (OR VIRTONAME (SETQ VIRTONAME (ARRAY IMSIZE (QUOTE POINTER)
					       NIL 0)))
      LP  (SELECTQ (SETQ BLOCKTYPE (BIN2 INX))
		   (0 (RETURN))
		   [1 (COND
			((EQ CURMEM IM)
			  (BIN2 INX)                         (* source line #)
			  (BIN2 INX)                         (* bits 0 to 15)
			  (BIN2 INX)                         (* bits 16 to 31)
			  (BIN2 INX)                         (* bits 32 to 47)
			  (FASTSETAW VIRTOREAL (PROG1 CURLOC (add CURLOC 1))
				     (LOGAND (BIN2 INX)
					     4095))          (* bits 48 to 63)
			  )
			(T (BIN2 INX)
			   (FRPTQ CURMEMWIDTH (BIN2 INX]
		   (2 (SETQ CURMEM (BIN2 INX))
		      (SETQ CURLOC (BIN2 INX))
		      (SETQ CURMEMWIDTH (IQUOTIENT (IPLUS (CADR (OR (FASSOC CURMEM MEMORIES)
								    (HELP)))
							  15)
						   16)))
		   [3                                        (* FIXUP MEM# LOC FIRSTBIT,,LASTBIT VALUE)
		      (COND
			((EQ (BIN2 INX)
			     IM)
			  (HELP))
			(T (BIN2 INX)
			   (BIN2 INX)
			   (BIN2 INX]
		   [4 (push MEMORIES (LIST (BIN2 INX)
					   (BIN2 INX)
					   (READNAME INX)))
		      (COND
			((EQ (CADDR (CAR MEMORIES))
			     (QUOTE IM))
			  (SETQ IM (CAAR MEMORIES))
			  (OR (EQ (CADAR MEMORIES)
				  64)
			      (HELP (QUOTE IM)
				    "wrong # bits"]
		   [5                                        (* symbol location)
		      (COND
			((EQ (BIN2 INX)
			     IM)
			  (FASTSETA VIRTONAME (BIN2 INX)
				    (READNAME INX)))
			(T (BIN2 INX)
			   (READNAME INX T]
		   (6 (BIN2 INX)
		      (BIN2 INX)
		      (BIN2 INX)
		      (READNAME INX T))
		   (HELP))
          (GO LP))
    (CLOSEF MBFILE])

(READNAME
  [LAMBDA (J FLG)                  (* lmm "16-MAY-81 16:51")
    (bind EVENBYTE CH CHARS do (COND
				 [(ZEROP (SETQ CH (\BIN J)))
				   (RETURN (PROG1 (OR FLG (PACKC (DREVERSE CHARS)))
						  (COND
						    ((NOT EVENBYTE)
						      (\BIN J]
				 (T (SETQ EVENBYTE (NOT EVENBYTE))
				    (push CHARS CH])
)
(DEFINEQ

(PLOTPCS
  [LAMBDA (ALLFLG)                                           (* lmm "12-NOV-82 12:29")
    (PROG (NAME (INC 0)
		LASTPRINTEDNAME V CNTPERSTAR (BIGGEST 0)
		(2NDBIGGEST 0)
		(3RDBIGGEST 0)
		(TOTHI 0)
		(TOTLO 0)
		CUM HALFSTAR MAXSTARS LASTSTARPOS NSTARS TABPOS THRESHOLD TOTAL (CUHI 0)
		(CULO 0))
          (PRIN1 "Microcode PC Sample: ")
          [for I from 0 to (SUB1 IMSIZE) do (COND
					      ((NEQ (SETQ V (UPCCOUNT I))
						    0)
						(add TOTHI (LRSH V 16))
						(add TOTLO (LOGAND V 65535))
						(COND
						  ((IGREATERP V 3RDBIGGEST)
						    (COND
						      [(IGREATERP V 2NDBIGGEST)
							(COND
							  ((IGREATERP V BIGGEST)
							    (SETQ BIGGEST V))
							  (T (SETQ 2NDBIGGEST V]
						      (T (SETQ 3RDBIGGEST V]
                                                             (* Each line has (NAME 14) (+nnn 4) 
							     (%| 1) stars ((nn.nnnn%%) 10) + 2 for luck)
          (SETQ MAXSTARS (IDIFFERENCE [SETQ LASTSTARPOS (IDIFFERENCE (LINELENGTH)
								     (COND
								       (ALLFLG 20)
								       (T 12]
				      20))
          (SETQ CNTPERSTAR (IQUOTIENT 3RDBIGGEST MAXSTARS))
          (SETQ HALFSTAR (IQUOTIENT CNTPERSTAR 2))
          (SETQ TOTAL (FPLUS TOTLO (FTIMES TOTHI 65536.0)))
          [SETQ THRESHOLD (COND
	      (ALLFLG 0)
	      (T (IMAX HALFSTAR (FIX (QUOTIENT (TIMES UPCTHRESHOLD CNTPERSTAR)
					       TOTAL]
          (SETQ TOTAL (FQUOTIENT TOTAL 100.0))
          (printout NIL " Each * = " CNTPERSTAR " count, or " .F8.2 (FQUOTIENT CNTPERSTAR TOTAL)
		    "%%")
          [for VPC from 0 to (SUB1 IMSIZE)
	     do [COND
		  ((SETQ V (FASTELT VIRTONAME VPC))
		    (SETQ NAME V)
		    (SETQ INC 0))
		  (T (SETQ INC (ADD1 INC]
		(SETQ V (UPCCOUNT (FASTELTW VIRTOREAL VPC)))
		(COND
		  (ALLFLG (COND
			    [(NEQ NAME LASTPRINTEDNAME)
			      (COND
				(LASTPRINTEDNAME             (* don't do it the first time)
						 (TAB LASTSTARPOS)
						 (PRINTCUMULATIVEPERCENT)))
			      (TERPRI)
			      (PRIN1 (COND
				       ((IGREATERP (SETQ TABPOS (NCHARS (SETQ LASTPRINTEDNAME NAME)))
						   14)
					 (SUBSTRING NAME 1 (SETQ TABPOS 14)))
				       (T NAME]
			    (T (TERPRI)
			       (SPACES TABPOS)))
			  (add CUHI (LRSH V 16))
			  (add CULO (LOGAND V 65535))
			  (COND
			    ((NEQ INC 0)
			      (printout NIL "+" .I3...T INC)))
			  (TAB 18)
			  (printout NIL "#" .I8.4 (FASTELTW VIRTOREAL VPC)
				    "  " .I10 V))
		  ((IGREATERP V THRESHOLD)
		    (COND
		      [(NEQ NAME LASTPRINTEDNAME)
			(COND
			  (LASTPRINTEDNAME                   (* don't do it the first time)
					   (TAB LASTSTARPOS)
					   (PRINTCUMULATIVEPERCENT)))
			(TERPRI)
			(PRIN1 (COND
				 ((IGREATERP (SETQ TABPOS (NCHARS (SETQ LASTPRINTEDNAME NAME)))
					     14)
				   (SUBSTRING NAME 1 (SETQ TABPOS 14)))
				 (T NAME]
		      (T (TERPRI)
			 (SPACES TABPOS)))
		    (add CUHI (LRSH V 16))
		    (add CULO (LOGAND V 65535))
		    (COND
		      ((NEQ INC 0)
			(printout NIL "+" .I3...T INC)))
		    (TAB 18)
		    (PRIN1 "|")
		    (FRPTQ (COND
			     ((IGEQ (SETQ NSTARS (IQUOTIENT (IPLUS V HALFSTAR)
							    CNTPERSTAR))
				    MAXSTARS)
			       (printout NIL "(" .I4 NSTARS ")")
			       (IDIFFERENCE MAXSTARS 6))
			     (T NSTARS))
			   (PRIN1 "*"]
          (TAB LASTSTARPOS)
          (PRINTCUMULATIVEPERCENT)
          (TERPRI)
          (SETQ CUHI (IDIFFERENCE TOTHI CUHI))
          (SETQ CULO (IDIFFERENCE TOTLO CULO))
          (printout NIL T T "Not shown: ")
          (PRINTCUMULATIVEPERCENT)
          (TERPRI])
)

(RPAQ? STATSBUFFER )

(RPAQ? VIRTOREAL )

(RPAQ? VIRTONAME )

(RPAQ UPCTHRESHOLD 0 (* lower threshold for percentage to show up on Microcode PC Sample histogram))
(DECLARE: EVAL@COMPILE 

(PUTPROPS BIN2 MACRO ((INX)
		      (IPLUS (LLSH (\BIN INX)
				   8)
			     (\BIN INX))))

(PUTPROPS UPCCOUNT MACRO [OPENLAMBDA (N)
				     (\MAKENUMBER (\GETBASE STATSBUFFER (ADD1 (LLSH N 1)))
						  (\GETBASE STATSBUFFER (LLSH N 1])
)
(DECLARE: DONTCOPY (PUTPROPS UPCSTATS COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (792 2348 (GATHERUPCSTATS 802 . 1399) (PRINTCUMULATIVEPERCENT 1401 . 1627) (PRINTUPC 
1629 . 2073) (UPCSTATS 2075 . 2346)) (2349 4906 (READMBFILE 2359 . 4561) (READNAME 4563 . 4904)) (4907
 8558 (PLOTPCS 4917 . 8556)))))
STOP