(FILECREATED " 3-Jan-86 17:10:20" {ERIS}<LISPCORE>LIBRARY>DIGEST.;3 14384  

      changes to:  (FNS DIGEST.FILE \DIGEST.FILE.FOR.TRANSMISSION \DIGEST.INITIALIZE 
			\DIGEST.SEND.FILE.BYTES \DIGEST.SEND.PARAMETERS \DIGEST.WRITE 
			\DIGEST.PREAMBLE \DIGEST.SEND.STRING \DIGEST.SEND.HEADER \DIGEST.SEND.PACKET)
		   (MACROS \DIGEST.INCREMENT.SEQNO \DIGEST.DEFAULT.CHECKSUM \DIGEST.CTL \DIGEST.CHAR)
		   (VARS DIGESTCOMS DIGEST.PACKET.TYPES \DIGESTOVLEN \DIGEST.INIT.PARAMETER.OFFSETS)

      previous date: " 3-Jan-86 16:49:25" {ERIS}<LISPCORE>LIBRARY>DIGEST.;1)


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

(PRETTYCOMPRINT DIGESTCOMS)

(RPAQQ DIGESTCOMS ((MACROS \DIGEST.CHAR \DIGEST.CTL \DIGEST.DEFAULT.CHECKSUM 
			     \DIGEST.INCREMENT.SEQNO)
		     (VARS DIGEST.PACKET.TYPES \DIGEST.INIT.PARAMETER.OFFSETS \DIGESTOVLEN)
		     (FNS DIGEST.FILE \DIGEST.FILE.FOR.TRANSMISSION \DIGEST.INITIALIZE 
			  \DIGEST.PREAMBLE \DIGEST.SEND.FILE.BYTES \DIGEST.SEND.HEADER 
			  \DIGEST.SEND.PACKET \DIGEST.SEND.PARAMETERS \DIGEST.SEND.STRING 
			  \DIGEST.WRITE)
		     (RECORDS KERMITSTATE)))
