(FILECREATED " 6-Jan-85 15:58:18" {ERIS}<LISPCORE>LIBRARY>COREHAX.;2
 10416Q 

      changes to:  (FNS CURRENTVMEMPAGES)

      previous date: "22-Feb-84 18:37:52" {ERIS}<LISPCORE>LIBRARY>COREHAX.;1)


(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT COREHAXCOMS)

(RPAQQ COREHAXCOMS
 ((FNS ARRAYSPACENAME CURRENTVMEMPAGES INCOREP PRINTVMEM SHOWVMEM \INCOREPTRP)
		    (VARS MAXVMPAGE)
		    (INITVARS (VMEMWINDOW))
		    (DECLARE: DONTCOPY (CONSTANTS (\MAXVMEMSEGMENT 77Q))
			      (FILES (LOADCOMP)
				     LLFAULT))))
(DEFINEQ

(ARRAYSPACENAME

  [LAMBDA (I)                                                (* lmm "11-OCT-82 14:49")

    (PROGN "Array/code/string"])

(CURRENTVMEMPAGES

  [LAMBDA NIL                                                (* lmm " 6-Jan-85 15:57")

    (
PROG
 (DTL TYP)
          (for
 I from
 0 to
 MAXVMPAGE when
 (\INCOREPTRP
 (create
 POINTER
							       PAGE# ← I))
	     do
                                              (* This is an awful hack because these constants will 

							     change and should be referenced symbolicly)

		[
SETQ
 TYP (
PROG
 ((SEG (
LRSH
 I 10Q)))
			        (
RETURN
 (
OR
 (
TYPENAME
 (
\VAG2
 SEG (
LLSH
 (
LOGAND
 I 377Q)
								       10Q)))
					    (
COND

					      ((
EQ
 \D1BCPLspace SEG)
						"BCPL and/or private memory")
					      ((
EQ
 (
\HILOC
 \PNPSPACE)
						   SEG)
						"Atom PName pointers")
					      ((
EQ
 (
\HILOC
 \DEFSPACE)
						   SEG)
						"Atom definition cells")
					      ((
EQ
 (
\HILOC
 \VALSPACE)
						   SEG)
						"Atom value cells")
					      ((
EQ
 (
\HILOC
 \PLISTSPACE)
						   SEG)
						"Atom property pointers")
					      ((
EQ
 (
\HILOC
 \AtomHashTable)
						   SEG)
						"Atom hash table")
					      ((
EQ
 (
\HILOC
 \PAGEMAP)
						   SEG)
						"page map page map")
					      ((
EQ
 (
\HILOC
 \PageMapTBL)
						   SEG)
						"page map table, interface page, stats")
					      ((
EQ
 (
\HILOC
 \HTCOLL)
						   SEG)
						"GC Hash collision table")
					      ((
EQ
 (
\HILOC
 \HTMAIN)
						   SEG)
						"GC hash table")
					      ((
EQ
 (
\HILOC
 \DISPLAYREGION)
						   SEG)
						"Display bank")
					      ((
EQ
 (
\HILOC
 \STACKSPACE)
						   SEG)
						"Stack Space")
					      ((
AND
 (
IGEQ
 SEG (
\HILOC
 \ARRAYSPACE))
						    (
ILEQ
 I \LASTARRAYPAGE))
						(ARRAYSPACENAME
 I))
					      ((
AND
 (
IGEQ
 SEG (
\HILOC
 \PNCHARSSPACE))
						    (
ILESSP
 SEG (
\HILOC
 \ARRAYSPACE)))
						"PName Characters")
					      (T "something else"]
		(add
 [
CDR
 (
OR
 (
ASSOC
 TYP DTL)
			      (
CAR
 (push
 DTL (
CONS
 TYP 0]
		     1))
          (
RETURN
 DTL])

(INCOREP

  [LAMBDA (FN)                                               (* lmm "11-OCT-82 14:40")

    (AND (CCODEP FN)
	 (\INCOREPTRP
 (fetch
 (LITATOM DEFPOINTER) of
 FN])

(PRINTVMEM

  [LAMBDA NIL                                                (* lmm " 3-JUN-83 00:55")

    (for
 X in
 (CURRENTVMEMPAGES
) do
 (printout
 T .I8 (CDR X)
					      ,,
					      (CAR X)
					      T])

(SHOWVMEM

  [LAMBDA (W)                                                (* lmm "19-Feb-84 15:12")

    [OR W (SETQ W (OR VMEMWINDOW (SETQ VMEMWINDOW (CREATEW (GETBOXREGION (WIDTHIFWINDOW 256)
									 (HEIGHTIFWINDOW
									   (ADD1 \MAXVMEMSEGMENT)
									   T))
							   "Virtual memory"]
    (do
 (for
 SEGMENT from
 0 to
 \MAXVMEMSEGMENT
	   do
 (for
 PAGE# from
 0 to
 (SUB1 256)
		 do
 (BITMAPBIT W PAGE# (IDIFFERENCE \MAXVMEMSEGMENT SEGMENT)
			       (COND
				 ((EQ (\READFLAGS (LOGOR (ITIMES SEGMENT 256)
							 PAGE#))
				      \VMAP.VACANT)
				   0)
				 (T 1)))
		    (BLOCK])

(\INCOREPTRP
  [LAMBDA (ADDR)                                (* lmm "11-OCT-82 14:44"
)
    (NOT (fetch (VMEMFLAGS VACANT) of (\READFLAGS (fetch (POINTER
							   PAGE#)
						     of ADDR])
)

(RPAQQ MAXVMPAGE
 37777Q)

(RPAQ? VMEMWINDOW
 )
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \MAXVMEMSEGMENT
 77Q)

(CONSTANTS (\MAXVMEMSEGMENT 77Q))
)

(FILESLOAD (LOADCOMP)
	   LLFAULT)
)
(PUTPROPS COREHAX COPYRIGHT ("Xerox Corporation" 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1101Q 7744Q (ARRAYSPACENAME 1113Q . 1332Q) (CURRENTVMEMPAGES 1334Q . 5400Q) (INCOREP 
5402Q . 5675Q) (PRINTVMEM 5677Q . 6250Q) (SHOWVMEM 6252Q . 7441Q) (\INCOREPTRP 7443Q . 7742Q)))))
STOP