(FILECREATED "11-Oct-84 14:34:16" {ERIS}<LISPCORE>LIBRARY>UPCSTATS.;3
 9157   

      changes to:  (FNS UPCSTATS)

      previous date: "12-NOV-82 12:47:49" {ERIS}<LISPCORE>LIBRARY>UPCSTATS.;1)


(* Copyright (c)  by NIL. All rights reserved.)

(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)                                   (* gbn "11-Oct-84 14:33")

    (
PROG
 ((STRF T)
	   (LCFIL))
          (DECLARE
 (
SPECVARS
 STRF LCFIL))
          (IF
 (
NOT
 (
EQ
 (
MACHINETYPE
)
		       (
QUOTE
 DORADO)))
	      THEN
 (PRINTOUT
 T " UPCSTATS  only runs on Dorados")
		   (
RETURN
))
          (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
  (FILEMAP (NIL (698 2431 (GATHERUPCSTATS 708 . 1305) (PRINTCUMULATIVEPERCENT 1307 . 1533) (PRINTUPC 
1535 . 1979) (UPCSTATS 1981 . 2429)) (2432 4989 (READMBFILE 2442 . 4644) (READNAME 4646 . 4987)) (4990
 8641 (PLOTPCS 5000 . 8639)))))
STOP