(FILECREATED " 1-Apr-85 17:34:39" {ERIS}<LISPNEW>PRINTPATCH.;2 23162  

      changes to:  (VARS PRINTPATCHCOMS))


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

(PRETTYCOMPRINT PRINTPATCHCOMS)

(RPAQQ PRINTPATCHCOMS ((FNS SETX.PRESS SETY.PRESS \ENDPAGE.PRESS \PRESSCURVE2 SETY.PRESS \IPCURVE2 
			    STORAGE)))
(DEFINEQ

(SETX.PRESS
  [LAMBDA (PRSTREAM X)                                       (* rrb "19-Mar-85 09:53")
    (PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
          (COND
	    ([AND (IGEQ X SPRUCEPAPERLEFTMICAS)
		  (ILEQ X SPRUCEPAPERRIGHTMICAS)
		  (NOT (IEQP X (fetch PRXPOS of (fetch IMAGEDATA of PRSTREAM]
	      (\BOUT ELSTREAM SetXCode)                      (* Outcharfn ignores characters that are not in the 
							     clipping region)
	      (\WOUT ELSTREAM X)))
          (replace PRXPOS of (fetch IMAGEDATA of PRSTREAM) with X])

(SETY.PRESS
  [LAMBDA (PRSTREAM Y)                                       (* rrb "18-Mar-85 16:55")
    (PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
          (COND
	    ([AND (IGEQ Y SPRUCEPAPERBOTTOMMICAS)
		  (ILEQ Y SPRUCEPAPERTOPMICAS)
		  (NOT (IEQP Y (fetch PRYPOS of (ffetch IMAGEDATA of PRSTREAM]
	      (\BOUT ELSTREAM SetYCode)
	      (\WOUT ELSTREAM Y)))
          (freplace PRYPOS of (ffetch IMAGEDATA of PRSTREAM) with Y])

(\ENDPAGE.PRESS
  [LAMBDA (PRSTREAM)                                         (* rrb "15-Mar-85 18:46")
    (PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
          (SHOW.PRESS PRSTREAM)
          (\ENTITYEND.PRESS PRSTREAM)
          (COND
	    ((NEQ 0 (\GETFILEPTR ELSTREAM))
	      (COND
		((ODDP (\GETFILEPTR PRSTREAM))
		  (\BOUT PRSTREAM 0)))
	      (\WOUT PRSTREAM 0)                             (* 0 word to separate DL from EL)
	      (COPYBYTES ELSTREAM PRSTREAM 0 (\GETFILEPTR ELSTREAM))
	      (\PARTEND.PRESS PRSTREAM 0])

(\PRESSCURVE2
  [LAMBDA (PRSTREAM SPLINE DASHING BRUSHFONT)                (* rrb "18-Mar-85 16:57")
                                                             (* Given a spline curve and a font, draw the lines to 
							     PRSTREAM)
    (RESETLST (RESETSAVE NIL (LIST (QUOTE DSPFONT)
				   (DSPFONT BRUSHFONT PRSTREAM)
				   PRSTREAM))
	      [PROG ((PRDATA (fetch IMAGEDATA of PRSTREAM)))
		    (COND
		      ((IGREATERP (IDIFFERENCE (GETFILEPTR (fetch ELSTREAM of PRDATA))
					       (fetch ELSTARTBYTE of PRDATA))
				  25000)
			(\ENTITYEND.PRESS PRSTREAM)          (* Hack to prevent mysterious overflow in length of 
							     entities)
			(\ENTITYSTART.PRESS PRSTREAM]
	      (\BOUT (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM))
		     ResetSpaceCode)                         (* because the space code shouldn't be interpreted 
							     specially when we are drawing in the vector font)
	      (PROG ((XPOLY (create POLYNOMIAL))
		     (X'POLY (create POLYNOMIAL))
		     (YPOLY (create POLYNOMIAL))
		     (Y'POLY (create POLYNOMIAL))
		     (X (fetch (SPLINE SPLINEX) of SPLINE))
		     (Y (fetch (SPLINE SPLINEY) of SPLINE))
		     (X'(fetch (SPLINE SPLINEDX) of SPLINE))
		     (Y'(fetch (SPLINE SPLINEDY) of SPLINE))
		     (X''(fetch (SPLINE SPLINEDDX) of SPLINE))
		     (Y''(fetch (SPLINE SPLINEDDY) of SPLINE))
		     (X'''(fetch (SPLINE SPLINEDDDX) of SPLINE))
		     (Y'''(fetch (SPLINE SPLINEDDDY) of SPLINE))
		     (#KNOTS (fetch #KNOTS of SPLINE))
		     (X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE)
			      1))
		     (Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE)
			      1))
		     IX IY DX DY XT YT X'T Y'T NEWXT NEWYT XDIFF YDIFF XWALLDT YWALLDT DUPLICATEKNOT 
		     EXTRANEOUS TT NEWT DELTA DASHON DASHLST DASHCNT HALFVECWIDTH PUTDX EXTRADX PUTDY 
		     EXTRADY)
		    (SETQ HALFVECWIDTH (FONTPROP BRUSHFONT (QUOTE SIZE)))
                                                             (* Half the width of the brush, in dots.
							     Used to help decide when the line we're drawing goes 
							     off-paper.)
		    (SETQ DASHON T)                          (* These are initialized outside the prog-bindings 
							     cause the compiler can't hack so many initialized 
							     variables)
		    (SETQ DASHLST DASHING)
		    (SETQ DASHCNT (CAR DASHING))
		    (SETXY.PRESS PRSTREAM (FIXR (FTIMES X0 MicasPerScan))
				 (FIXR (FTIMES Y0 MicasPerScan)))
                                                             (* Move to the first knot on the curve)
		    (replace VECMOVINGRIGHT of (fetch IMAGEDATA of PRSTREAM) with T)
                                                             (* Start by assuming we're moving in increasing X 
							     (since the vector fonts only have strokes that work in 
							     that direction))
		    (replace VECWASDISPLAYING of (fetch IMAGEDATA of PRSTREAM)
		       with (AND (GEQ X0 0)
				 (GEQ Y0 0)))
		    (replace VECSEGCHARS of (fetch IMAGEDATA of PRSTREAM) with NIL)
		    (replace VECCURX of (fetch IMAGEDATA of PRSTREAM) with X0)
                                                             (* And set the current X and Y positions, denominated 
							     in dover spots)
		    (replace VECCURY of (fetch IMAGEDATA of PRSTREAM) with Y0)
                                                             (* Set up initial values in vec variables, perform 
							     SetX/SetY.)
		    (SETQ TT 0.0)
		    (SETQ DELTA 16)
		    (SETQ IX (FIXR X0))
		    (SETQ IY (FIXR Y0))
		    [for KNOT# from 1 to (SUB1 #KNOTS)
		       do (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#)
				    (ELT X'' KNOT#)
				    (ELT X' KNOT#)
				    (ELT X KNOT#))           (* Set up the polynomials that describe X and X' over 
							     this segment)
			  (LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#)
				    (ELT Y'' KNOT#)
				    (ELT Y' KNOT#)
				    (ELT Y KNOT#))           (* Set up the polynomials that describe Y and Y' over 
							     this segment)
			  (SETQ XT (POLYEVAL TT XPOLY 3))    (* XT ← X (t) --Evaluate the next point)
			  (SETQ YT (POLYEVAL TT YPOLY 3))    (* YT ← Y (t))
			  (COND
			    [(NOT (IEQP KNOT# (SUB1 #KNOTS)))
                                                             (* This isn't the last knot.
							     Check to see if the next knot in line is a duplicated 
							     knot.)
			      (SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#))
							    (ELT X (IPLUS KNOT# 2)))
						       (EQP (ELT Y (ADD1 KNOT#))
							    (ELT Y (IPLUS KNOT# 2]
			    (T (SETQ DUPLICATEKNOT NIL)))
			  [until (GEQ TT 1.0)
			     do 

          (* Run the parameter, TT, from 0.0 up to 1.0. That moves the X and Y locations smoothly from this knot to the next 
	  one.)


				(SETQ X'T (POLYEVAL TT X'POLY 2)) 
                                                             (* X'T ← X' (t))
				(SETQ Y'T (POLYEVAL TT Y'POLY 2)) 
                                                             (* Y'T ← Y' (t))
				(COND
				  ((EQP X'T 0.0)             (* Never let X' really get to 0.0 -- things become 
							     ill-conditioned there.)
				    (SETQ X'T .0005)))
				(COND
				  ((EQP Y'T 0.0)             (* Likewise Y'.)
				    (SETQ Y'T .0005)))
				[COND
				  ((FGTP X'T 0.0)            (* If X' is positive, we'll try moving in the +X 
							     direction)
				    (SETQ DX DELTA))
				  (T                         (* If not, we'll try the -X direction.)
				     (SETQ DX (IMINUS DELTA]
				[COND
				  ((FGTP Y'T 0.0)            (* Likewise, if Y' is positive, try moving by DELTA in 
							     the +Y direction)
				    (SETQ DY DELTA))
				  (T (SETQ DY (IMINUS DELTA]
				(SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX)
								      XT)
							 X'T))
                                                             (* Compute a dT, based on moving by DELTA in X.)
				(SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY)
								      YT)
							 Y'T))
                                                             (* And a dT based on moving by DELTA in Y.)
				[COND
				  ((FLESSP XWALLDT YWALLDT)

          (* Use the smaller of the two dT's. In this case, dT for X was smaller, so compute a new DY as depending on DX.)


				    (SETQ NEWT (FPLUS TT XWALLDT))
				    (SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T)))
							  IY)))
				  (T                         (* Changing Y gave the smaller dT.
							     Compute a new DX, as though it depended on DY.)
				     (SETQ NEWT (FPLUS TT YWALLDT))
				     (SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T)))
							   IX]
				(SETQ PUTDX DX)
				(SETQ EXTRADX 0)
				(SETQ PUTDY DY)
				(SETQ EXTRADY 0)
				[COND
				  ((IGREATERP DX 16)
				    (SETQ PUTDX 16)
				    (SETQ EXTRADX (IDIFFERENCE DX 16]
				[COND
				  ((IGREATERP -16 DX)
				    (SETQ PUTDX -16)
				    (SETQ EXTRADX (IPLUS DX 16]
				[COND
				  ((IGREATERP DY 16)
				    (SETQ PUTDY 16)
				    (SETQ EXTRADY (IDIFFERENCE DY 16]
				[COND
				  ((IGREATERP -16 DY)
				    (SETQ PUTDY -16)
				    (SETQ EXTRADY (IPLUS DY 16]
				(COND
				  ([AND (FGTP NEWT 1.0)
					(OR DUPLICATEKNOT (EQ KNOT# (SUB1 #KNOTS]
				    (SETQ NEWT 1.0)))
				(SETQ NEWXT (POLYEVAL NEWT XPOLY 3)) 
                                                             (* New XT ← X (new t))
				(SETQ NEWYT (POLYEVAL NEWT YPOLY 3)) 
                                                             (* New YT ← Y (new t))
				(SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX)
							      NEWXT)))
				(SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY)
							      NEWYT)))
				(COND
				  ((AND (IGREATERP DELTA 1)
					(OR (FGTP XDIFF 1.0)
					    (FGTP YDIFF 1.0)))

          (* If we're more than a dover spot off where we'd expect to be because of the size of DELTA--and if there's room to 
	  make DELTA smaller--then try DELTA←DELTA/2)


				    (SETQ DELTA (LRSH DELTA 1)))
				  (T                         (* No, this estimate is close enough.
							     Put out a vector segment based on it, and move to the 
							     new TT.)
				     (\VECPUT PRSTREAM PUTDX PUTDY HALFVECWIDTH)
                                                             (* Print out a stroke using the vector font.)
				     (COND
				       ((OR (NEQ EXTRADX 0)
					    (NEQ EXTRADY 0))
                                                             (* If, actually, it was too big for one stroke, use 
							     another.)
					 (\VECPUT PRSTREAM EXTRADX EXTRADY HALFVECWIDTH)))
				     (SETQ IX (IPLUS IX DX))
                                                             (* Our new current location, in Dover spots)
				     (SETQ IY (IPLUS IY DY))
				     (SETQ TT NEWT)          (* Set TT to its new value)
				     (SETQ XT NEWXT)         (* And set the new floating-point values for X 
							     (t) and Y (t).)
				     (SETQ YT NEWYT)
				     (COND
				       ((AND (ILESSP DELTA 16)
					     (OR (FLESSP XDIFF .5)
						 (FLESSP YDIFF .5)))
                                                             (* If we were especially close, try making DELTA larger
							     for the next go round.)
					 (SETQ DELTA (LLSH DELTA 1]
			  (SETQ TT (FDIFFERENCE TT 1.0)) 

          (* Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try 
	  to keep the line going from where it got to in passing the last knot.)


			  (COND
			    (DUPLICATEKNOT 

          (* This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems 
	  trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are 
	  discontinuous there.)


					   (add KNOT# 1]
		    (\ENDVECRUN PRSTREAM HALFVECWIDTH])

(SETY.PRESS
  [LAMBDA (PRSTREAM Y)                                       (* rrb "18-Mar-85 16:55")
    (PROG [(ELSTREAM (fetch ELSTREAM of (fetch IMAGEDATA of PRSTREAM]
          (COND
	    ([AND (IGEQ Y SPRUCEPAPERBOTTOMMICAS)
		  (ILEQ Y SPRUCEPAPERTOPMICAS)
		  (NOT (IEQP Y (fetch PRYPOS of (ffetch IMAGEDATA of PRSTREAM]
	      (\BOUT ELSTREAM SetYCode)
	      (\WOUT ELSTREAM Y)))
          (freplace PRYPOS of (ffetch IMAGEDATA of PRSTREAM) with Y])

(\IPCURVE2
  [LAMBDA (IPSTREAM SPLINE DASHING BRUSH)                    (* hdj "13-Mar-85 18:08")
                                                             (* Given a spline curve and a font, draw the lines to 
							     IPSTREAM)
    (PROG ((XPOLY (create POLYNOMIAL))
	   (X'POLY (create POLYNOMIAL))
	   (YPOLY (create POLYNOMIAL))
	   (Y'POLY (create POLYNOMIAL))
	   (X (fetch (SPLINE SPLINEX) of SPLINE))
	   (Y (fetch (SPLINE SPLINEY) of SPLINE))
	   (X'(fetch (SPLINE SPLINEDX) of SPLINE))
	   (Y'(fetch (SPLINE SPLINEDY) of SPLINE))
	   (X''(fetch (SPLINE SPLINEDDX) of SPLINE))
	   (Y''(fetch (SPLINE SPLINEDDY) of SPLINE))
	   (X'''(fetch (SPLINE SPLINEDDDX) of SPLINE))
	   (Y'''(fetch (SPLINE SPLINEDDDY) of SPLINE))
	   (#KNOTS (fetch #KNOTS of SPLINE))
	   (X0 (ELT (fetch (SPLINE SPLINEX) of SPLINE)
		    1))
	   (Y0 (ELT (fetch (SPLINE SPLINEY) of SPLINE)
		    1))
	   IX IY DX DY XT YT X'T Y'T NEWXT NEWYT XDIFF YDIFF XWALLDT YWALLDT DUPLICATEKNOT EXTRANEOUS 
	   TT NEWT DELTA DASHON DASHLST DASHCNT IPDATA SEG#)
          (SETQ DASHON T)                                    (* These are initialized outside the prog-bindings 
							     cause the compiler can't hack so many initialized 
							     variables)
          (SETQ DASHLST DASHING)
          (SETQ DASHCNT (CAR DASHING))
          (SETQ SEG# 0)
          (SETQ IPDATA (fetch IMAGEDATA of IPSTREAM))
          (MOVETO.IP IPSTREAM X0 Y0)
          (replace IPXPOS of IPDATA with X0)
          (replace IPYPOS of IPDATA with Y0)
          (SETQ TT 0.0)
          (SETQ DELTA 128)
          (SETQ IX (FIXR X0))
          (SETQ IY (FIXR Y0))
          [for KNOT# from 1 to (SUB1 #KNOTS)
	     do (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#)
			  (ELT X'' KNOT#)
			  (ELT X' KNOT#)
			  (ELT X KNOT#))
		(LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#)
			  (ELT Y'' KNOT#)
			  (ELT Y' KNOT#)
			  (ELT Y KNOT#))
		(SETQ XT (POLYEVAL TT XPOLY 3))              (* XT ← X (t) --Evaluate the next point)
		(SETQ YT (POLYEVAL TT YPOLY 3))              (* YT ← Y (t))
		(COND
		  [(NOT (IEQP KNOT# (SUB1 #KNOTS)))          (* This isn't the last knot.
							     Check to see if the next knot in line is a duplicated 
							     knot.)
		    (SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#))
						  (ELT X (IPLUS KNOT# 2)))
					     (EQP (ELT Y (ADD1 KNOT#))
						  (ELT Y (IPLUS KNOT# 2]
		  (T (SETQ DUPLICATEKNOT NIL)))
		[until (GEQ TT 1.0)
		   do (SETQ X'T (POLYEVAL TT X'POLY 2))      (* X'T ← X' (t))
		      (SETQ Y'T (POLYEVAL TT Y'POLY 2))      (* Y'T ← Y' (t))
		      (COND
			((EQP X'T 0.0)
			  (SETQ X'T .0005)))
		      (COND
			((EQP Y'T 0.0)
			  (SETQ Y'T .0005)))
		      [COND
			((FGTP X'T 0.0)
			  (SETQ DX DELTA))
			(T (SETQ DX (IMINUS DELTA]
		      [COND
			((FGTP Y'T 0.0)
			  (SETQ DY DELTA))
			(T (SETQ DY (IMINUS DELTA]
		      (SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX)
							    XT)
					       X'T))
		      (SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY)
							    YT)
					       Y'T))
		      [COND
			((FLESSP XWALLDT YWALLDT)
			  (SETQ NEWT (FPLUS TT XWALLDT))
			  (SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T)))
						IY)))
			(T (SETQ NEWT (FPLUS TT YWALLDT))
			   (SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T)))
						 IX]
		      (COND
			([AND (FGTP NEWT 1.0)
			      (OR DUPLICATEKNOT (EQ KNOT# (SUB1 #KNOTS]
			  (SETQ NEWT 1.0)))
		      (SETQ NEWXT (POLYEVAL NEWT XPOLY 3)) 
                                                             (* New XT ← X (new t))
		      (SETQ NEWYT (POLYEVAL NEWT YPOLY 3)) 
                                                             (* New YT ← Y (new t))
		      (SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX)
						    NEWXT)))
		      (SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY)
						    NEWYT)))
		      (COND
			((AND (IGREATERP DELTA 1)
			      (OR (FGTP XDIFF 1.0)
				  (FGTP YDIFF 1.0)))
			  (SETQ DELTA (LRSH DELTA 1)))
			(T (if (IGREATERP (add SEG# 1)
					  MAXSEGSPERTRAJECTORY)
			       then (\SETBRUSH.IP IPSTREAM BRUSH)
				    (MASKSTROKE.IP IPSTREAM)
				    (SETQ SEG# 0)
				    (MOVETO.IP IPSTREAM (fetch IPXPOS of IPDATA)
					       (fetch IPYPOS of IPDATA)))
			   (LINETO.IP IPSTREAM (add (fetch IPXPOS of IPDATA)
						    DX)
				      (add (fetch IPYPOS of IPDATA)
					   DY))
			   (SETQ IX (IPLUS IX DX))
			   (SETQ IY (IPLUS IY DY))
			   (SETQ TT NEWT)
			   (SETQ XT NEWXT)
			   (SETQ YT NEWYT)
			   (COND
			     ((AND (ILESSP DELTA 128)
				   (OR (FLESSP XDIFF .5)
				       (FLESSP YDIFF .5)))
			       (SETQ DELTA (LLSH DELTA 1]
		(SETQ TT (FDIFFERENCE TT 1.0)) 

          (* Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try 
	  to keep the line going from where it got to in passing the last knot.)


		(COND
		  (DUPLICATEKNOT 

          (* This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems 
	  trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are 
	  discontinuous there.)


				 (add KNOT# 1]
          (\SETBRUSH.IP IPSTREAM BRUSH)
          (MASKSTROKE.IP IPSTREAM])

(STORAGE
  [LAMBDA (TYPES PAGETHRESHOLD)                              (* bvm: "12-Feb-85 17:22")
    (PROG ((TOTALALLOCMDS (CREATECELL \FIXP))
	   (TOTALHUNKS (CREATECELL \FIXP))
	   (FREE (CREATECELL \FIXP))
	   (HUNKSTATS (from 0 to 2 collect (create HUNKSTAT)))
	   TYPE TYPENAME DOBLOCKSFLG)
          (DECLARE (SPECVARS HUNKSTATS))
          (printout NIL "Type" 15 "Assigned" 30 "Free items" 45 "In use" 55 "Total alloc" T 15 
		    "pages [items]"
		    T)
          (COND
	    [(AND TYPES (NEQ TYPES T))
	      (for TYPE HFLG inside TYPES when [COND
						 ((FIXP TYPE)
						   (COND
						     ((OR (ILESSP TYPE 0)
							  (IGREATERP TYPE \MaxTypeNumber))
                                                             (* An explicit type number ought to be "right")
						       (ERROR "Not a type number" TYPE))
						     ((EQ TYPE 0)
						       (SETQ DOBLOCKSFLG T)
						       NIL)
						     (T T)))
						 (T (SETQ TYPE (\TYPENUMBERFROMNAME TYPE]
		 do (COND
		      ((fetch DTDHUNKP of (\GETDTD TYPE))
			(SETQ HFLG T)))
		    (\STORAGE.TYPE TYPE FREE TOTALALLOCMDS PAGETHRESHOLD)
		 finally (COND
			   (HFLG (\STORAGE.HUNKTYPE TOTALALLOCMDS PAGETHRESHOLD]
	    (T (for I from 1 to \MaxTypeNumber do (\STORAGE.TYPE I FREE TOTALALLOCMDS PAGETHRESHOLD))
	       (\STORAGE.HUNKTYPE TOTALHUNKS PAGETHRESHOLD)
	       (printout NIL T "TOTAL" 15 .I5 (IPLUS TOTALALLOCMDS TOTALHUNKS)
			 T T)
	       (printout NIL "Data Spaces Summary" T)
	       (printout NIL 30 "Allocated" 50 "Remaining" T)
	       (printout NIL 32 "Pages" 52 "Pages" T)
	       (printout NIL "Datatypes (incl. LISTP etc.)" 30 .I8 TOTALALLOCMDS 50 "\" T)
                                                             (* Arrayspace and MDS come out of the same pot, so lump
							     their "remaining" pages together)
	       (printout NIL "ArrayBlocks" (COND
			   ((NOT (IEQP TOTALHUNKS 0))
			     " (variable)")
			   (T ""))
			 30 .I8 (SELECTC \STORAGEFULLSTATE
					 ((LIST \SFS.FULLYSWITCHED \SFS.ARRAYSWITCHED)
					   (IPLUS (IDIFFERENCE \LeastMDSPage \FirstArrayPage)
						  (IDIFFERENCE \NxtArrayPage \SecondArrayPage)))
					 (IDIFFERENCE \NxtArrayPage \FirstArrayPage))
			 50 "--" .I6 (CAR (STORAGE.LEFT))
			 T)
	       (COND
		 ((NOT (IEQP TOTALHUNKS 0))
		   (printout NIL "ArrayBlocks (chunked)" 30 .I8 TOTALHUNKS 50 "/" T)))

          (* \LastATOMpage marks off atom indexes as if they were word addresses; but the space behind a litatom is one cell 
	  in each of the four spaces: DEFSPACE, VALSPACE, PNAMESPACE, and PROPSPACE)


	       (\STLINP "Litatoms" (ITIMES (FOLDHI \AtomFrLst CELLSPERPAGE)
					   4)
			(ITIMES (UNFOLD (ADD1 \LastAtomPage)
					WORDSPERCELL)
				4))
	       (COND
		 (\PNAMES.IN.BLOCKS? (\STLINP "Litatom Pnames (from bootstrap)" (ADD1 \CurPnPage)
					      (ADD1 \CurPnPage)))
		 (T (\STLINP "Litatom Pnames" (ADD1 \CurPnPage)
			     \LastPnPage)))
	       (SETQ DOBLOCKSFLG T)))
          (COND
	    (DOBLOCKSFLG (\SHOW.ARRAY.FREELISTS])
)
(PUTPROPS PRINTPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (344 23081 (SETX.PRESS 354 . 1010) (SETY.PRESS 1012 . 1560) (\ENDPAGE.PRESS 1562 . 2182)
 (\PRESSCURVE2 2184 . 13142) (SETY.PRESS 13144 . 13692) (\IPCURVE2 13694 . 19761) (STORAGE 19763 . 
23079)))))
STOP