PROGRAM T2T C C TAPE COPY - TO COPY TAPE A TO TAPE B C C Initialially designed to replace the FLX DOS to DOS copy C because of its inherent slowness, so this program C handles DOS files, but handles any file or set C of files that end with 2 EOF'S. (BRU and DSC also - and VMS BACKUP!) C C TO TASK BUILD, USE THE FOLLOWING OPTIONS: C FORTRAN/F77 T2T/SHAREABLE C T2T/ID=T2T C / C UNITS=3 C ASG=TI:3 C ACTFIL=3 C SUPLIB=FCSFSL:SV C // C IMPLICIT INTEGER (A-Z) DIMENSION ISB(2),DPB(6) CHARACTER MESS*70,CMDLIN*80,TNAME*4,TIMES*8 BYTE BUFFER(32256) DATA TNAME/'MM0:'/ C TIN = 1 TOUT = 2 CRT = 3 MAXEOF = 2 HIGHD = "4000 ! IO.STC FOR 1600 BPI (11TH BIT SET) LOWD = 0 ! IO.STC FOR 800 BPI CALL GETADR(DPB,BUFFER) C C Get command line from user C CALL GETMCR(CMDLIN,LEN) IF (LEN.LE.0) GO TO 5 ST = INDEX(CMDLIN,' ')+1 ! Get start of qualifier CMDLIN = CMDLIN(ST:LEN) CMDLEN = LEN-ST+1 DECODE (CMDLEN,7,CMDLIN,ERR=5) DEVI,DENSI,DEVO,DENSO GO TO 8 C C Incomplete or missing command line C 5 WRITE (CRT,6) 6 FORMAT ('$Enter the input #, density, output #, density : ') READ (CRT,7,ERR=5,END=60) DEVI,DENSI,DEVO,DENSO 7 FORMAT (4I5) 8 ENCODE(1,9,TNAME(3:3),ERR=5) DEVI 9 FORMAT (I1) CALL ASSIGN(TIN,TNAME,4) ENCODE(1,9,TNAME(3:3),ERR=10) DEVO CALL ASSIGN(TOUT,TNAME,4) C C Attach, Rewind and set to 800 BPI C DO 10 DEV=TIN,TOUT CALL WTQIO("1400,DEV,1,,ISB) !IO.ATT IF (ISB(1).NE.1) GO TO 40 CALL WTQIO ("2500,DEV,1,,ISB) !IO.STC IF (ISB(1).NE.1) GO TO 55 CALL WTQIO ("2400,DEV,1,,ISB) !IO.RWD IF (ISB(1).NE.1) GO TO 50 10 CONTINUE C C set the density (only needed if = 1600) C IF (DENSI.NE.1600) GO TO 17 CALL WTQIO("2500,TIN,1,,ISB,HIGHD) IF (ISB(1).NE.1) GO TO 45 17 IF (DENSO.NE.1600) GO TO 18 CALL WTQIO("2500,TOUT,1,,ISB,HIGHD) IF (ISB(1).NE.1) GO TO 45 18 CONTINUE C C COPY LOOP C NOEOF = 0 20 DPB(2) = 32256 ! VMS LARGEST SIZE? CALL WTQIO("1000,TIN,1,,ISB,DPB) !IO.RLB IF (ISB(1).EQ.1) GO TO 25 IF (ISB(1).NE.246) THEN CALL FCSERR(ISB,MESS) WRITE (CRT,21) DEVI,MESS 21 FORMAT (' Unit ',I1,1X,A70) ENDIF NOEOF = NOEOF+1 GO TO 30 25 NOEOF = 0 DPB(2) = ISB(2) CALL WTQIO("400,TOUT,1,,ISB,DPB) !IO.WLB IF (ISB(1).EQ.1) GO TO 20 CALL FCSERR(ISB,MESS) WRITE (CRT,21) DEVO,MESS GO TO 20 30 CALL WTQIO("3000,TOUT,1,,ISB) !IO.EOF IF (ISB(1).EQ.1) GO TO 35 CALL FCSERR(ISB,MESS) WRITE (CRT,21) DEVO,MESS 35 IF (NOEOF.LT.MAXEOF) GO TO 20 C C That should do it - required number of EOF's in a row C 38 CALL WTQIO("2500,TIN,1,,ISB,LOWD) !SET DENSITY BACK TO 800 CALL WTQIO("2500,TOUT,1,,ISB,LOWD) CALL WTQIO("2400,TIN,1,,ISB) !REWIND THEM CALL WTQIO("2400,TOUT,1,,ISB) CALL WTQIO("2000,TIN,1,,ISB) !DETACH CALL WTQIO("2000,TOUT,1,,ISB) GO TO 60 C C ERROR ATTACHING C 40 WRITE (CRT,41) 41 FORMAT (' Failed to attach tape drive') GO TO 38 C C ERROR SETTING DENSITY TO 1600 C 45 WRITE (CRT,46) 46 FORMAT (' Failed to set density to 1600') GO TO 38 C C FAILED ON THE REWIND C 50 WRITE (CRT,51) 51 FORMAT (' Failed to rewind the tape') GO TO 38 C C FAILED ON SETTING THE DENSITY TO 800 C 55 WRITE (CRT,56) 56 FORMAT (' Failed to set the density to 800') GO TO 38 60 END SUBROUTINE FCSERR(ISB,MESS) C C Routine to receive the ISB status and return the appropriate C message corresponding. The length of the message is up to 70 C characters. C C All information taken from the I/O drivers reference manual C pages B-1 to B-3. C DIMENSION ISB(2) INTEGER ERR BYTE CODES(2),ZERO CHARACTER*70 MESS LOGICAL SUCCES EQUIVALENCE (ERR,CODES(1)) PARAMETER (ZERO=0) C ERR = ISB(1) SUCCES = CODES(1).GE.ZERO IF (SUCCES) THEN GO TO (1,2,3),CODES(1) GO TO 10 C C Codes with success? of 0 C 1 MESS = 'I/O request pending' ! IS.PND GO TO 15 C C Codes with success of 1 C 2 IF (CODES(2).EQ.ZERO) THEN MESS = 'Successful completion' ! IS.SUC ELSEIF (CODES(2).EQ."3) THEN MESS(1:25) = 'Successful completion on ' ! IS.CC MESS(26:70) = 'read terminated by CTRL/C' ELSEIF (CODES(2).EQ."15) THEN MESS(1:25) = 'Successful completion wit' ! IS.CR MESS(26:70) = 'h carriage return' ELSEIF (CODES(2).EQ."33) THEN MESS(1:25) = 'Successful completion wit' ! IS.ESC MESS(26:70) = 'h ESCape' ELSEIF (CODES(2).EQ."233) THEN MESS(1:25) = 'Successful completion wit' ! IS.ESQ MESS(26:70) = 'h an escape sequence' ELSE GO TO 10 ENDIF GO TO 15 C C Codes with success of 2 C 3 MESS(1:25) = 'Successful completion on ' ! IS.TMO MESS(26:50) = 'read terminated by time-o' MESS(51:70) = 'ut' GO TO 15 ELSE C C NON-success returns C ERR = ERR-256 IF (ERR.EQ.-15) THEN MESS = 'Operation aborted' ! IE.ABO ELSEIF (ERR.EQ.-34) THEN MESS = 'File already open' ! IE.ALN ELSEIF (ERR.EQ.-1) THEN MESS = 'Bad parameter' ! IE.BAD ELSEIF (ERR.EQ.-56) THEN MESS = 'Bad block' ! IE.BBE ELSEIF (ERR.EQ.-66) THEN MESS(1:25) = 'Block check error or fram' ! IE.BCC MESS(26:70) = 'ing error' ELSEIF (ERR.EQ.-20) THEN MESS = 'Illegal block number' ! IE.BLK ELSEIF (ERR.EQ.-19) THEN MESS(1:25) = 'Byte-ligned buffer specif' ! IE.BYT MESS(26:70) = 'ied (odd byte count)' ELSEIF (ERR.EQ.-73) THEN MESS = 'Connection rejected' ! IE.CNR ELSEIF (ERR.EQ.-22) THEN MESS = 'UDC connect error' ! IE.CON ELSEIF (ERR.EQ.-8) THEN MESS = 'Device already attached' ! IE.DAA ELSEIF (ERR.EQ.-13) THEN MESS = 'Data overrun' ! IE.DAO ELSEIF (ERR.EQ.-7) THEN MESS = 'Device not attached' ! IE.DNA ELSEIF (ERR.EQ.-3) THEN MESS = 'Device not ready' ! IE.DNR ELSEIF (ERR.EQ.-9) THEN MESS = 'Device not attachable' ! IE.DUN ELSEIF (ERR.EQ.-10) THEN MESS = 'End-of-file encountered' ! IE.EOF ELSEIF (ERR.EQ.-62) THEN MESS = 'End-of-tape encountered' ! IE.EOT ELSEIF (ERR.EQ.-11) THEN MESS = 'End-of-volume encountered' ! IE.EOV ELSEIF (ERR.EQ.-59) THEN MESS = 'Fatal hardware error' ! IE.FHE ELSEIF (ERR.EQ.-89) THEN MESS(1:25) = 'Event flag already specif' ! IE.FLG MESS(26:70) = 'ied' ELSEIF (ERR.EQ.-81) THEN MESS(1:25) = 'ICS/ICR controller alread' ! IE.FLN MESS(26:70) = 'y offline' ELSEIF (ERR.EQ.-97) THEN MESS = 'Invalid event flag' ! IE.IEF ELSEIF (ERR.EQ.-82) THEN MESS = 'Invalid escape sequence' ! IE.IES ELSEIF (ERR.EQ.-2) THEN MESS = 'Illegal function' ! IE.IFC ELSEIF (ERR.EQ.-21) THEN MESS(1:25) = 'Invalid UDC or ICS/ICR mo' ! IE.MOD MESS(26:70) = 'dule' ELSEIF (ERR.EQ.-79) THEN MESS(1:25) = 'Task not linked to specif' ! IE.NLK MESS(26:70) = 'ied ICS/ICR interrupts' ELSEIF (ERR.EQ.-37) THEN MESS = 'File not open' ! IE.NLN ELSEIF (ERR.EQ.-23) THEN MESS(1:25) = 'No dynamic memory availab' ! IE.NOD MESS(26:50) = 'le to allocate a secondar' MESS(51:70) = 'y control block' ELSEIF (ERR.EQ.-80) THEN MESS(1:25) = 'Task specified in ICS/ICR' ! IE.NST MESS(26:50) = ' Link or Unlink request n' MESS(51:70) = 'ot installed' ELSEIF (ERR.EQ.-87) THEN MESS = 'Task not triggered' ! IE.NTR ELSEIF (ERR.EQ.-65) THEN MESS = 'Device off line' ! IE.OFL ELSEIF (ERR.EQ.-5) THEN MESS = 'Illegal subfunction' ! IE.ONP ELSEIF (ERR.EQ.-18) THEN MESS(1:25) = 'Illegal read overlay requ' ! IE.OVR MESS(26:70) = 'est' ELSEIF (ERR.EQ.-83) THEN MESS = 'Partial escape sequence' ! IE.PES ELSEIF (ERR.EQ.-16) THEN MESS = 'Privilege violation' ! IE.PRI ELSEIF (ERR.EQ.-88) THEN MESS = 'Transfer rejected' ! IE.REJ ELSEIF (ERR.EQ.-17) THEN MESS(1:25) = 'Nonsharable resource in u' ! IE.RSU MESS(26:70) = 'se' ELSEIF (ERR.EQ.-6) THEN MESS(1:25) = 'Illegal address space (nu' ! IE.SPC MESS(26:50) = 'mber of bytes to send cou' MESS(51:70) = 'ld be zero)' ELSEIF (ERR.EQ.-74) THEN MESS = 'Time-out error' ! IE.TMO ELSEIF (ERR.EQ.-4) THEN MESS = 'Unrecoverable error' ! IE.VER ELSEIF (ERR.EQ.-86) THEN MESS = 'Write check error' ! IE.WCK ELSEIF (ERR.EQ.-12) THEN MESS = 'Write-locked device' ! IE.WLK ELSE GO TO 10 ENDIF ENDIF GO TO 15 C C Unknown code C 10 ENCODE(8,11,MESS) ISB(1) 11 FORMAT (O8) MESS(9:70) = ' (octal) - unknown status code' C C That's all folks C 15 RETURN END