(FILECREATED "20-Jan-85 03:59:44" {ERIS}<LISPCORE>LIBRARY>LOADDM.;2
 2971   

      changes to:  (VARS LOADDMCOMS)
		   (MACROS CONVERTDATE)

      previous date: "30-DEC-82 19:51:31" {ERIS}<LISPCORE>LIBRARY>LOADDM.;1)


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

(PRETTYCOMPRINT LOADDMCOMS)

(RPAQQ LOADDMCOMS
 ((FNS LOADDM READNAME)
		   (DECLARE: DONTCOPY (MACROS \WORDIN \FIXPIN CONVERTDATE))))
(DEFINEQ

(LOADDM

  [LAMBDA (FILE ASK ALLMODE)       (* lmm "10-DEC-82 08:11")

    (RESETLST
      (PROG (OUTOFD BT N OFD (OUTFILE (CONS)))
	    [RESETSAVE (SETQ FILE (OPENFILE FILE (QUOTE INPUT)
					    (QUOTE OLD)
					    8))
		       (QUOTE (PROGN (CLOSEF? OLDVALUE]
	    (SETQ OFD (GETSTREAM FILE))
	    [RESETSAVE NIL (LIST (FUNCTION (LAMBDA (X)
				     (COND
				       ((CAR X)
					 (CLOSEF? (CAR X))
					 (AND RESETSTATE (DELFILE (CAR X]
	    (do

	      (SELECTQ
		(SETQ BT (\BIN OFD))
		(255               (* name block)

		  (\BIN OFD)
		  (\BIN OFD)       (* ignore checksum)

		  (PRIN2 (SETQ N (READNAME
 OFD))
			 T T)
		  [AND (CAR OUTFILE)
		       (CLOSEF (PROG1 (CAR OUTFILE)
				      (RPLACA OUTFILE]
		  [COND
		    ((AND ASK (EQ [ASKUSER NIL NIL "? " (QUOTE ((Y es)
								 (N o]
				  (QUOTE N)))
		      (SETQ OUTOFD NIL))
		    (T (SETQ OUTOFD
			 (GETSTREAM [CAR (RPLACA OUTFILE
						 (OPENFILE
						   N
						   (QUOTE OUTPUT)
						   (QUOTE NEW)
						   (SELECTQ [OR ALLMODE (ASKUSER
								  NIL NIL "  mode: "
								  (QUOTE ((T ext)
									   (B inary]
							    (T NIL)
							    8]
				    (QUOTE OUTPUT]
		  (TERPRI T))
		[254               (* data block)

		     (SETQ N (IPLUS (LLSH (\BIN OFD)
					  8)
				    (\BIN OFD)))
		     (\BIN OFD)
		     (\BIN OFD)
		     (COND
		       [OUTOFD (FRPTQ N (\BOUT OUTOFD (\BIN OFD]
		       (T (FRPTQ N (\BIN OFD]
		(251               (* creation date)

		     [SETQ N (CONVERTDATE (PROG1 (\FIXPIN OFD)
						 (\WORDIN OFD]
		     (AND OUTOFD (SETFILEINFO OUTOFD (QUOTE ICREATIONDATE)
					      N)))
		(252               (* END BLOCK)

		     (RETURN))
		(ERROR BT "ILLEGAL BLOCK TYPE"])

(READNAME

  [LAMBDA (OFD FLG)                (* lmm "30-DEC-81 23:39")

    (bind
 CH CHARS do
 (COND
			[(ZEROP (SETQ CH (\BIN OFD)))
			  (RETURN (PACKC (DREVERSE CHARS]
			(T (push
 CHARS CH])
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \WORDIN MACRO
 (OPENLAMBDA (OFD)
				    (
LOGOR
 (
LLSH
 (
\BIN
 OFD)
						 8)
					   (
\BIN
 OFD))))

(PUTPROPS \FIXPIN MACRO
 (OPENLAMBDA (OFD)
				    (
LOGOR
 (
LLSH
 (\WORDIN OFD)
						 16)
					   (\WORDIN OFD))))

(PUTPROPS CONVERTDATE 10MACRO
 ((X)
			       (ALTO.TO.TENEX.DATE X)))

(PUTPROPS CONVERTDATE MACRO
 ((X)
			     (
ALTO.TO.LISP.DATE
 X)))

(PUTPROPS CONVERTDATE DMACRO
 ((X)
			      (ALTO.TO.LISP.DATE X)))
)
)
(PUTPROPS LOADDM COPYRIGHT ("Xerox Corporation" 1982 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (437 2367 (LOADDM 447 . 2152) (READNAME 2154 . 2365)))))
STOP