C C SNDRCV.FTN - Remote Slave Program. C C Written by: Roger Lipsett INTERMETRICS April 1979. C C Rewitten by: C Robin Miller at Project Software & Development, Inc. 1981. C PROGRAM SNDRCV INCLUDE 'SNDRCV.INC' LOGICAL*1 TOREM(5), TOVAX(5) LOGICAL COMP DATA TOREM/'T','O','R','E','M'/ ! Input to remote. DATA TOVAX/'T','O','V','A','X'/ ! Output to the VAX. CALL SETUP ! Do special setup stuff. FILOPN = .FALSE. ! Show file is closed. WRITE (TOLUN,50) ! Tell user we're started. 50 FORMAT (' SNDRCV Version 2.1 started ... Type CTRL/X and RETURN ', 1 'to abort.') C C Get the direction of the transfer. C 100 CALL READIT(RBUFF,NBYTES) IF (COMP(RBUFF,TOREM,5)) GO TO 110 IF (COMP(RBUFF,TOVAX,5)) GO TO 120 CALL SNAK ! Presume bad transmission, GO TO 100 ! and try again. 110 FLOW = IN ! Set FLOW to input (GET). GO TO 130 ! Continue... 120 FLOW = OUT ! Set FLOW to output (SEND). 130 CALL SACK ! Tell host we got direction. C C Dispatch to appropriate subroutine. C IF (FLOW .EQ. OUT) GO TO 300 ! If output, send a file. CALL GET ! Get a file from the host. GO TO 310 ! Branch to common exit. 300 CALL SEND ! Send a file to the host, 310 CALL TOTALS ! Print out the totals. CALL EXIT ! and exit. END LOGICAL FUNCTION COMP(OP1,OP2,NBYTES) C C This function compares two buffers each NBYTES long. C LOGICAL*1 OP1(1), OP2(1) COMP = .FALSE. DO 100 I=1,NBYTES 100 IF (OP1(I) .NE. OP2(I)) RETURN COMP = .TRUE. RETURN END INTEGER FUNCTION CHKSUM(IBUFF,NBYTES) C C This function calculates a checksum. C LOGICAL*1 IBUFF(1) CHKSUM = 0 ! Initialize checksum. IF (NBYTES .EQ. 0) RETURN ! No byte count, no checksum. DO 100 I=1,NBYTES CHKSUM = CHKSUM + IBUFF(I) ! Accumulate checksum. 100 CONTINUE CHKSUM = CHKSUM .AND. "777 ! Clear high bits. RETURN END SUBROUTINE SACK C C Subroutine to send an ACK (Acknowlegement) to the host. C INCLUDE 'SNDRCV.INC/NOLIST' LOGICAL*1 LCODE(1) LCODE(1) = ACK ! Save the last code sent, CALL WRITIT(ACK,1,.FALSE.) ! and send the ACK. RETURN C C Entry to send a NAK (Negative Acknowlegement) to the host. C ENTRY SNAK LCODE(1) = NAK ! Save the last code sent, CALL WRITIT(NAK,1,.FALSE.) ! and send the NAK. RETURN C C Entry to send an ENQ (Enquire) to the host. C ENTRY SENQ LCODE(1) = ENQ ! Save the last code sent, CALL WRITIT(ENQ,1,.FALSE.) ! and send the ENQ. RETURN C C Entry to send EOF (End of File) to the host. C ENTRY SEOF LCODE(1) = EOF ! Save the last code sent, CALL WRITIT(EOF,1,.TRUE.) ! and send the EOF. RETURN C C Entry to send EOT (End of Transmission) to the host. C ENTRY SEOT LCODE(1) = EOT ! Save the last code sent, CALL WRITIT(EOT,1,.TRUE.) ! and send the EOT. RETURN C C Entry to send CAN (Cancel Transmission) to the host. C ENTRY SCAN LCODE(1) = CAN ! Save the last code sent, CALL WRITIT(CAN,1,.FALSE.) ! and send the CAN. RETURN C C Entry to resend last code to host. This is used when the C host sends an ENQ because the last response was garbled. C ENTRY RESEND CALL WRITIT(LCODE,1,.FALSE.) ! Resend last code. RETURN END SUBROUTINE GET C C Gets a file transmitted from the host. C INCLUDE 'SNDRCV.INC/NOLIST' ASSIGN 50 TO GETNAM ASSIGN 100 TO LOOP ! Loop reading from host. ASSIGN 500 TO ERROR ! Transmission error. ASSIGN 600 TO REOF ! End of file. ASSIGN 700 TO REOT ! End of transmission. 50 CALL READIT(FILNAM,NBYTES) ! Get file name from host. IF (FILNAM(1) .EQ. EOT) GO TO REOT ! End of transmission. FILNAM(NBYTES+1) = 0 ! Terminate the file name. OPEN (UNIT=IOLUN, NAME=FILNAM, TYPE='NEW', 1 CARRIAGECONTROL='LIST', ERR=9000) FILOPN = .TRUE. ! Show file is open. CALL SACK ! Tell host OK. INDEX = 7 ! Index into buffer. 100 CALL READIT(RBUFF,NBYTES) ! Read the next line. IF (NBYTES .EQ. 0) GO TO ERROR ! Transmission error. IF (NBYTES .GT. 6) GO TO 200 ! Possible record. IF (RBUFF(1) .EQ. EOF) GO TO REOF ! Received end of file. IF (RBUFF(1) .NE. ENQ) GO TO ERROR ! Transmission error. CALL RESEND ! Resend the last code, GO TO LOOP ! and try again. C C C Decode the byte count and checksum. C 200 DECODE (7,210,RBUFF,ERR=500) DSIZE, CHECK 210 FORMAT (I4,I3) IF (CHKSUM(RBUFF(INDEX+1),DSIZE) .NE. CHECK) GO TO ERROR IF (DSIZE .EQ. 0) GO TO 310 WRITE (IOLUN,300,ERR=9100) (RBUFF(INDEX+I),I=1,DSIZE) 300 FORMAT (A1) GO TO 320 310 WRITE (IOLUN,300) ! Write blank record. 320 CALL COUNTS(DSIZE) ! Update counts. CALL SACK ! Send host an ACK, GO TO LOOP ! and read next record. C C Here for transmission error. C 500 CALL SNAK ! Send the host a NAK, GO TO LOOP ! and read next record. C C Here for end of file. C 600 CLOSE (UNIT=IOLUN) ! Close the output file. CALL SACK ! Tell host we got EOF. GO TO GETNAM ! Get next file name. C C Here for End of Transmission. C 700 CALL SACK ! Tell host we got EOT, RETURN ! and return. C C Here for OPEN error. C 9000 CALL OPERR ! Report error to host. GO TO GETNAM ! Wait for file name. C C Here for WRITE error. C 9100 CALL OPERR ! Report error to host. RETURN ! Presume error is fatal. END SUBROUTINE SEND C C Sends a file to the host. C INCLUDE 'SNDRCV.INC/NOLIST' ASSIGN 50 TO GETNAM 50 CALL READIT(FILNAM,NBYTES) ! Get file name from host. FILNAM(NBYTES+1) = 0 ! Terminate file name. OPEN (UNIT=IOLUN, NAME=FILNAM, TYPE='OLD', READONLY, ERR=9000) FILOPN = .TRUE. ! Show file is open. CALL SACK ! Tell Host OK. C C Synchronize with the host. C 100 CALL READIT(RBUFF,NBYTES) IF (RBUFF(1) .EQ. SYN) GO TO 110 CALL SNAK ! Bad SYN character. GO TO 100 ! Retry... 110 CALL SACK ! Got SYN character. C C Loop here reading records from the input file. C ASSIGN 200 TO LOOP ! Loop reading from file. INDEX = 7 ! Index into buffer. 200 READ (IOLUN,210,END=1000,ERR=9100) 1 NBYTES,(XBUFF(INDEX+I),I=1,NBYTES) 210 FORMAT (Q,A1) C C The format of the record sent to the host is: C C bbbbcccrrr...rrr C C Where: b = bytecount, c = checksum, r = record. C ENCODE (7,300,XBUFF(1)) NBYTES, CHKSUM(XBUFF(INDEX+1),NBYTES) 300 FORMAT (I4,I3) CALL COUNTS(NBYTES) ! Accumulate totals. CALL WRITIT(XBUFF,NBYTES+INDEX,.TRUE.)! Write the line to the host. GO TO LOOP ! Read the next record. C C Here for end of file. C 1000 CLOSE (UNIT=IOLUN) ! Close input file. CALL SEOF ! Send end of file, CALL SEOT ! and end of transmission. RETURN C C Here for OPEN error. C 9000 CALL OPERR ! Report error to host. GO TO GETNAM ! Wait for file name. C C Here for READ error. C 9100 CALL OPERR ! Report error to host. RETURN ! Presume error is fatal. END SUBROUTINE GETRES(CODE) C C This subroutine gets a response from the host, makes C sure it is valid, then passes the code back for the C subroutine to do further processing. C C Action taken: C o if code is ACK, NAK, ENQ, EOF, or EOT, return code. C o if code is CAN (Cancel), abort the transmission. C o else presume the response was garbled, send ENQ to the C host, and loop to get retransmitted code. C INCLUDE 'SNDRCV.INC/NOLIST' LOGICAL*1 CODE(1) RETRYS = 0 ! Initialize retry counter. 100 CALL READIT(TBUFF,NBYTES) ! Get response from host. CODE(1) = TBUFF(1) ! Copy the received code. D WRITE (TOLUN,150) CODE(1) D150 FORMAT (X,'Last code =', I4) IF (CODE(1) .EQ. ACK .OR. CODE(1) .EQ. NAK) RETURN IF (CODE(1) .EQ. EOF .OR. CODE(1) .EQ. EOT) RETURN IF (CODE(1) .EQ. ENQ) RETURN IF (CODE(1) .EQ. CAN) GO TO 300 ! Abort transmission. RETRYS = RETRYS + 1 ! Increment retry count. IF (RETRYS .GT. RLIMIT) GO TO 200 ! Too many... CALL SENQ ! Send host an ENQ. GO TO 100 ! Check response again. 200 WRITE (TOLUN,210) CAN, RLIMIT 210 FORMAT ('+',A1,'Retry limit of', I3, ' exceeded, exiting ...') GO TO 500 ! Branch to common exit. C C Entry to abort file transmission. C ENTRY ABORT 300 WRITE (TOLUN,310) 310 FORMAT (' File transmission aborted...') 500 CALL TOTALS ! Report totals, CALL EXIT ! and exit... END SUBROUTINE COUNTS(NBYTES) C C Subroutine to accumulate record and byte counts. C INCLUDE 'SNDRCV.INC/NOLIST' RECCNT = RECCNT + 1 ! Accumulate record count. BYTCNT = BYTCNT + NBYTES ! Accumulate byte count. TRECNT = TRECNT + 1 ! Total record count. TBYTES = TBYTES + NBYTES ! Total byte count. RETURN C C Entry to print record and byte counts for this file. C ENTRY TOTALS WRITE (TOLUN,100) TRECNT, TBYTES, TMOCNT 100 FORMAT (' SNDRCV Status Report: '/, 1 ' Total records:', I8, ', total bytes:', I10, 1 ', timeouts:' I7) WRITE (TOLUN,110) BCCERR, DAOERR, VERERR 110 FORMAT (' Framing errors:', I7, ', overruns: ', I7, 1 ', parity errors:', I7) RETURN END