C PROGRAM: FOREIGN TAPE PROCESSOR C AUTHOR: PETER J. HUNTER C DIVISION OF ENVIRONMENTAL STUDIES C 2120 WICKSON HALL C DAVIS, CA. 95616 C (916) 752-7533 C C ABSTRACT: C FTP IS DESIGNED TO PROVIDE THE USER WITH MAXIMUM FLEXIBILIY C IN DEALING WITH NON-DEC TAPES. C C REVISION HISTORY AND NOTES: C C 17-SEP-81 C * CREATED C C DECLARATION SECTION: C INTEGER * CONSOLE, !CONSOLE LUN * DISKUNIT, !DISK LUN * PRNUNIT, !PRINTER UNIT * NPARAM, !NUMBER OF PARAMETER SLOTS * DPARAM(2,20), !DEFAULT PARAMETER VALUES * PARAM(2,20), !USER PARAMETER VALUES * ERRCODE, !FTP ERROR CODE * IN, !INPUT CODE = 1 * OUT, !OUTPUT CODE = 2 * FSLEN, !FILE SPEC LENGTH * CMDPTR, !COMMAND LINE POINTER * CMDLEN, !COMMAND LINE LENGTH * SCAN, !COMMAND LINE SCANNER FUNCTION * MTUNIT, !TAPE UNIT # * IO, !IO CODE 1=OUT, 2=IN * IREC, !RECORD COUNTER * RECODE, !CHARACTER TRANSLATION CODE * EBCDIC, !EBCDIC CODE(3) * BINARY, !BINARY FILETYPE CODE(1) * DKREAD, !DISK READ ROUTINE * IEND C INTEGER * ICHAN(4), !TAPE CHANNEL # * IOPEN(4), !OPEN STATUS OF EACH TAPE # * IBLOCK(4), !# BLOCKS READ * IDPB(6), !QIO DEVICE PARAMETER BLOCK * ISB(2), !QIO STATUS BLOCK * IEFN(4), !EVENT FLAG NUMBERS * FILECTRL(2,4), !FILE CONTROL INFORMATION * IBUFFER(8192), !TAPE IO BUFFER * MAXBUF, !MAX BUFFER SIZE * FT, !FILE TYPE * RS, !RECORD SIZE * BS, !BLOCK SIZE * DF, !DUMP FORMAT * SW, !SWAP * RC, !RECORD COUNT * TMOVE, !TAPE MOVEMENT * TCNT, !TAPE COUNT * DC, !DEVICE CODE * LI, !LIST OPTIONS * NULL1, !EMPTY * EOT, !END OF TAPE * BOT, !BEGINNING OF TAPE * EOF !END OF FILE BYTE * BBUFFER(16384), !TAPE IQ CHARACTER BUFFER * CMDLINE(81), !INPUT COMMAND LINE * SWITCHES(40), !COMMAND LINE SWITCHES * DEVICES(20), !DEVICE CODES * INFILE(32), !INPUT FILE NAME * OUTFILE(32), !OUTPUT FILE NAME * ERROR !STRING ERROR FUNCTION C LOGICAL * TAPEIN, !TAPE DEVICE IS INPUT * SWAP !SWAP BYTES FLAG C EQUIVALENCE * (IBUFFER,BBUFFER) C INITIALIZATION SECTION C C COMMON /CODES/SWITCHES,DEVICES COMMON /MTIO/ICHAN,IOPEN,IBLOCK,IDPB,ISB,IEFN C DATA MAXBUF/8192/ DATA PRNUNIT,DISKUNIT,CONSOLE/6,7,5/ DATA RS,FT,DF,BS,NULLI,RC,SW,TMOVE,TCNT,DC,LI * /1, 2, 3, 4, 5, 6, 7, 8, 9,10,11/ DATA IN,OUT/2,1/ DATA EBCDIC,BINARY/3,1/ DATA EOF,EOT,BOT/-10, -11, -10/ DATA NPARAM/11/ DATA DPARAM/ * !SWITCH OUTPUT INPUT * 80,80, !RECSIZE: 80 80 * 2,2, !FILETYPE: ASCII ASCII * 2,0, !DUMP FORMAT: ASCII N/A * 80,80, !BLOCKSIZE: 80 80 * 0,0, !UNDEFINED * 32767,32767, !RECORD COUNT: 32767 32767 * 0,0, !SWAP TOGGLE: OFF OFF * 0,0, !TAPE MOVEMENT: UDEF. N/A * 0,0, !MOVEMENT COUNT: " N/A * 0,0, !DEVICE CODE: UNDEF. UNDEF. * 0,0, !LIST TOGGLE: OFF OFF * 18*0/ !UNDEFINED C C C INITIALZE SWITCHES AND DEVICE CODES CALL SCOPY(SWITCHES,'RSFTDFCPCORCSWRWFFBFFRBRTMLI',ERROR) CALL SCOPY(DEVICES,'MTTTTIDKDYSY',ERROR) CALL ERRSET(64,,,,.FALSE.) !RESET INPUT CONVERSION ERROR MESSAGE CALL ERRSET(39,,,,.FALSE.) !RESET READ ERROR MESSAGE DO 10 I=1,4 IOPEN(I) = 0 ICHAN(I) = 0 IBLOCK(I) = 0 10 CONTINUE C GET A COMMAND LINE 100 CONTINUE WRITE(CONSOLE,101) 101 FORMAT('$FTP>') CALL GETSTR(CONSOLE,CMDLINE,80,ERROR) IF(ERROR)GOTO 9999 C C CMDPTR=1 CMDLEN=LEN(CMDLINE) INFILE(1)=0 OUTFILE(1)=0 C C SKIP ANY BLANKS C CALL SKIPBLANKS(CMDLINE,CMDPTR,CMDLEN) C C SEE IF A FILE SPEC IS PRESENT BY SCANNING FOR A SWITCH DELIMITER. C STORE IN "FILE SPEC LENGTH: FSLEN". C FSLEN= SCAN(CMDLINE,CMDPTR,CMDLEN) C C CLEAR PARAMETER AREA. C DO 110 I=1,NPARAM PARAM(IN,I)=0 110 PARAM(OUT,I)=0 C ERRCODE=0 IF(FSLEN.GT.0) CALL FILESPEC(CMDLINE,CMDPTR,CMDLEN,PARAM, * FSLEN,OUTFILE,OUT,ERRCODE) IF(ERRCODE.EQ.0) GO TO 120 CALL ERRMES(CONSOLE,ERRCODE,CMDPTR) GO TO 100 C 120 CONTINUE IF(CMDLINE(CMDPTR) .EQ. '=')GOTO 130 CALL DECODESWITCHES(CMDLINE,CMDPTR,CMDLEN,PARAM,OUT,ERRCODE) IF(ERRCODE.EQ.0) GO TO 130 CALL ERRMES(CONSOLE,ERRCODE,CMDPTR) GO TO 100 C 130 CONTINUE IF(CMDPTR .GE. CMDLEN) GO TO 150 C C PROCESS INPUT FILE SPECS. C CMDPTR=CMDPTR+1 CALL SKIPBLANKS(CMDLINE,CMDPTR,CMDLEN) FSLEN= SCAN(CMDLINE,CMDPTR,CMDLEN) IF(FSLEN.GT.0) CALL FILESPEC(CMDLINE,CMDPTR,CMDLEN,PARAM, * FSLEN,INFILE,IN,ERRCODE) IF(ERRCODE.EQ.0) GO TO 140 CALL ERRMES(CONSOLE,ERRCODE,CMDPTR) GO TO 100 C C 140 CONTINUE IF(CMDPTR .GE. CMDLEN)GOTO 150 CALL DECODESWITCHES(CMDLINE,CMDPTR,CMDLEN,PARAM,IN,ERRCODE) IF(ERRCODE.EQ.0) GO TO 150 CALL ERRMES(CONSOLE,ERRCODE,CMDPTR) GO TO 100 C C 150 CONTINUE C ADD ANY DEFAULT PARAMETERS TO THE USER PARAMETERS DO 155 I=1,NPARAM IF(PARAM(IN,I) .EQ. 0)PARAM(IN,I)=DPARAM(IN,I) IF(PARAM(OUT,I) .EQ. 0)PARAM(OUT,I)=DPARAM(OUT,I) 155 CONTINUE C C CHECK TO SEE IF OUTPUT DEFAULTS ARE TO BE LISTED C IF(PARAM(OUT,LI) .EQ. 0) GO TO 160 CALL LIST(CONSOLE,PARAM,OUT) IF(PARAM(OUT,DC) .LE. 0) GO TO 100 WRITE(CONSOLE,151) (FILECTRL(J,PARAM(OUT,DC)), J=1,2) 151 FORMAT(3X,'Tape unit positioned at file',I3,' record',I5) GO TO 100 C 160 IF(PARAM(IN,LI) .EQ. 0) GO TO 170 C C LIST DEFAULT INPUT SWITCHES C CALL LIST(CONSOLE,PARAM,IN) IF(PARAM(IN,DC) .LE. 0) GO TO 100 WRITE(CONSOLE,151) (FILECTRL(J,PARAM(IN,DC)), J=1,2) GO TO 100 C C CHECK TO SEE IF ANY DEFAULTS ARE TO BE RESET. DEFAULT SWITCH VALUES C CAN BE SET BY LISTING SWITCH VALUES, BUT NO INPUT OR OUTPUT FILE. C EG. /DF:HX/RC:1 WOULD SET THE DEFAULT DUMP FORMAT TO HEX WITH C A RECORD COUNT OF 1. C 170 CONTINUE C IF(INFILE(1).NE.0 .OR. OUTFILE(1).NE.0) GO TO 180 !BR FILENAME C C RESET DEFAULTS C DO 175 I=1,NPARAM DPARAM(IN,I)=PARAM(IN,I) DPARAM(OUT,I)=PARAM(OUT,I) 175 CONTINUE GO TO 100 C 180 CONTINUE C C CHECK FOR INPUT, OUTPUT OR TRANSFER COMMAND C IF(INFILE(1) .NE. 0) GO TO 300 !BRIF INPUT OR TRANSFER C C OUTPUT COMMAND ONLY C IF(PARAM(OUT,DC) .GT. 0) GOTO 181 !MUST BE TAPE ERRCODE = 17 CALL ERRMES(CONSOLE,ERRCODE,-1) GOTO 100 181 CONTINUE J=1 IF(IOPEN(PARAM(OUT,DC)) .EQ. 0) J=MTOPEN(PARAM(OUT,DC)-1) IF(J.GT.0) GO TO 190 CALL ERRMES(CONSOLE,J,-1) GO TO 100 C C RW FF BF FR FB ? ? TM 190 GO TO (200,210,220,230,240,191,191,250), PARAM(OUT,TMOVE) C 191 CALL ERRMES(CONSOLE,15,-1) !CONFUSED! GOTO 100 C 200 CONTINUE C REWIND TAPE FILE. J=MTREW(PARAM(OUT,DC)-1) IF(J.GT.0) GO TO 205 CALL ERRMES(CONSOLE,J,-1) GO TO 100 205 FILECTRL(1,PARAM(OUT,DC))=0 !RESET FILE POINTER FILECTRL(2,PARAM(OUT,DC))=0 !RESET RECORD POINTER GO TO 100 C 210 CONTINUE C FORWARD FILES(S). EXECUTE AS A SERIES OF SINGLE FILE FORWARD COMMANDS C DO 215 I=1,PARAM(OUT,TCNT) J=MTFRSP(PARAM(OUT,DC)-1,0) IF(J.GT.0) GO TO 214 IF(J.EQ.EOT) GO TO 211 !BRIF AT END-OF-TAPE CALL ERRMES(CONSOLE,J,-1) !SOME OTHER ERROR GO TO 100 211 WRITE(CONSOLE,212) I-1 212 FORMAT(' WARNING: End-of-tape encountered after',I5,' files.') GO TO 100 214 J=PARAM(OUT,DC) FILECTRL(1,J)=FILECTRL(1,J)+1 !INCREMENT FILE COUNTER FILECTRL(2,J)=0 !RESET RECORD POINTER 215 CONTINUE GO TO 100 C 220 CONTINUE C BACKSPACE FILES. DO 225 I=1,PARAM(OUT,TCNT) J=MTBKSP(PARAM(OUT,DC)-1,0) IF( MTABOT(PARAM(OUT,DC)-1) .NE. 0)GOTO 221 !AT BOT IF(J.GE.0) GO TO 224 !BRIF NO ERROR GOTO 223 !SOME OTHER ERROR 221 WRITE(CONSOLE,222) I-1 222 FORMAT(' WARNING: Beginning-of-tape encountered after',I5, * ' files.') GO TO 205 !RESET FILE CONTROL PARAMETERS 223 CALL ERRMES(CONSOLE,J,-1) GO TO 100 C C ADJUST FILE AND RECORD POINTERS C 224 FILECTRL(1,PARAM(OUT,DC))=FILECTRL(1,PARAM(OUT,DC))-1 FILECTRL(2,PARAM(OUT,DC))=0 225 CONTINUE GOTO 100 C 230 CONTINUE C FORWARD SPACE RECORDS WITHIN FILE. DO 235 I=1,PARAM(OUT,TCNT) J=MTFRSP(PARAM(OUT,DC)-1,1) IF(J.GE.0) GO TO 234 IF(J.NE.EOF .AND. J.NE.EOT) GO TO 232 WRITE(CONSOLE,231) I-1 231 FORMAT(' WARNING: End-of-file encountered after',I5,' records.') C C BACKSPACE ONE FILE TO GET IN FRONT OF EOF MARK. C J = MTBKSP(PARAM(OUT,DC)-1,0) C GO TO 100 232 CALL ERRMES(CONSOLE,J,-1) GO TO 100 234 J=PARAM(OUT,DC) FILECTRL(2,J)=FILECTRL(2,J)+1 235 CONTINUE GO TO 100 C 240 CONTINUE C BACKSPACE A GIVEN NUMBER OF RECORDS DO 245 I=1,PARAM(OUT,TCNT) J=MTBKSP(PARAM(OUT,DC)-1,1) C C SEE IF BOT WAS FOUND... C IF(MTABOT(PARAM(OUT,DC)-1) .NE. 0) GOTO 241 !BOT FOUND C C IF NOT ERRORS, JUST CONTINUE C IF(J.GE.0) GO TO 244 C C IF THERE WAS AN ERROR, AND IT WASN'T AND EOF, GO PROCESS IT C IF(J.NE.EOF) GO TO 242 C C IF IT WAS AN EOF, THEN SPACE FORWARD ONE RECORD TO GET TO THE C FIRST RECORD OF THE FILE C J = MTFRSP(PARAM(OUT,DC)-1) FILECTRL(2,PARAM(OUT,DC)) = 0 !RESET RECORD PTR. C 241 CONTINUE WRITE(CONSOLE,2410) I-1 2410 FORMAT(' WARNING: Beginning-of-file found after',I4, * ' records.') GO TO 100 242 CALL ERRMES(CONSOLE,J,-1) GO TO 100 244 J=PARAM(OUT,DC) FILECTRL(2,J)=FILECTRL(2,J)-1 245 CONTINUE GO TO 100 C 250 CONTINUE C WRITE ONE OR MORE EOF MARKS. DO 255 I=1,PARAM(OUT,TCNT) ERRCODE = MTEOF(PARAM(OUT,DC)-1) IF(ERRCODE .GT. 0)GOTO 255 CALL ERRMES(CONSOLE,ERRCODE,-1) GOTO 100 255 CONTINUE J=PARAM(OUT,DC) FILECTRL(1,J)=FILECTRL(1,J)+1 FILECTRL(2,J)=0 GO TO 100 C C 300 CONTINUE C C IF AN OUTPUT FILE IS PRESENT, BRANCH TO THE TRANSFER SECTION C IF(OUTFILE(1) .NE. 0)GOTO 400 C C INPUT FILE ONLY. DO PARITY CHECK C IF(PARAM(IN,TMOVE) .EQ. 6)GOTO 305 CALL ERRMES(CONSOLE,15,-1) !CONFUSED! GOTO 100 C 305 CONTINUE J = 1 KUNIT = PARAM(IN,DC) IF(IOPEN(KUNIT) .EQ. 0)J=MTOPEN(KUNIT-1) IF(J .GT. 0)GOTO 310 CALL ERRMES(CONSOLE,J,-1) GOTO 100 C C PARITY CHECK LOOP. READ UNTIL EOT C 310 J = MTREAD(KUNIT-1,IBUFFER,MAXBUF) IF(J .LE. 0)GOTO 315 FILECTRL(2,KUNIT) = FILECTRL(2,KUNIT) + 1 GOTO 310 C C CHECK ERROR CONDITIONS. C 315 IF(J.EQ.EOT)GOTO 320 C IF(J.NE.EOF)GOTO 330 !PROCESS OTHER ERROR C C ON EOF, INCREMENT FILE COUNTER, RESET RECORD COUNTER C IF NO RECORDS HAVE BEEN READ IN THIS FILE, THEN TWO EOF'S HAVE C OCCURED TOGETHER, INDICATING END OF TAPE. C IF(FILECTRL(2,KUNIT) .EQ. 0)GOTO 320 C C ELSE, INCREMENT FILE COUNT AND RESET RECORD COUNTER C FILECTRL(1,KUNIT) = FILECTRL(1,KUNIT) + 1 FILECTRL(2,KUNIT) = 0 GOTO 310 320 CONTINUE WRITE(CONSOLE,321) FILECTRL(1,KUNIT) 321 FORMAT(' No parity errors detected.',I4,' files read on tape.') GOTO 100 C C ON OTHER ERROR, ASSUME PARITY. C 330 CALL ERRMES(CONSOLE,J,-1) WRITE(CONSOLE,331)(FILECTRL(J,KUNIT),J=1,2) 331 FORMAT(' File',I4,' Record',I5,' Parity check terminated.') GOTO 100 C C DATA TRANSFER SECTION.... C 400 CONTINUE C C THIS IS DATA TRANSFER SECTION. FIRST DETERMINE IF IT IS A TAPE TO C TAPE TRANSFER. C C ..... TAPE TO TAPE ..... IF(PARAM(IN,DC).GT.0 .AND. PARAM(OUT,DC).GT.0) GOTO 600 C C DETERMINE INPUT MODE C IF(PARAM(IN,DC).LT.0) GOTO 405 C INPUT = TAPE TAPEIN=.TRUE. MTUNIT=PARAM(IN,DC) GO TO 408 405 TAPEIN=.FALSE. !TAPE IS OUTPUT MTUNIT=PARAM(OUT,DC) C OPEN THE TAPE UNIT 408 J=1 IF(IOPEN(MTUNIT).EQ.0) J=MTOPEN(MTUNIT-1) IF(J.GT.0) GOTO 410 CALL ERRMES(CONSOLE,J,-1) GO TO 100 C C ASSIGN AND OPEN, IF NECESSARY, OUTPUT UNIT C 410 CONTINUE C IREC = 0 IO=OUT IF(.NOT.TAPEIN) IO=IN KUNIT=CONSOLE IF(PARAM(IO,DC).LT.-1) KUNIT=DISKUNIT IF(KUNIT.EQ.CONSOLE) GOTO 430 C C OPEN DISK FILE BASED ON FILE TYPE C IF(PARAM(IO,FT).NE.BINARY) GOTO 420 C C OPEN BINARY, DIRECT ACCESS FILE C IREC=(PARAM(IO,RS)+3)/4 IF(IO.EQ.OUT) OPEN(UNIT=KUNIT,NAME=OUTFILE,TYPE='NEW', * ACCESS='DIRECT',RECORDSIZE=IREC,ERR=415) IF(IO.EQ.IN) OPEN(UNIT=KUNIT,NAME=INFILE,TYPE='OLD', * ACCESS='DIRECT',RECORDSIZE=IREC,ERR=415) C C IREC=0 GO TO 430 C C ERROR ON OPEN C 415 CALL ERRMES(CONSOLE,18,-1) CLOSE(UNIT=KUNIT,ERR=100) GO TO 100 C C IF NOT BINARY, OPEN AS ASCII C 420 CONTINUE C IF(IO.EQ.OUT) OPEN(UNIT=KUNIT,NAME=OUTFILE,TYPE='NEW', * CARRIAGECONTROL='LIST',ERR=415) IF(IO.EQ.IN) OPEN(UNIT=KUNIT,NAME=INFILE,TYPE='OLD', * CARRIAGECONTROL='LIST',ERR=415) IREC=0 GO TO 430 C C CHECK SWAP AND RECODE FLAGS. C 430 CONTINUE SWAP=.FALSE. RECODE=0 IF(PARAM(IN,SW).NE.0) SWAP=.TRUE. IF(PARAM(IN,FT).EQ.PARAM(OUT,FT)) GOTO 440 !FILETYPES THE SAME IF(PARAM(IN,FT).EQ.EBCDIC) RECODE=1 IF(PARAM(OUT,FT).EQ.EBCDIC) RECODE=2 C 440 CONTINUE C C NOW READ UNTIL EOF OR RECORD COUNT COMPLETE. C IPTR=1 C 450 IF(TAPEIN) GOTO 500 C C INPUT FROM DISK FILE C ERRCODE=DKREAD(KUNIT,BBUFFER(IPTR),PARAM(IN,RS), * PARAM(IN,FT),IREC) IF(IREC.GT.PARAM(IN,RC)) ERRCODE= -1 IF(ERRCODE.GT.0) GOTO 460 !NOT EOF IF(KUNIT.NE.CONSOLE) CLOSE(UNIT=KUNIT) IF(IPTR.EQ.1) GOTO 480 !BRIF AT C !BEGINNING OF BUFFER GOTO 470 !ELSE, DUMP CURRENT BUFFER C C BUILD UP BUFFER C 460 IEND=IPTR+PARAM(IN,RS)-1 IF(IEND.EQ.PARAM(OUT,BS)) GOTO 470 !GO DUMPBUFFER IPTR=IEND+1 GO TO 450 C C WRITE BUFFER TO TAPE C 470 IPTR=1 NWORDS=IEND/2 IF(SWAP) CALL ISWAP(IBUFFER,NWORDS) IF(RECODE.NE.0) CALL TRANSLATE(BBUFFER,IEND,RECODE) J = MTWRIT(MTUNIT-1,IBUFFER,NWORDS) IF(J.GT.0) GOTO 475 CALL ERRMES(CONSOLE,J-1) IF(KUNIT.NE.CONSOLE) CLOSE(UNIT=KUNIT) GO TO 100 C C 475 FILECTRL(2,MTUNIT) = FILECTRL(2,MTUNIT)+1 IF(ERRCODE.GT.0 .AND. FILECTRL(2,MTUNIT).LT.PARAM(OUT,RC)) * GO TO 450 C C CLOSE TAPE FILE C 480 J = MTEOF(MTUNIT-1) WRITE(CONSOLE,481) IREC,(FILECTRL(J,MTUNIT),J=1,2) 481 FORMAT(I6,' Records written to tape file ',I4, * ' in ',I4,' blocks.') FILECTRL(1,MTUNIT) = FILECTRL(1,MTUNIT)+1 FILECTRL(2,MTUNIT) = 0 GO TO 100 C C INPUT FROM TAPE, OUTPUT TO DISK OR CONSOLE C 500 CONTINUE ERRCODE = MTREAD(MTUNIT-1,IBUFFER,MAXBUF) IF(ERRCODE.GT.0) GOTO 510 !READ OK IF(ERRCODE.EQ.EOF) GOTO 505 CALL ERRMES(CONSOLE,ERRCODE,-1) C 505 IF(KUNIT .EQ. CONSOLE)GOTO 100 CLOSE(UNIT=KUNIT) WRITE(CONSOLE,506) IREC 506 FORMAT(I6,' Records written to output file') C C INCREMENT FILE COUNT C FILECTRL(1,MTUNIT) = FILECTRL(1,MTUNIT) + 1 FILECTRL(2,MTUNIT) = 0 C GO TO 100 C 510 CONTINUE FILECTRL(2,MTUNIT)=FILECTRL(2,MTUNIT) + 1 NWORDS=ERRCODE IF(PARAM(OUT,DF).NE.5) GOTO 520 WRITE(KUNIT,511) NWORDS,(FILECTRL(3-J,MTUNIT),J=1,2) 511 FORMAT(1X,I4,' Words in record ',I4,' of file ',I4,'.') IREC=IREC+1 IF(IREC.EQ.PARAM(OUT,RC)) GOTO 505 GO TO 590 C 520 IF(SWAP) CALL ISWAP(IBUFFER,NWORDS) IF(RECODE) CALL TRANSLATE(BBUFFER,NWORDS*2,RECODE) C C PROCESS RECORDS WITHIN BUFFER C C C MAKE SURE THIS ISN'T A SHORT BLOCK C I1=MIN0(PARAM(IN,BS),NWORDS*2) C DO 580 IPTR=1,I1,PARAM(OUT,RS) IEND=IPTR+PARAM(OUT,RS)-1 C C BI AS HX OT GOTO(530, 540, 550, 560), PARAM(OUT,DF) C 530 CONTINUE !BINARY DUMP WRITE(KUNIT'IREC+1,ERR=535) (BBUFFER(I),I=IPTR,IEND) IREC=IREC+1 GO TO 570 535 CALL ERRMES(CONSOLE,19,-1) !DISK WRITE ERROR GO TO 505 C 540 CONTINUE !ASCII DUMP C C STRIP OFF THE NUMBER OF TRAILING BLANKS C ILEN = IPTR+PARAM(OUT,RS) DO 541 I=1,PARAM(OUT,RS) ILEN = ILEN - 1 IF(BBUFFER(ILEN) .NE. ' ')GOTO 542 541 CONTINUE 542 CONTINUE IF(KUNIT .EQ. CONSOLE) WRITE(KUNIT,544,ERR=535) * (BBUFFER(I),I=IPTR,ILEN) IF(KUNIT .NE. CONSOLE) WRITE(KUNIT,543,ERR=535) * (BBUFFER(I),I=IPTR,ILEN) 543 FORMAT(132A1) 544 FORMAT(1X,131A1) IREC=IREC+1 GO TO 570 C 550 CONTINUE !HEX DUMP ISTART = (IPTR+1)/2 ILEN = MIN0(NWORDS,PARAM(IO,RS)/2) CALL DUMP(KUNIT,PARAM(IO,DF),FILECTRL(1,MTUNIT),IREC, * IBUFFER(ISTART),ILEN,ERRCODE) IF(ERRCODE .NE. 0)GOTO 535 IREC=IREC+1 GO TO 570 C 560 CONTINUE !OCTAL DUMP ISTART = (IPTR + 1)/2 ILEN = MIN0(NWORDS,PARAM(IO,RS)/2) CALL DUMP(KUNIT,PARAM(IO,DF),FILECTRL(1,MTUNIT),IREC, * IBUFFER(ISTART),ILEN,ERRCODE) IF(ERRCODE .NE. 0)GOTO 535 IREC=IREC+1 GO TO 570 C C CHECK OUTPUT RECORD COUNT. IF DONE, GO CLOSE OUTPUT FILE. C 570 IF(IREC.GE.PARAM(OUT,RC)) GO TO 505 C 580 CONTINUE C C CHECK TO MAKE SURE TAPE COUNT HAS NOT BEEN EXCEEDED. C 590 CONTINUE IF(FILECTRL(2,MTUNIT).GE.PARAM(IN,RC)) GO TO 505 !TERMINATE GO TO 500 !CONTINUE C GO TO 100 600 CONTINUE C C TAPE TO TAPE COPY. THIS COPYS ONE TAPE TO ANOTHER FOR A SPECIFIED C NUMBER OF FILES. C C FIRST, MAKE SURE BOTH TAPE FILES ARE OPEN. C J=1 IFILE = 0 MTIN = PARAM(IN,DC) MTOUT = PARAM(OUT,DC) IF(IOPEN(MTIN) .EQ. 0)J = MTOPEN(MTIN-1) IF(J .GT. 0)GOTO 610 605 CALL ERRMES(CONSOLE,J,-1) GOTO 100 C 610 IF(IOPEN(MTOUT) .EQ. 0)J=MTOPEN(MTOUT-1) IF(J .LE. 0)GOTO 605 C C DO THE COPY FOR THE SPECIFIED NUMBER OF FILES. STOP AT EOT C 620 NWORDS = MTREAD(MTIN-1, IBUFFER, MAXBUF) IF(NWORDS .GT. 0)GOTO 630 !MIDDLE OF FILE IF(NWORDS .EQ. EOT)GOTO 650 !END OF TAPE IF(NWORDS .NE. EOF)GOTO 640 !TAPE ERROR C C AT EOF, MAKE SURE SOME RECORDS WERE TRANSFERED. IF NOT, C THEN THERE WERE 2 EOF IN A ROW, HENCE, EOT. C IF(FILECTRL(2,MTIN) .EQ. 0)GOTO 650 !EOT C C UPDATE FILE CONTROL PARAMETERS. C FILECTRL(1,MTIN) = FILECTRL(1,MTIN) + 1 FILECTRL(1,MTOUT) = FILECTRL(1,MTOUT) + 1 FILECTRL(2,MTIN) = 0 FILECTRL(2,MTOUT) = 0 C C WRITE AN EOF TO THE OUTPUT TAPE C J = MTEOF(MTOUT-1) C C TEST THE NUMBER OF FILES COPIED C IFILE = IFILE + 1 IF(IFILE .LT. PARAM(IN,TCNT))GOTO 620 !MORE TO COPY GOTO 660 !DONE C C WRITE TAPE RECORD AND INCREMENT NUMBER OF RECORDS COPIED C 630 CONTINUE ERRCODE = MTWRIT(MTOUT-1,IBUFFER,NWORDS) IF(ERRCODE .LE. 0)GOTO 640 !WRITE ERROR FILECTRL(2,MTIN)=FILECTRL(2,MTIN) + 1 FILECTRL(2,MTOUT) = FILECTRL(2,MTOUT) + 1 GOTO 620 C C BAD ERROR. REPORT AND STOP C 640 CALL ERRMES(CONSOLE,NWORDS,-1) WRITE(CONSOLE,641)(FILECTRL(3-J,MTIN),J=1,2) 641 FORMAT(5X,'After record',I5,' in file',I4,'.') GOTO 100 C C AT EOT, WRITE 2 EOFS , REPORT AND QUIT C 650 J=MTEOF(MTOUT-1) J=MTEOF(MTOUT-1) C C UPDATE FILE POINTERS C FILECTRL(1,MTIN) = FILECTRL(1,MTIN) + 1 FILECTRL(1,MTOUT) = FILECTRL(1,MTOUT) + 1 FILECTRL(2,MTIN) = 0 FILECTRL(2,MTOUT) = 0 C C REPORT C 660 WRITE(CONSOLE,661)IFILE 661 FORMAT(1X,I5,' files copied.') GOTO 100 C C STOP THE PROGRAM 9999 STOP 'FTP' END