(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED " 7-Jan-88 15:36:10" "{ERINYES}<LispUsers>Lyric>DUMPLOAD.;4"
 5124   

      changes to%:  (FNS \DUMP.COPY \DUMP.PURGE DUMPREAD) (VARS DUMPLOADCOMS) (PROPS (DUMPREAD ARGNAMES))

      previous date%: " 4-Dec-83 17:53:41" {ERINYES}<LISP>KOTO>LISPUSERS>DUMPLOAD.;1)


(* "
Copyright (c) 1983, 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT DUMPLOADCOMS)

(RPAQQ DUMPLOADCOMS
 ((FNS DUMPREAD \DUMP.PARSEDATE \DUMP.PARSENAME \DUMP.COPY \DUMP.PURGE) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * DUMPTYPES)) (PROP ARGNAMES DUMPREAD) (PROP FILETYPE DUMPLOAD) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA DUMPREAD))))
)
(DEFINEQ

(DUMPREAD

(CL:LAMBDA (FILE &KEY ((:COPY-TO COPYFLG) T) ((:ASK ASKFLG)) ((:PRINT PRINTFLG) T) ((:DATES DATEFLG) T) (COLLECT NIL COLLECTP)) (* ; "Edited  7-Jan-88 14:28 by bvm:") (LET (STREAM OUTSTREAM) (CL:UNWIND-PROTECT (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (*STANDARD-OUTPUT* (GETSTREAM T (QUOTE OUTPUT))) SEEFLG RESULT NAME CREATIONDATE KEYWORD TYPE) (IF (NULL COPYFLG) ELSEIF (EQ COPYFLG T) THEN (SETQ SEEFLG T) (SETQ ASKFLG T) (SETQ COPYFLG NIL) ELSEIF (NOT COLLECTP) THEN (SETQ COLLECT T)) (SETQ KEYWORD (COND (SEEFLG (SETQ OUTSTREAM (GETSTREAM T (QUOTE OUTPUT))) "See") (COPYFLG "Copy") (T (SETQ ASKFLG NIL)))) (SETQ STREAM (OPENSTREAM FILE (QUOTE INPUT) (QUOTE OLD) (QUOTE ((SEQUENTIAL T))))) LP (SETQ TYPE (BIN STREAM)) TYPELP (SELECTC TYPE (\DUMP.END (* ; "End of file, return accumulated names, if we've been collecting") (RETURN RESULT)) (\DUMP.NAME (SETQ NAME (\DUMP.PARSENAME STREAM))) (\DUMP.DATE (SETQ CREATIONDATE (\DUMP.PARSEDATE STREAM)) (* ; "Date is in alto format") (SETQ CREATIONDATE (AND (OR DATEFLG COPYFLG) (GDATE (ALTO.TO.LISP.DATE CREATIONDATE) (DATEFORMAT TIME.ZONE))))) (\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 (CL:Y-OR-N-P "~A ~A~@[ [~A]~]? " KEYWORD NAME CREATIONDATE)) (T (COND (PRINTFLG (CL:FORMAT T "~A~@[ [~A]~]" NAME 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 (PACKFILENAME.STRING (QUOTE DIRECTORY) COPYFLG (QUOTE BODY) NAME) (QUOTE OUTPUT) NIL NIL (BQUOTE ((SEQUENTIAL T) (CREATIONDATE (\, CREATIONDATE)))))) (PROG1 (\DUMP.COPY STREAM OUTSTREAM) (SETQ NAME (CLOSEF OUTSTREAM)) (SETQ OUTSTREAM NIL) (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)) (* ;; "Be sure to clean up this stream on the way out") (IF (AND OUTSTREAM (NEQ COPYFLG T)) THEN (* ; "Flush partially written copy") (DELFILE (CLOSEF OUTSTREAM))) (AND STREAM (CLOSEF STREAM)))))
)

(\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 (EQ 0 (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) (* ; "Edited  7-Jan-88 15:15 by bvm:") (* ;; "Copy data blocks byte-by-byte from INSTREAM to OUTSTREAM.  Return the type of the next block.  TTYP is true if OUTSTREAM is the terminal.") (bind TYPE do (COPYBYTES INSTREAM OUTSTREAM (PROG1 (\WIN INSTREAM) (* ; "Length in bytes.  Now skip checksum") (BIN INSTREAM) (BIN INSTREAM))) repeatwhile (EQ (SETQ TYPE (BIN INSTREAM)) \DUMP.DATA) finally (RETURN TYPE)))
)

(\DUMP.PURGE

(LAMBDA (STREAM) (* ; "Edited  7-Jan-88 15:31 by bvm:") (do (SETFILEPTR STREAM (+ (PROG1 (\WIN STREAM) (* ; "Second word is checksum, which ignore") (BIN STREAM) (BIN STREAM)) (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 DUMPREAD ARGNAMES
 (FILE &KEY :ASK :COPY-TO :DATES :PRINT :COLLECT))

(PUTPROPS DUMPLOAD FILETYPE
 :COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 DUMPREAD)
)
(PUTPROPS DUMPLOAD COPYRIGHT ("Xerox Corporation" 1983 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (767 4355 (DUMPREAD 777 . 3111) (\DUMP.PARSEDATE 3113 . 3292) (\DUMP.PARSENAME 3294 . 
3618) (\DUMP.COPY 3620 . 4079) (\DUMP.PURGE 4081 . 4353)))))
STOP