SUBROUTINE UPDATE_TOTALS(NBYTES) C C This routine is called after a record is successfully transmitted C to update the various counters. C INCLUDE 'COM.INC/NOLIST' RETRY_COUNT = 0 ! Reinitialize retry counter. BYTE_COUNT = BYTE_COUNT + NBYTES ! Accumulate the byte count RECORD_COUNT = RECORD_COUNT + 1 ! and the record count. TOTAL_BYTES = TOTAL_BYTES + NBYTES ! Update the total byte count. TOTAL_RECORDS = TOTAL_RECORDS + 1 ! and the record count. IF (DUMP_MODE) RETURN ! No display if dumping a file. IF (DISPLAY_SCREEN) THEN IF (MOD (RECORD_COUNT,DISPLAY_RECORD) .EQ. 0) THEN CALL REPORT_RECORD() ! Report the record number. ENDIF ENDIF RETURN ENTRY CLEAR_COUNTS C C Entry to initialize counts. C 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 #. PARITY_ERRORS = 0 ! Initialize OVERRUN_ERRORS = 0 ! the TIMEOUTS = 0 ! various FRAMING_ERRORS = 0 ! counters. RETRY_COUNT = 0 ! FILE_COUNT = 0 ! Number of file transfered. BLOCK_COUNT = 0 ! Number of blocks transfered. BLOCK_RECEIVED = 0 ! Received block number. BLOCK_XMITTED = 0 ! Transmitted block number. RETURN ENTRY COUNT_FILES C C This routine is called after each file transmission to reset C some counters and to update the files copied count. C BYTE_COUNT = 0 ! Clear the byte count, RECORD_COUNT = 0 ! the record count, ERROR_COUNT = 0 ! the error count and, ERROR_RECORD = 0 ! the error record number. FILE_COUNT = FILE_COUNT + 1 ! Count number of files copied. RETRY_COUNT = 0 ! Reinitialize retry counter. RETURN ENTRY REPORT_TOTALS C C Entry to report the final statistics. C IF (FILE_COUNT .GT. 1) THEN CALL SYS$FAO ('!/Total of !UL files copied.!/', 1 SIZE, SCRATCH, %VAL(FILE_COUNT+1) ) CALL WRITE_USER (SCRATCH(1:SIZE)) ENDIF IF (PROTOCOL .EQ. VAXNET) THEN CALL SYS$FAO ('!/VAXNET Status Report:!/'// 1 'Total records:!8UL, total bytes:!10UL, timeouts:!7UL!/'// 1 'Framing errors:!7UL, overruns: !7UL, parity errors:!7UL!/', 1 SIZE, SCRATCH, 1 %VAL(TOTAL_RECORDS), %VAL(TOTAL_BYTES), %VAL(TIMEOUTS), 1 %VAL(FRAMING_ERRORS), %VAL(OVERRUN_ERRORS),%VAL(PARITY_ERRORS)) ELSE CALL SYS$FAO ('!/XMODEM Status Report:!/'// 1 'Total blocks:!7UL, total records:!7UL, total bytes:!8UL!/'// 1 'Parity errors:!6UL, overruns:!7UL, timeouts:!8UL!/', 1 SIZE, SCRATCH, 1 %VAL(BLOCK_COUNT), %VAL(RECORD_COUNT), %VAL(BYTE_COUNT), 1 %VAL(PARITY_ERRORS), %VAL(FRAMING_ERRORS),%VAL(OVERRUN_ERRORS)) ENDIF CALL WRITE_USER (SCRATCH(1:SIZE)) END SUBROUTINE REPORT_RECORD C C This routine is used to update the statistics on the screen. C This routine is also called by the out-of-band AST generated by C typing the ESCape key. If this AST occurs while we're in the C middle of updating the screen, the error "Recursive I/O operation" C occurs and VAXNET aborts. For this reason, the IO_IN_PROGRESS C flag is used to avoid this problem. C INCLUDE 'COM.INC/NOLIST' INCLUDE '($TTDEF)/NOLIST' INTEGER SIZE, SON, EON IF ( (BATCH_MODE) .OR. (IO_IN_PROGRESS) ) RETURN IO_IN_PROGRESS = .TRUE. SON = INDEX (VAX_FILE(1:VSIZE), ']') + 1 ! Start of name. EON = INDEX (VAX_FILE(1:VSIZE), ';') - 1 ! End of name. IF (EON .LT. 0) EON = VSIZE ! No version number. IF (PROTOCOL .EQ. VAXNET) THEN CALL SYS$FAO ('!AS - Record count: !UL, byte count: !UL'// 1 ', Naks: !UL, (!UL)', SIZE, SCRATCH, 1 VAX_FILE(SON:EON), 1 %VAL(RECORD_COUNT), %VAL(BYTE_COUNT), 1 %VAL(ERROR_COUNT), %VAL(ERROR_RECORD) ) ELSE CALL SYS$FAO ('!AS - Blocks: !UL, records: !UL, bytes: !UL'// 1 ', Naks: !UL, (!UL)', SIZE, SCRATCH, 1 VAX_FILE(SON:EON), %VAL(BLOCK_COUNT), 1 %VAL(RECORD_COUNT), %VAL(BYTE_COUNT), 1 %VAL(ERROR_COUNT), %VAL(ERROR_RECORD) ) ENDIF IF (DISPLAY_SCREEN .AND. (.NOT. DUMP_MODE)) THEN CALL WRITE_TTY (SCRATCH(1:SIZE)//CHAR(CR)) ELSE CALL WRITE_TTY (SCRATCH(1:SIZE)//SS) ENDIF IO_IN_PROGRESS = .FALSE. RETURN END LOGICAL FUNCTION REPORT_ERROR (DISPLAY) C C This routine is used to report a transmission error. If the retry C limit is exceeded, the function returns failure. C C Inputs: C DISPLAY - Controls whether the error should be displayed. C INCLUDE 'COM.INC/NOLIST' LOGICAL DISPLAY CHARACTER*(*) RETRY_MSG PARAMETER (RETRY_MSG = SS// 1 '*** Retry limit exceeded, aborting file transmission ***' 1 //BELL//SS) REPORT_ERROR = .TRUE. ! Presume limit not exceeded. ERROR_COUNT = ERROR_COUNT + 1 ! Adjust the error counter. ERROR_RECORD = RECORD_COUNT + 1 ! Save the error record number. RETRY_COUNT = RETRY_COUNT + 1 ! Adjust the retry counter. IF (PROTOCOL .EQ. VAXNET) THEN CALL SYS$FAO ('*** Transmission ERROR on RECORD number !UL ***!/', 1 SIZE, SCRATCH, %VAL(RECORD_COUNT+1)) ELSE CALL SYS$FAO ('*** Transmission ERROR on BLOCK number !UL ***!/', 1 SIZE, SCRATCH, %VAL(BLOCK_COUNT+1)) ENDIF IF (.NOT. DISPLAY_SCREEN) THEN CALL WRITE_USER (SCRATCH(1:SIZE)) ! Display the error record. ELSE CALL WRITE_LOGFILE (%REF(SCRATCH),SIZE) ! Write to log file. IF (DISPLAY) CALL REPORT_RECORD() ! Report the record number. ENDIF IF (RETRY_COUNT .GE. RETRY_LIMIT) THEN REPORT_ERROR = .FALSE. ! Show retry limit exceeded. CALL WRITE_USER (RETRY_MSG) ! Tell the user what happened. ENDIF RETURN END SUBROUTINE REPORT_HOWTO C C This subroutine simply displays a message telling how to abort a C file transmission. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) HOWTO_MSG PARAMETER (HOWTO_MSG = SS// 1 '*** Type CTRL/C to abort the file transmission. ***'//DS) IF (.NOT. BATCH_MODE) THEN IF (.NOT. UNIX_MODE) THEN CALL WRITE_USER (HOWTO_MSG) ! Tellem how to abort. ENDIF ENDIF RETURN ENTRY REPORT_SUCCESS C C Routine to display a successful transmission. C CALL CHECK_DISPLAY() IF (.NOT. WATCH_FILES) RETURN IF (PROTOCOL .EQ. XMODEM) THEN CALL SYS$FAO ('*** File "!AS" successfully transferred. ***!/', 1 SIZE, SCRATCH, VAX_FILE(1:VSIZE)) CALL WRITE_USER (SCRATCH(1:SIZE)) RETURN ENDIF IF (FLOW .EQ. TO_VAX) THEN CALL SYS$FAO ('%GET - File "!AS" copied to "!AS" (!UL records, '// 1 '!UL bytes)!/', SIZE, SCRATCH, 1 REMOTE_FILE(1:RSIZE), VAX_FILE(1:VSIZE), 1 %VAL(RECORD_COUNT), %VAL(BYTE_COUNT)) ELSE CALL SYS$FAO ('%SEND- File "!AS" copied to "!AS" (!UL records, '// 1 '!UL bytes)!/', SIZE, SCRATCH, 1 VAX_FILE(1:VSIZE), REMOTE_FILE(1:RSIZE), 1 %VAL(RECORD_COUNT), %VAL(BYTE_COUNT)) ENDIF C C Break into two lines if we will exceed the terminal width. C IF (SIZE .GT. (TTY_WIDTH+2)) THEN PTR = INDEX (SCRATCH(1:SIZE), ' to "') CALL WRITE_USER (SCRATCH(1:PTR+3)//SS) CALL WRITE_USER (' '//SCRATCH(PTR+3:SIZE)) ELSE CALL WRITE_USER (SCRATCH(1:SIZE)) ENDIF RETURN ENTRY REPORT_ABORT C C Routine to display a aborted transmission. C CALL CHECK_DISPLAY() CALL WRITE_USER ('*** Transmission of file "'//VAX_FILE(1:VSIZE)// 1 '" aborted. ***'//SS) RETURN ENTRY REPORT_VAXFILE C C Routine to display the VAX file name. C CALL WRITE_USER ('*** The current VAX file is "'// 1 VAX_FILE(1:VSIZE)//'". ***'//SS) RETURN ENTRY REPORT_REMFILE C C Routine to display the REMOTE file name. C CALL WRITE_USER ('*** The current REMOTE file is "'// 1 REMOTE_FILE(1:RSIZE)//'". ***'//SS) RETURN END SUBROUTINE CHECK_DISPLAY C C This routine simply writes single spacing to the local terminal C if record information was displayed on the screen. C INCLUDE 'COM.INC/NOLIST' IF (DISPLAY_SCREEN) THEN IF (RECORD_COUNT .GE. DISPLAY_RECORD) THEN CALL WRITE_TTY (SS) ENDIF ENDIF RETURN END