LOGICAL FUNCTION GET_XMODEM C C This routine is used transfer a file from the remote system to C the VAX using the XMODEM protocol. C INCLUDE 'COM.INC/NOLIST' 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. LOGICAL REPORT_ERROR, RECEIVED_EOF INTEGER I, INDEX, SIZE INTEGER BLOCK_EXPECTED, PREVIOUS_BLOCK, BLOCK_COMP, CHECKSUM, REC_SIZE GET_XMODEM = .FALSE. ! Initialize to bad return. C C Synchronize with remote XMODEM. The sending XMODEM program is C waiting to receive a NAK, all other characters are ignored. C CALL SEND_NAK() ! Send NAK to synchronize. 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 9999 ! Abort if CTRL/C typed. RBUFFER(1) = READ_BYTE (6) ! Read the first byte. IF (RIOSB(1) .NE. SS$_NORMAL) GO TO 600 ! Report error/NAK. IF ( (RBUFFER(1) .NE. SOH) .AND. (RBUFFER(1) .NE. EOT) ) GO TO 100 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: < 128 data bytes > C CALL RAW_READ (RBUFFER(2), DATA_SIZE+(DATA_INDEX-1), TIMEOUT_COUNT) BLOCK_RECEIVED = RBUFFER(2) .AND. BITMASK ! Copy the block number. BLOCK_COMP = RBUFFER(3) .AND. BITMASK ! Copy complemented block #. IF (BLOCK_RECEIVED .NE. BLOCK_EXPECTED) GO TO 550 IF ( (BLOCK_RECEIVED + BLOCK_COMP) .NE. BITMASK) GO TO 600 CHECKSUM = XMODEM_CHECKSUM (RBUFFER(DATA_INDEX), DATA_SIZE) IF (CHECKSUM .NE. (RBUFFER(CHECKSUM_INDEX) .AND. BITMASK)) GO TO 600 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) (LBUFFER(INDEX),INDEX=1,REC_SIZE) CALL XMODEM_TOTALS (REC_SIZE) ! Update the file totals. CALL XMODEM_REPORT() ! Report the file totals. REC_SIZE = 0 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) CALL SEND_CAN() ! Cancel the transmission. GO TO 9999 ! 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) (LBUFFER(INDEX),INDEX=1,REC_SIZE) 400 FORMAT (A1) 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 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)) CALL SEND_CAN() ! Cancel the transmission. GO TO 9999 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 CALL SEND_CAN() ! Limit exceeded, abort transmission. GO TO 9999 ! Report the abortion ... 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. 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 C C This routine is used transfer a file to the remote system from C the VAX using the XMODEM protocol. C INCLUDE 'COM.INC/NOLIST' 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. LOGICAL REPORT_ERROR, AT_EOF 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 to tell us to send. C If we timeout waiting for the NAK, we'll start sending anyway. C RBUFFER(1) = READ_BYTE (TIMEOUT_COUNT) ! Read the first byte. CALL CLEAR_TYPEAHEAD() ! Clear any other garbage. C C Read a record from the input file. C 100 IF (CONTROLC_TYPED) GO TO 9999 ! CTRL/C typed to abort. DINDEX = 1 ! Index into input record. READ (FILE_UNIT,110,END=9900,ERR=9990) BYTES,(LBUFFER(I),I=1,BYTES) 110 FORMAT (Q,A1) 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: < 128 data bytes > 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. 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. 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 9999 ! 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) GO TO 9999 ! Transmission is cancelled. 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 CALL SEND_CAN() ! Limit exceeded, abort. GO TO 9999 ! Report the abortion ... 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. 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) CALL RAW_READ (BUFF, 1, SECONDS) 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) 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 INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'RAW_READ') LOGICAL*1 BUFFER(1) INTEGER BYTES, SECONDS, STATUS STATUS = 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),NOTERM,,) RAW_READ = STATUS ! Copy the directive status. IF (.NOT. CHECK_STATUS (MODULE_NAME, STATUS)) RETURN RAW_READ = RIOSB(1) ! Pass back I/O status. RBYTE_COUNT = RIOSB(2) ! Save the byte count. CALL WRITE_DEBUG (MODULE_NAME, BUFFER, RBYTE_COUNT) C C Check for various errors: C IF (RIOSB(1) .EQ. SS$_TIMEOUT) THEN ! Timeout error ? TIMEOUTS = TIMEOUTS + 1 ! Yes, count it. GO TO 200 ! And continue ... ELSEIF (RIOSB(1) .EQ. SS$_PARITY) THEN ! Parity error ? PARITY_ERRORS = PARITY_ERRORS + 1 ! Yes, count it, GO TO 200 ! And continue ... ELSEIF (RIOSB(1) .EQ. SS$_DATAOVERUN) THEN ! Data overrun ? OVERRUN_ERRORS = OVERRUN_ERRORS + 1 ! Yes, count it. GO TO 200 ! And continue ... ELSEIF (RIOSB(1) .NE. SS$_ABORT) THEN ! CTRL/C to abort. CALL CHECK_STATUS (MODULE_NAME, RAW_READ) ENDIF RETURN C C Here for timeout and hardware errors. C 200 BUFFER(1) = 0 ! Force bad transmission RBYTE_COUNT = 0 ! by clearing buffer & BC. RETURN END SUBROUTINE 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. C BYTES - The number of bytes to write. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) MODULE_NAME PARAMETER (MODULE_NAME = 'RAW_WRITE') LOGICAL*1 BUFFER(1) INTEGER BYTES, STATUS CALL WRITE_DEBUG (MODULE_NAME, BUFFER, BYTES) STATUS = SYS$QIOW (%VAL(REFN_OUT),%VAL(RCHAN_OUT), 1 %VAL(IO$_WRITELBLK + IO$M_NOFORMAT), 1 XIOSB,,,BUFFER,%VAL(BYTES),,,,) CALL CHECK_STATUS (MODULE_NAME, STATUS) 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 'COM.INC/NOLIST' 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