(FILECREATED "30-DEC-82 19:51:31" <BLISPUSERS>LOADDM.;9
    3518

      changes to:  (VARS LOADDMCOMS)

      previous date: "10-DEC-82 08:15:55" <BLISPUSERS>LOADDM.;8)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT LOADDMCOMS)

(RPAQQ LOADDMCOMS
 ((FNS LOADDM READNAME ALTO.TO.TENEX.DATE)
		   (DECLARE: EVAL@COMPILEWHEN (EQ (COMPILEMODE)
						  (QUOTE PDP-10))
			     COPYWHEN
			     (EQ (COMPILEMODE)
				 (QUOTE PDP-10))
			     (FILES (FROM LISPUSERS)
				    DFOR10))
		   (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])

(ALTO.TO.TENEX.DATE

  [LAMBDA (N)                      (* lmm "29-JUN-80 23:07")

                                   (* ALTO DATES ARE IN SECONDS SINCE JAN 1, 1901 GMT.

				   TENEX DATES ARE GMT DAY,,SEC)

    (XWD (IPLUS (IQUOTIENT N (ITIMES 74Q 30Q 74Q))
		(CONSTANT (LRSH (IDATE "01-JAN-01 00:00:00 GMT")
				22Q)))
	 (IREMAINDER N (ITIMES 74Q 30Q 74Q)))])
)
(DECLARE: EVAL@COMPILEWHEN (EQ (COMPILEMODE)
			       (QUOTE PDP-10)) COPYWHEN (EQ (COMPILEMODE)
							    (QUOTE PDP-10)) 
(FILESLOAD (FROM LISPUSERS)
	   DFOR10)
)
(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)
			     X))
)
)
(PUTPROPS LOADDM COPYRIGHT ("Xerox Corporation" 1982))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (565 2871 (LOADDM 575 . 2280) (READNAME 2282 . 2493) (ALTO.TO.TENEX.DATE 2495 . 2869)))
))
STOP