(FILECREATED "22-Feb-84 18:37:52" {PHYLUM}<LISPCORE>LIBRARY>COREHAX.;3
 3231   

      changes to:  (VARS COREHAXCOMS)

      previous date: "19-Feb-84 15:13:07" {PHYLUM}<LISPCORE>LIBRARY>COREHAX.;2)


(* Copyright (c) 1983, 1984 by Xerox Corporation)

(PRETTYCOMPRINT COREHAXCOMS)

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

(ARRAYSPACENAME

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

    (PROGN "Array/code/string"])

(CURRENTVMEMPAGES
  [LAMBDA NIL                                   (* lmm "11-OCT-82 14:52"
)
    (PROG (DTL TYP)
          (for I from 0 to MAXVMPAGE when (NOT (fetch (VMEMFLAGS VACANT)
						  of (\READFLAGS I)))
	     do 

          (* This is an awful hack because these constants 
	  will change and should be referenced symbolicly)


		[SETQ TYP
		  (SELECTC (LRSH I 8)
			   (0 "BCPL/net buffers/IOCBs")
			   (16 "Atom PName pointers")
			   (17 "Atom definition cells")
			   (18 "Atom value cells")
			   (19 "Atom property pointers")
			   (20 "Atom hash table")
			   (21 "page map page map")
			   (22 "page map, etc.")
			   (60 "GC Hash collision table")
			   (57 "GC hash table")
			   (62 "Display bank")
			   (COND
			     ((IGREATERP (LRSH I 8)
					 32)
			       (ARRAYSPACENAME I))
			     (T (TYPENAME (\VAG2 (LRSH I 8)
						 (LLSH (LOGAND I 255)
						       8]
		(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
 16383)

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

(RPAQQ \MAXVMEMSEGMENT
 63)

(CONSTANTS (\MAXVMEMSEGMENT 63))
)

(FILESLOAD (LOADCOMP)
	   LLFAULT)
)
(PUTPROPS COREHAX COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (546 2944 (ARRAYSPACENAME 556 . 699) (CURRENTVMEMPAGES 701 . 1692) (INCOREP 1694 . 1881)
 (PRINTVMEM 1883 . 2116) (SHOWVMEM 2118 . 2749) (\INCOREPTRP 2751 . 2942)))))
STOP