LOGICAL FUNCTION DUMP_FILE(FILES) C C Routine to dump a file to the remote. C C Inputs: C FILE_NAME - string descriptor containing the file name. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) FILES LOGICAL GET_VAXFILE INTEGER*4 B, S, E CHARACTER*80 DUMP_TERM INTEGER*4 DSIZE ASSIGN 100 TO LOOP ! Loop reading from file. C ASSIGN 200 TO RETRY ! Retry after transmission error. ASSIGN 50 TO NEXT_FILE ! Here to open the next file. DUMP_FILE = .FALSE. ! Initialize to bad return. CALL FLUSH_LOGFILE() ! Empty the logfile buffer. CALL REENABLE() ! Enable CTRL/C AST's. C C Parse the file names (if any). C B = 1 ! Start at first character. CALL PARSE_CMD(FILES,B,S,E) ! Parse the file name (if any). 50 IF (.NOT. GET_VAXFILE(FILES(S:E-1))) RETURN ! Get/open the VAX file. C C Ready to start dumping. C CALL INIT_TIMER() ! Initialize the timer. 100 IF (CONTROLC_TYPED) GO TO 9999 ! If aborted, clean up and return. READ (FILE_UNIT,110,END=9900) RBYTES,(XBUFFER(I),I=1,RBYTES) 110 FORMAT (Q,A1) C C Post a read to get the echo back from the remote. C IF (.NOT. POST_READ(RBUFFER,TIMEOUT_COUNT,TERMPTR)) RETURN C C Send a record to the remote and wait for the echo. C CALL WRITE_REMOTE(XBUFFER(1),RBYTES) CALL SYS$WAITFR(%VAL(REFN_IN)) ! Wait for the read. IF (CONTROLC_TYPED) RETURN ! Return if we were aborted. STATUS = RIOSB(1) ! Copy the I/O status code. C C Expect timeout errors when there is a transmission error. C IF (STATUS .NE. SS$_TIMEOUT) THEN CALL CHECK_STATUS('DUMP_FILE',STATUS) ENDIF IF (STATUS) THEN NBYTES = RIOSB(2) + 1 ! Byte count + terminator. ELSE NBYTES = RIOSB(2) ! Presume no terminator. ENDIF C C Display the echo from the remote at the terminal and to the C logfile if echoing is enabled, else write the echo from the C remote to the logfile only. C IF (ECHO_DUMP) THEN IF (LOCAL_ECHO) THEN ! For IBM, fake the echo. RBYTES = RBYTES + 1 ! Adjust the record size. XBUFFER(RBYTES) = CR ! Append a carriage return. IF (NBYTES .EQ. 0) THEN ! Also append a line feed RBYTES = RBYTES + 1 ! Adjust the record size. XBUFFER(RBYTES) = LF ! if nothing received. ENDIF CALL WRITE_BUFFER(XBUFFER(1),RBYTES) ! Original record. ENDIF CALL WRITE_BUFFER(RBUFFER(1),NBYTES) ! Received data. ELSE CALL WRITE_LOGFILE(RBUFFER(1),NBYTES) ! Write to logfile. ENDIF C C If there are more characters in the typeahead buffer, maybe due C to terminal wraparound, read them now before doing the next dump C to prevent loss of data. C TBYTES = CHECK_TYPEAHEAD() ! Get typehead count (if any). IF (TBYTES .GT. 0) THEN STATUS = SYS$QIOW(%VAL(REFN_IN),%VAL(RCHAN_IN), 1 %VAL(IO$_TTYREADALL + IO$M_NOECHO), 1 RIOSB,,,RBUFFER,%VAL(TBYTES),,NOTERM,,) CALL CHECK_STATUS('DUMP_TTYREADALL',STATUS) IF (ECHO_DUMP) THEN CALL WRITE_BUFFER(RBUFFER(1),TBYTES) ELSE CALL WRITE_LOGFILE(RBUFFER(1),TBYTES) ENDIF ENDIF GO TO LOOP C C Here for EOF on input. C 9900 CALL WRITE_USER(SS//'*** End of file detected on file '// 1 VAX_FILE(1:VSIZE)//' ***'//SS) C C If a symbol called DUMP_TERM is defined, write these characters C to the remote at end of file. Control characters are allowed. C IF (GET_SYMBOL('DUMP_TERM',DUMP_TERM,DSIZE)) THEN CALL WRITE_CTRL(%REF(DUMP_TERM),DSIZE) ENDIF 9999 CLOSE (UNIT=FILE_UNIT) ! Close the VAX file. C C Let the user know we detected their CTRL/C to abort. C IF (CONTROLC_TYPED) THEN CALL WRITE_USER(SS// 1 '*** File dumping has been aborted. ***'//SS) ELSE CALL PARSE_CMD(FILES,B,S,E) ! Another file to dump ? IF (S .GT. 0) GO TO NEXT_FILE ENDIF CALL ELAPSED_TIME() ! Display the elapsed time. C C For CROSSFILE, redisplay the editor prompt so the user C knows where they are. C IF (CROSS_FILE) THEN CALL WRITE_BUFFER(RBUFFER,NBYTES) ENDIF DUMP_FILE = .TRUE. ! Show success. RETURN END