(DECLARE: EVAL@COMPILE 
(DEFMACRO \DIGEST.CHAR (X)
	  (BQUOTE (IPLUS (\, X)
			 32)))
(DEFMACRO \DIGEST.CTL (X)
	  (BQUOTE (LOGAND (MASK.1'S 0 8)
			  (LOGXOR , X 64))))
(DEFMACRO \DIGEST.DEFAULT.CHECKSUM (S)
	  (BQUOTE (\KERMIT.CHAR (LOGAND (IPLUS (\, S)
					       (FOLDLO (LOGAND (\, S)
							       192)
						       64))
					(MASK.1'S 0 6)))))
(DEFMACRO \DIGEST.INCREMENT.SEQNO (KERMITSTATE)
	  (BQUOTE (change (fetch (KERMITSTATE CURRENTSEQNO)
				 of
				 (\, KERMITSTATE))
			  (IMOD (ADD1 DATUM)
				64))))
)

(RPAQQ DIGEST.PACKET.TYPES ((DIGEST.DATA.PACKET (CHARCODE D))
			      (DIGEST.ACK.PACKET (CHARCODE Y))
			      (DIGEST.NAK.PACKET (CHARCODE N))
			      (DIGEST.SENDINIT.PACKET (CHARCODE S))
			      (DIGEST.BREAK.PACKET (CHARCODE B))
			      (DIGEST.FILEHEADER.PACKET (CHARCODE F))
			      (DIGEST.EOF.PACKET (CHARCODE Z))
			      (DIGEST.ERROR.PACKET (CHARCODE E))
			      (DIGEST.ILLEGAL.PACKET (CHARCODE T))
			      (DIGEST.GENERIC.SERVER.COMMAND (CHARCODE G))))

(RPAQQ \DIGEST.INIT.PARAMETER.OFFSETS ((\KPARM.MAXL 1)
					 (\KPARM.TIME 2)
					 (\KPARM.NPAD 3)
					 (\KPARM.PADC 4)
					 (\KPARM.EOL 5)
					 (\KPARM.QCTL 6)
					 (\KPARM.QBIN 7)))

(RPAQQ \DIGESTOVLEN 5)
(DEFINEQ

(DIGEST.FILE
  (LAMBDA (INPUTFILE OUTPUTFILE)                             (* ejs: " 3-Jan-86 17:01")

          (* * Send a file to a remote kermit)


    (COND
      ((AND (SETQ INPUTFILE (INFILEP INPUTFILE))
	      OUTPUTFILE)
	(LET* ((KERMITSTATE (create KERMITSTATE
				      EOL _(CHARCODE EOL)
				      EOLCONVENTION _ NIL)))
	      (\DIGEST.FILE.FOR.TRANSMISSION INPUTFILE OUTPUTFILE KERMITSTATE)))
      (OUTPUTFILE (ERROR "Can't find input file")))))

(\DIGEST.FILE.FOR.TRANSMISSION
  (LAMBDA (LOCALFILE REMOTEFILE KERMITSTATE)                 (* ejs: " 3-Jan-86 17:04")

          (* * Send a file)


    (LET ((OUTPUTSTREAM (COND
			  ((STREAMP REMOTEFILE)
			    REMOTEFILE)
			  (T (OPENSTREAM REMOTEFILE (QUOTE OUTPUT)
					   (QUOTE NEW)
					   (QUOTE ((TYPE BINARY)
						      (SEQUENTIAL T)))))))
	  INPUTSTREAM)
         (\DIGEST.INITIALIZE KERMITSTATE OUTPUTSTREAM (QUOTE STORE))
         (COND
	   ((\DIGEST.PREAMBLE KERMITSTATE)
	     (SETQ INPUTSTREAM (OPENSTREAM LOCALFILE (QUOTE INPUT)
					       (QUOTE OLD)
					       (QUOTE ((TYPE BINARY)
							  (SEQUENTIAL T)))))
	     (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
						      (CLOSEF? STREAM)))
						  INPUTSTREAM))
			 (\DIGEST.SEND.HEADER LOCALFILE KERMITSTATE)
			 (\DIGEST.SEND.FILE.BYTES INPUTSTREAM KERMITSTATE))
	     (replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE COMPLETE)))))))

(\DIGEST.INITIALIZE
  (LAMBDA (KERMITSTATE OUTPUTSTREAM FORWHAT)                 (* ejs: " 3-Jan-86 17:09")
    (with KERMITSTATE KERMITSTATE (SETQ CURRENTSEQNO 0)
	    (SETQ OUTSTREAM OUTPUTSTREAM)
	    (SETQ QBIN (CHARCODE &))
	    (SELECTQ FORWHAT
		       (RECEIVE (SETQ STATE (QUOTE REC.INIT)))
		       (STORE (SETQ STATE (QUOTE SEND.INIT)))
		       (ERROR "Illegal Kermit operation" FORWHAT))
	    KERMITSTATE)))

(\DIGEST.PREAMBLE
  (LAMBDA (KERMITSTATE)                                      (* ejs: " 3-Jan-86 16:54")
    (LET (PARAMETER.PACKET)
         (SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
		    (REC.INIT (SETQ PARAMETER.PACKET (\KERMIT.GET.PACKET KERMITSTATE))
			      (SELECTC (NTHCHARCODE PARAMETER.PACKET KERMIT.PACKET.TYPE)
					 (KERMIT.SENDINIT.PACKET (\KERMIT.PARSE.REMOTE.PARAMETERS
								   PARAMETER.PACKET KERMITSTATE))
					 (KERMIT.ERROR.PACKET (HELP (\KERMIT.DATASECTION 
										 PARAMETER.PACKET)))
					 (ERROR "Unexpected packet type: " PARAMETER.PACKET))
			      (LET ((QBIN (fetch (KERMITSTATE QBIN) of KERMITSTATE)))
			           (SELECTC QBIN
					      ((CHARCODE N)
						(replace (KERMITSTATE QBIN) of KERMITSTATE
						   with NIL))
					      ((CHARCODE Y)
						(replace (KERMITSTATE QBIN) of KERMITSTATE
						   with (CHARCODE &)))
					      (COND
						((OR (AND (GEQ QBIN 33)
							      (LEQ QBIN 62))
						       (AND (GEQ QBIN 96)
							      (LEQ QBIN 126)))
						  (replace (KERMITSTATE QBIN) of KERMITSTATE
						     with QBIN)))))
			      (\DIGEST.SEND.PARAMETERS KERMITSTATE)
			      (replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE 
											 REC.FILE)))
		    (SEND.INIT (\DIGEST.SEND.PARAMETERS KERMITSTATE)
			       (replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE 
											SEND.FILE)))
		    (HELP "Illegal Kermit state" (fetch (KERMITSTATE STATE) of KERMITSTATE))))))

