C C GETSEND.FOR C C These routines perform the GET and SEND functions to and C from a remote CPU. C C Roger Lipsett INTERMETRICS APRIL 27, 1979 C C Rewritten by: C Robin Miller at Project Software & Development, Inc. 1981 C SUBROUTINE GETSEND INCLUDE 'COM.INC' LOGICAL I, INIT_REMOTE, GET, SEND C C Character strings for questions, help, etc. C CHARACTER*(*) ABORT_MSG, DONE_MSG PARAMETER (ABORT_MSG = SS//'File Transmission Aborted.'//SS) PARAMETER (DONE_MSG = SS//'File Transmission Complete.'//SS) IN_A_COMMAND = .TRUE. ! Show command in progress. CALL SET_CONTROLC_AST ! Enable Control/C traps. C C Test for DUMP mode. No protocol used in this mode. C IF (DUMP_MODE) GO TO 1000 C C When using the SNDRCV program, this gets us started. C IF (.NOT. INIT_REMOTE()) GO TO 3100 C C Initiate the GET or SEND. C 1000 VSIZE = 0 ! Clear VAX file name. RSIZE = 0 ! Clear REMOTE file name. IF (FLOW .EQ. IN) THEN I = GET() ! Get file from remote. ELSE I = SEND() ! Send file to remote. ENDIF IF (.NOT. IN_A_COMMAND) THEN ! Was CTRL/C typed to abort ? CALL SEND_CAN ! Yes, tell remote to abort. ENDIF IF (I) THEN C C Transmission Successful. C CALL PRTFINAL CALL WRITE_USER(DONE_MSG) ELSE C C Transmission Aborted. C CALL WRITE_USER(ABORT_MSG) ENDIF 3100 CALL DISPLAY_TIME ! Display date and time. CLOSE (UNIT=FILE_UNIT) ! Save whatever we transmitted. IN_A_COMMAND = .FALSE. ! No longer in a command. CALL REENABLE ! Enable local read/writes. RETURN END LOGICAL FUNCTION INIT_REMOTE C C This function performs the initial handshake with the running SNDRCV C program, by sending it the direction and mode of the file transfer. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 TOVAX(6), TOREM(6), CODE(1) DATA TOVAX/'T','O','V','A','X',0/, TOREM/'T','O','R','E','M',0/ CHARACTER*(*) INIT_ERROR PARAMETER (INIT_ERROR = SS// 1 '*** Error initializing SNDRCV program on the remote. ***' 1 //BELL//SS) INIT_REMOTE = .FALSE. ! Initialize to bad return. C C Send the direction. C 100 IF (FLOW .EQ. IN) THEN CALL WRITE_REMOTE(TOVAX,5) ELSE CALL WRITE_REMOTE(TOREM,5) ENDIF CALL GET_RESPONSE(CODE) ! Get response from remote. IF (CODE(1) .NE. ACK) GO TO 9000 INIT_REMOTE = .TRUE. ! Show success. RETURN C C Initialization Error. C 9000 CALL WRITE_USER(INIT_ERROR) RETURN END LOGICAL FUNCTION GET C C Routine to transfer a file from the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 CODE(1) LOGICAL GET_VAXFILE, GET_REMFILE GET = .FALSE. ! Initialize to bad return. IF (.NOT. GET_REMFILE()) RETURN ! Get/open remote file. IF (.NOT. GET_VAXFILE()) RETURN ! Get/open the VAX file. C C Synchronize with remote CPU. C 300 IF (.NOT. IN_A_COMMAND) RETURN ! Abort operation. CALL SEND_SYN ! Send SYNC byte. CALL GET_RESPONSE(CODE) ! Get response from remote. IF (CODE(1) .EQ. NAK) GO TO 300 ! Transmission error. IF (CODE(1) .EQ. CAN) RETURN ! Cancel transmission. C C Loop reading from the remote CPU. C CALL CLEAR_COUNTS ! Initialize the counters. ASSIGN 400 TO LOOP ! Loop reading from remote. ASSIGN 600 TO ERROR ! Transmission error. ASSIGN 700 TO REOF ! Received end of file. 400 IF (.NOT. IN_A_COMMAND) RETURN IF (READ_REMOTE(RBUFFER,BUFFER_SIZE) .EQ. SS$_ABORT) RETURN IF (RBYTE_COUNT .GT. 6) GO TO 405 IF (RBUFFER(1) .EQ. EOF) THEN GO TO REOF ! Received end of file. ELSEIF (RBUFFER(1) .EQ. ENQ) THEN CALL RESEND_CODE ! Resend last code, GO TO LOOP ! and try again. ELSE GO TO ERROR ! Transmission error. ENDIF C C Get the byte count and the checksum (4 and 3 bytes respectively). C 405 DECODE (7,410,RBUFFER(1),ERR=600) NBYTES, CHECKSUM 410 FORMAT (I4,I3) C C Now check the following things: make sure length of record is right, C that the length of a binary transfer is a multiple of 8, and that C the checksum checks. C IF (RBYTE_COUNT .NE. NBYTES+7 .OR. 1 (GET_CHECKSUM(RBUFFER(8),NBYTES) .NE. CHECKSUM)) 1 GO TO ERROR C C If here, everything is OK. Write the record to the output file. C IF (NBYTES .GT. 0) THEN WRITE (FILE_UNIT,500) (RBUFFER(I+7),I=1,NBYTES) 500 FORMAT (A1) ELSE WRITE (FILE_UNIT,510) 510 FORMAT () ENDIF CALL TOTALS(NBYTES) ! Update the totals. CALL SEND_ACK ! Send remote an ACK. GO TO LOOP ! And get next record. C C Here to send NAK to remote for tranmission error. C 600 CALL REPORT_ERROR ! Report the error. CALL SEND_NAK ! Send the remote NAK. GO TO LOOP ! And try again. C C Here to process end of file. C 700 CALL SEND_ACK ! Tell remote we got EOF. CALL GET_RESPONSE(CODE) ! Expect EOT next (for now). CALL SEND_ACK ! Tell remote we got EOT. GET = .TRUE. ! Return success. RETURN END LOGICAL FUNCTION SEND C C Routine to send a file to the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 CODE(1) LOGICAL GET_VAXFILE, GET_REMFILE SEND = .FALSE. ! Initialize to bad return. IF (.NOT. GET_VAXFILE()) RETURN ! Get/open the VAX file. IF (.NOT. DUMP_MODE) THEN IF (.NOT. GET_REMFILE()) RETURN ! Get/open the remote file. ENDIF C C Loop writing to the remote CPU. C CALL CLEAR_COUNTS ! Initialize the counters. ASSIGN 100 TO LOOP ! Loop reading from file. ASSIGN 200 TO RETRY ! Retry after transmission error. 100 IF (.NOT. IN_A_COMMAND) RETURN READ (FILE_UNIT,110,END=9900) NBYTES,(XBUFFER(I+7),I=1,NBYTES) 110 FORMAT (Q,A1) C C DUMP mode uses no protocol. C IF (DUMP_MODE) GO TO 300 C C Protocol is used here. C C Write to the remote and get ACK/NAK back. C 200 IF (.NOT. IN_A_COMMAND) RETURN CHECKSUM = GET_CHECKSUM(XBUFFER(8),NBYTES) ! Calculate checksum. ENCODE (7,210,XBUFFER(1)) NBYTES, CHECKSUM ! Put it in buffer. 210 FORMAT (I4,I3) C C Write it to the remote and wait for a response. C CALL WRITE_REMOTE(XBUFFER,NBYTES+7) CALL GET_RESPONSE(CODE) ! Get response from remote. IF (CODE(1) .EQ. CAN) RETURN ! Transmission aborted. IF (CODE(1) .EQ. ACK) THEN CALL TOTALS(NBYTES) ! Update the totals GO TO LOOP ! and get next record. ELSE CALL REPORT_ERROR ! Report transmission error GO TO RETRY ! and send the record again. ENDIF C C DUMP mode processing. C C Send an input line to the remote and wait for the echo. C 300 CALL WRITE_REMOTE(XBUFFER(8),NBYTES) IF (READ_REMOTE(RBUFFER,BUFFER_SIZE) .EQ. SS$_ABORT) RETURN IF (DEBUG_MODE) CALL WRITE_RBUFFER(RBUFFER,RBYTE_COUNT) CALL TOTALS(NBYTES) ! Update the totals. GO TO LOOP C C Here for EOF on input. C 9900 CALL SEND_EOF ! Send EOF to remote. IF (DUMP_MODE) GO TO 9930 ! All done if DUMP mode. CALL GET_RESPONSE(CODE) ! Get response from remote. IF (CODE(1) .EQ. NAK) GO TO 9900! Transmission error. 9910 CALL SEND_EOT ! End of transmission. CALL GET_RESPONSE(CODE) ! Get response from remote. IF (CODE(1) .EQ. NAK) GO TO 9910! Transmission error. 9930 SEND = .TRUE. ! Show success. RETURN END LOGICAL FUNCTION GET_VAXFILE C C This function is used to get the file name of the file C on the VAX and then open it for either read or write. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) VAXQ, INPUT_ERROR, OUTPUT_ERROR PARAMETER (VAXQ = 'Enter the name of the VAX file: ') PARAMETER (INPUT_ERROR = SS// 1 '*** Unable to open input file ***'//BELL//SS) PARAMETER (OUTPUT_ERROR = SS// 1 '*** Unable to open output file ***'//BELL//SS) GET_VAXFILE = .FALSE. ! Initialize to bad return. C C Get name of file on VAX. C ASSIGN 100 TO VAX_PROMPT 100 CALL PROMPT_USER(VAXQ,%REF(VAX_FILE),LEN(VAX_FILE)) IF (LIOSB(1) .NE. SS$_NORMAL) THEN CALL SEND_CAN ! Tell remote to abort. RETURN ENDIF VSIZE = LBYTE_COUNT IF (TERMINATOR .EQ. ESCAPE) GO TO VAX_PROMPT IF (VSIZE .EQ. 0) THEN IF (RSIZE .GT. 0) THEN VAX_FILE = REMOTE_FILE ! Copy the file name, VSIZE = RSIZE ! and the length. ELSE GO TO VAX_PROMPT ! Try again. ENDIF ENDIF IF (FLOW .EQ. IN) THEN OPEN (UNIT=FILE_UNIT, TYPE='NEW', NAME=VAX_FILE(1:VSIZE), 1 CARRIAGECONTROL='LIST', BUFFERCOUNT=2, ERR=9900) ELSE OPEN (UNIT=FILE_UNIT, TYPE='OLD', READONLY, 1 FILE=VAX_FILE(1:VSIZE), ERR=9910) ENDIF GET_VAXFILE = .TRUE. ! Return success. RETURN C C Here to report open error for output file. C 9900 CALL WRITE_USER(OUTPUT_ERROR) ! Report the error, GO TO VAX_PROMPT ! and ask question again. C C Here to report open error for input file. C 9910 CALL WRITE_USER(INPUT_ERROR) ! Report the error, GO TO VAX_PROMPT ! and ask question again. END LOGICAL FUNCTION GET_REMFILE C C This function is used to get/open the file name on the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 CODE(1) CHARACTER*(*) REMOTEQ, INPUT_ERROR, OUTPUT_ERROR PARAMETER (REMOTEQ = 'Enter the name of the REMOTE file: ') PARAMETER (INPUT_ERROR = SS// 1 '*** Unable to open remote input file ***'//BELL//SS) PARAMETER (OUTPUT_ERROR = SS// 1 '*** Unable to open remote output file ***'//BELL//SS) GET_REMFILE = .FALSE. ! Initialize to bad return. C C Get name of file on VAX. C ASSIGN 100 TO REMOTE_PROMPT 100 CALL PROMPT_USER(REMOTEQ,%REF(REMOTE_FILE),LEN(REMOTE_FILE)) IF (LIOSB(1) .NE. SS$_NORMAL) THEN CALL SEND_CAN ! Tell remote to exit. RETURN ENDIF RSIZE = LBYTE_COUNT IF (TERMINATOR .EQ. ESCAPE) GO TO REMOTE_PROMPT IF (RSIZE .EQ. 0) THEN IF (VSIZE .GT. 0) THEN REMOTE_FILE = VAX_FILE ! Copy the file name, RSIZE = VSIZE ! and the length. ELSE GO TO REMOTE_PROMPT ! Try again. ENDIF ENDIF C C Send the file name to the remote. C CALL WRITE_REMOTE(%REF(REMOTE_FILE),RSIZE) CALL GET_RESPONSE(CODE) ! Get response from remote. IF (CODE(1) .EQ. CAN) RETURN ! Cancel transmission. IF (CODE(1) .EQ. ACK) THEN GET_REMFILE = .TRUE. RETURN ELSE IF (FLOW .EQ. IN) THEN CALL WRITE_USER(INPUT_ERROR) ELSE CALL WRITE_USER(OUTPUT_ERROR) ENDIF GO TO REMOTE_PROMPT ENDIF END SUBROUTINE CLEAR_TYPEAHEAD C C Clears the typeahead buffer on the remote channel. C INCLUDE 'COM.INC/NOLIST' STATUS = SYS$QIOW(,%VAL(REMOTE_CHANNEL), 1 %VAL(IO$_READLBLK + IO$M_PURGE), 2 RIOSB,,,RBUFFER,%VAL(0),,,,) CALL CHECK_STATUS('CLEAR_TYPEAHEAD',STATUS) RETURN END SUBROUTINE TOTALS(NBYTES) C C Accumulate the totals. C INCLUDE 'COM.INC/NOLIST' BYTE_COUNT = BYTE_COUNT + NBYTES ! Accumulate byte count. RECORD_COUNT = RECORD_COUNT + 1 ! Accumulate record count. TOTAL_BYTES = TOTAL_BYTES + NBYTES ! Total byte count. TOTAL_RECORDS = TOTAL_RECORDS + 1 ! Total record count. 100 TYPE 150, RECORD_COUNT, BYTE_COUNT, ERROR_COUNT, ERROR_RECORD 150 FORMAT('+Record count:', I6,', byte count:', I8, 1 ', Naks:', I5, ' (', I6, ')') RETURN C C Entry to initialize counts. C ENTRY CLEAR_COUNTS BYTE_COUNT = 0 ! Clear byte count. RECORD_COUNT = 0 ! Clear record count. TOTAL_BYTES = 0 ! Clear total bytes. TOTAL_RECORDS = 0 ! Clear total records. ERROR_COUNT = 0 ! Clear error count. ERROR_RECORD = 0 ! Clear error record #. RETURN C C Entry to report a transmission error. C ENTRY REPORT_ERROR ERROR_COUNT = ERROR_COUNT + 1 ERROR_RECORD = RECORD_COUNT + 1 IF (LOGFILE) WRITE (LOG_UNIT,200) RECORD_COUNT+1, SS 200 FORMAT (X,'Transmission ERROR on RECORD ', I6, A) GO TO 100 ! Update terminal. C C Entry to print final message. C ENTRY PRTFINAL IF (LOGFILE) THEN WRITE (LOG_UNIT,300) RECORD_COUNT, BYTE_COUNT, SS 300 FORMAT ('Total records:', I6,', total bytes:', I8, A) ENDIF RETURN END INTEGER FUNCTION GET_CHECKSUM(BUFFER,NBYTES) C C Computes the checksum. C LOGICAL*1 BUFFER(1) GET_CHECKSUM = 0 ! Initialize checksum. IF (NBYTES .GT. 0) THEN DO 100 I=1,NBYTES GET_CHECKSUM = GET_CHECKSUM + BUFFER(I) 100 CONTINUE ENDIF GET_CHECKSUM = GET_CHECKSUM .AND. "777 RETURN END SUBROUTINE SEND_ACK C C Subroutine to send ACK (Acknowlegment) to the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 LAST_CODE(2) LAST_CODE(1) = ACK ! Save the last code. 100 CALL WRITE_REMOTE(LAST_CODE(1),1) RETURN C C Entry to send NAK (Negative Acknowlement) to the remote. C ENTRY SEND_NAK LAST_CODE(1) = NAK ! Save the last code, GO TO 100 ! and send it. C C Entry to send SYN (Synchronize) to the remote. C ENTRY SEND_SYN LAST_CODE(1) = SYN ! Save the last code, GO TO 100 ! and send it. C C Entry to send ENQ (Enquire) to the remote. C ENTRY SEND_ENQ LAST_CODE(1) = ENQ ! Save the last code, GO TO 100 ! and send it. C C Entry to send EOF (End of File) to the remote. C ENTRY SEND_EOF LAST_CODE(1) = EOF ! Save the last code, GO TO 100 ! and send it. C C Entry to send EOT (End of Transmission) to the remote. C ENTRY SEND_EOT LAST_CODE(1) = EOT ! Save the last code, GO TO 100 ! and send it. C C Entry to send CAN (Cancel) to the remote. C ENTRY SEND_CAN LAST_CODE(1) = CAN ! Save the last code, GO TO 100 ! and send it. C C This entry is used to resend the last code in the event that C the previous transmission was lost or garbled and the remote C sent us an ENQ to find out what the last response was. C ENTRY RESEND_CODE GO TO 100 ! Resend the last code. END SUBROUTINE WRITE_REMOTE(BUFFER,NBYTES) C C This subroutine is used to write a buffer to the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 BUFFER(1) CALL CLEAR_TYPEAHEAD ! Clear remote typeahead. BUFFER(NBYTES+1) = CR ! Append Terminator. STATUS = SYS$QIOW(,%VAL(REMOTE_CHANNEL), 1 %VAL(IO$_WRITELBLK + IO$M_NOFORMAT), 1 XIOSB,,,BUFFER,%VAL(NBYTES+1),,,,) CALL CHECK_STATUS('WRITE_REMOTE',STATUS) RETURN END INTEGER FUNCTION READ_REMOTE(BUFFER,NBYTES) C C This function is called to read a line from the remote. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 BUFFER(1) 100 IF (.NOT. IN_A_COMMAND) RETURN STATUS = SYS$QIOW(,%VAL(REMOTE_CHANNEL), 1 %VAL(IO$_READLBLK + IO$M_NOECHO + IO$M_TIMED), 1 RIOSB,,,BUFFER,%VAL(NBYTES), 1 %VAL(TIMEOUT_COUNT),TERMTBL,,) READ_REMOTE = RIOSB(1) ! Pass back I/O status. RBYTE_COUNT = RIOSB(2) ! Save the byte count. IF (RIOSB(1) .EQ. SS$_TIMEOUT) THEN ! Timeout ? 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 ... ELSE CALL CHECK_STATUS('READ_REMOTE',STATUS) 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. CALL CLEAR_TYPEAHEAD ! Clear remote typeahead buffer, RETURN ! and return. END SUBROUTINE GET_RESPONSE(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, CAN, EOF, or EOT, return code. C o else presume the response was garbled, send ENQ to the C host, and loop to get retransmitted code. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 CODE(1) CHARACTER*(*) RETRY_MSG PARAMETER (RETRY_MSG = SS// 1 '*** Retry limit of 8 exceeded, aborting transmission. ***' 1 //BELL//SS) RETRY_COUNT = 0 ! Initialize retry counter. 100 IF (.NOT. IN_A_COMMAND) RETURN IF (READ_REMOTE(TBUFFER,BUFFER_SIZE) .EQ. SS$_ABORT) RETURN CODE(1) = TBUFFER(1) ! Copy the received code. IF (CODE(1) .EQ. ACK .OR. CODE(1) .EQ. NAK) GO TO 200 IF (CODE(1) .EQ. ENQ .OR. CODE(1) .EQ. CAN) GO TO 200 IF (CODE(1) .EQ. EOF .OR. CODE(1) .EQ. EOT) GO TO 200 RETRY_COUNT = RETRY_COUNT + 1 ! Increment retry count. IF (RETRY_COUNT .GT. RETRY_LIMIT) THEN CALL WRITE_USER(RETRY_MSG) CODE(1) = CAN ! Cancel transmission, RETURN ! and return. ELSE IF (DEBUG_CODE) CALL WRITE_RBUFFER(TBUFFER,RBYTE_COUNT) CALL SEND_ENQ ! Send remote an ENQ, GO TO 100 ! and try again. ENDIF C C Here for valid code. C 200 IF (RBYTE_COUNT .GT. 1) 1 CALL WRITE_RBUFFER(TBUFFER(2),RBYTE_COUNT-1) RETURN END SUBROUTINE WRITE_RBUFFER(BUFFER,NBYTES) C C This subroutine writes the contents of the buffer received C from the remote to the terminal and the log file. C INCLUDE 'COM.INC/NOLIST' LOGICAL*1 BUFFER(1) TYPE 100, NBYTES, SS IF (LOGFILE) WRITE (LOG_UNIT,100) NBYTES, DS 100 FORMAT (' The buffer received from the remote contains (', 1 I4,'):',A) IF (NBYTES .EQ. 0) RETURN TYPE 200, (BUFFER(I),I=1,NBYTES), SS IF (LOGFILE) WRITE (LOG_UNIT,200) (BUFFER(I),I=1,NBYTES), DS 200 FORMAT (1X,A1,A) RETURN END SUBROUTINE WAITABIT(SECONDS) C C This subroutine just waits a little then returns. C IMPLICIT INTEGER*4 (A-Z) CHARACTER*(*) SECONDS STATUS = SYS$CANWAK(,) ! Cancel wakeups. CALL CHECK_STATUS('WAITABIT(CANWAK)',STATUS) STATUS = SYS$BINTIM('0 00:00:'//SECONDS,DELTA) CALL CHECK_STATUS('WAITABIT(BINTIM)',STATUS) STATUS = SYS$SCHDWK(,,DELTA,,) ! Schedule wakeup. CALL CHECK_STATUS('WAITABIT(SCHDWK)',STATUS) STATUS = SYS$HIBER() ! Go into hibernation. RETURN END SUBROUTINE DISPLAY_TIME C C Subroutine to display the current time. C INCLUDE 'COM.INC/NOLIST' CHARACTER TIMBUF*30 ! Store time here. CALL SYS$ASCTIM(LEN,TIMBUF,,) TYPE 100, TIMBUF, SS IF (LOGFILE) WRITE (LOG_UNIT,100) TIMBUF, SS 100 FORMAT (X,A,A) RETURN END