LOGICAL FUNCTION GET_XMODEM (LBUFF)
C
C	This routine is used transfer a file from the remote system to
C	the VAX using the XMODEM protocol.
C
C	Inputs:
C		LBUFF = The local buffer.			(By Descriptor)
C
C	The local buffer LBUFF is presumed to be filled with the buffer
C	address and length of buffer LBUFFER.  This way, we can access the
C	same buffer as a characters string or via byte offsets.
C
C	Outputs:
C		.TRUE./.FALSE. = Success/Failure.
C
	INCLUDE 'COM.INC/NOLIST'

	CHARACTER*(*) LBUFF
	CHARACTER*(*) MODULE_NAME

	PARAMETER (MODULE_NAME = 'GET_XMODEM')
	PARAMETER (DATA_INDEX = 4)		! Index to 1st data byte.
	PARAMETER (DATA_SIZE = 128)		! Number of data bytes.
	PARAMETER (CHECKSUM_INDEX = 132)	! Index to checksum byte/crc.
	LOGICAL REPORT_ERROR, RECEIVED_EOF
	INTEGER I, INDEX, SIZE, READ_LENGTH
	INTEGER BLOCK_EXPECTED, PREVIOUS_BLOCK, BLOCK_COMP, CHECKSUM, REC_SIZE
	LOGICAL USE_CRC
	CHARACTER ANSWER*1
	PARAMETER CRC_PROMPT = 'Use CRC (Y/N) ? '

	GET_XMODEM = .FALSE.			! Initialize to bad return.
	CALL PROMPT_USER(CRC_PROMPT, %REF(ANSWER), 1)
	CALL STR$UPCASE(ANSWER,ANSWER)
	USE_CRC = ANSWER.EQ.'Y'
C
C	Synchronize with remote XMODEM.  The sending XMODEM program is
C	waiting to receive a NAK or a C, all other characters are ignored.
C
	IF (USE_CRC) THEN
	   CALL SEND_CRC()			! Send C to synchronize.
	   READ_LENGTH = CHECKSUM_INDEX
	ELSE
	   CALL SEND_NAK()			! Send NAK to synchronize.
	   READ_LENGTH = CHECKSUM_INDEX - 1
	END IF
	BLOCK_EXPECTED = 1			! Initialize the block number.
	PREVIOUS_BLOCK = BLOCK_EXPECTED		! Initialize the previous block.
	RECEIVED_EOF = .FALSE.			! Initialize the EOF flag.
	REC_SIZE = 0				! Initialize the record size.
C
C	Loop, waiting for the first byte from the remote.
C
C	We expect either an SOH or EOT byte at this point.
C
100	IF (CONTROLC_TYPED) GO TO 9998		! Abort if CTRL/C typed.
	RBUFFER(1) = READ_BYTE (TIMEOUT_COUNT)	! Read the first byte.
	IF (RIOSB(1) .NE. SS$_NORMAL) GO TO 600 ! Report error/NAK.