(\DIGEST.SEND.FILE.BYTES
  (LAMBDA (FILESTREAM KERMITSTATE)                           (* ejs: " 3-Jan-86 17:02")

          (* * Send all the bytes of file)


    (replace (STREAM ENDOFSTREAMOP) of FILESTREAM with (FUNCTION (LAMBDA NIL -1)))
    (bind (PACKET _(ALLOCSTRING (fetch (KERMITSTATE MAXL) of KERMITSTATE)))
	    (QCTL _(fetch (KERMITSTATE QCTL) of KERMITSTATE))
	    (QBIN _(fetch (KERMITSTATE QBIN) of KERMITSTATE))
	    DONE CHAR MASKEDCHAR DATASECTION FILLEDATASECTION MAXCHARS CHARINDEX
       first (SETQ DATASECTION (\KERMIT.DATASECTION PACKET))
	       (SETQ MAXCHARS (NCHARS DATASECTION))
       until DONE as I from 1
       do (for old CHARINDEX from 1 to MAXCHARS
	       do (SETQ CHAR (BIN FILESTREAM))
		    (COND
		      ((EQ -1 CHAR)
			(SETQ DONE T)
			(RETURN)))
		    (COND
		      ((AND QBIN (IGREATERP CHAR (MASK.1'S 0 7)))
			(SETQ MASKEDCHAR (LOGAND CHAR (MASK.1'S 0 7)))
			(COND
			  ((OR (EQ CHARINDEX MAXCHARS)
				 (AND (EQ CHARINDEX (SUB1 MAXCHARS))
					(OR (ILESSP MASKEDCHAR (CHARCODE SPACE))
					      (EQ MASKEDCHAR QBIN)
					      (EQ MASKEDCHAR QCTL)
					      (EQ MASKEDCHAR (CHARCODE DEL)))))
                                                             (* No room for possible quoted and controlified 
							     character)
			    (SETQ WAITINGCHAR CHAR)
			    (RETURN)))
			(RPLCHARCODE DATASECTION CHARINDEX QBIN)
			(SETQ CHAR (LOGAND CHAR (MASK.1'S 0 7)))
			(add CHARINDEX 1)))
		    (COND
		      ((OR (ILESSP CHAR (CHARCODE SPACE))
			     (EQ CHAR QBIN)
			     (EQ CHAR QCTL)
			     (EQ CHAR (CHARCODE DEL)))
			(COND
			  ((EQ CHARINDEX MAXCHARS)         (* No room for both prefix and controlified character)
			    (SETQ WAITINGCHAR CHAR)
			    (RETURN)))
			(RPLCHARCODE DATASECTION CHARINDEX QCTL)
			(COND
			  ((OR (EQ CHAR QBIN)
				 (EQ CHAR QCTL)))
			  (T (SETQ CHAR (\KERMIT.CTL CHAR))))
			(add CHARINDEX 1)))
		    (RPLCHARCODE DATASECTION CHARINDEX CHAR))
	    (SETQ FILLEDATASECTION (SUBSTRING DATASECTION 1 (SUB1 CHARINDEX)
						  FILLEDATASECTION))
	    (COND
	      ((NEQ 0 (NCHARS FILLEDATASECTION))
		(\DIGEST.SEND.PACKET FILLEDATASECTION KERMIT.DATA.PACKET KERMITSTATE))
	      ((NOT DONE)
		(ERROR "No characters to send, but not done either." KERMITSTATE))))))

(\DIGEST.SEND.HEADER
  (LAMBDA (FILENAME KERMITSTATE)                             (* ejs: " 3-Jan-86 16:41")

          (* * Receive the file header, open the file according to TYPE, and return)


    (\DIGEST.SEND.PACKET (PACKFILENAME.STRING (QUOTE NAME)
						  (FILENAMEFIELD FILENAME (QUOTE NAME))
						  (QUOTE EXTENSION)
						  (FILENAMEFIELD FILENAME (QUOTE EXTENSION)))
			   DIGEST.FILEHEADER.PACKET KERMITSTATE)
    (replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE SEND.DATA))))

(\DIGEST.SEND.PACKET
  (LAMBDA (CONTENTS TYPE KERMITSTATE SEQNO)                  (* ejs: " 3-Jan-86 16:40")

          (* * Send a packet and wait for the response)


    (DECLARE (USEDFREE KERMITSTATUSWINDOW))
    (LET ((OUTSTREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
	  (CURRENTSEQNO (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE))
	  ANSWER.PACKET LENGTH SEQ ANSWER.TYPE CHAR (CHECKSUM 0))
         (\DIGEST.SEND.STRING CONTENTS TYPE KERMITSTATE SEQNO)
         (\DIGEST.INCREMENT.SEQNO KERMITSTATE))))

(\DIGEST.SEND.PARAMETERS
  (LAMBDA (KERMITSTATE)                                      (* ejs: " 3-Jan-86 16:51")
    (LET ((MYPARAMETERS (ALLOCSTRING (CONSTANT (LENGTH \DIGEST.INIT.PARAMETER.OFFSETS)))))
         (RPLCHARCODE MYPARAMETERS \KPARM.MAXL (\KERMIT.CHAR 72))
         (RPLCHARCODE MYPARAMETERS \KPARM.TIME (\KERMIT.CHAR 10))
         (RPLCHARCODE MYPARAMETERS \KPARM.NPAD (\KERMIT.CHAR 0))
         (RPLCHARCODE MYPARAMETERS \KPARM.PADC (\KERMIT.CHAR 0))
         (RPLCHARCODE MYPARAMETERS \KPARM.EOL (\KERMIT.CHAR 0))
         (RPLCHARCODE MYPARAMETERS \KPARM.QCTL (CHARCODE #))
         (RPLCHARCODE MYPARAMETERS \KPARM.QBIN (CHARCODE &))
         (SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
		    (REC.INIT (\DIGEST.SEND.PACKET MYPARAMETERS KERMIT.ACK.PACKET KERMITSTATE))
		    (SEND.INIT (\DIGEST.SEND.PACKET MYPARAMETERS DIGEST.SENDINIT.PACKET KERMITSTATE)
			       )
		    (ERROR "Illegal Kermit state")))))

(\DIGEST.SEND.STRING
  (LAMBDA (STRING TYPE KERMITSTATE SEQNO)                    (* ejs: " 3-Jan-86 16:44")

          (* * Send a string of data to the remote kermit. The string MUST have been prefixified already)


    (LET* ((STREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
	   (LENGTH (NCHARS STRING))
	   (PACKET (ALLOCSTRING (IPLUS LENGTH \DIGESTOVLEN)))
	   (CHECKSUM 0)
	   TEMP)
          (RPLCHARCODE PACKET KERMIT.PACKET.MARK (fetch (KERMITSTATE MARKCHAR) of KERMITSTATE))
          (RPLCHARCODE PACKET KERMIT.PACKET.LEN (SETQ CHECKSUM
			   (\DIGEST.CHAR (IPLUS LENGTH (CONSTANT (IDIFFERENCE \DIGESTOVLEN 
										KERMIT.PACKET.LEN)))))
			 )
          (SETQ TEMP (\DIGEST.CHAR (OR SEQNO (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE)
					   )))
          (add CHECKSUM TEMP)
          (RPLCHARCODE PACKET KERMIT.PACKET.SEQ TEMP)
          (add CHECKSUM TYPE)
          (RPLCHARCODE PACKET KERMIT.PACKET.TYPE TYPE)
          (COND
	    ((NEQ 0 LENGTH)
	      (bind CHAR for I from \DIGESTOVLEN to (IPLUS LENGTH (CONSTANT (SUB1
											  
										     \DIGESTOVLEN)))
		 as J from 1 to LENGTH
		 do (SETQ CHAR (NTHCHARCODE STRING J))
		      (COND
			((ILESSP CHAR (CHARCODE SPACE))
			  (ERROR "Call to \KERMIT.SEND.STRING with unprefixed characters: " STRING))
			)
		      (add CHECKSUM CHAR)
		      (RPLCHARCODE PACKET I CHAR))))
          (RPLCHARCODE PACKET (NCHARS PACKET)
			 (\DIGEST.DEFAULT.CHECKSUM CHECKSUM))
          (\DIGEST.WRITE PACKET KERMITSTATE)
          (replace (KERMITSTATE LASTPACKETOUT) of KERMITSTATE with PACKET)
      PACKET)))

(\DIGEST.WRITE
  (LAMBDA (STRING KERMITSTATE)                               (* ejs: " 3-Jan-86 17:07")

          (* * Sends STRING out on STREAM with FORCEOUTPUT)


    (LET ((STREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
	  PADC)
         (PRIN3 STRING STREAM)
         (TERPRI STREAM))))
)
[DECLARE: EVAL@COMPILE 

(DATATYPE KERMITSTATE ((LASTPACKETIN POINTER)
	   (LASTPACKETOUT POINTER)
	   (STATE POINTER)
	   (INSTREAM POINTER)
	   (OUTSTREAM POINTER)
	   (EOLCONVENTION POINTER)
	   (EOL POINTER)
	   (QBIN POINTER)
	   (TIME FIXP)
	   (CURRENTSEQNO BYTE)
	   (MARKCHAR BYTE)
	   (MAXL BYTE)
	   (NPAD BYTE)
	   (PADC BYTE)
	   (QCTL BYTE)
	   (CHKT BYTE)
	   (REPT BYTE))
	  CURRENTSEQNO _ 0 MARKCHAR _ KERMIT.DEFAULT.MARK.CHARACTER MAXL _ 
	  KERMIT.DEFAULT.RECV.PACKET.SIZE TIME _ KERMIT.DEFAULT.TIMEOUT.TIME NPAD _ 
	  KERMIT.DEFAULT.PAD.CHARS PADC _ KERMIT.DEFAULT.PAD.CHARACTER QCTL _ 
	  KERMIT.DEFAULT.PREFIX.CHARACTER EOL _ KERMIT.DEFAULT.EOL.CHARACTER)
]
(/DECLAREDATATYPE (QUOTE KERMITSTATE)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FIXP BYTE 
				  BYTE BYTE BYTE BYTE BYTE BYTE BYTE))
		  (QUOTE ((KERMITSTATE 0 POINTER)
			  (KERMITSTATE 2 POINTER)
			  (KERMITSTATE 4 POINTER)
			  (KERMITSTATE 6 POINTER)
			  (KERMITSTATE 8 POINTER)
			  (KERMITSTATE 10 POINTER)
			  (KERMITSTATE 12 POINTER)
			  (KERMITSTATE 14 POINTER)
			  (KERMITSTATE 16 FIXP)
			  (KERMITSTATE 14 (BITS . 7))
			  (KERMITSTATE 12 (BITS . 7))
			  (KERMITSTATE 10 (BITS . 7))
			  (KERMITSTATE 8 (BITS . 7))
			  (KERMITSTATE 6 (BITS . 7))
			  (KERMITSTATE 4 (BITS . 7))
			  (KERMITSTATE 2 (BITS . 7))
			  (KERMITSTATE 0 (BITS . 7))))
		  (QUOTE 18))
(PUTPROPS DIGEST COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2343 12905 (DIGEST.FILE 2353 . 2857) (\DIGEST.FILE.FOR.TRANSMISSION 2859 . 3909) (
\DIGEST.INITIALIZE 3911 . 4383) (\DIGEST.PREAMBLE 4385 . 6032) (\DIGEST.SEND.FILE.BYTES 6034 . 8644) (
\DIGEST.SEND.HEADER 8646 . 9203) (\DIGEST.SEND.PACKET 9205 . 9765) (\DIGEST.SEND.PARAMETERS 9767 . 
10781) (\DIGEST.SEND.STRING 10783 . 12574) (\DIGEST.WRITE 12576 . 12903)))))
STOP
