PROGRAM TCPY IMPLICIT INTEGER*4 (A-Z) INCLUDE '($IODEF)' INCLUDE '($SSDEF)' BYTE Z(32000) BYTE BELL BYTE FLAG CHARACTER*4 ALLMT0,ALLMT1 INTEGER*4 IOSB$L(2) INTEGER*2 IOSB$W(4) EQUIVALENCE (IOSB$L(1),IOSB$W(1)) C DATA ALLMT0/'MTA0'/,ALLMT1/'MTA1'/ BELL=7 STATUS = SYS$ASSIGN( 'MTA0', INCHAN,, ) C STATUS = SYS$ALLOC( ALLMT0,,,) C IF(STATUS.NE.SS$_NORMAL.AND.STATUS.NE.SS$_DEVALRALLOC)GO TO 9000 STATUS = SYS$ASSIGN( 'MTA1', OUTCHAN,, ) C STATUS = SYS$ALLOC( ALLMT1,,,) C IF(STATUS.NE.SS$_NORMAL.AND.STATUS.NE.SS$_DEVALRALLOC)GOTO 9000 STATUS = SYS$QIOW(,%VAL(INCHAN),%VAL(IO$_REWIND),IOSB$L,,,,,,,,) IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS)) STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_REWIND),IOSB$L,,,,,,,,) IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS)) IF(IOSB$W(1).EQ.SS$_WRITLCK)GOTO 9100 DO WHILE (.TRUE.) STATUS = SYS$QIOW(,%VAL(INCHAN),%VAL(IO$_READVBLK), 1 %REF(IOSB$L),,,%REF(Z),%VAL(32000),,,,) IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS)) IF(IOSB$W(1).EQ.SS$_ENDOFTAPE)CALL EXIT IF(IOSB$W(1).EQ.SS$_ENDOFFILE)THEN STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_WRITEOF),IOSB$L,,,,,,,,) IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS)) FLAG=FLAG+1 IF(FLAG.EQ.3)CALL EXIT ELSE FLAG=0 STATUS = SYS$QIOW(,%VAL(OUTCHAN),%VAL(IO$_WRITEVBLK), 1 %REF(IOSB$L),,,%REF(Z),%VAL(IOSB$W(2)),,,,) IF(STATUS.NE.1) CALL LIB$SIGNAL(%VAL(STATUS)) IF(IOSB$W(1).NE.1) CALL LIB$SIGNAL(%VAL(STATUS)) END IF END DO 9000 WRITE(6,9010)BELL 9010 FORMAT(/,1A1,'ERROR - Cannot allocate tape drive.'//) GOTO 9999 9100 WRITE(6,9110)BELL 9110 FORMAT(/,1A1,'ERROR - Cannot write to MTA1: Please insert write 1 ring.'//) 9999 CALL EXIT END