(FILECREATED " 4-Dec-83 17:53:41" {PHYLUM}<LISPCORE>LIBRARY>DUMPLOAD.;1
 5437   

      changes to:  (VARS DUMPLOADCOMS))


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT DUMPLOADCOMS)

(RPAQQ DUMPLOADCOMS
 ((FNS DUMPREAD \DUMP.PARSEDATE \DUMP.PARSENAME \DUMP.COPY \DUMP.PURGE)
		     (DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS * DUMPTYPES))))
(DEFINEQ

(DUMPREAD

  [LAMBDA (FILE OPTIONS)                                     (* bvm: " 4-Dec-83 17:51")

    (RESETLST
      (PROG ((PRINTFLG T)
	     SEEFLG COLLECT ASKFLG COPYFLG DATEFLG RESULT STREAM NAME CREATIONDATE LENGTH CHECKSUM 
	     KEYWORD \THISFILELINELENGTH)
	    (DECLARE
 (SPECVARS \THISFILELINELENGTH))
	    [COND
	      ((NULL OPTIONS)
		(SETQ ASKFLG (SETQ SEEFLG T)))
	      (T (for
 OP inside
 OPTIONS do
 (SELECTQ OP
						    (ASK (SETQ ASKFLG (SETQ PRINTFLG T)))
						    (PRINT (SETQ PRINTFLG T))
						    (QUIET (SETQ PRINTFLG NIL))
						    (SEE (SETQ SEEFLG T))
						    (COPY (SETQ COLLECT (SETQ COPYFLG T))
							  (SETQ SEEFLG))
						    (COLLECT (SETQ COLLECT T))
						    (DATES (SETQ DATEFLG T))
						    NIL]
	    [SETQ KEYWORD (COND
		(SEEFLG (SETQ OUTSTREAM (GETSTREAM T (QUOTE OUTPUT)))
			(SETQ \THISFILELINELENGTH (LINELENGTH NIL OUTSTREAM))
			"See")
		(COPYFLG "Load")
		(T (SETQ ASKFLG NIL]
	    [RESETSAVE NIL (LIST (QUOTE CLOSEF)
				 (SETQ STREAM (OPENSTREAM FILE (QUOTE INPUT)
							  (QUOTE OLD)
							  8
							  (QUOTE ((SEQUENTIAL]
	LP  (SETQ TYPE (BIN STREAM))
	TYPELP
	    (SELECTC TYPE
		     (\DUMP.END (RETURN RESULT))
		     (\DUMP.NAME (SETQ NAME (\DUMP.PARSENAME
 STREAM)))
		     [\DUMP.DATE (SETQ CREATIONDATE (\DUMP.PARSEDATE
 STREAM))
				 (SETQ CREATIONDATE (AND (OR DATEFLG COPYFLG)
							 (GDATE (ALTO.TO.LISP.DATE CREATIONDATE]
		     (\DUMP.ERROR (ERROR "Error block encountered in dump file" (FULLNAME STREAM)))
		     (\DUMP.DATA [COND
				   [(COND
				       ((NULL NAME)
					 (printout
 T "[Skipping nameless data...]" T)
					 NIL)
				       (ASKFLG
					 (EQ (QUOTE Y)
					     (ASKUSER NIL NIL
						      [CONS KEYWORD
							    (CONS NAME (AND CREATIONDATE
									    (LIST (LIST CREATIONDATE]
						      NIL T)))
				       (T [COND
					    (PRINTFLG (printout
 T NAME)
						      (COND
							(CREATIONDATE (printout
 T " (" CREATIONDATE 
										")")))
						      (COND
							(SEEFLG (printout
 T (QUOTE :)
									  T))
							(COPYFLG (printout
 T " -> "))
							(T (TERPRI T]
					  T))
				     [SETQ TYPE (COND
					 [SEEFLG (PROG1 (\DUMP.COPY
 STREAM OUTSTREAM T)
							(COND
							  (PRINTFLG (printout
 T .TAB0 0 T]
					 [COPYFLG [SETQ OUTSTREAM
						    (OPENSTREAM (MKATOM NAME)
								(QUOTE OUTPUT)
								NIL NIL
								(APPEND (QUOTE (SEQUENTIAL))
									(LIST (LIST (QUOTE 
										     CREATIONDATE)
										    CREATIONDATE]
						  (PROG1 (\DUMP.COPY
 STREAM OUTSTREAM)
							 (SETQ NAME (CLOSEF OUTSTREAM))
							 (COND
							   (PRINTFLG (printout
 T NAME T]
					 (T (\DUMP.PURGE
 STREAM]
				     (COND
				       (COLLECT (push
 RESULT NAME]
				   (T (SETQ TYPE (\DUMP.PURGE
 STREAM]
				 (SETQ NAME (SETQ CREATIONDATE NIL))
				 (GO TYPELP))
		     (ERROR "Bad Block Type in dump file" (FULLNAME STREAM)))
	    (GO LP])

(\DUMP.PARSEDATE

  [LAMBDA (INSTREAM)                                         (* bvm: " 2-Dec-83 18:22")

    (PROG1 (\MAKENUMBER (\WIN INSTREAM)
			(\WIN INSTREAM))
	   (BIN INSTREAM)                                    (* Ignore two bytes)

	   (BIN INSTREAM])

(\DUMP.PARSENAME

  [LAMBDA (INSTREAM)                                         (* bvm: " 2-Dec-83 18:26")

    (BIN INSTREAM)                                           (* Skip two bytes)

    (BIN INSTREAM)
    (PROG ((CHARS (bind
 CH until
 (ZEROP (SETQ CH (BIN INSTREAM))) collect
 CH))
	   RESULT)
          (SETQ RESULT (ALLOCSTRING (LENGTH CHARS)))
          (for
 CH in
 CHARS as
 I from
 1 do
 (RPLCHARCODE RESULT I CH))
          (RETURN RESULT])

(\DUMP.COPY

  [LAMBDA (INSTREAM OUTSTREAM TTYP)                          (* bvm: " 2-Dec-83 18:35")

    (bind
 TYPE LENGTH
       do
 (SETQ LENGTH (\WIN INSTREAM))
	  (BIN INSTREAM)                                     (* Skip checksum)

	  (BIN INSTREAM)
	  [COND
	    [TTYP (RPTQ LENGTH (\CKPOSBOUT OUTSTREAM (BIN INSTREAM]
	    (T (RPTQ LENGTH (\BOUT OUTSTREAM (BIN INSTREAM]
       repeatwhile
 (EQ (SETQ TYPE (BIN INSTREAM))
		       \DUMP.DATA)
       finally
 (RETURN TYPE])

(\DUMP.PURGE

  [LAMBDA (STREAM)                                           (* bvm: " 2-Dec-83 18:15")

    (do
 (SETFILEPTR STREAM (IPLUS (PROG1 (\WIN STREAM)
					 (\WIN STREAM)       (* Second word is checksum, which ignore)

					 )
				  (GETFILEPTR STREAM)))
       repeatwhile
 (EQ (SETQ $$VAL (BIN STREAM))
		       \DUMP.DATA])
)
(DECLARE: EVAL@COMPILE DONTCOPY 

(RPAQQ DUMPTYPES
 ((\DUMP.DATE 251)
		  (\DUMP.END 252)
		  (\DUMP.ERROR 253)
		  (\DUMP.DATA 254)
		  (\DUMP.NAME 255)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \DUMP.DATE
 251)

(RPAQQ \DUMP.END
 252)

(RPAQQ \DUMP.ERROR
 253)

(RPAQQ \DUMP.DATA
 254)

(RPAQQ \DUMP.NAME
 255)

(CONSTANTS (\DUMP.DATE 251)
	   (\DUMP.END 252)
	   (\DUMP.ERROR 253)
	   (\DUMP.DATA 254)
	   (\DUMP.NAME 255))
)
)
(PUTPROPS DUMPLOAD COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (364 4917 (DUMPREAD 374 . 3296) (\DUMP.PARSEDATE 3298 . 3569) (\DUMP.PARSENAME 3571 . 
4058) (\DUMP.COPY 4060 . 4563) (\DUMP.PURGE 4565 . 4915)))))
STOP