C
C	If we don't get one of the expected control bytes, we wait until
C	the line is idle to read any garbage characters.  This is done
C	since we may have missed the SOH byte and we don't want any data
C	in that block to abort us prematurly via EOT or CAN.
C
	IF ( (RBUFFER(1) .NE. SOH) .AND. (RBUFFER(1) .NE. EOT)
	1		.AND. (RBUFFER(1) .NE. CAN) ) THEN
	    CALL WAIT_TILL_IDLE (MODULE_NAME,RBUFFER) ! Discard garbage.
	    GO TO 100				! Look for SOH again.
	ENDIF
	IF (RBUFFER(1) .EQ. CAN) THEN
	    CALL CHECK_DISPLAY()		! Check display formatting.
	    CALL WRITE_USER ('*** Received a CANcel from the remote. ***'//SS)
	    GO TO 9999				! Abort the transmission.
	ENDIF
	IF (RBUFFER(1) .EQ. EOT) GO TO 700	! End of transmission.
	IF (RBUFFER(1) .NE. SOH) GO TO 600	! First byte sould be SOH.
C
C	We received the SOH byte, read the rest of the block.
C
C	Format:  <SOH><block #><comp block #>< 128 data bytes ><checksum>
C	  or     <SOH><block #><comp block #>< 128 data bytes ><crc_h><crc_l>
C
	IF ( .NOT. (RAW_READ (RBUFFER(2), READ_LENGTH,
	1				TIMEOUT_COUNT, NOTERM)) ) GO TO 600
	BLOCK_RECEIVED = RBUFFER(2) .AND. BITMASK ! Copy the block number.
	BLOCK_COMP = RBUFFER(3)	.AND. BITMASK	  ! Copy complemented block #.
	IF ( (BLOCK_RECEIVED + BLOCK_COMP) .NE. BITMASK) THEN
	  IF (DEBUG_MODE) THEN
	    CALL CHECK_DISPLAY()
	    CALL SYS$FAO ('*** Block mismatch: received block is !UL ***!/',
	1			SIZE, SCRATCH, %VAL(BLOCK_RECEIVED) )
	    CALL WRITE_USER (SCRATCH(1:SIZE))
	    CALL SYS$FAO ('***             complemented block is !UL ***!/',
	1			SIZE, SCRATCH, %VAL(BLOCK_COMP) )
	    CALL WRITE_USER (SCRATCH(1:SIZE))
	  ENDIF
	  GO TO 600				! Report the error condition.
	ENDIF
	IF (BLOCK_RECEIVED .NE. BLOCK_EXPECTED) GO TO 550
	IF (USE_CRC) THEN
	  CALL XMODEM_CRC (RBUFFER(DATA_INDEX), DATA_SIZE+2)
	  IF (RBUFFER(CHECKSUM_INDEX).NE.0 .OR.
	1	RBUFFER(CHECKSUM_INDEX+1).NE.0) THEN
	    IF (DEBUG_MODE) THEN
	      CALL CHECK_DISPLAY()
	      CHECKSUM = RBUFFER(CHECKSUM_INDEX)
	      CALL SYS$FAO ('*** CRC error: Byte one = !XB ***!/',
	1			SIZE, SCRATCH, %VAL(CHECKSUM) )
	      CALL WRITE_USER (SCRATCH(1:SIZE))
	      CHECKSUM = RBUFFER(CHECKSUM_INDEX+1)
	      CALL SYS$FAO ('***            Byte two = !XB ***!/',
	1			SIZE, SCRATCH, %VAL(CHECKSUM) )
	      CALL WRITE_USER (SCRATCH(1:SIZE))
	    ENDIF
	    GO TO 600				! Report the error condition.
	  ENDIF
	ELSE
	  CHECKSUM = XMODEM_CHECKSUM (RBUFFER(DATA_INDEX), DATA_SIZE)
	  IF (CHECKSUM .NE. (RBUFFER(CHECKSUM_INDEX) .AND. BITMASK)) THEN
	    IF (DEBUG_MODE) THEN
	      CALL CHECK_DISPLAY()
	      CALL SYS$FAO (
	1		'*** Checksum error: expected checksum is !UL ***!/',
	1			SIZE, SCRATCH, %VAL(CHECKSUM) )
	      CALL WRITE_USER (SCRATCH(1:SIZE))
	      INCHECKSUM = RBUFFER(CHECKSUM_INDEX)
	      CALL SYS$FAO (
	1		'***       While the received checksum is !UL ***!/',
	1			SIZE, SCRATCH, %VAL(INCHECKSUM) )
	      CALL WRITE_USER (SCRATCH(1:SIZE))
	    ENDIF
	    GO TO 600				! Report the error condition.
	  ENDIF
	ENDIF
	BLOCK_COUNT = BLOCK_COUNT + 1		! Adjust the block count.
C
C	Copy the receive buffer and break at CR/LF if text mode.
C
	DO 200 I = DATA_INDEX,DATA_SIZE+(DATA_INDEX-1)
	REC_SIZE = REC_SIZE + 1			! Update the record size.
	LBUFFER(REC_SIZE) = RBUFFER(I)		! Copy the receive buffer.
	IF (FILE_TYPE .EQ. BINARY) GO TO 200	! Copy entire buffer if binary.
	IF (LBUFFER(REC_SIZE) .EQ. EOF) THEN
	    REC_SIZE = REC_SIZE - 1		! Don't write the CTRL/Z.
	    RECEIVED_EOF = .TRUE.		! Show EOF was received.
	    GO TO 300				! And go write the buffer.
	ENDIF
	IF (REC_SIZE .GT. 1) THEN
	    IF ( (LBUFFER(REC_SIZE-1) .EQ. CR) .AND.
	1		(LBUFFER(REC_SIZE) .EQ. LF) ) THEN
		REC_SIZE = REC_SIZE - 2		! Adjust for the CR/LF.
		WRITE (FILE_UNIT,400,ERR=999) LBUFF(1:REC_SIZE)
		CALL XMODEM_TOTALS (REC_SIZE)	! Update the file totals.
		CALL XMODEM_REPORT()		! Report the file totals.
		REC_SIZE = 0			! Reset the record size.
	    ENDIF
	ENDIF
200	CONTINUE
C
C	Check for too many bytes in the output buffer.
C
	IF (REC_SIZE .GT. OUT_SIZE) THEN
	    CALL CHECK_DISPLAY()
	    CALL WRITE_USER ('*** The output record is too large, '//
	1		'are you sure this is an ASCII file ? ***'//SS)
	    GO TO 9998				! And report the abortion.
	ENDIF
	IF (FILE_TYPE .EQ. ASCII) GO TO 500	! Don't write buffer yet.
C
C	Write the buffer to the output file.
C
300	IF (REC_SIZE .GT. 0) THEN
	    WRITE (FILE_UNIT,400,ERR=999) LBUFF(1:REC_SIZE)
400	    FORMAT (A)
	    CALL XMODEM_TOTALS (REC_SIZE)	! Update the totals.
	    CALL XMODEM_REPORT()		! Report the file totals.
	    REC_SIZE = 0			! Initialize the record size.
	ENDIF
500	PREVIOUS_BLOCK = BLOCK_EXPECTED		! Copy the current block #.
	BLOCK_EXPECTED = MOD (BLOCK_EXPECTED+1,256) .AND. BITMASK
	CALL SEND_ACK()				! Send an ACKnowlegment.
	GO TO 100				! Go read the next block.
C
C	We come here when the block number don't match.
C
550	IF (BLOCK_RECEIVED .EQ. PREVIOUS_BLOCK) THEN
	    IF (.NOT. REPORT_ERROR(.FALSE.)) THEN
		GO TO 9998			! Exceeded retry limit, abort.
	    ELSE
		IF (DEBUG_MODE) THEN
		    CALL CHECK_DISPLAY()
		    CALL WRITE_USER ('*** Received the previous block,'//
	1			' resending the ACKnowlegment ... ***'//SS)
		ENDIF
	    ENDIF
	    CALL SEND_ACK()			! ACK previous block number.
	    GO TO 100				! Go read the next block.
	ELSE
	    CALL CHECK_DISPLAY()
	    CALL SYS$FAO ('*** Phase error -- received block is !UL ***!/',
	1		SIZE, SCRATCH, %VAL(BLOCK_RECEIVED) )
	    CALL WRITE_USER (SCRATCH(1:SIZE))
	    CALL SYS$FAO ('***      While the expected block is !UL ***!/',
	1		SIZE, SCRATCH, %VAL(BLOCK_EXPECTED) )
	    CALL WRITE_USER (SCRATCH(1:SIZE))
	    GO TO 9998
	ENDIF
C
C	We come here to send a NAK for a tranmission error.
C
600	CALL WAIT_TILL_IDLE (MODULE_NAME,RBUFFER) ! Wait until remote is idle.
	IF (REPORT_ERROR(.TRUE.)) THEN	! Report the transmission error.
	    CALL SEND_NAK()		! Tell remote to resend last record.
	    GO TO 100			! And try again.
	ELSE
	    GO TO 9998			! Retry limit exceeded, abort.
	ENDIF
C
C	We come here to process end of file.
C
700	CLOSE (UNIT=FILE_UNIT)		! Close the input file
	CALL SEND_ACK()			! Tell remote XMODEM we got EOT.
	CALL REPORT_SUCCESS()		! Report the transmission success.
	GET_XMODEM = .TRUE.		! Return success.
	RETURN
C
C	We come here if an error occurs writing the output file.
C
999	CALL RMS_ERROR (MODULE_NAME)	! Report the RMS error message.
C
C	Come here to send CANcel and abort transmission.
C
9998	CALL SEND_CAN()			! Cancel the transmission & exit.
C
C	We come here to report failure.
C
9999	CLOSE (UNIT=FILE_UNIT)		! Close the input file.
	CALL REPORT_ABORT()		! Report the aborted transmission.
	RETURN
	END

	LOGICAL FUNCTION SEND_XMODEM (LBUFF)
C
C	This routine is used transfer a file to the remote system from
C	the VAX using the XMODEM protocol.
C
C	Inputs:
C		LBUFF = The local buffer.			(By Descriptor)
C
C	The local buffer LBUFF is presumed to be filled with the buffer
C	address and length of buffer LBUFFER.  This way, we can access the
C	same buffer as a characters string or via byte offsets.
C
C	Outputs:
C		.TRUE./.FALSE. = Success/Failure.
C
	INCLUDE 'COM.INC/NOLIST'

	CHARACTER*(*) LBUFF

	PARAMETER (DATA_INDEX = 4)		! Index to 1st data byte.
	PARAMETER (DATA_SIZE = 128)		! Number of data bytes.
	PARAMETER (BLOCK_SIZE = DATA_SIZE + 3)	! Size of block - checksum/crc.
	LOGICAL REPORT_ERROR, AT_EOF, USE_CRC/.FALSE./
	INTEGER BYTES, XMIT_SIZE, CHECKSUM, DINDEX, I

	SEND_XMODEM = .FALSE.			! Initialize to bad return.
	AT_EOF = .FALSE.			! Show not at end of file.
	BLOCK_XMITTED = 1			! Initialize the block #.
	XMIT_SIZE = DATA_INDEX - 1		! Initialize the XMIT size.
C
C	The remote XMODEM should have sent a NAK or a C to tell us to send.
C	If we timeout waiting for the NAK or C, we'll start sending anyway.
C
	RBUFFER(1) = READ_BYTE (TIMEOUT_COUNT)	! Read the first byte.
	USE_CRC = RBUFFER(1).EQ.ICHAR('C')
	CALL CLEAR_TYPEAHEAD()			! Clear any other garbage.
C
C	Read a record from the input file.
C
100	IF (CONTROLC_TYPED) GO TO 9998		! CTRL/C typed to abort.
	DINDEX = 1				! Index into input record.
	READ (FILE_UNIT,110,END=9900,ERR=9990) BYTES, LBUFF
110	FORMAT (Q, A)
	CALL XMODEM_TOTALS (BYTES)		! Update the file totals.
C
C	If we're in text mode, append a CR/LF sequence.
C
	IF (FILE_TYPE .EQ. ASCII) THEN
	    LBUFFER(BYTES+1) = CR		! Append a carraige return
	    LBUFFER(BYTES+2) = LF		!	and a line feed.
	    BYTES = BYTES + 2			! Adjust the byte count.
	ENDIF
	IF (BYTES .EQ. 0) GO TO 100		! Blank binary record.
C
C	Prepare the buffer to transmit.
C
C	Format:  <SOH><block #><comp block #>< 128 data bytes ><checksum>
C	  or     <SOH><block #><comp block #>< 128 data bytes ><crc_h><crc_l>
C
200	DO 300 I = DINDEX,BYTES
	XMIT_SIZE = XMIT_SIZE + 1		! Adjust the XMIT buffer size.
	XBUFFER(XMIT_SIZE) = LBUFFER(I) .AND. BITMASK ! Copy the next byte.
	IF (XMIT_SIZE .EQ. BLOCK_SIZE) GO TO 400 ! Go transmit this block.
300	CONTINUE
	GO TO 100				! Go read the next record.
C
C	Calculate the checksum and transmit this block.
C
400	DINDEX = I + 1				! Save index into record.
	XBUFFER(1) = SOH			! Start with the SOH byte.
	XBUFFER(2) = BLOCK_XMITTED		! Fill in the block number.
	XBUFFER(3) = (255 - BLOCK_XMITTED) .AND. BITMASK ! Comp. block number.
	IF (USE_CRC) THEN
	   XBUFFER(XMIT_SIZE+1) = 0		! Preset to 0
	   XBUFFER(XMIT_SIZE+2) = 0		! Preset to 0
	   CALL XMODEM_CRC(XBUFFER(DATA_INDEX), DATA_SIZE+2)
	   XMIT_SIZE = XMIT_SIZE + 2
	ELSE
	   CHECKSUM = XMODEM_CHECKSUM (XBUFFER(DATA_INDEX), DATA_SIZE)
	   XMIT_SIZE = XMIT_SIZE + 1		! Point to checksum byte.
	   XBUFFER(XMIT_SIZE) = CHECKSUM	! Fill in the checksum.
	END IF
	BLOCK_XMITTED = MOD (BLOCK_XMITTED+1,256) .AND. BITMASK
	BLOCK_COUNT = BLOCK_COUNT + 1		! Adjust the block count.
C
C	Write the buffer to the remote.
C
600	IF (CONTROLC_TYPED) GO TO 9998		! CTRL/C typed to abort.
	CALL RAW_WRITE (XBUFFER, XMIT_SIZE)	! Write this block of data.
C
C	Now, we must wait for an ACKnowlegment.
C
	RBUFFER(1) = READ_BYTE (TIMEOUT_COUNT)	! Read response from remote.
	IF (RIOSB(1) .NE. SS$_NORMAL) GO TO 700 ! Report transmission error.
	IF (RBUFFER(1) .EQ. CAN) THEN
	    CALL CHECK_DISPLAY()		! Check display formatting.
	    CALL WRITE_USER ('*** Received a CANcel from the remote. ***'//SS)
	    GO TO 9999				! Transmission is cancelled.
	ENDIF
	IF (RBUFFER(1) .EQ. ACK) GO TO 800	! Block successfully sent.
C
C	Report the transmission error.
C
700	IF (REPORT_ERROR(.TRUE.)) THEN		! Report transmission error.
	    GO TO 600				! And try again.
	ELSE
	    GO TO 9998				! Retry limit exceeded, abort.
	ENDIF
C
C	Now we're ready to finish the previous record or read the next.
C
800	IF (XBUFFER(1) .EQ. EOT) GO TO 9910	! Our EOT has been ACKed.
	CALL XMODEM_REPORT()			! Display the file totals.
900	IF (AT_EOF) THEN
	    XMIT_SIZE = 1			! Set size of XMIT buffer.
	    XBUFFER(XMIT_SIZE) = EOT		! Get ready to send EOT.
	    GO TO 600				! Send end of transmission.
	ENDIF
	XMIT_SIZE = DATA_INDEX - 1		! Reinitialize the XMIT size.
	IF (DINDEX .LE. BYTES) THEN
	    GO TO 200				! Finish the previous record.
	ELSE
	    GO TO 100				! Read the next record.
	ENDIF
C
C	We come here for end of file on input file.
C
9900	AT_EOF = .TRUE.				! Show we're at end of file.
	IF ( (FILE_TYPE .EQ. BINARY) .AND.
	1	(XMIT_SIZE .EQ. DATA_INDEX-1) ) GO TO 900 ! Send EOT only.
C
C	This is the last block, so we pad it with EOF bytes.
C
	DO 9901 I = 1,BLOCK_SIZE
	XMIT_SIZE = XMIT_SIZE + 1		! Bump the XMIT buffer size.
	XBUFFER(XMIT_SIZE) = EOF		! Fill buffer with EOF's.
	IF (XMIT_SIZE .EQ. BLOCK_SIZE) GO TO 400 ! Go transmit this block.
9901	CONTINUE
C
C	Transmission complete.
C
9910    CLOSE (UNIT=FILE_UNIT)			! Close the input file.
	CALL REPORT_SUCCESS()			! Report transmission success.
	SEND_XMODEM = .TRUE.			! Show success.
	RETURN
C
C	We come here if an error occurs writing the output file.
C
9990	CALL RMS_ERROR (MODULE_NAME)		! Report the RMS error message.
C
C	Come here when CANcelling the transmission.
C
9998	CALL SEND_CAN()				! Cancel the transmission.
C
C	Here to report failure.
C
9999	CLOSE (UNIT=FILE_UNIT)			! Close the output file.
	IF (AT_EOF) THEN
	    CALL CHECK_DISPLAY()
	    CALL WRITE_USER('*** Remote not responding on completion. ***'//SS)
	ENDIF
	CALL REPORT_ABORT()			! Report aborted transmission.
	RETURN
	END

	INTEGER FUNCTION READ_BYTE (SECONDS)
C
C	This routine is used to read a single byte.
C
C	Inputs:
C		SECONDS = The timeout in seconds.
C
	INCLUDE 'COM.INC/NOLIST'

	INTEGER SECONDS
	LOGICAL*1 BUFF(1)

	BUFF(1) = 0
	CALL RAW_READ (BUFF, 1, SECONDS, NOTERM)
	READ_BYTE = BUFF(1) .AND. BITMASK
	RETURN
	END

	SUBROUTINE SEND_BYTE (BUFFER)
C
C	This routine is used to write a single byte.
C
	INCLUDE 'COM.INC/NOLIST'

	LOGICAL*1 BUFFER(1), BUFF(1)

	BUFF(1) = BUFFER(1) .AND. BITMASK
	CALL RAW_WRITE (BUFF(1))
	RETURN
	END

	INTEGER FUNCTION RAW_READ (BUFFER, BYTES, SECONDS, READ_TTBL)
C
C	This routine is used to read raw data (no interpretation).
C
C	Inputs:
C		BUFFER		The buffer to read into.
C		BYTES		The number of bytes to read.
C		SECONDS		The timeout in seconds.
C		READ_TTBL	The read terminator table.
C
C	Outputs:
C		Passes back system service or I/O status code.
C
	INCLUDE 'COM.INC/NOLIST'

	CHARACTER*(*) MODULE_NAME
	PARAMETER (MODULE_NAME = 'RAW_READ')

	LOGICAL*1 BUFFER(1)
	INTEGER BYTES, SECONDS, READ_TTBL, STATUS

	RAW_READ = SYS$QIOW (%VAL(REFN_IN),%VAL(RCHAN_IN),
	1		%VAL(IO$_TTYREADALL + IO$M_NOECHO + IO$M_TIMED),
	1		RIOSB,,,BUFFER,%VAL(BYTES),
	1		%VAL(SECONDS),READ_TTBL,,)
	IF (.NOT. RAW_READ) THEN
	    CALL CHECK_STATUS (MODULE_NAME, RAW_READ)
	    RETURN
	ENDIF
	RAW_READ = RIOSB(1)		! Pass back I/O status.
	RBYTE_COUNT = RIOSB(2)		! Save the byte count.
	IF (DEBUG_MODE) THEN
	    CALL WRITE_DEBUG (MODULE_NAME, BUFFER, RBYTE_COUNT)
	ENDIF
C
C	Check for various errors:
C
	IF     (RIOSB(1) .EQ. SS$_TIMEOUT) THEN		! Timeout error ?
		TIMEOUTS = TIMEOUTS + 1			! Yes, count it.
	ELSEIF (RIOSB(1) .EQ. SS$_PARITY) THEN		! Parity error ?
		PARITY_ERRORS = PARITY_ERRORS + 1	! Yes, count it,
	ELSEIF (RIOSB(1) .EQ. SS$_DATAOVERUN) THEN	! Data overrun ?
		OVERRUN_ERRORS = OVERRUN_ERRORS + 1	! Yes, count it.
	ELSEIF (RIOSB(1) .NE. SS$_ABORT) THEN		! CTRL/C to abort.
		CALL CHECK_STATUS (MODULE_NAME, RAW_READ)
	ENDIF
	RETURN
	END

	LOGICAL FUNCTION RAW_WRITE (BUFFER, BYTES)
C
C	This routine is used to write raw data (no interpretation).
C
C	Inputs:
C		BUFFER = The buffer to write.			(By Reference)
C		BYTES = The number of bytes to write.		(By Reference)
C
C	Outputs:
C		.TRUE./.FALSE. = Success/Failure.
C
	INCLUDE 'COM.INC/NOLIST'

	CHARACTER*(*) MODULE_NAME
	PARAMETER (MODULE_NAME = 'RAW_WRITE')

	LOGICAL*1 BUFFER(1)
	INTEGER BYTES, STATUS

	IF (DEBUG_MODE) THEN
	    CALL WRITE_DEBUG (MODULE_NAME, BUFFER, BYTES)
	ENDIF
	RAW_WRITE = SYS$QIOW (%VAL(REFN_OUT),%VAL(RCHAN_OUT),
	1		%VAL(IO$_WRITELBLK + IO$M_NOFORMAT),
	1		XIOSB,,,BUFFER,%VAL(BYTES),,,,)
	IF (.NOT. STATUS) THEN
	    CALL CHECK_STATUS (MODULE_NAME, RAW_WRITE)
	ENDIF
	RETURN
	END

	INTEGER FUNCTION XMODEM_CHECKSUM (BUFFER, BYTES)
C
C	Calculate the checksum for the XMODEM protocol.
C
C	Outputs:
C		Returns the calculated checksum.
C
	IMPLICIT NONE
	INCLUDE 'PROTO.INC'

	LOGICAL*1 BUFFER(1)
	INTEGER BYTES, I

	XMODEM_CHECKSUM = 0			! Initialize the checksum.
	DO I = 1, BYTES
	    XMODEM_CHECKSUM = (XMODEM_CHECKSUM + BUFFER(I)) .AND. BITMASK
	ENDDO
	RETURN
	END

	SUBROUTINE XMODEM_CRC (BUFFER, BYTES)
C
C	Calculate the crc for the XMODEM protocol.
C
C	Outputs:
C		Returns the calculated crc.
C
	IMPLICIT NONE

	LOGICAL*1 BUFFER(*)
	INTEGER BYTES, I, BYTE, J, NEWBYTE

c  updates the Cyclic Redundancy Code
c  (lifted from XMODEM_AU on DECUS s87 tape)
c  uses x^16 + x^12 + x^5 + 1 as recommended by CCITT
c  and as used by CRCSUBS version 1.20 for 8080 microprocessor
c  and incorporated into the MODEM7 protocol of the CP/M user's group
c
c  during sending:
c  call updcrc   for all bytes including CRC bytes
c
c  during reception:
c  call updcrc  all bytes PLUS the two received CRC bytes must be passed
c       to this routine - then zero in high and low means good checksum
c
c  see Computer Networks, Andrew S. Tanenbaum, Prentiss-Hall, 1981
c
c  must declare integer to allow shifting
	INTEGER BIT,BITL,BITH

	INTEGER HIGH,LOW
	BYTE HIGHBYTE,LOWBYTE
	EQUIVALENCE (HIGH,HIGHBYTE)
	EQUIVALENCE (LOW,LOWBYTE)

	HIGH = 0
	LOW  = 0

	DO I=1,BYTES
	    BYTE=BUFFER(I)

	    DO J=1,8
c  get high bits of bytes so we don't lose them when shift
c  positive is left shift
		BIT =ISHFT( IAND(128,BYTE), -7)
		BITL=ISHFT( IAND(128,LOW),  -7)
		BITH=ISHFT( IAND(128,HIGH), -7)
c  get ready for next iteration
		NEWBYTE=ISHFT(BYTE,1)
		BYTE=NEWBYTE		! introduced dummy variable newbyte
					! to avoid "access violation"
c  shift those bits in
		LOW =ISHFT(LOW ,1)+BIT
		HIGH=ISHFT(HIGH,1)+BITL

		IF (BITH.EQ.1) THEN
		    HIGH=IEOR(16,HIGH)
		    LOW=IEOR(33,LOW)
		ENDIF
	    ENDDO
	ENDDO
	BUFFER(BYTES-1) = HIGHBYTE
	BUFFER(BYTES  ) = LOWBYTE

	RETURN
	END

	SUBROUTINE XMODEM_TOTALS (BYTES)
C
C	This routine is called after a record is successfully transmitted
C	to update the various counters.  Since the routine is called while
C	building a transmit buffer from multiple input records, the record
C	display has a special entry which is called after tranmitting the
C	current block.
C
	INCLUDE 'PROTO.INC'

	INTEGER BYTES

	BYTE_COUNT = BYTE_COUNT + BYTES		! Accumulate the byte count
	RECORD_COUNT = RECORD_COUNT + 1		!	and the record count.
	RETURN

	ENTRY XMODEM_REPORT
	RETRY_COUNT = 0				! Reinitialize retry counter.
	IF (DISPLAY_SCREEN) THEN
	    IF (MOD (BLOCK_COUNT,DISPLAY_RECORD) .EQ. 0) THEN
		CALL REPORT_RECORD()		! Report the record number.
	    ENDIF
	ENDIF
	RETURN
	END