(FILECREATED " 4-Mar-86 16:30:02" {QV}<PEDERSEN>LISP>GCCOUNT.;15 31738
changes to: (VARS GCCOUNTCOMS)
(FNS PLUSHASH PLUSHASH0 PLUSHASH1 PLUSHASHR1 GC.MONITOR GCCOUNT GCCOUNTENTRIES
START.MONITOR.GC GC.MONITOR.SCRIPT END.MONITOR.GC GCSLOTDIST GCOBJECTDIST
GCSNAPTABLE RANDDIST GCHIGHTBITDIST REHASHGCTABLE GCTABLE.GETSTATS
GCHIGHBYTEDIST XORHASH HIGHMASKHASH FULLXORHASH)
(RECORDS GCENTRY)
previous date: "26-Feb-86 18:21:57" {QV}<PEDERSEN>LISP>GCCOUNT.;12)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GCCOUNTCOMS)
(RPAQQ GCCOUNTCOMS ((FNS ARM\HTFIND CLEAR.GCCASES CNTCOLL CNTDERIV CNTREF COMPILE.EXPRS
DUMP.GCCASES END.MONITOR.GC END.SAMPLE\HTFIND FULLXORHASH
GC.HASHTABLE.STATS GC.MONITOR GC.MONITOR.SCRIPT GCCOUNT GCCOUNTENTRIES
GCHIGHBYTEDIST GCHIGHTBITDIST GCOBJECTDIST GCSLOTDIST GCSNAPTABLE
GCTABLE.GETSTATS INSTRUMENTED\HTFIND MAKEFREQ PLUSHASH0 PLUSHASH1
PLUSHASHR1 RANDDIST REHASHGCTABLE RESTORE\HTFIND START.MONITOR.GC
START.SAMPLE\HTFIND XORHASH \HTFIND.PUNT.STATS)
(P (LOAD? (QUOTE GCHAX.DCOM))
(LOAD? (QUOTE {QV}<PEDERSEN>BENCHMARKS>DERIV.DCOM))
(CLEAR.GCCASES))
(RECORDS GCENTRY)))
(DEFINEQ
(ARM\HTFIND
[LAMBDA (FN) (* jop: " 7-Feb-86 16:43")
(if (NOT (CCODEP FN))
then (HELP "FN not compiled" FN))
(MOVD (QUOTE \HTFIND)
(QUOTE \HTFIND.SAVE))
(MOVD FN (QUOTE \HTFIND])
(CLEAR.GCCASES
[LAMBDA NIL (* jop: "10-Feb-86 14:49")
(DECLARE (GLOBALVARS \GC.CHAINLENGTHS \GC.LINKCASE \GC.NEWCOLLCASE \GC.BIGREFCASE
\GC.NOCOLLCASE \GC.DELLINKCASE \GC.FLATTEDCHAINCASE \GC.NOCOLLBIGREFCASE
\GC.NEWLINKCASE))
(if (OR (NOT (BOUNDP \GC.CHAINLENGTHS))
(NOT (type? ARRAY \GC.NEWLINKCASE)))
then (SETQ \GC.CHAINLENGTHS (MAKE-ARRAY 6)))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE \GC.CHAINLENGTHS))
do (PASET 0 \GC.CHAINLENGTHS I))
(SETQ \GC.LINKCASE 0)
(SETQ \GC.NEWCOLLCASE 0)
(SETQ \GC.BIGREFCASE 0)
(SETQ \GC.NOCOLLCASE 0)
(SETQ \GC.DELLINKCASE 0)
(SETQ \GC.FLATTEDCHAINCASE 0)
(SETQ \GC.NOCOLLBIGREFCASE 0)
(SETQ \GC.NEWLINKCASE 0)
NIL])
(CNTCOLL
[LAMBDA (ARRAY INDEX ZEROP)
(DECLARE (SPECVARS \#GCENTRIES \#GCLOSERS)) (* jop: " 6-Feb-86 14:16")
(PROG ((\#GCENTRIES 0)
(\#GCLOSERS 0))
(\MAPGC [FUNCTION (LAMBDA (PTR REFCNT COLLISIONP)
(add \#GCENTRIES 1)
(AND COLLISIONP (add \#GCLOSERS 1]
ZEROP)
(PASET \#GCENTRIES ARRAY INDEX 0)
(PASET \#GCLOSERS ARRAY INDEX 1])
(CNTDERIV
[LAMBDA (N NORECLAIMFLG) (* jop: " 9-Feb-86 16:50")
(if (NULL N)
then (SETQ N 10))
(PRINTOUT T "N is" , N T)
(PROG (GCCOUNT.BEFORE SAMPLE GCCOUNT.AFTER)
(if NORECLAIMFLG
then (RECLAIMMIN MAX.SMALLP))
(FRPTQ 10 (RECLAIM))
(SETQ GCCOUNT.BEFORE (GCCOUNT))
(FRPTQ 10 (RECLAIM))
(START.SAMPLE\HTFIND)
[for I from 1 to N do (DERIV (QUOTE (PLUS (TIMES 3 X X)
(TIMES A X X)
(TIMES B X)
5]
(SETQ SAMPLE (END.SAMPLE\HTFIND))
(SETQ GCCOUNT.AFTER (GCCOUNT))
(FRPTQ 10 (RECLAIM))
(if NORECLAIMFLG
then (RECLAIMMIN 3000))
(RETURN (LIST GCCOUNT.BEFORE SAMPLE GCCOUNT.AFTER])
(CNTREF
[LAMBDA NIL
(DECLARE (SPECVARS \#GCENTRIES \#GCLOSERS \#GCARRAY))
(* jop: " 6-Feb-86 17:03")
(PROG ((\#GCARRAY (MAKE-ARRAY 64 (QUOTE :INITIAL-ELEMENT)
0)))
(\MAPGC [FUNCTION (LAMBDA (PTR REFCNT COLLISIONP)
(PASET (ADD1 (PAREF \#GCARRAY (IMIN REFCNT 63)))
\#GCARRAY
(IMIN REFCNT 63]
T)
(RETURN \#GCARRAY])
(COMPILE.EXPRS
[LAMBDA (FILE) (* jop: " 9-Feb-86 16:58")
(PROG ((FLIST (FILEFNSLST FILE))
EXPRS)
(SETQ EXPRS (for F in FLIST when (EXPRP F) collect F))
(RETURN (if EXPRS
then (COMPILE EXPRS])
(DUMP.GCCASES
[LAMBDA NIL (* jop: "10-Feb-86 15:49")
(DECLARE (GLOBALVARS \GC.CHAINLENGTHS \GC.LINKCASE \GC.NEWCOLLCASE \GC.BIGREFCASE
\GC.NOCOLLCASE \GC.DELLINKCASE \GC.FLATTEDCHAINCASE \GC.NOCOLLBIGREFCASE
\GC.NEWLINKCASE))
(LIST (QUOTE DATE)
(DATE)
(QUOTE TOTAL.PUNTS)
(PAREF \GC.CHAINLENGTHS 0)
(QUOTE CHAIN.LENGTHS.FROM.ONE)
(for I from 1 to (SUB1 (ARRAY-TOTAL-SIZE \GC.CHAINLENGTHS))
collect (PAREF \GC.CHAINLENGTHS I))
(QUOTE LINK.CASES)
\GC.LINKCASE
(QUOTE NEW.COLLISION.CASES)
\GC.NEWCOLLCASE
(QUOTE BIG.REF.COUNT.CASES)
\GC.BIGREFCASE
(QUOTE NO.COLLISION.CASES)
\GC.NOCOLLCASE
(QUOTE NO.COLL.BIG.REF.CASES)
\GC.NOCOLLBIGREFCASE
(QUOTE DEL.LINK.CASES)
\GC.DELLINKCASE
(QUOTE FLATTEN.CHAIN.CASES)
\GC.FLATTEDCHAINCASE
(QUOTE NEW.LINK.CASES)
\GC.NEWLINKCASE])
(END.MONITOR.GC
[LAMBDA NIL (* jop: " 3-Mar-86 14:10")
(* *)
(DECLARE (GLOBALVARS \GC.MONITOR.PROCESS \GC.END.MONITOR))
(SETQ \GC.END.MONITOR NIL)
(PROCESS.RESULT \GC.MONITOR.PROCESS T])
(END.SAMPLE\HTFIND
[LAMBDA NIL (* jop: " 7-Feb-86 18:33")
(RESTORE\HTFIND)
(DUMP.GCCASES])
(FULLXORHASH
[LAMBDA (INDEX HIGHBITS) (* jop: " 2-Mar-86 15:55")
(PROG ((MASK (LOGAND (LOGOR (LLSH HIGHBITS 8)
HIGHBITS)
32767)))
(RETURN (LOGXOR INDEX MASK])
(GC.HASHTABLE.STATS
[LAMBDA (PROPLST) (* jop: "31-Dec-00 19:02")
(* *)
(PROG ((TOTAL.ENTRIES (LISTGET PROPLST (QUOTE TOTAL.ENTRIES)))
(TOTAL.COLLISIONS (LISTGET PROPLST (QUOTE TOTAL.COLLISIONS)))
(TOTAL.BIGREF (LISTGET PROPLST (QUOTE TOTAL.BIGREF)))
(SLOTLENGTHS (LISTGET PROPLST (QUOTE SLOTLENGTHS)))
TOTALSLOTS TOTALSLOTSFULL TOTALLINKS)
(SETQ TOTALSLOTS (for SLOT in SLOTLENGTHS sum SLOT))
(SETQ TOTALSLOTSFULL (for SLOT in (CDR SLOTLENGTHS) sum SLOT))
(SETQ TOTALLINKS (for SLOT in (CDDR SLOTLENGTHS) sum SLOT))
(PRINTOUT T "Total slots:" , TOTALSLOTS , "Slots full:" , TOTALSLOTSFULL , "Link slots:"
, TOTALLINKS T T)
(PRINTOUT T "Distribution of slots:" T)
(PRINTOUT T "Empty" 8 "Main slot" 20 "Link 2" 28 "Link 3" 36 "Link 4" 44 "Link 5+")
(for SLOT in SLOTLENGTHS as TAB in (QUOTE (0 8 20 28 36 44))
do (PRINTOUT T .TAB TAB SLOT) finally (PRINTOUT T T T))
(PRINTOUT T "%% Full out of total slots:" , , (TIMES 100 (FQUOTIENT TOTALSLOTSFULL
TOTALSLOTS))
T)
(PRINTOUT T "%% Links out of full slots:" , , (TIMES 100 (FQUOTIENT TOTALLINKS
TOTALSLOTSFULL))
T)
(PRINTOUT T "%% Links of length 2 out of link slots:" , ,
(TIMES 100 (FQUOTIENT (CAR (NTH SLOTLENGTHS 3))
TOTALLINKS))
T)
(PRINTOUT T T)
(PRINTOUT T "Total entries:" , TOTAL.ENTRIES , "Total collisions:" , TOTAL.COLLISIONS ,
"Total big ref count:"
, TOTAL.BIGREF T T)
(PRINTOUT T "%% Entries in collision:" , (TIMES 100 (FQUOTIENT TOTAL.COLLISIONS
TOTAL.ENTRIES))
T)
(PRINTOUT T "%% Entries with big ref counts:" , (TIMES 100 (FQUOTIENT TOTAL.BIGREF
TOTAL.ENTRIES))
T T])
(GC.MONITOR
[LAMBDA (MAXSECONDS) (* jop: " 3-Mar-86 14:14")
(* *)
(DECLARE (GLOBALVARS \GC.END.MONITOR))
(SETQ \GC.END.MONITOR T)
(while \GC.END.MONITOR
collect (BLOCK (TIMES 1000 (RAND 1 MAXSECONDS)))
(GCCOUNTENTRIES])
(GC.MONITOR.SCRIPT
[LAMBDA (N) (* jop: " 3-Mar-86 14:06")
(* *)
(if (NULL N)
then (SETQ N 10))
(START.MONITOR.GC 5)
(LOAD (QUOTE PLOT.DCOM))
(LOAD (QUOTE PLOT)
(QUOTE PROP))
(LOAD (QUOTE PLOTOBJECTS)
(QUOTE PROP))
(LOAD (QUOTE TWODGRAPHICS)
(QUOTE PROP))
(LOAD (QUOTE PLOTEXAMPLES.DCOM))
(LOAD (QUOTE PLOTEXAMPLES)
(QUOTE PROP))
[MASTERSCOPE (QUOTE (ANALYZE ANY ON (QUOTE (PLOT PLOTOBJECTS TWODGRAPHICS PLOTEXAMPLES]
(BLOCK)
(MASTERSCOPE (QUOTE (WHO CALLS REDRAWPLOTWINDOW)))
(BLOCK)
(bind PLOTVAR for I from 1 to N
do (SETQ PLOTVAR (PACK* (QUOTE P)
I))
(SET PLOTVAR (CREATEPLOT T (CREATEREGION 100 100 300 300)))
(PLOTPOINTS (EVAL PLOTVAR)
(SINEWAVE 100 2 0 1 1))
(PLOTCURVE (EVAL PLOTVAR)
(SINEWAVE 100 4 0 1 2))
(CLOSEPLOTWINDOW (EVAL PLOTVAR))
(BLOCK))
(LOAD (QUOTE SKETCH.DCOM))
(LOAD (QUOTE SKETCHSTREAM.DCOM))
(BLOCK)
(bind PLOTVAR SKETCH SKETCHVIEWPORT for I from 1 to N
do (SETQ PLOTVAR (PACK* (QUOTE P)
I))
(SETQ SKETCH (PACK* (QUOTE S)
I))
[SET SKETCH (OPENSKETCHSTREAM "Layout of plot" (LIST (QUOTE REGION)
(CREATEREGION
(PLUS 100
(TIMES I 10))
100 300 300]
(SETQ SKETCHVIEWPORT (CREATEVIEWPORT (EVAL SKETCH)))
(ADJUSTVIEWPORT SKETCHVIEWPORT (DSPCLIPPINGREGION NIL (EVAL SKETCH))
(EVAL PLOTVAR))
(DRAWPLOT (EVAL PLOTVAR)
(EVAL SKETCH)
SKETCHVIEWPORT
(DSPCLIPPINGREGION NIL (EVAL SKETCH)))
(BLOCK))
(END.MONITOR.GC])
(GCCOUNT
[LAMBDA NIL (* jop: "10-Feb-86 15:49")
(* *)
(PROG ((TOTALENTRIES 0)
(TOTALCOLLISIONS 0)
(TOTALBIGREF 0)
(SLOTCNT (MAKE-ARRAY 6 (QUOTE :INITIAL-ELEMENT)
0)))
[bind ENTRY for I from 0 to 32767
do (SETQ ENTRY (\ADDBASE \HTMAIN I))
(if (fetch (GC EMPTY) of ENTRY)
then (PASET (ADD1 (PAREF SLOTCNT 0))
SLOTCNT 0)
else (if (fetch (GC LINKP) of ENTRY)
then (bind (CHAINLENGTH ← 0)
(NEXTLINK ←(fetch (GC LINKPTR) of ENTRY))
LINK repeatuntil (EQ 0 NEXTLINK)
do (SETQ LINK (\ADDBASE \HTCOLL NEXTLINK))
(SETQ TOTALENTRIES (ADD1 TOTALENTRIES))
(SETQ TOTALCOLLISIONS (ADD1 TOTALCOLLISIONS))
(if (EQ (fetch (GC CNT) of LINK)
\MAXHTCNT)
then (SETQ TOTALBIGREF (ADD1 TOTALBIGREF)))
(SETQ CHAINLENGTH (ADD1 CHAINLENGTH))
(SETQ NEXTLINK (fetch (GC NXTPTR) of LINK))
finally (PASET (ADD1 (PAREF SLOTCNT (IMIN
CHAINLENGTH 5)))
SLOTCNT
(IMIN CHAINLENGTH 5)))
else (PASET (ADD1 (PAREF SLOTCNT 1))
SLOTCNT 1)
(SETQ TOTALENTRIES (ADD1 TOTALENTRIES))
(if (EQ (fetch (GC CNT) of ENTRY)
\MAXHTCNT)
then (SETQ TOTALBIGREF (ADD1 TOTALBIGREF]
(RETURN (LIST (QUOTE DATE)
(DATE)
(QUOTE TOTAL.ENTRIES)
TOTALENTRIES
(QUOTE TOTAL.COLLISIONS)
TOTALCOLLISIONS
(QUOTE TOTAL.BIGREF)
TOTALBIGREF
(QUOTE SLOTLENGTHS)
(for J from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTCNT))
collect (PAREF SLOTCNT J])
(GCCOUNTENTRIES
[LAMBDA NIL (* jop: " 3-Mar-86 13:02")
(* *)
(PROG ((TOTALCOLLISIONS 0)
(TOTALENTRIES 0))
[bind ENTRY for I from 0 to 32767
do (SETQ ENTRY (\ADDBASE \HTMAIN I))
(if (fetch (GC LINKP) of ENTRY)
then (bind (CHAINLENGTH ← 0)
(NEXTLINK ←(fetch (GC LINKPTR) of ENTRY))
LINK repeatuntil (EQ 0 NEXTLINK)
do (SETQ LINK (\ADDBASE \HTCOLL NEXTLINK))
(SETQ CHAINLENGTH (ADD1 CHAINLENGTH))
(SETQ NEXTLINK (fetch (GC NXTPTR) of LINK))
finally (SETQ TOTALENTRIES (PLUS TOTALENTRIES CHAINLENGTH))
(SETQ TOTALCOLLISIONS (PLUS TOTALCOLLISIONS
CHAINLENGTH)))
elseif (NOT (fetch (GC EMPTY) of ENTRY))
then (SETQ TOTALENTRIES (ADD1 TOTALENTRIES]
(RETURN (LIST (QUOTE IDATE)
(IDATE)
(QUOTE VMEMSIZE)
(VMEMSIZE)
(QUOTE TOTALENTRIES)
TOTALENTRIES
(QUOTE TOTALCOLLISIONS)
TOTALCOLLISIONS])
(GCHIGHBYTEDIST
[LAMBDA (GCTABLE) (* jop: "28-Feb-86 18:31")
(* *)
(LET* ((BITS 8)
(SLOTCNT (MAKE-ARRAY (EXPT 2 BITS)
(QUOTE :INITIAL-ELEMENT)
0)))
(bind HIGHBYTE for ITEM in GCTABLE
do (if (LISTP (CAR ITEM))
then (for SUBITEM in ITEM
do (SETQ HIGHBYTE (LRSH (fetch (GCENTRY INDEX) of SUBITEM)
8))
(PASET (ADD1 (PAREF SLOTCNT HIGHBYTE))
SLOTCNT HIGHBYTE))
else (SETQ HIGHBYTE (LRSH (fetch (GCENTRY INDEX) of ITEM)
8))
(PASET (ADD1 (PAREF SLOTCNT HIGHBYTE))
SLOTCNT HIGHBYTE)))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTCNT))
collect (CONS I (PAREF SLOTCNT I])
(GCHIGHTBITDIST
[LAMBDA (GCSNAPTABLE) (* jop: "28-Feb-86 16:50")
(* *)
(LET* ((BITS 8)
(SLOTCNT (MAKE-ARRAY (EXPT 2 BITS)
(QUOTE :INITIAL-ELEMENT)
0)))
(bind HIGHBITS for ITEM in GCSNAPTABLE
do (if (LISTP (CAR ITEM))
then (for SUBITEM in ITEM
do (SETQ HIGHBITS (fetch (GCENTRY HIBITS) of SUBITEM))
(PASET (ADD1 (PAREF SLOTCNT HIGHBITS))
SLOTCNT HIGHBITS))
else (SETQ HIGHBITS (fetch (GCENTRY HIBITS) of ITEM))
(PASET (ADD1 (PAREF SLOTCNT HIGHBITS))
SLOTCNT HIGHBITS)))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTCNT))
collect (CONS I (PAREF SLOTCNT I])
(GCOBJECTDIST
[LAMBDA (GCSNAPTABLE) (* jop: "28-Feb-86 16:23")
(* *)
(LET* ((BITS 8)
(SLOTCNT (MAKE-ARRAY (EXPT 2 BITS)
(QUOTE :INITIAL-ELEMENT)
0)))
(bind LASTBITS INDEX CNT for ITEM in GCSNAPTABLE
do (if (LISTP (CAR ITEM))
then (SETQ INDEX (fetch (GCENTRY INDEX) of (CAR ITEM)))
(SETQ CNT (LENGTH ITEM))
else (SETQ INDEX (fetch (GCENTRY INDEX) of ITEM))
(SETQ CNT 1))
(SETQ LASTBITS (LOGAND INDEX 255))
(PASET (PLUS (PAREF SLOTCNT LASTBITS)
CNT)
SLOTCNT LASTBITS))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTCNT))
collect (CONS I (PAREF SLOTCNT I])
(GCSLOTDIST
[LAMBDA (LIMIT) (* jop: "27-Feb-86 22:22")
(* *)
(if (NULL LIMIT)
then (SETQ LIMIT 1))
(LET* [(GC.TABLESIZE 32768)
(SLOTCNT (MAKE-ARRAY GC.TABLESIZE (QUOTE :ELEMENT-TYPE)
(QUOTE (UNSIGNED-BYTE 8]
(bind ENTRY CNT for I from 0 to (SUB1 GC.TABLESIZE)
do (SETQ ENTRY (\ADDBASE \HTMAIN I))
(SETQ CNT (if (fetch (GC EMPTY) of ENTRY)
then 0
elseif (fetch (GC LINKP) of ENTRY)
then (bind (CHAINLENGTH ← 0)
(NEXTLINK ←(fetch (GC LINKPTR) of ENTRY))
LINK repeatuntil (EQ 0 NEXTLINK)
do (SETQ LINK (\ADDBASE \HTCOLL NEXTLINK))
(SETQ CHAINLENGTH (ADD1 CHAINLENGTH))
(SETQ NEXTLINK (fetch (GC NXTPTR) of LINK))
finally (RETURN (IMIN 256 CHAINLENGTH)))
else 1))
(8ASET CNT SLOTCNT I))
(for I from 0 to (SUB1 GC.TABLESIZE) when (IGEQ (8AREF SLOTCNT I)
LIMIT)
collect (CONS I (8AREF SLOTCNT I])
(GCSNAPTABLE
[LAMBDA NIL (* jop: "28-Feb-86 16:15")
(* *)
(LET* ((GC.TABLESIZE 32768))
(bind ENTRY CNT for I from 0 to (SUB1 GC.TABLESIZE) eachtime (SETQ ENTRY
(\ADDBASE
\HTMAIN I))
when (NOT (fetch (GC EMPTY) of ENTRY))
collect (if (fetch (GC LINKP) of ENTRY)
then (bind (NEXTLINK ←(fetch (GC LINKPTR) of ENTRY))
LINK repeatuntil (EQ 0 NEXTLINK)
collect (SETQ LINK (\ADDBASE \HTCOLL NEXTLINK))
(SETQ NEXTLINK (fetch (GC NXTPTR) of LINK))
(create GCENTRY
INDEX ← I
HIBITS ←(fetch (GC HIBITS) of LINK)))
else (create GCENTRY
INDEX ← I
HIBITS ←(fetch (GC HIBITS) of ENTRY])
(GCTABLE.GETSTATS
[LAMBDA (GCTABLE) (* jop: "28-Feb-86 18:05")
(* *)
(PROG ((GCTABLESIZE 32768)
(TOTALENTRIES 0)
(TOTALCOLLISIONS 0)
(SLOTCNT (MAKE-ARRAY 6 (QUOTE :INITIAL-ELEMENT)
0)))
(bind ITEMLENGTH for ITEM in GCTABLE
do (if (LISTP (CAR ITEM))
then (SETQ ITEMLENGTH (LENGTH ITEM))
(SETQ TOTALENTRIES (PLUS TOTALENTRIES ITEMLENGTH))
(SETQ TOTALCOLLISIONS (PLUS TOTALCOLLISIONS ITEMLENGTH))
(PASET (ADD1 (PAREF SLOTCNT (IMIN 5 ITEMLENGTH)))
SLOTCNT
(IMIN 5 ITEMLENGTH))
else (SETQ TOTALENTRIES (ADD1 TOTALENTRIES))
(PASET (ADD1 (PAREF SLOTCNT 1))
SLOTCNT 1)))
(PASET (DIFFERENCE GCTABLESIZE (for I from 1 to 5 sum (PAREF SLOTCNT I)))
SLOTCNT 0)
(RETURN (LIST (QUOTE TOTAL.ENTRIES)
TOTALENTRIES
(QUOTE TOTAL.COLLISIONS)
TOTALCOLLISIONS
(QUOTE SLOTLENGTHS)
(for J from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTCNT))
collect (PAREF SLOTCNT J])
(INSTRUMENTED\HTFIND
[LAMBDA (PTR CASE) (* jop: "10-Feb-86 17:18")
(DECLARE (GLOBALVARS \GC.CHAINLENGTHS \GC.LINKCASE \GC.NEWCOLLCASE \GC.BIGREFCASE
\GC.NOCOLLCASE \GC.DELLINKCASE \GC.FLATTEDCHAINCASE \GC.NOCOLLBIGREFCASE
\GC.NEWLINKCASE)) (* Use index zero to store total punts)
(PASET (IMIN MAX.SMALLP (ADD1 (PAREF \GC.CHAINLENGTHS 0)))
\GC.CHAINLENGTHS 0)
(PROG ((PROBE PTR)
ENTRY) (* Get the main hash table entry)
(SETQ ENTRY (\ADDBASE \HTMAIN (LRSH (\LOLOC PROBE)
1)))
(if (fetch (GC LINKP) of ENTRY)
then (* Entry is a chain)
(SETQ \GC.LINKCASE (IMIN MAX.SMALLP (ADD1 \GC.LINKCASE)))
[LET ((MAXINDEX (SUB1 (ARRAY-TOTAL-SIZE \GC.CHAINLENGTHS)))
(CHAINLENGTH 0)
REFCNT) (* Chase down the chain)
(bind (NEXTOFFSET ←(fetch (GC LINKPTR) of ENTRY))
(TESTBITS ←(\HILOC PROBE))
LINK repeatuntil (EQ 0 NEXTOFFSET)
do (SETQ LINK (\ADDBASE \HTCOLL NEXTOFFSET))
(SETQ CHAINLENGTH (ADD1 CHAINLENGTH))
(if (EQ (fetch (GC HIBITS) of LINK)
TESTBITS)
then (SETQ REFCNT (fetch (GC CNT) of LINK)))
(SETQ NEXTOFFSET (fetch (GC NXTPTR) of LINK)))
(* Increment the chainlength counter)
(PASET [IMIN MAX.SMALLP (ADD1 (PAREF \GC.CHAINLENGTHS
(IMIN CHAINLENGTH MAXINDEX]
\GC.CHAINLENGTHS
(IMIN CHAINLENGTH MAXINDEX))
(* if entry not on chain)
(if (NULL REFCNT)
then (SETQ \GC.NEWLINKCASE (IMIN MAX.SMALLP (ADD1
\GC.NEWLINKCASE)))
(SETQ REFCNT (SELECTC CASE
(\ADDREFCASE 2)
(\SCANREFCASE 1)
0)))
[if [OR (EQ REFCNT \MAXHTCNT)
(AND (EQ CASE \ADDREFCASE)
(EQ REFCNT (SUB1 \MAXHTCNT]
then (* Big ref case)
(SETQ \GC.BIGREFCASE (IMIN MAX.SMALLP (ADD1
\GC.BIGREFCASE]
(* Check for del link)
(if (OR (AND (EQ REFCNT 2)
(EQ CASE \DELREFCASE))
(AND (EQ REFCNT 0)
(EQ CASE \ADDREFCASE)))
then (SETQ \GC.DELLINKCASE (IMIN MAX.SMALLP (ADD1
\GC.DELLINKCASE)))
(if (EQ CHAINLENGTH 2)
then (SETQ \GC.FLATTEDCHAINCASE (IMIN MAX.SMALLP
(ADD1
\GC.FLATTEDCHAINCASE]
elseif (EQ (fetch (GC HIBITS) of ENTRY)
(\HILOC PROBE))
then (SETQ \GC.NOCOLLCASE (IMIN MAX.SMALLP (ADD1 \GC.NOCOLLCASE)))
(* Should only punt if big ref count)
[if [OR (EQ (fetch (GC CNT) of ENTRY)
\MAXHTCNT)
(AND (EQ CASE \ADDREFCASE)
(EQ (fetch (GC CNT) of ENTRY)
(SUB1 \MAXHTCNT]
then (SETQ \GC.BIGREFCASE (IMIN MAX.SMALLP (ADD1 \GC.BIGREFCASE)))
(SETQ \GC.NOCOLLBIGREFCASE (IMIN MAX.SMALLP (ADD1
\GC.NOCOLLBIGREFCASE]
(* chain of length one)
(PASET (IMIN MAX.SMALLP (ADD1 (PAREF \GC.CHAINLENGTHS 1)))
\GC.CHAINLENGTHS 1)
elseif (NOT (fetch (GC EMPTY) of ENTRY))
then (* Must be a new collision)
(SETQ \GC.NEWCOLLCASE (IMIN MAX.SMALLP (ADD1 \GC.NEWCOLLCASE)))
(SETQ \GC.NEWLINKCASE (IMIN MAX.SMALLP (ADD1 \GC.NEWLINKCASE)))
(* Chain of length two)
(PASET (IMIN MAX.SMALLP (ADD1 (PAREF \GC.CHAINLENGTHS 2)))
\GC.CHAINLENGTHS 2)))
(\HTFIND.SAVE PTR CASE])
(MAKEFREQ
[LAMBDA (LST START) (* jop: "26-Feb-86 18:14")
(* *)
(if (NULL START)
then (SETQ START 0))
(for CNT in LST as I from START collect (CONS I CNT])
(PLUSHASH0
[LAMBDA (INDEX HIGHBYTE) (* jop: " 3-Mar-86 20:42")
(LOGAND (PLUS HIGHBYTE INDEX)
32767])
(PLUSHASH1
[LAMBDA (INDEX HIGHBYTE) (* jop: " 3-Mar-86 20:51")
(LOGAND (PLUS (LSH HIGHBYTE 1)
INDEX)
32767])
(PLUSHASHR1
[LAMBDA (INDEX HIGHBYTE) (* jop: " 3-Mar-86 20:56")
(LOGAND (PLUS (RSH HIGHBYTE 1)
INDEX)
32767])
(RANDDIST
[LAMBDA (N) (* jop: "28-Feb-86 16:40")
(* *)
(LET* ((BITS 8)
(SLOTCNT (MAKE-ARRAY (EXPT 2 BITS)
(QUOTE :INITIAL-ELEMENT)
0)))
(bind LASTBITS for I from 1 to N
do (SETQ LASTBITS (RAND 0 255))
(PASET (ADD1 (PAREF SLOTCNT LASTBITS))
SLOTCNT LASTBITS))
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTCNT))
collect (CONS I (PAREF SLOTCNT I])
(REHASHGCTABLE
[LAMBDA (GCTABLE REHASHFN) (* jop: "28-Feb-86 18:34")
(* *)
(LET* ((GC.TABLESIZE 32768)
(SLOTS (MAKE-ARRAY GC.TABLESIZE)))
[bind INDEX HIGHBITS NEWINDEX for ITEM in GCTABLE
do (if (LISTP (CAR ITEM))
then (for SUBITEM in ITEM
do (SETQ INDEX (fetch (GCENTRY INDEX) of SUBITEM))
(SETQ HIGHBITS (fetch (GCENTRY HIBITS) of SUBITEM))
(SETQ NEWINDEX (APPLY* REHASHFN INDEX HIGHBITS))
(LET* ((ENTRY (PAREF SLOTS NEWINDEX))
(NEWVALUE (create GCENTRY
INDEX ← NEWINDEX
HIBITS ←(fetch (GCENTRY HIBITS)
of SUBITEM)))
(NEWENTRY (if ENTRY
then (if (LISTP (CAR ENTRY))
then (NCONC1 ENTRY NEWVALUE)
else (LIST ENTRY NEWVALUE))
else NEWVALUE)))
(PASET NEWENTRY SLOTS NEWINDEX)))
else (SETQ INDEX (fetch (GCENTRY INDEX) of ITEM))
(SETQ HIGHBITS (fetch (GCENTRY HIBITS) of ITEM))
(SETQ NEWINDEX (APPLY* REHASHFN INDEX HIGHBITS))
(LET* ((ENTRY (PAREF SLOTS NEWINDEX))
(NEWVALUE (create GCENTRY
INDEX ← NEWINDEX
HIBITS ←(fetch (GCENTRY HIBITS) of ITEM)))
(NEWENTRY (if ENTRY
then (if (LISTP (CAR ENTRY))
then (NCONC1 ENTRY NEWVALUE)
else (LIST ENTRY NEWVALUE))
else NEWVALUE)))
(PASET NEWENTRY SLOTS NEWINDEX]
(for I from 0 to (SUB1 (ARRAY-TOTAL-SIZE SLOTS)) when (PAREF SLOTS I)
collect (PAREF SLOTS I])
(RESTORE\HTFIND
[LAMBDA NIL (* jop: " 5-Feb-86 18:01")
(MOVD (QUOTE \HTFIND.SAVE)
(QUOTE \HTFIND])
(START.MONITOR.GC
[LAMBDA (MAXSECONDS) (* jop: " 3-Mar-86 14:12")
(* *)
(DECLARE (GLOBALVARS \GC.MONITOR.PROCESS))
(if (NULL MAXSECONDS)
then (SETQ MAXSECONDS 10))
(SETQ \GC.MONITOR.PROCESS (ADD.PROCESS (LIST (FUNCTION GC.MONITOR)
MAXSECONDS])
(START.SAMPLE\HTFIND
[LAMBDA NIL (* jop: " 7-Feb-86 16:44")
(CLEAR.GCCASES)
(ARM\HTFIND (FUNCTION INSTRUMENTED\HTFIND])
(XORHASH
[LAMBDA (INDEX HIGHBITS) (* jop: "28-Feb-86 18:36")
(LOGXOR INDEX HIGHBITS])
(\HTFIND.PUNT.STATS
[LAMBDA (PROPLST) (* jop: "10-Feb-86 15:43")
(* *)
(PROG ((TOTAL.PUNTS (LISTGET PROPLST (QUOTE TOTAL.PUNTS)))
(CHAIN.LENGTHS.FROM.ONE (LISTGET PROPLST (QUOTE CHAIN.LENGTHS.FROM.ONE)))
(LINK.CASES (LISTGET PROPLST (QUOTE LINK.CASES)))
(NEW.COLLISION.CASES (LISTGET PROPLST (QUOTE NEW.COLLISION.CASES)))
(BIG.REF.COUNT.CASES (LISTGET PROPLST (QUOTE BIG.REF.COUNT.CASES)))
(NO.COLLISION.CASES (LISTGET PROPLST (QUOTE NO.COLLISION.CASES)))
(NO.COLL.BIG.REF.CASES (LISTGET PROPLST (QUOTE NO.COLL.BIG.REF.CASES)))
(DEL.LINK.CASES (LISTGET PROPLST (QUOTE DEL.LINK.CASES)))
(FLATTEN.CHAIN.CASES (LISTGET PROPLST (QUOTE FLATTEN.CHAIN.CASES)))
(NEW.LINK.CASES (LISTGET PROPLST (QUOTE NEW.LINK.CASES)))
LINK.BIG.REF.CASES END.OF.CHAIN.NEW.LINKS)
(SETQ LINK.BIG.REF.CASES (DIFFERENCE BIG.REF.COUNT.CASES NO.COLL.BIG.REF.CASES))
(SETQ END.OF.CHAIN.NEW.LINKS (DIFFERENCE NEW.LINK.CASES NEW.COLLISION.CASES))
(PRINTOUT T "Total punts:" , TOTAL.PUNTS T)
(PRINTOUT T "Link cases:" , LINK.CASES ,, "New collisions:" , NEW.COLLISION.CASES ,,
"Non-link Big ref cases:"
, NO.COLLISION.CASES T T)
(PRINTOUT T "%% Link cases:" ,, (TIMES 100 (FQUOTIENT LINK.CASES TOTAL.PUNTS))
T)
(PRINTOUT T "%% New collisions:" ,, (TIMES 100 (FQUOTIENT NEW.COLLISION.CASES
TOTAL.PUNTS))
T)
(PRINTOUT T "%% Non-link big ref:" ,, (TIMES 100 (FQUOTIENT NO.COLLISION.CASES
TOTAL.PUNTS))
T T)
(PRINTOUT T "Distribution of chainlengths (with new collisions counted as 2):" T)
(PRINTOUT T "Main slot" 12 "Link 2" 20 "Link 3" 28 "Link 4" 36 "Link 5+")
(for L in CHAIN.LENGTHS.FROM.ONE as TAB in (QUOTE (0 12 20 28 36))
do (PRINTOUT T .TAB TAB L) finally (PRINTOUT T T T))
(PRINTOUT T "%% Link 2:" ,, (TIMES 100 (FQUOTIENT (CADR CHAIN.LENGTHS.FROM.ONE)
TOTAL.PUNTS))
T T)
(PRINTOUT T "Total Big ref counts:" , BIG.REF.COUNT.CASES ,, "Non-link Big ref cases:" ,
NO.COLL.BIG.REF.CASES ,, "Link Big ref cases:" , LINK.BIG.REF.CASES T T)
(PRINTOUT T "%% Big ref out of total punts:" ,, (TIMES 100 (FQUOTIENT
BIG.REF.COUNT.CASES
TOTAL.PUNTS))
T T)
(PRINTOUT T "Link cases:" , LINK.CASES ,, "End-of-chain new links" ,
END.OF.CHAIN.NEW.LINKS T)
(PRINTOUT T "Delete link cases:" , DEL.LINK.CASES ,, "Flatten chain cases" ,
FLATTEN.CHAIN.CASES T T)
(PRINTOUT T "%% end-of-chain new link cases out of link cases" ,,
(TIMES 100 (FQUOTIENT END.OF.CHAIN.NEW.LINKS LINK.CASES))
T)
(PRINTOUT T "%% Del link out of link cases" ,, (TIMES 100 (FQUOTIENT DEL.LINK.CASES
LINK.CASES))
T)
(PRINTOUT T "%% Flatten chain cases out of del link" ,,
(TIMES 100 (FQUOTIENT FLATTEN.CHAIN.CASES (if (EQP DEL.LINK.CASES 0)
then 1
else DEL.LINK.CASES)))
T])
)
(LOAD? (QUOTE GCHAX.DCOM))
(LOAD? (QUOTE {QV}<PEDERSEN>BENCHMARKS>DERIV.DCOM))
(CLEAR.GCCASES)
[DECLARE: EVAL@COMPILE
(RECORD GCENTRY (INDEX . HIBITS))
]
(PUTPROPS GCCOUNT COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1239 31500 (ARM\HTFIND 1249 . 1540) (CLEAR.GCCASES 1542 . 2427) (CNTCOLL 2429 . 2857) (
CNTDERIV 2859 . 3724) (CNTREF 3726 . 4204) (COMPILE.EXPRS 4206 . 4526) (DUMP.GCCASES 4528 . 5574) (
END.MONITOR.GC 5576 . 5864) (END.SAMPLE\HTFIND 5866 . 6029) (FULLXORHASH 6031 . 6284) (
GC.HASHTABLE.STATS 6286 . 8302) (GC.MONITOR 8304 . 8646) (GC.MONITOR.SCRIPT 8648 . 10650) (GCCOUNT
10652 . 12620) (GCCOUNTENTRIES 12622 . 13847) (GCHIGHBYTEDIST 13849 . 14730) (GCHIGHTBITDIST 14732 .
15572) (GCOBJECTDIST 15574 . 16417) (GCSLOTDIST 16419 . 17614) (GCSNAPTABLE 17616 . 18539) (
GCTABLE.GETSTATS 18541 . 19789) (INSTRUMENTED\HTFIND 19791 . 24181) (MAKEFREQ 24183 . 24452) (
PLUSHASH0 24454 . 24617) (PLUSHASH1 24619 . 24802) (PLUSHASHR1 24804 . 24988) (RANDDIST 24990 . 25540)
(REHASHGCTABLE 25542 . 27333) (RESTORE\HTFIND 27335 . 27511) (START.MONITOR.GC 27513 . 27887) (
START.SAMPLE\HTFIND 27889 . 28085) (XORHASH 28087 . 28224) (\HTFIND.PUNT.STATS 28226 . 31498)))))
STOP