;;; THE SUM OF (STATUS MEMFREE) IN A FRESHLY LOADED LISP,
;;;	AND (APPLY 'PLUS (MAK-MEMORY-MAP))  SHOULD BE EQUAL TO
;;; 	(// 262144. (GETDDTSYM 'SEGSIZ)), I.E. THE TOTAL NUMBER 
;;; 	OF SEGMENTS.  USUALLY, THIS IS 512.
;;; AS A COMPUTATION PROGRESSES, (STATUS MEMFREE) DECREASES DUE 
;;; 	TO GOBBLING OF SPACE RESOURCES.

(DEFUN PRT-MEMORY-MAP ()
  ((LAMBDA (N)
    (MAPC '(LAMBDA (X Z)
		(TERPRI)
		(PRINC Z)
		(PRINC '| = |)
		(PROG () 
		      (SETQ N (- 7 (FLATSIZE X)))
		 A    (AND (ZEROP (SETQ N (1- N))) (RETURN NIL))
		      (PRINC '/ )
		      (GO A))
		(PRIN1 X))
	 (MAK-MEMORY-MAP)
	 '(|System Pure Code                | 
	   |System Writeable Variables      |
	   |Initial Pure List Structure     |
	   |Initial Writeable List Structure|
	   |Binary Program Space            |
	   |Pushdown Stacks                 |)))
   0)
  T)

(DEFUN MAK-MEMORY-MAP ()
  (PROG (N Z L SEGSIZ)
	(DECLARE (FIXNUM N))
	(AND (NULL (SETQ SEGSIZ (GETDDTSYM 'SEGSIZ))) (BREAK NODDT))
	(SETQ L (LIST (- (STATUS BPSH) (STATUS BPSL) -1)
		      (- (BOOLE 4 (+ (1- SEGSIZ)
				     (BOOLE 1 (EXAMINE (GETDDTSYM 'OSC2)) 262143.))
				  (1- SEGSIZ))
			 (BOOLE 1 (EXAMINE (GETDDTSYM 'FXC2)) 262143.))
))
	(SETQ N 0)	;SETUP FOR EXTRA IMPURE FS SEGMENTS
	   (MAPC '(LAMBDA (X) 
		   (AND (FIXP (SETQ Z (GETDDTSYM X))) 
			(SETQ N (+ N Z))))
		 '(NSYMSG NXXASG NXXZSG NBNSG NXXBSG NIFLSG))
	(SETQ L (CONS (+ (- (GETDDTSYM 'BSYMSG) (GETDDTSYM 'BSARSG))
			 (- (GETDDTSYM 'BIFLSG) (GETDDTSYM 'BIFSSG))
			 (* SEGSIZ N))
		      L))
	(SETQ N 0)	;SETUP FOR PURE FREE STORAGE
	   (AND (FIXP (SETQ Z (GETDDTSYM 'NXXPSG))) (SETQ N Z))
	(SETQ L (CONS (+ (- (GETDDTSYM 'BPFLSG) (GETDDTSYM 'BSY2SG)) 
			 (* SEGSIZ (+ (GETDDTSYM 'NPFLSG) N)))
		      L))
	(SETQ N 0)	;SETUP FOR SYSTEM VARIABLES
	   (MAPC '(LAMBDA (X) 
		   (AND (FIXP (SETQ Z (GETDDTSYM X))) 
			(SETQ N (+ N (* SEGSIZ Z)))))
		 '(NZERSG NBITSG NSTSG NSCRSG))
	(RETURN (CONS (* SEGSIZ (GETDDTSYM 'NSYSSG)) (CONS N L)))))

(DEFUN REM-MEMORY-MAP ()
   (REMPROP 'PRT-MEMORY-MAP 'EXPR)
   (REMPROP 'MAK-MEMORY-MAP 'EXPR)
   (REMPROP 'REM-MEMORY-MAP 'EXPR)
   T)