(FILECREATED "15-Jan-85 22:00:28" {ERIS}<LISPCORE>LIBRARY>SNOOPY.;67 52526
changes to: (FNS \SAS.INCREMENT.STATS)
previous date: " 4-Jan-85 23:45:06" {ERIS}<LISPCORE>LIBRARY>SNOOPY.;66)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SNOOPYCOMS)
(RPAQQ SNOOPYCOMS ((COMS (* "A lot is used from ABC environment")
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(P (OR (AND (GETP (QUOTE EXPORTS.ALL)
(QUOTE FILE))
(OR (INTERSECTION FILELST (QUOTE (SYSEDIT ABC)))))
(HELP (QUOTE ABC)))))
(* "Some items culled from LLARRAYELT")
(DECLARE: EVAL@COMPILE DONTCOPY (GLOBALVARS \ArraryFrLst))
(* "More items culled from LLFAULT")
(DECLARE: EVAL@COMPILE DONTCOPY (PROP DOPVAL TIMES3)
(RECORDS VMEMFLAGS RPT)
(CONSTANTS \VMAP.DIRTY \VMAP.CLEAN \VMAP.REF \VMAP.VACANT
\VMAP.FLAGS)
(CONSTANTS \RPT.EMPTY \RPT.UNAVAILABLE \PAGETABLESTOPFLG
\RPTENTRYLENGTH)
(CONSTANTS \MAXVMPAGE \MAXVMSEGMENT)
(GLOBALVARS \REALPAGETABLE \RPTSIZE)))
(INITVARS (SNOOPY.ARRAYBLOCKSIZES (QUOTE (1 2 3 4 5 6 7 8 9 10 12 14 16 20 24 28 32 40 48 64
84 128 256 512 1024 2048 4096 8192 16384 NIL)))
(SNOOPY.CODEBLOCKSIZES (QUOTE (12 16 20 24 28 32 36 42 50 64 128 256 512 1024 2048
NIL)))
(SNOOPY.PTRBLOCKSIZES (QUOTE (4 5 6 7 8 10 12 16 24 32 42 64 128 256 512 1024 2048
4096 8192 16384 NIL)))
(SNOOPY.STKMINSIZES (QUOTE (20 24 28 32 36 40 44 48 52 NIL)))
(SNOOPY.INITONPAGESIZES (QUOTE (8 10 12 14 16 20 24 28 32 36 40 48 56 64 72 80 90
100 120 NIL)))
(SNOOPY.CODEREMNANTS)
(SNOOPY.DEFAULT.OUTFILE (QUOTE <LISPSTATS>USERDATE.HISTOGRAPHS))
(MAX.CELLSPERHUNK 64))
(GLOBALVARS SNOOPY.ARRAYBLOCKSIZES SNOOPY.CODEBLOCKSIZES SNOOPY.PTRBLOCKSIZES
SNOOPY.STKMINSIZES SNOOPY.INITONPAGESIZES SNOOPY.CODEREMNANTS
SNOOPY.DEFAULT.OUTFILE MAX.CELLSPERHUNK)
(FNS SHOW.HISTOGRAPHS SHOW.ALL.HISTOGRAPHS \SAS.SHOWINIT \SAS.STORAGE)
(COMS (* "Snooping on real memory usage")
(FNS SHOW.REALMEMORY.HISTOGRAPHS \SAS.CHECKMEMSTATSARRAY \SAS.GATHER.REALMEMSTATS
\SAS.PRINT.REALMEMSTATS)
(INITVARS (\MEMUSAGE.STATS))
(GLOBALVARS \MEMUSAGE.STATS))
(COMS (* "Showing data about ARRAYBLOCK sizes")
(FNS SHOW.ARRAYBLOCK.HISTOGRAPHS \SAS.CODEBLOCKSTATS \SAS.INDEXINLIST
\SAS.INCREMENT.STATS \SAS.HUNKABLE.SIZE \SAS.CALCFRAGCOEFF)
(INITVARS (USEDBLOCKS.FREQ)
(USEDBLOCKS.CONSUMPTION)
(USEDHUNKS.CONSUMPTION)
(FREEBLOCKS.FREQ)
(FREEBLOCKS.CONSUMPTION)
(CODEBLOCKS.FREQ)
(CODEBLOCKS.CONSUMPTION)
(CODEHUNKS.CONSUMPTION)
(PTRBLOCKS.FREQ)
(PTRBLOCKS.CONSUMPTION)
(PTRHUNKS.CONSUMPTION)
(STKMINS.FREQ)
(INITONPAGE.FREQ)
(INITONPAGE.PERCENT)
(STRADDLERMISSES.FREQ)
(AUSE.TIMER (SETUPTIMER 0 NIL (QUOTE TICKS))))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CODEARRAYBLOCK))
(GLOBALVARS USEDBLOCKS.FREQ USEDHUNKS.CONSUMPTION FREEBLOCKS.FREQ
FREEBLOCKS.CONSUMPTION USEDBLOCKS.CONSUMPTION CODEBLOCKS.FREQ
CODEBLOCKS.CONSUMPTION CODEHUNKS.CONSUMPTION PTRBLOCKS.FREQ
PTRBLOCKS.CONSUMPTION PTRHUNKS.CONSUMPTION STKMINS.FREQ INITONPAGE.FREQ
INITONPAGE.PERCENT STRADDLERMISSES.FREQ AUSE.TIMER)
(FNS \SAS.INITIALIZE.STATSARRAYS \SAS.INITIALIZE.PNAMEARRAYS \SAS.INITIALIZEARRAY
\SAS.INITIALIZE.CHECKSIZESLST \SAS.NULLORFIXP))
(COMS (* "Snooping on LITATOM and STRINGP statistics")
(INITVARS (PNAMEHUNKS.CONSUMPTION))
(GLOBALVARS PNAMEHUNKS.CONSUMPTION)
(FNS SHOW.LITATOM.HISTOGRAPHS \SAS.COLLECTLITATOMSTATS \SAS.PRINTLITATOMCELLS
\SAS.PRINTLITATOMPNAMES SHOW.STRINGP.HISTOGRAPHS \SAS.INITIALIZE.PNAMESTATS)
(GLOBALVARS PNAME.FREQ PNAME.CONSUMPTION VCELLS.FREQ VCELLS.CONSUMPTION))
(FILES (SYSLOAD COMPILED FROM LISPUSERS)
CMLARRAY GCHAX)
(DECLARE: DONTEVAL@COMPILE DONTEVAL@LOAD DOCOPY (P (\SAS.INITIALIZE.STATSARRAYS)))
(COMS (DECLARE: EVAL@COMPILE DONTCOPY (MACROS FORMFEED))
(* "Related to format of statistics printout")
(FNS \SAS.PRINTSECTIONHEADER \SAS.STATSOUT)
(INITVARS (\SAS.LINEDIVIDER
"------------------------------------------------------------------")
(\SAS.1-Aug-84% 00:00 490160752))
(* "Random date offset, to make default unique file names shorter")
(GLOBALVARS \SAS.LINEDIVIDER \SAS.1-Aug-84% 00:00))
(LOCALVARS . T)))
(* "A lot is used from ABC environment")
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(OR (AND (GETP (QUOTE EXPORTS.ALL)
(QUOTE FILE))
(OR (INTERSECTION FILELST (QUOTE (SYSEDIT ABC)))))
(HELP (QUOTE ABC)))
)
(* "Some items culled from LLARRAYELT")
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \ArraryFrLst)
)
)
(* "More items culled from LLFAULT")
(DECLARE: EVAL@COMPILE DONTCOPY
(PUTPROPS TIMES3 DOPVAL
(1 COPY LLSH1 IPLUS2))
[DECLARE: EVAL@COMPILE
(ACCESSFNS VMEMFLAGS ((VACANT (EQ (LOGAND DATUM \VMAP.VACANT)
\VMAP.VACANT))
(DIRTY (NEQ (LOGAND DATUM \VMAP.DIRTY)
0))
(REFERENCED (NEQ (LOGAND DATUM \VMAP.REF)
0))))
(BLOCKRECORD RPT ((NEXTRP WORD) (* rp of next entry in page chain)
(VP WORD) (* Virtual page number occupying this real page)
(LOCKED FLAG)
(FILEPAGE BITS 15) (* Page in Lisp.VirtualMem)
)
(BLOCKRECORD RPT ((NIL WORD)
(UNOCCUPIEDVPBITS BITS 2)
(VPONLY BITS 14)
(FILEPAGE&LOCK WORD)))
(ACCESSFNS RPT ((RPTRBASE (\ADDBASE \REALPAGETABLE (TIMES3 DATUM)))
(EMPTY (EQ (fetch (RPT VP) of DATUM)
\RPT.EMPTY)
(COND
(NEWVALUE (replace (RPT VP) of DATUM with \RPT.EMPTY))
(T (ERROR "Invalid replace of RPT.EMPTY" DATUM))))
(UNAVAILABLE (EQ (fetch (RPT VP) of DATUM)
\RPT.UNAVAILABLE)
(COND
(NEWVALUE (replace (RPT VP) of DATUM with
\RPT.UNAVAILABLE))
(T (ERROR "Invalid replace of RPT.UNAVAILABLE" DATUM))))
(OCCUPIED (ZEROP (fetch (RPT UNOCCUPIEDVPBITS) of DATUM)))))
(* Given a RP, RPTRBASE produces a pointer to its entry
in the real page table)
)
]
(DECLARE: EVAL@COMPILE
(RPAQQ \VMAP.DIRTY 4096)
(RPAQQ \VMAP.CLEAN 0)
(RPAQQ \VMAP.REF 32768)
(RPAQQ \VMAP.VACANT 12288)
(RPAQQ \VMAP.FLAGS 61440)
(CONSTANTS \VMAP.DIRTY \VMAP.CLEAN \VMAP.REF \VMAP.VACANT \VMAP.FLAGS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \RPT.EMPTY 16384)
(RPAQQ \RPT.UNAVAILABLE 16640)
(RPAQQ \PAGETABLESTOPFLG 0)
(RPAQQ \RPTENTRYLENGTH 3)
(CONSTANTS \RPT.EMPTY \RPT.UNAVAILABLE \PAGETABLESTOPFLG \RPTENTRYLENGTH)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \MAXVMPAGE 16383)
(RPAQQ \MAXVMSEGMENT 63)
(CONSTANTS \MAXVMPAGE \MAXVMSEGMENT)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \REALPAGETABLE \RPTSIZE)
)
)
(RPAQ? SNOOPY.ARRAYBLOCKSIZES (QUOTE (1 2 3 4 5 6 7 8 9 10 12 14 16 20 24 28 32 40 48 64 84 128 256
512 1024 2048 4096 8192 16384 NIL)))
(RPAQ? SNOOPY.CODEBLOCKSIZES (QUOTE (12 16 20 24 28 32 36 42 50 64 128 256 512 1024 2048 NIL)))
(RPAQ? SNOOPY.PTRBLOCKSIZES (QUOTE (4 5 6 7 8 10 12 16 24 32 42 64 128 256 512 1024 2048 4096 8192
16384 NIL)))
(RPAQ? SNOOPY.STKMINSIZES (QUOTE (20 24 28 32 36 40 44 48 52 NIL)))
(RPAQ? SNOOPY.INITONPAGESIZES (QUOTE (8 10 12 14 16 20 24 28 32 36 40 48 56 64 72 80 90 100 120 NIL)))
(RPAQ? SNOOPY.CODEREMNANTS )
(RPAQ? SNOOPY.DEFAULT.OUTFILE (QUOTE <LISPSTATS>USERDATE.HISTOGRAPHS))
(RPAQ? MAX.CELLSPERHUNK 64)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SNOOPY.ARRAYBLOCKSIZES SNOOPY.CODEBLOCKSIZES SNOOPY.PTRBLOCKSIZES SNOOPY.STKMINSIZES
SNOOPY.INITONPAGESIZES SNOOPY.CODEREMNANTS SNOOPY.DEFAULT.OUTFILE MAX.CELLSPERHUNK)
)
(DEFINEQ
(SHOW.HISTOGRAPHS
(LAMBDA (FILE TITLE) (* JonL "20-Nov-84 23:11")
(DECLARE (SPECVARS FILE))
(RESETLST (\SAS.SHOWINIT)
(\SAS.PRINTLITATOMCELLS FILE T)
(\SAS.CALCFRAGCOEFF FILE)
(FORMFEED FILE)
(\SAS.STORAGE FILE 100))))
(SHOW.ALL.HISTOGRAPHS
(LAMBDA (FILE TITLE) (* JonL " 4-Jan-85 23:36")
(DECLARE (SPECVARS FILE TITLE))
(RESETLST (\SAS.SHOWINIT)
(\SAS.COLLECTLITATOMSTATS)
(\SAS.PRINTLITATOMCELLS FILE)
(FORMFEED FILE)
(\SAS.PRINTLITATOMPNAMES FILE)
(SHOW.STRINGP.HISTOGRAPHS FILE)
(FORMFEED FILE)
(SHOW.ARRAYBLOCK.HISTOGRAPHS FILE)
(FORMFEED FILE)
(\SAS.STORAGE FILE))))
(\SAS.SHOWINIT
(LAMBDA NIL (* JonL " 4-Jan-85 23:36")
(* * Before doing anything else, capture the "pages-in-core" statistics, and then print them out after setup.
Sets the freevar FILE, and also puts out minimal GC statistics.)
(DECLARE (USEDFREE FILE TITLE))
(PROG ((REALMEMSTATS (\SAS.GATHER.REALMEMSTATS)))
(RESETSAVE (RADIX 10))
(RESETSAVE (SETQ FILE
(OPENFILE
(PACKFILENAME (QUOTE BODY)
FILE
(QUOTE NAME)
(PACK* (SUBSTRING
USERNAME 1
(PROG NIL
(RETURN (SUB1 (OR (FIXP (STRPOS "." USERNAME))
(RETURN))))))
(IDIFFERENCE (IDATE)
\SAS.1-Aug-84% 00:00))
(QUOTE BODY)
SNOOPY.DEFAULT.OUTFILE)
(QUOTE OUTPUT)))
(QUOTE (PROGN (CLOSEF? OLDVALUE)
(AND (INFILEP OLDVALUE)
RESETSTATE
(DELFILE OLDVALUE)))))
(if TITLE
then (\SAS.PRINTSECTIONHEADER TITLE FILE)
(printout FILE T T))
(RADIX 8)
(printout FILE T "**** SNOOPY statistics for user " USERNAME ", on " (GDATE)
.TAB 20 "Machine: " .TAB 40 (OR (ETHERHOSTNAME)
(AND (type? NSADDRESS \MY.NSADDRESS)
(\PRINTNSADDRESS \MY.NSADDRESS FILE))
(ETHERHOSTNUMBER))
" ("
(L-CASE (MACHINETYPE)
T)
")" .TAB 20 "Microcode Version: " .TAB 40 (QUOTE %[)
(LOADBYTE (MICROCODEVERSION)
8 8)
", "
(LOADBYTE (MICROCODEVERSION)
0 8)
(QUOTE %])
.TAB 20 "Memory Size: " .TAB 40 (REALMEMORYSIZE)
(QUOTE Q)
.TAB 20 "Lisp System Date: " .TAB 40 MAKESYSDATE -2 (QUOTE %()
(OR (AND (BOUNDP (QUOTE MAKESYSNAME))
MAKESYSNAME)
"No MAKESYSNAME")
(QUOTE %))
.TAB 20 "LLARRAYELT date:" .TAB 40 (CAAR (GETP (QUOTE LLARRAYELT)
(QUOTE FILEDATES)))
T T T)
(RADIX 10)
(TERPRI FILE)
(\SAS.PRINT.REALMEMSTATS FILE REALMEMSTATS)
(PROG ((COLLS (PROGN (FRPTQ 20 (RECLAIM))
(\#COLLISIONS))))
(\SAS.PRINTSECTIONHEADER "GC Hash Table: Number of Entries and Collisions" FILE)
(printout FILE T "Number of entries: " .TAB 24 .I5 (CAR COLLS)
", " .F5.1 (TIMES 100.0 (CADDR COLLS))
"%% in collision chains." T T)))))
(\SAS.STORAGE
(LAMBDA (FILE PAGETHRESHOLD) (* JonL "20-Nov-84 23:11")
(RESETLST (RESETSAVE STORAGE.ARRAYSIZES SNOOPY.ARRAYBLOCKSIZES)
(RESETSAVE (OUTPUT FILE))
(\SAS.PRINTSECTIONHEADER "Printout by STORAGE Function")
(TERPRI)
(TERPRI)
(STORAGE NIL PAGETHRESHOLD)
(TERPRI))))
)
(* "Snooping on real memory usage")
(DEFINEQ
(SHOW.REALMEMORY.HISTOGRAPHS
(LAMBDA (FILE TYPES) (* JonL "15-Sep-84 16:36")
(\SAS.PRINT.REALMEMSTATS FILE (\SAS.GATHER.REALMEMSTATS TYPES))))
(\SAS.CHECKMEMSTATSARRAY
(LAMBDA NIL (* JonL "15-Sep-84 16:54")
(if (AND (type? CMLARRAY \MEMUSAGE.STATS)
(EQUAL (QUOTE (MOD 65536))
(ARRAYELEMENTTYPE \MEMUSAGE.STATS))
(EQ 2 (ARRAYRANK \MEMUSAGE.STATS))
(EQ 5 (ARRAYDIMENSION \MEMUSAGE.STATS 1))
(ILEQ 20 (ARRAYDIMENSION \MEMUSAGE.STATS 0)))
then (* Lookin' good!)
else (SETQ \MEMUSAGE.STATS (MAKEARRAY (QUOTE (20 5))
(QUOTE ELEMENTTYPE)
(QUOTE (MOD 65536)))))
T))
(\SAS.GATHER.REALMEMSTATS
(LAMBDA (TYPES) (* JonL "18-Sep-84 04:57")
(\SAS.CHECKMEMSTATSARRAY) (* The array should have been set up before now, but
just in case ...)
(OR (LISTP TYPES)
(SETQ TYPES (QUOTE (LISTP))))
(PROG ((NTYPES (LENGTH TYPES))
(ROW.INDEX 0)
(RP 0)
(#LOCKEDPAGES 0)
(#AVAILABLEPAGES 0)
(HTMAINHI (\HILOC \HTMAIN))
(HTCOLHI (\HILOC \HTCOLL))
(DISPHI (\HILOC \DISPLAYREGION))
(TTHI (\HILOC \MDSTypeTable))
(PMAPHI (\HILOC \PageMapTBL))
(SPMAPHI (\HILOC \PAGEMAP))
TN.TO.ROWINDEX COL.INDEX OTHERDATATYPESROW LITATOMROW STACKROW GCHASH&TYPE.ROW PMAPROW
SCREENBITMAPROW UNRECOGNIZEDTYPEROW)
(* Column indices on this array are -- 0 is the datatype typenumber, 1 is the number of "present-but-unreferenced"
pages for this type, 2 is the number of "read-referenced-only" pages, 3 is the number of "dirty" pages, and 4 is the
number of pages with "unknown" map entries.)
(* Row indices are: 0'th row is for unknown datatype, n+1'th row is for ARRAYBLOCKs, 1 thru n are for the n datatype
numbers found in the TYPES list.)
(OR (ILEQ (IPLUS 5 NTYPES)
(ARRAYDIMENSION \MEMUSAGE.STATS 0))
(SETQ \MEMUSAGE.STATS (MAKEARRAY (LIST (IPLUS 10 NTYPES)
5)
(QUOTE ELEMENTTYPE)
(QUOTE (MOD 65536)))))
(FILLARRAY \MEMUSAGE.STATS 0)
(SETQ TN.TO.ROWINDEX (MAPCONC TYPES
(FUNCTION (LAMBDA (X)
(if (EQ X (QUOTE ARRAYBLOCK))
then NIL
else (PROG ((TYPENO (if (AND (FIXP X)
(IGREATERP X 0)
(ILEQ X \MaxTypeNumber))
then X
elseif
(AND (LITATOM X)
(FIXP (\TYPENUMBERFROMNAME
X)))
else (ERROR
"Not coercible into a datatype"
X))))
(add ROW.INDEX 1)
(16ASET TYPENO \MEMUSAGE.STATS ROW.INDEX 0)
(RETURN (LIST (CONS TYPENO ROW.INDEX)))))))))
(16ASET MAX.SMALLP \MEMUSAGE.STATS 0 0) (* Row zero is reserved for arrayblocks whether or not
it is used.)
(SETQ OTHERDATATYPESROW (add ROW.INDEX 1))
(SETQ LITATOMROW (add ROW.INDEX 1))
(SETQ STACKROW (add ROW.INDEX 1))
(SETQ GCHASH&TYPE.ROW (add ROW.INDEX 1))
(SETQ PMAPROW (add ROW.INDEX 1))
(SETQ SCREENBITMAPROW (add ROW.INDEX 1))
(SETQ UNRECOGNIZEDTYPEROW (add ROW.INDEX 1))
(* * Note that the above ordering must be maintained between OTHERDATATYPESROW LITATOMROW STACKROW
UNRECOGNIZEDTYPEROW)
(for RP# from 0 to (SUB1 \RPTSIZE)
bind (PNPHI ←(\HILOC \PNPSPACE))
(PLHI ←(\HILOC \PLISTSPACE))
VP# RPTADDR VMFLAGS PTR PTRHI TYPENO
do (SETQ RPTADDR (fetch (RPT RPTRBASE) of RP#))
(if (fetch (RPT LOCKED) of RPTADDR)
then (add #LOCKEDPAGES 1))
(if (fetch (RPT OCCUPIED) of RPTADDR)
then (SETQ VP# (fetch (RPT VP) of RPTADDR))
(SETQ VMFLAGS (LOGAND \VMAP.FLAGS (\READFLAGS VP#)))
(SETQ COL.INDEX (if (fetch (VMEMFLAGS VACANT) of VMFLAGS)
then (HELP "HHCTB")
elseif (BITTEST VMFLAGS \VMAP.DIRTY)
then 2
elseif (BITTEST VMFLAGS \VMAP.REF)
then 1
elseif (EQ \VMAP.CLEAN VMFLAGS)
then 3
else 4))
(SETQ TYPENO (NTYPX (SETQ PTR (create POINTER
PAGE# ← VP#))))
(SETQ ROW.INDEX (if (EQ 0 TYPENO)
then (if (type? ARRAYBLOCK PTR)
then 0
elseif (EQ \STACKHI (SETQ PTRHI (\HILOC PTR)))
then STACKROW
elseif (AND (ILEQ PNPHI PTRHI)
(ILEQ PTRHI PLHI))
then LITATOMROW
elseif (EQ PTRHI DISPHI)
then SCREENBITMAPROW
elseif (OR (EQ PTRHI HTCOLHI)
(AND (EQ PTRHI HTMAINHI)
(ILEQ (FOLDLO (\LOLOC PTR)
WORDSPERPAGE)
\HTMAINnpages))
(EQ PTR \HTOVERFLOW)
(EQ PTR \HTBIGCOUNT)
(AND (EQ PTRHI TTHI)
(IGEQ (\LOLOC PTR)
(IQUOTIENT WORDSPERSEGMENT
2))))
then GCHASH&TYPE.ROW
elseif (OR (AND (EQ PTRHI PMAPHI)
(ILESSP (\LOLOC PTR)
(IQUOTIENT
WORDSPERSEGMENT 2)))
(EQ PTRHI SPMAPHI))
then PMAPROW
else UNRECOGNIZEDTYPEROW)
elseif (CDR (ASSOC TYPENO TN.TO.ROWINDEX))
elseif (ILEQ TYPENO \MaxTypeNumber)
then OTHERDATATYPESROW
else (HELP TYPENO (QUOTE \MaxTypeNumber))
UNRECOGNIZEDTYPEROW))
(16ASET (ADD1 (16AREF \MEMUSAGE.STATS ROW.INDEX COL.INDEX))
\MEMUSAGE.STATS ROW.INDEX COL.INDEX)
elseif (NOT (fetch (RPT UNAVAILABLE) of RPTADDR))
then (add #AVAILABLEPAGES 1)))
(RETURN (LIST #LOCKEDPAGES #AVAILABLEPAGES OTHERDATATYPESROW)))))
(\SAS.PRINT.REALMEMSTATS
(LAMBDA (FILE L) (* JonL "18-Sep-84 04:57")
(* * L communicates the results from the stats gathering phase. (#LOCKEDPAGES #AVAILABLEPAGES OTHERDATATYPESROW))
(PROG (#LOCKEDPAGES #AVAILABLEPAGES OTHERDATATYPESROW UNRECOGNIZEDTYPEROW STACKROW
GCHASH&TYPE.ROW PMAPROW SCREENBITMAPROW LITATOMROW (TOTALTOTAL 0)
(TOTALUNREFERENCED 0)
(TOTALREADONLY 0)
(TOTALDIRTY 0)
(TOTALUNKNOWN 0)
TYPENAME UNREFERENCED READONLY DIRTY UNKNOWN TOTAL)
(SETQ #LOCKEDPAGES (pop L))
(SETQ #AVAILABLEPAGES (pop L))
(SETQ OTHERDATATYPESROW (pop L))
(SETQ LITATOMROW (ADD1 OTHERDATATYPESROW))
(SETQ STACKROW (ADD1 LITATOMROW))
(SETQ GCHASH&TYPE.ROW (ADD1 STACKROW))
(SETQ PMAPROW (ADD1 GCHASH&TYPE.ROW))
(SETQ SCREENBITMAPROW (ADD1 PMAPROW))
(SETQ UNRECOGNIZEDTYPEROW (ADD1 SCREENBITMAPROW))
(\SAS.PRINTSECTIONHEADER "Histographs for Real Memory Usage" FILE)
(printout FILE T "Number of locked pages = " #LOCKEDPAGES
", Number of pages available and free = "
#AVAILABLEPAGES T T
" Type Name Total# Referenced Dirty Untouched ??"
T)
(for ROW.INDEX from 0 to UNRECOGNIZEDTYPEROW
do (SETQ TYPENAME (if (EQ 0 ROW.INDEX)
then "[ArrayBlocks]"
elseif (IGEQ ROW.INDEX OTHERDATATYPESROW)
then (if (IGEQ ROW.INDEX UNRECOGNIZEDTYPEROW)
then (QUOTE "[Unrecognized]")
elseif (IGEQ ROW.INDEX SCREENBITMAPROW)
then "[ScreenBitMap]"
elseif (IGEQ ROW.INDEX PMAPROW)
then "[PageMaps]"
elseif (IGEQ ROW.INDEX GCHASH&TYPE.ROW)
then "[GCHash&TypeTables]"
elseif (IGEQ ROW.INDEX STACKROW)
then "[StackSpace]"
elseif (IGEQ ROW.INDEX LITATOMROW)
then "[LitatomCells]"
else "[otherDataTypes]")
else (\TYPENAMEFROMNUMBER (16AREF \MEMUSAGE.STATS ROW.INDEX 0))))
(if (ILESSP 16 (NCHARS TYPENAME))
then (SETQ TYPENAME (SUBSTRING TYPENAME 1 16)))
(add TOTALREADONLY (SETQ READONLY (16AREF \MEMUSAGE.STATS ROW.INDEX 2)))
(add TOTALDIRTY (SETQ DIRTY (16AREF \MEMUSAGE.STATS ROW.INDEX 3)))
(add TOTALUNREFERENCED (SETQ UNREFERENCED (16AREF \MEMUSAGE.STATS ROW.INDEX 1)))
(add TOTALUNKNOWN (SETQ UNKNOWN (16AREF \MEMUSAGE.STATS ROW.INDEX 4)))
(add TOTALTOTAL (SETQ TOTAL (IPLUS READONLY DIRTY UNREFERENCED UNKNOWN)))
(printout FILE T " " TYPENAME .TAB 20 .I6 TOTAL .TAB 30 .I6 UNREFERENCED .TAB 40 .I6
READONLY .TAB 50 .I6 DIRTY .TAB 60 .I6 UNKNOWN)
finally (printout FILE T T "Totals: " .TAB 20 .I6 TOTALTOTAL .TAB 30 .I6
TOTALUNREFERENCED .TAB 40 .I6 TOTALREADONLY .TAB 50 .I6 TOTALDIRTY
.TAB 60 .I6 TOTALUNKNOWN))
(TERPRI FILE))))
)
(RPAQ? \MEMUSAGE.STATS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \MEMUSAGE.STATS)
)
(* "Showing data about ARRAYBLOCK sizes")
(DEFINEQ
(SHOW.ARRAYBLOCK.HISTOGRAPHS
(LAMBDA (FILE INUSE.ONLY?) (* JonL "16-Sep-84 23:59")
(PROG ((PREVIOUSFREEBLOCKSIZE 0)
(CURRENTFREEBLOCKSIZE 0)
(CURRENTUSEDBLOCKSIZE 0)
(FRAGMENTATIONCOEFF 0.0)
(BIGESTSTACKLOSER.SIZE 0)
(LARGESTONPAGELOSER.SIZE 0)
BIGESTSTACKLOSER LARGESTONPAGELOSER CURRENTRUNTYPE N LEN LEN.DATA FNP)
(DECLARE (SPECVARS BIGESTSTACKLOSER.SIZE BIGESTSTACKLOSER LARGESTONPAGELOSER.SIZE
LARGESTONPAGELOSER))
(SETQ SNOOPY.CODEREMNANTS (NCONC1 (for HUNKSIZE in SNOOPY.CODEBLOCKSIZES
until (OR (NULL HUNKSIZE)
(IGREATERP HUNKSIZE MAX.CELLSPERHUNK))
collect (IREMAINDER CELLSPERPAGE HUNKSIZE))
NIL))
(\SAS.INITIALIZE.STATSARRAYS)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS)))
(for (ABLOCK ← \ARRAYSPACE) by (\ADDBASE2 ABLOCK (fetch (ARRAYBLOCK ARLEN) of ABLOCK))
repeatuntil (EQ ABLOCK \ArrayFrLst)
finally (if (EQ CURRENTRUNTYPE (QUOTE FREE))
then (* This is essentially the same code as in the loop
below)
(SETQ FRAGMENTATIONCOEFF (FPLUS FRAGMENTATIONCOEFF
(FQUOTIENT (SQRT (FTIMES (FLOAT
PREVIOUSFREEBLOCKSIZE)
(FLOAT
CURRENTFREEBLOCKSIZE)))
(FLOAT CURRENTUSEDBLOCKSIZE))
)))
do (SETQ LEN.DATA (IDIFFERENCE (SETQ LEN (fetch (ARRAYBLOCK ARLEN) of ABLOCK))
\ArrayBlockOverheadCells))
(if (fetch (ARRAYBLOCK INUSE) of ABLOCK)
then (if (NEQ CURRENTRUNTYPE (QUOTE USED))
then (if (EQ CURRENTRUNTYPE (QUOTE FREE))
then (* When we next encounter a used segment, we can
calculate the fragmention coefficient generated by the
previous used segment)
(SETQ FRAGMENTATIONCOEFF
(FPLUS FRAGMENTATIONCOEFF
(FQUOTIENT (SQRT (FTIMES (FLOAT
PREVIOUSFREEBLOCKSIZE)
(FLOAT
CURRENTFREEBLOCKSIZE)))
(FLOAT CURRENTUSEDBLOCKSIZE)))))
(SETQ CURRENTRUNTYPE (QUOTE USED))
(SETQ CURRENTUSEDBLOCKSIZE 0))
(SELECTC (fetch (ARRAYBLOCK GCTYPE) of ABLOCK)
((LIST UNBOXEDBLOCK.GCT)
(\SAS.INCREMENT.STATS USEDBLOCKS.FREQ USEDBLOCKS.CONSUMPTION
LEN.DATA LEN SNOOPY.ARRAYBLOCKSIZES)
(\SAS.INCREMENT.STATS NIL USEDHUNKS.CONSUMPTION LEN.DATA
(\SAS.HUNKABLE.SIZE LEN.DATA
SNOOPY.ARRAYBLOCKSIZES)
SNOOPY.ARRAYBLOCKSIZES))
((LIST CODEBLOCK.GCT)
(\SAS.CODEBLOCKSTATS LEN (\ADDBASE ABLOCK \ArrayBlockHeaderWords))
)
((LIST PTRBLOCK.GCT)
(\SAS.INCREMENT.STATS PTRBLOCKS.FREQ PTRBLOCKS.CONSUMPTION
LEN.DATA LEN SNOOPY.PTRBLOCKSIZES)
(\SAS.INCREMENT.STATS NIL PTRHUNKS.CONSUMPTION LEN.DATA
(\SAS.HUNKABLE.SIZE LEN.DATA
SNOOPY.PTRBLOCKSIZES)
SNOOPY.PTRBLOCKSIZES))
(SHOULDNT))
else (if (NOT INUSE.ONLY?)
then (\SAS.INCREMENT.STATS FREEBLOCKS.FREQ FREEBLOCKS.CONSUMPTION LEN LEN
SNOOPY.ARRAYBLOCKSIZES))
(if (NEQ CURRENTRUNTYPE (QUOTE FREE))
then (SETQ CURRENTRUNTYPE (QUOTE FREE))
(SETQ PREVIOUSFREEBLOCKSIZE CURRENTFREEBLOCKSIZE)
(SETQ CURRENTFREEBLOCKSIZE 0)))
(SELECTQ CURRENTRUNTYPE
(USED (add CURRENTUSEDBLOCKSIZE LEN))
(FREE (add CURRENTFREEBLOCKSIZE LEN))
(SHOULDNT))
(if (TIMEREXPIRED? AUSE.TIMER)
then (* Give a yield every second or so.)
(* Don't worry excessively about this disrupting the parsing of array space! Yea, we know that if the ROVER of
\PARSEARRAYSPACE just happens to get merged one way or other during the BLOCK ...)
(BLOCK)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS)))))
(for I FREQ from 0 to (LENGTH SNOOPY.INITONPAGESIZES) when (NEQ 0 (SETQ FREQ
(16AREF INITONPAGE.FREQ I)
))
do (PASET (FQUOTIENT (FTIMES 100.0 (PAREF INITONPAGE.PERCENT I))
FREQ)
INITONPAGE.PERCENT I)) (* Calculate the average percentage -- currently holds
the raw sums of ratios)
(printout FILE T \SAS.LINEDIVIDER T "Histographs for ARRAYBLOCK Storage" T \SAS.LINEDIVIDER)
(if (NOT INUSE.ONLY?)
then (\SAS.STATSOUT FREEBLOCKS.FREQ FREEBLOCKS.CONSUMPTION NIL SNOOPY.ARRAYBLOCKSIZES
"ArrayBlocks Free (block size includes overhead cells)"
FILE)
(printout FILE T "Fragmentation coefficient = " .F10.2 FRAGMENTATIONCOEFF T))
(\SAS.STATSOUT CODEBLOCKS.FREQ CODEBLOCKS.CONSUMPTION CODEHUNKS.CONSUMPTION
SNOOPY.CODEBLOCKSIZES "ArrayBlocks in Use (with GCTYPE = CODEBLOCK.GCT)"
FILE)
(FORMFEED FILE)
(\SAS.STATSOUT USEDBLOCKS.FREQ USEDBLOCKS.CONSUMPTION USEDHUNKS.CONSUMPTION
SNOOPY.ARRAYBLOCKSIZES "ArrayBlocks in Use (with GCTYPE = UNBOXEDBLOCK.GCT)"
FILE)
(\SAS.STATSOUT PTRBLOCKS.FREQ PTRBLOCKS.CONSUMPTION PTRHUNKS.CONSUMPTION
SNOOPY.PTRBLOCKSIZES "ArrayBlocks in Use (with GCTYPE = PTRBLOCK.GCT)" FILE)
(FORMFEED FILE)
(\SAS.PRINTSECTIONHEADER "Histographs for CODE Memory Requirements" FILE)
(PROGN (\SAS.STATSOUT STKMINS.FREQ NIL NIL SNOOPY.STKMINSIZES
"Minimun Stack Sizes (in Cells)"
FILE)
(printout FILE T "Function with largest STKMIN requirement is: " BIGESTSTACKLOSER T)
)
(PROGN (\SAS.STATSOUT INITONPAGE.FREQ INITONPAGE.PERCENT NIL SNOOPY.INITONPAGESIZES
"Initial Segment 'on page' Alignment"
FILE)
(printout FILE T "Function with largest 'on page' requirement is: "
LARGESTONPAGELOSER T)
(printout FILE T "Ratios of 'INITONPAGE' misses for page-straddling codehunks:" T -3)
(for I from 0 as HUNKSIZE in SNOOPY.CODEBLOCKSIZES until (OR (NULL HUNKSIZE)
(IGREATERP HUNKSIZE
MAX.CELLSPERHUNK))
when (NEQ 0 (SETQ N (16AREF STRADDLERMISSES.FREQ I)))
do (printout FILE N (QUOTE /)
(16AREF CODEBLOCKS.FREQ I)
(QUOTE %[)
HUNKSIZE
(QUOTE %])
-3)))
(TERPRI FILE)
(RETURN T))))
(\SAS.CODEBLOCKSTATS
(LAMBDA (LEN FNADDR) (* JonL "16-Sep-84 19:30")
(DECLARE (USEDFREE BIGESTSTACKLOSER.SIZE BIGESTSTACKLOSER LARGESTONPAGELOSER.SIZE
LARGESTONPAGELOSER))
(PROG ((LEN.DATA (IDIFFERENCE LEN \ArrayBlockOverheadCells))
CODEHUNKSIZE STKMINCELLS INITONPAGECELLS)
(\SAS.INCREMENT.STATS CODEBLOCKS.FREQ CODEBLOCKS.CONSUMPTION LEN.DATA LEN
SNOOPY.CODEBLOCKSIZES)
(SETQ CODEHUNKSIZE (\SAS.HUNKABLE.SIZE LEN.DATA SNOOPY.CODEBLOCKSIZES))
(\SAS.INCREMENT.STATS NIL CODEHUNKS.CONSUMPTION LEN.DATA CODEHUNKSIZE SNOOPY.CODEBLOCKSIZES)
(* Next few are for statistics on the sizes of
stackframes required)
(SETQ STKMINCELLS (FOLDHI (fetch (FNHEADER STKMIN) of FNADDR)
WORDSPERCELL))
(\SAS.INCREMENT.STATS STKMINS.FREQ NIL STKMINCELLS NIL SNOOPY.STKMINSIZES)
(if (IGREATERP STKMINCELLS BIGESTSTACKLOSER.SIZE)
then (SETQ BIGESTSTACKLOSER.SIZE STKMINCELLS)
(SETQ BIGESTSTACKLOSER (fetch (CODEARRAYBLOCK ABFRAMENAME) of FNADDR)))
(* Next few are for statistics on the sizes of
header/nametable before the STARTPC which must be kept
on the same page.)
(SETQ INITONPAGECELLS (CEIL (ADD1 (FOLDHI (fetch (FNHEADER STARTPC) of FNADDR)
BYTESPERCELL))
CELLSPERQUAD))
(\SAS.INCREMENT.STATS INITONPAGE.FREQ INITONPAGE.PERCENT INITONPAGECELLS (FQUOTIENT
INITONPAGECELLS
LEN.DATA)
SNOOPY.INITONPAGESIZES)
(if (IGREATERP INITONPAGECELLS LARGESTONPAGELOSER.SIZE)
then (SETQ LARGESTONPAGELOSER.SIZE INITONPAGECELLS)
(SETQ LARGESTONPAGELOSER (fetch (FNHEADER FRAMENAME) of FNADDR)))
(if (ILEQ CODEHUNKSIZE MAX.CELLSPERHUNK)
then (* INITONPAGECELLS is still the number of initial cells
that this code block must keep on a page.)
(PROG ((STRADDLER'S.MAXONPAGE (CAR (NTH SNOOPY.CODEREMNANTS
(ADD1 (\SAS.INDEXINLIST CODEHUNKSIZE
SNOOPY.CODEBLOCKSIZES)))))
) (* These many cells are what a page-straddling hunk of
this size would keep on the first page)
(if (NULL STRADDLER'S.MAXONPAGE)
then (printout T T "STRADDLER'S.MAXONPAGE is NIL on CODEHUNKSIZE = "
CODEHUNKSIZE)
elseif (AND (NEQ 0 STRADDLER'S.MAXONPAGE)
(ILESSP STRADDLER'S.MAXONPAGE INITONPAGECELLS))
then (\SAS.INCREMENT.STATS STRADDLERMISSES.FREQ NIL CODEHUNKSIZE NIL
SNOOPY.CODEBLOCKSIZES)))))))
(\SAS.INDEXINLIST
(LAMBDA (FREQ SIZESLST) (* JonL "13-Sep-84 20:40")
(* find the index in SIZESLST such that FREQ is "first"
less-than-or-equal to that storagesize)
(find I from 0 as X in SIZESLST suchthat (NOT (GREATERP FREQ (OR (NUMBERP X)
(RETURN I)))))))
(\SAS.INCREMENT.STATS
(LAMBDA (FREQA CONSUMPTIONA INDEXSIZE CONSUMPTIONSIZE SIZELST)
(* JonL "15-Jan-85 22:00")
(* * We acumulate number of items in FREQA and the sizes of the items in CONSUMPTIONA N is the "histogram index"
into a frequency array;)
(PROG ((N (\SAS.INDEXINLIST INDEXSIZE (\DTEST SIZELST (QUOTE LISTP)))))
(if FREQA
then (LET ((V (16AREF FREQA N)))
(if (ILESSP V MAX.SMALLP)
then (16ASET (ADD1 V)
FREQA N))))
(if CONSUMPTIONA
then (* Yup, sure would have been nice to have had ucoded
version of ASET and AREF here!)
(if (FIXP CONSUMPTIONSIZE)
then (NASET (PLUS CONSUMPTIONSIZE (NAREF CONSUMPTIONA N))
CONSUMPTIONA N)
else (PASET (PLUS CONSUMPTIONSIZE (PAREF CONSUMPTIONA N))
CONSUMPTIONA N))))))
(\SAS.HUNKABLE.SIZE
(LAMBDA (NCELLS SIZESLST) (* JonL "15-Sep-84 15:33")
(* How big is the chunk size needed to store an item of
NCELLS number of cells? uses the SIZESLST quantization
list)
(PROG ((HUNKSIZE (find X in (SETQ SIZESLST (\DTEST SIZESLST (QUOTE LISTP)))
suchthat (NOT (GREATERP NCELLS (OR (NUMBERP X)
(RETURN)))))))
(RETURN (OR (AND HUNKSIZE (ILEQ HUNKSIZE MAX.CELLSPERHUNK)
HUNKSIZE)
(IPLUS \ArrayBlockOverheadCells NCELLS))))))
(\SAS.CALCFRAGCOEFF
(LAMBDA (FILE) (* JonL "20-Nov-84 23:06")
(* * Scans arrayblock space merely to calculate the Fragmentation Coefficient)
(PROG ((PREVIOUSFREEBLOCKSIZE 0)
(CURRENTFREEBLOCKSIZE 0)
(CURRENTUSEDBLOCKSIZE 0)
(FRAGMENTATIONCOEFF 0.0)
CURRENTRUNTYPE N LEN LEN.DATA FNP)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS)))
(for (ABLOCK ← \ARRAYSPACE) by (\ADDBASE2 ABLOCK (fetch (ARRAYBLOCK ARLEN) of ABLOCK))
repeatuntil (EQ ABLOCK \ArrayFrLst)
finally (if (EQ CURRENTRUNTYPE (QUOTE FREE))
then (* This is essentially the same code as in the loop
below)
(SETQ FRAGMENTATIONCOEFF (FPLUS FRAGMENTATIONCOEFF
(FQUOTIENT (SQRT (FTIMES (FLOAT
PREVIOUSFREEBLOCKSIZE)
(FLOAT
CURRENTFREEBLOCKSIZE)))
(FLOAT CURRENTUSEDBLOCKSIZE))
)))
do (SETQ LEN.DATA (IDIFFERENCE (SETQ LEN (fetch (ARRAYBLOCK ARLEN) of ABLOCK))
\ArrayBlockOverheadCells))
(if (fetch (ARRAYBLOCK INUSE) of ABLOCK)
then (if (NEQ CURRENTRUNTYPE (QUOTE USED))
then (if (EQ CURRENTRUNTYPE (QUOTE FREE))
then (* When we next encounter a used segment, we can
calculate the fragmention coefficient generated by the
previous used segment)
(SETQ FRAGMENTATIONCOEFF
(FPLUS FRAGMENTATIONCOEFF
(FQUOTIENT (SQRT (FTIMES (FLOAT
PREVIOUSFREEBLOCKSIZE)
(FLOAT
CURRENTFREEBLOCKSIZE)))
(FLOAT CURRENTUSEDBLOCKSIZE)))))
(SETQ CURRENTRUNTYPE (QUOTE USED))
(SETQ CURRENTUSEDBLOCKSIZE 0))
else (if (NEQ CURRENTRUNTYPE (QUOTE FREE))
then (SETQ CURRENTRUNTYPE (QUOTE FREE))
(SETQ PREVIOUSFREEBLOCKSIZE CURRENTFREEBLOCKSIZE)
(SETQ CURRENTFREEBLOCKSIZE 0)))
(SELECTQ CURRENTRUNTYPE
(USED (add CURRENTUSEDBLOCKSIZE LEN))
(FREE (add CURRENTFREEBLOCKSIZE LEN))
(SHOULDNT))
(if (TIMEREXPIRED? AUSE.TIMER)
then (* Give a yield every second or so.)
(* Don't worry excessively about this disrupting the parsing of array space! Yea, we know that if the ROVER of
\PARSEARRAYSPACE just happens to get merged one way or other during the BLOCK ...)
(BLOCK)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS)))))
(printout FILE T T \SAS.LINEDIVIDER T "Fragmentation coefficient = " .F10.2
FRAGMENTATIONCOEFF T \SAS.LINEDIVIDER T))))
)
(RPAQ? USEDBLOCKS.FREQ )
(RPAQ? USEDBLOCKS.CONSUMPTION )
(RPAQ? USEDHUNKS.CONSUMPTION )
(RPAQ? FREEBLOCKS.FREQ )
(RPAQ? FREEBLOCKS.CONSUMPTION )
(RPAQ? CODEBLOCKS.FREQ )
(RPAQ? CODEBLOCKS.CONSUMPTION )
(RPAQ? CODEHUNKS.CONSUMPTION )
(RPAQ? PTRBLOCKS.FREQ )
(RPAQ? PTRBLOCKS.CONSUMPTION )
(RPAQ? PTRHUNKS.CONSUMPTION )
(RPAQ? STKMINS.FREQ )
(RPAQ? INITONPAGE.FREQ )
(RPAQ? INITONPAGE.PERCENT )
(RPAQ? STRADDLERMISSES.FREQ )
(RPAQ? AUSE.TIMER (SETUPTIMER 0 NIL (QUOTE TICKS)))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD CODEARRAYBLOCK ((ABSTKMIN WORD)
(NIL WORD) (* The NA field)
(NIL WORD) (* The PV field)
(ABSTARTPC WORD)
(NIL BITS 10)
(NIL BITS 2) (* ARGTYPE)
(NIL BITS 4)
(ABFRAMENAMELO WORD)
(ABFRAMENAMEHI BYTE))
(ACCESSFNS CODEARRAYBLOCK ((ABFRAMENAME (\VAG2 (fetch ABFRAMENAMEHI
of DATUM)
(fetch ABFRAMENAMELO
of DATUM))))))
]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS USEDBLOCKS.FREQ USEDHUNKS.CONSUMPTION FREEBLOCKS.FREQ FREEBLOCKS.CONSUMPTION
USEDBLOCKS.CONSUMPTION CODEBLOCKS.FREQ CODEBLOCKS.CONSUMPTION CODEHUNKS.CONSUMPTION
PTRBLOCKS.FREQ PTRBLOCKS.CONSUMPTION PTRHUNKS.CONSUMPTION STKMINS.FREQ INITONPAGE.FREQ
INITONPAGE.PERCENT STRADDLERMISSES.FREQ AUSE.TIMER)
)
(DEFINEQ
(\SAS.INITIALIZE.STATSARRAYS
(LAMBDA NIL (* JonL "16-Sep-84 17:58")
(PROG ((LEN (\SAS.INITIALIZE.PNAMEARRAYS))
(CLEN (\SAS.INITIALIZE.CHECKSIZESLST (QUOTE SNOOPY.CODEBLOCKSIZES))))
(\SAS.CHECKMEMSTATSARRAY)
(\SAS.INITIALIZEARRAY (QUOTE CODEBLOCKS.FREQ)
(QUOTE (MOD 65536))
CLEN)
(\SAS.INITIALIZEARRAY (QUOTE CODEBLOCKS.CONSUMPTION)
(QUOTE FIXNUM)
CLEN)
(\SAS.INITIALIZEARRAY (QUOTE CODEHUNKS.CONSUMPTION)
(QUOTE FIXNUM)
CLEN)
(\SAS.INITIALIZEARRAY (QUOTE PTRBLOCKS.FREQ)
(QUOTE (MOD 65536))
LEN)
(\SAS.INITIALIZEARRAY (QUOTE PTRBLOCKS.CONSUMPTION)
(QUOTE FIXNUM)
LEN)
(\SAS.INITIALIZEARRAY (QUOTE PTRHUNKS.CONSUMPTION)
(QUOTE FIXNUM)
LEN)
(* * Following four are created here, because this function is called at load time in order to do most of the
consing before the SHOW functions are run)
(\SAS.INITIALIZEARRAY (QUOTE STKMINS.FREQ)
(QUOTE (MOD 65536))
(IPLUS 10 (LENGTH SNOOPY.STKMINSIZES)))
(\SAS.INITIALIZEARRAY (QUOTE INITONPAGE.FREQ)
(QUOTE (MOD 65536))
(IPLUS 10 (LENGTH SNOOPY.INITONPAGESIZES)))
(\SAS.INITIALIZEARRAY (QUOTE INITONPAGE.PERCENT)
(QUOTE POINTER)
(IPLUS 10 (LENGTH SNOOPY.INITONPAGESIZES))
0.0)
(\SAS.INITIALIZEARRAY (QUOTE STRADDLERMISSES.FREQ)
(QUOTE (MOD 65536))
CLEN))))
(\SAS.INITIALIZE.PNAMEARRAYS
(LAMBDA NIL (* JonL " 2-Sep-84 17:55")
(* * Returns the length of the SNOOPY.ARRAYBLOCKSIZES after checking its validity. Ascertains that the arrays AUSE
and AFREE are big enough.)
(PROG ((LEN (\SAS.INITIALIZE.CHECKSIZESLST (QUOTE SNOOPY.ARRAYBLOCKSIZES))))
(\SAS.INITIALIZEARRAY (QUOTE USEDBLOCKS.FREQ)
(QUOTE (MOD 65536))
LEN)
(\SAS.INITIALIZEARRAY (QUOTE USEDBLOCKS.CONSUMPTION)
(QUOTE FIXNUM)
LEN)
(\SAS.INITIALIZEARRAY (QUOTE USEDHUNKS.CONSUMPTION)
(QUOTE FIXNUM)
LEN)
(\SAS.INITIALIZEARRAY (QUOTE FREEBLOCKS.FREQ)
(QUOTE (MOD 65536))
LEN)
(\SAS.INITIALIZEARRAY (QUOTE FREEBLOCKS.CONSUMPTION)
(QUOTE FIXNUM)
LEN)
(RETURN LEN))))
(\SAS.INITIALIZEARRAY
(LAMBDA (NAME ARRAYELEMENTTYPE MINSIZE INITELEMENT) (* JonL "16-Sep-84 17:53")
(* * Ensures that the array in NAME is big enough, and initializes it to zeros.)
(if (NULL MINSIZE)
then (SETQ MINSIZE (LENGTH SNOOPY.ARRAYBLOCKSIZES))
elseif (FIXP MINSIZE)
elseif (LISTP MINSIZE)
then (SETQ MINSIZE (LENGTH MINSIZE))
else (\ILLEGAL.ARG MINSIZE))
(PROG ((A (GETATOMVAL NAME)))
(if (AND (type? CMLARRAY A)
(EQUAL ARRAYELEMENTTYPE (ARRAYELEMENTTYPE A))
(IGEQ (ARRAYDIMENSION A 0)
MINSIZE))
then (* Lookin' good!)
else (SETATOMVAL NAME (SETQ A (MAKEARRAY MINSIZE (QUOTE ELEMENTTYPE)
ARRAYELEMENTTYPE))))
(FILLARRAY A (OR INITELEMENT 0)))))
(\SAS.INITIALIZE.CHECKSIZESLST
(LAMBDA (NAME) (* JonL " 2-Sep-84 14:58")
(* * Check that NAME is a global variable whose value is a valid quantiztion list)
(PROG (TEM (SIZESLST (GETATOMVAL NAME)))
(OR (AND (LISTP SIZESLST)
(EVERY SIZESLST (FUNCTION \SAS.NULLORFIXP)))
(ERROR SIZESLST (CONCAT "Bad value for " NAME)))
(OR (AND (SETQ TEM (LISTP (LAST SIZESLST)))
(NULL (CAR TEM)))
(SETATOMVAL NAME (APPEND SIZESLST (QUOTE (NIL)))))
(RETURN (IPLUS (LENGTH SIZESLST)
(PROG1 6 (* Little fudge/safety factor)))))))
(\SAS.NULLORFIXP
(LAMBDA (X) (* JonL "17-Aug-84 22:32")
(OR (NULL X)
(FIXP X))))
)
(* "Snooping on LITATOM and STRINGP statistics")
(RPAQ? PNAMEHUNKS.CONSUMPTION )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PNAMEHUNKS.CONSUMPTION)
)
(DEFINEQ
(SHOW.LITATOM.HISTOGRAPHS
(LAMBDA (FILE) (* JonL "15-Sep-84 20:14")
(\SAS.COLLECTLITATOMSTATS)
(\SAS.PRINTLITATOMCELLS FILE)
(\SAS.PRINTLITATOMPNAMES FILE)
T))
(\SAS.COLLECTLITATOMSTATS
(LAMBDA NIL (* JonL "15-Sep-84 19:56")
(\SAS.INITIALIZE.PNAMESTATS)
(MAPATOMS (FUNCTION (LAMBDA (ATM)
(PROG ((NWORDS (FOLDHI (ADD1 (fetch (LITATOM PNAMELENGTH) of ATM))
BYTESPERCELL))
#CELLSPNAME N #VALCELLS FNP) (* no litatom can have more than 256 characters in its
pname)
(SETQ #CELLSPNAME (FOLDHI NWORDS WORDSPERCELL))
(\SAS.INCREMENT.STATS PNAME.FREQ PNAME.CONSUMPTION #CELLSPNAME NWORDS
SNOOPY.ARRAYBLOCKSIZES)
(\SAS.INCREMENT.STATS NIL PNAMEHUNKS.CONSUMPTION #CELLSPNAME
(\SAS.HUNKABLE.SIZE #CELLSPNAME SNOOPY.ARRAYBLOCKSIZES)
SNOOPY.ARRAYBLOCKSIZES)
(SETQ #VALCELLS (IPLUS (if (fetch (LITATOM DEFPOINTER) of ATM)
then 1
else 0)
(if (NEQ (fetch (LITATOM VALUE) of ATM)
(QUOTE NOBIND))
then 1
else 0)
(if (fetch (LITATOM PROPLIST) of ATM)
then 1
else 0)))
(\SAS.INCREMENT.STATS VCELLS.FREQ VCELLS.CONSUMPTION #VALCELLS #VALCELLS
(QUOTE (0 1 2 3)))
(if (TIMEREXPIRED? AUSE.TIMER)
then (* Give a yield every second or so.)
(BLOCK)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS)))))
)))
(* * Adjust the totals for CELL comsumption, since the statistics were gathered in WORDs)
(for I from 0 to (SUB1 (ARRAYDIMENSION PNAME.CONSUMPTION 0))
do (NASET (FOLDHI (NAREF PNAME.CONSUMPTION I)
WORDSPERCELL)
PNAME.CONSUMPTION I))))
(\SAS.PRINTLITATOMCELLS
(LAMBDA (FILE FLG) (* JonL "20-Nov-84 22:56")
(\SAS.PRINTSECTIONHEADER (CONCAT "Highest Litatom number used: " \AtomFrLst)
FILE)
(if (NOT FLG)
then (\SAS.STATSOUT VCELLS.FREQ VCELLS.CONSUMPTION NIL
(QUOTE (0 1 2 3 4 NIL))
"Multiplicities of Litatom 'cells'" FILE))))
(\SAS.PRINTLITATOMPNAMES
(LAMBDA (FILE) (* JonL "15-Sep-84 20:13")
(\SAS.PRINTSECTIONHEADER "Histographs for LITATOM Pname Storage" FILE)
(\SAS.STATSOUT PNAME.FREQ PNAME.CONSUMPTION PNAMEHUNKS.CONSUMPTION SNOOPY.ARRAYBLOCKSIZES
"Litatom Pname Lengths (in Cells)"
FILE)
(printout FILE T "Actual number of pages in pname chars space = " \CurPnPage T)))
(SHOW.STRINGP.HISTOGRAPHS
(LAMBDA (FILE) (* JonL "15-Sep-84 19:44")
(* Try to minimize the visibility of garbage.)
(MAPC (PROG1 (\COLLECTINUSE (QUOTE STRINGP))
(\SAS.INITIALIZE.PNAMESTATS))
(FUNCTION (LAMBDA (STR)
(PROG ((NCELLS (FOLDHI (fetch (STRINGP LENGTH) of STR)
BYTESPERCELL)))
(\SAS.INCREMENT.STATS PNAME.FREQ PNAME.CONSUMPTION NCELLS (IPLUS NCELLS
\ArrayBlockOverheadCells)
SNOOPY.ARRAYBLOCKSIZES)
(\SAS.INCREMENT.STATS NIL PNAMEHUNKS.CONSUMPTION NCELLS (\SAS.HUNKABLE.SIZE
NCELLS SNOOPY.ARRAYBLOCKSIZES)
SNOOPY.ARRAYBLOCKSIZES)
(if (TIMEREXPIRED? AUSE.TIMER)
then (* Give a yield every second or so.)
(BLOCK)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS))))))))
(printout FILE T \SAS.LINEDIVIDER T "Histographs for STRINGP Storage" T \SAS.LINEDIVIDER)
(\SAS.STATSOUT PNAME.FREQ PNAME.CONSUMPTION PNAMEHUNKS.CONSUMPTION SNOOPY.ARRAYBLOCKSIZES
"String Pname Lengths (in Cells)"
FILE)))
(\SAS.INITIALIZE.PNAMESTATS
(LAMBDA NIL (* JonL " 2-Sep-84 17:55")
(\SAS.INITIALIZE.PNAMEARRAYS)
(* * Note how we can just share the same histogram arrays used by SHOW.ARRAYBLOCK.HISTOGRAPHS)
(SETQ PNAME.FREQ USEDBLOCKS.FREQ)
(SETQ PNAME.CONSUMPTION USEDBLOCKS.CONSUMPTION)
(SETQ PNAMEHUNKS.CONSUMPTION USEDHUNKS.CONSUMPTION)
(SETQ VCELLS.FREQ FREEBLOCKS.FREQ)
(SETQ VCELLS.CONSUMPTION FREEBLOCKS.CONSUMPTION)
(SETQ AUSE.TIMER (SETUPTIMER \RCLKSECOND AUSE.TIMER (QUOTE TICKS)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PNAME.FREQ PNAME.CONSUMPTION VCELLS.FREQ VCELLS.CONSUMPTION)
)
(FILESLOAD (SYSLOAD COMPILED FROM LISPUSERS)
CMLARRAY GCHAX)
(DECLARE: DONTEVAL@COMPILE DONTEVAL@LOAD DOCOPY
(\SAS.INITIALIZE.STATSARRAYS)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS FORMFEED MACRO ((FILE)
(PRIN1 (CONSTANT (CHARACTER (CHARCODE FF)))
FILE)))
)
)
(* "Related to format of statistics printout")
(DEFINEQ
(\SAS.PRINTSECTIONHEADER
(LAMBDA (TITLELINE FILE) (* JonL "20-Aug-84 23:42")
(printout FILE T T \SAS.LINEDIVIDER T TITLELINE T \SAS.LINEDIVIDER)))
(\SAS.STATSOUT
(LAMBDA (FREQA #CELLSA.BLOCKS #CELLSA.HUNKS SIZESLST TITLELINE FILE)
(* JonL "16-Sep-84 20:09")
(* FREQA is the frequency array; #CELLSA.BLOCKS is the array holding the total number of cells required to store
the items as "blocks"; #CELLSA.HUNKS is similar for hunks.)
(printout FILE T T .TAB0 (IQUOTIENT (IDIFFERENCE 58 (NCHARS TITLELINE))
2)
TITLELINE T)
(PROG ((INITONPAGEP (EQ #CELLSA.BLOCKS INITONPAGE.PERCENT))
(TITEMS 0)
(TITEMS.LE.HUNKMAX 0)
(TBCELLS 0)
(THCELLS 0)
TBCELLS.LE.HUNKMAX THCELLS.LE.HUNKMAX FIRST.NONZERO LAST.NONZERO)
(* * Accumulate the total number of items in the frequency counts; also the total amount of space specified by the
#CELLS arrays.)
(for I NITEMS from 0 as X in SIZESLST
do (if #CELLSA.HUNKS
then (if (AND (NULL TBCELLS.LE.HUNKMAX)
(OR (NULL X)
(IGREATERP X MAX.CELLSPERHUNK)))
then (* Keep a record of the cumulative totals just for those
that share in "hunking")
(SETQ TITEMS.LE.HUNKMAX TITEMS)
(SETQ TBCELLS.LE.HUNKMAX TBCELLS)
(SETQ THCELLS.LE.HUNKMAX THCELLS))
(add THCELLS (NAREF #CELLSA.HUNKS I)))
(add TITEMS (SETQ NITEMS (16AREF FREQA I)))
(if (NEQ 0 NITEMS)
then (if (NULL FIRST.NONZERO)
then (SETQ FIRST.NONZERO I))
(SETQ LAST.NONZERO I)
(if (AND #CELLSA.BLOCKS (NOT INITONPAGEP))
then (add TBCELLS (NAREF #CELLSA.BLOCKS I)))))
(* * Back up one, so that, when there is a run of zero-entries, at least one of them will show up.)
(OR (ILEQ FIRST.NONZERO 1)
(add FIRST.NONZERO -1))
(printout FILE T T "ItemSize" .TAB 12 " Frequency[cum]")
(if #CELLSA.BLOCKS
then (printout FILE .TAB 34 (if (NOT INITONPAGEP)
then " #BlockCells"
else "Average %% of codelength")))
(if #CELLSA.HUNKS
then (printout FILE .TAB 56 " #HunkCells"))
(for I from FIRST.NONZERO as X in (NTH SIZESLST (ADD1 FIRST.NONZERO))
bind #Items #BCells #HCells (TITEMS.DIVISOR ←(TIMES TITEMS .01))
(TBCELLS.DIVISOR ←(TIMES TBCELLS .01))
(THCELLS.DIVISOR ←(TIMES THCELLS .01))
(Cumu#Items ← 0)
(CumuBlockCells ← 0)
(CumuHunkCells ← 0)
until (IGREATERP I LAST.NONZERO)
do (add Cumu#Items (SETQ #Items (16AREF FREQA I)))
(if #CELLSA.BLOCKS
then (if (NOT INITONPAGEP)
then (SETQ #BCells (NAREF #CELLSA.BLOCKS I))
(add CumuBlockCells #BCells)
else (SETQ #BCells (PAREF #CELLSA.BLOCKS I))))
(if #CELLSA.HUNKS
then (add CumuHunkCells (SETQ #HCells (NAREF #CELLSA.HUNKS I))))
(if (FIXP X)
then (printout FILE T "le " X)
else (printout FILE T "others"))
(printout FILE .TAB 12 .I6 #Items " [" .F5.1 (QUOTIENT Cumu#Items TITEMS.DIVISOR)
"%%]")
(if #CELLSA.BLOCKS
then (printout FILE .TAB 34)
(if (NOT INITONPAGEP)
then (printout FILE .I6 #BCells " [" .F5.1 (QUOTIENT CumuBlockCells
TBCELLS.DIVISOR)
"%%]")
else (printout FILE .F6.2 #BCells)))
(if #CELLSA.HUNKS
then (printout FILE .TAB 56 .I6 #HCells " [" .F5.1 (QUOTIENT CumuHunkCells
THCELLS.DIVISOR)
"%%]"))
finally (PROGN (printout FILE T T "Totals:" .TAB 12 .I6 TITEMS)
(if (AND #CELLSA.BLOCKS (NOT INITONPAGEP))
then (printout FILE .TAB 34 .I6 TBCELLS " (~" (FOLDHI TBCELLS
CELLSPERPAGE)
" pages)"))
(if #CELLSA.HUNKS
then (printout FILE .TAB 56 .I6 THCELLS " (~" (FOLDHI THCELLS
CELLSPERPAGE)
" pages)")
(printout FILE T T " (le " MAX.CELLSPERHUNK ")" .TAB 12 .I6
TITEMS.LE.HUNKMAX .TAB 34 .I6 TBCELLS.LE.HUNKMAX " (~"
(FOLDHI TBCELLS.LE.HUNKMAX CELLSPERPAGE)
" pages)")
(printout FILE .TAB 56 .I6 THCELLS.LE.HUNKMAX " (~"
(FOLDHI THCELLS.LE.HUNKMAX CELLSPERPAGE)
" pages)")))))
(TERPRI FILE)))
)
(RPAQ? \SAS.LINEDIVIDER "------------------------------------------------------------------")
(RPAQ? \SAS.1-Aug-84% 00:00 490160752)
(* "Random date offset, to make default unique file names shorter")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \SAS.LINEDIVIDER \SAS.1-Aug-84% 00:00)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(PUTPROPS SNOOPY COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8143 12063 (SHOW.HISTOGRAPHS 8153 . 8483) (SHOW.ALL.HISTOGRAPHS 8485 . 8997) (
\SAS.SHOWINIT 8999 . 11663) (\SAS.STORAGE 11665 . 12061)) (12108 21803 (SHOW.REALMEMORY.HISTOGRAPHS
12118 . 12320) (\SAS.CHECKMEMSTATSARRAY 12322 . 12924) (\SAS.GATHER.REALMEMSTATS 12926 . 18652) (
\SAS.PRINT.REALMEMSTATS 18654 . 21801)) (21950 36512 (SHOW.ARRAYBLOCK.HISTOGRAPHS 21960 . 28515) (
\SAS.CODEBLOCKSTATS 28517 . 31416) (\SAS.INDEXINLIST 31418 . 31840) (\SAS.INCREMENT.STATS 31842 .
32876) (\SAS.HUNKABLE.SIZE 32878 . 33514) (\SAS.CALCFRAGCOEFF 33516 . 36510)) (38038 42134 (
\SAS.INITIALIZE.STATSARRAYS 38048 . 39581) (\SAS.INITIALIZE.PNAMEARRAYS 39583 . 40454) (
\SAS.INITIALIZEARRAY 40456 . 41314) (\SAS.INITIALIZE.CHECKSIZESLST 41316 . 41988) (\SAS.NULLORFIXP
41990 . 42132)) (42302 46972 (SHOW.LITATOM.HISTOGRAPHS 42312 . 42553) (\SAS.COLLECTLITATOMSTATS 42555
. 44315) (\SAS.PRINTLITATOMCELLS 44317 . 44716) (\SAS.PRINTLITATOMPNAMES 44718 . 45157) (
SHOW.STRINGP.HISTOGRAPHS 45159 . 46383) (\SAS.INITIALIZE.PNAMESTATS 46385 . 46970)) (47461 52088 (
\SAS.PRINTSECTIONHEADER 47471 . 47669) (\SAS.STATSOUT 47671 . 52086)))))
STOP