SUBROUTINE T_ASSG(LDRV) IMPLICIT INTEGER*4 (S) COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CHARACTER*6 DRIVES(0:1) DATA LFIRST/2*.TRUE./ DATA DRIVES/'_MTA0:','_MTA1:'/ CALL IFERR(SYS$ASSIGN(DRIVES(LDRV),ICHAN(LDRV),,), . 'T_ASSG COULDN''T ASSIGN A CHANNEL') D TYPE *,LDRV,ICHAN(LDRV) CALL IFERR(LIB$GET_EF(IFLAG(LDRV)), . 'T_ASSG COULDN''T GET AN EF') LFIRST(LDRV)=.FALSE. CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_ASSG COULDN''T SET EF') C set status to success ISTAT(LDRV)=0 RETURN END SUBROUTINE T_READ(LDRV,BUFFER,LENGTH) C C RAW TAPE I/O C CALL WITH: C CALL T_READ(LDRV,BUFFER,LENGTH) C where C LDRV is magtape drive number, eg 0 for MTA0: C BUFFER is buffer address, C LENGTH is number of bytes C C Also, execution is asynchronous. C IMPLICIT INTEGER*4 (S) EXTERNAL IO$_READVBLK COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CALL T_CHECK(LDRV) IF(LFIRST(LDRV))CALL T_ASSG(LDRV) NBY(LDRV) = LENGTH I = SYS$QIO(%VAL(IFLAG(LDRV)),%VAL(ICHAN(LDRV)),IO$_READVBLK, 1IOSB(1,LDRV),,, 1BUFFER,%VAL(LENGTH),,,,) IF(MOD(I,8).EQ.1)RETURN CALL ERRMES(I) CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_READ COULDN''T SET EF') ISTAT(LDRV)=2 RETURN END SUBROUTINE T_WRIT(LDRV,BUFFER,LENGTH) C C RAW TAPE I/O C CALL WITH: C CALL T_WRIT(LDRV,BUFFER,LENGTH) C where C LDRV is magtape drive number, eg 0 for MTA0: C BUFFER is buffer address, C LENGTH is number of bytes C C Also, execution is asynchronous. C IMPLICIT INTEGER*4 (S) EXTERNAL IO$_WRITEVBLK COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CALL T_CHECK(LDRV) IF(LFIRST(LDRV))CALL T_ASSG(LDRV) NBY(LDRV) = 0 I = SYS$QIO(%VAL(IFLAG(LDRV)),%VAL(ICHAN(LDRV)),IO$_WRITEVBLK, 1IOSB(1,LDRV),,, 1BUFFER,%VAL(LENGTH),,,,) IF(MOD(I,8).EQ.1)RETURN CALL ERRMES(I) CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_WRIT COULDN''T SET EF') ISTAT(LDRV)=2 RETURN END SUBROUTINE T_WAIT(LDRV,NSTATE,NBYTES) C C LDRV is magtape drive number, eg 0 for MTA0: C C RETURNS NSTATE = 0 => SUCCESS C 1 => EOF C 2 => ERROR C 3 => EOT C NBYTES = NUMBER OF BYTES IN LAST TRANSFER C IMPLICIT INTEGER*4 (S) EXTERNAL SS$_ENDOFFILE EXTERNAL SS$_DATAOVERUN COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST COMMON/IO_ERR/WRTMES LOGICAL WRTMES INTEGER*2 IST(4,0:1) EQUIVALENCE (IOSB,IST) DATA WRTMES/.TRUE./ C CALL T_CHECK(LDRV) CALL IFERR(SYS$WAITFR(%VAL(IFLAG(LDRV))), . 'T_WAIT COULDN''T WAIT FOR EF') CALL T_CHECK(LDRV) ISTAT(LDRV) = 0 IRES = IST(1,LDRV) IRES = IRES.AND.'0000FFFF'X IF(MOD(IRES,8).EQ.1)GO TO 10 ISTAT(LDRV)=2 IF(IRES.EQ.%LOC(SS$_ENDOFFILE))ISTAT(LDRV)=1 IF(ISTAT(LDRV).NE.2)GO TO 10 CALL ERRMES(IRES) C 10 CONTINUE NSTATE=ISTAT(LDRV) NBYTES=IST(2,LDRV) NBYTES=NBYTES.AND.'0000FFFF'X C C unfortunately, the VMS 1.6 handler never returns C SS$_DATAOVERUN C C IF(IRES.EQ.%LOC(SS$_DATAOVERUN))THEN IF((NBY(LDRV).NE.0).AND.(NBYTES.GT.NBY(LDRV)))THEN IRES = %LOC(SS$_DATAOVERUN) IF(WRTMES)CALL ERRMES(IRES) NBYTES = MIN(NBYTES,NBY(LDRV)) END IF RETURN END SUBROUTINE T_WEOF(LDRV) C C RAW TAPE I/O C CALL WITH: C CALL T_WEOF(LDRV) C where C LDRV is magtape drive number, eg 0 for MTA0: C C Also, execution is asynchronous. C IMPLICIT INTEGER*4 (S) EXTERNAL IO$_WRITEOF COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CALL T_CHECK(LDRV) IF(LFIRST(LDRV))CALL T_ASSG(LDRV) NBY(LDRV) = 0 I = SYS$QIO(%VAL(IFLAG(LDRV)),%VAL(ICHAN(LDRV)),IO$_WRITEOF, 1IOSB(1,LDRV),,, 1,,,,,) IF(MOD(I,8).EQ.1)RETURN CALL ERRMES(I) CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_WEOF COULDN''T SET EF') ISTAT(LDRV)=2 RETURN END SUBROUTINE T_RWND(LDRV) C C RAW TAPE I/O C CALL WITH: C CALL T_RWND(LDRV) C where C LDRV is magtape drive number, eg 0 for MTA0: C C Also, execution is asynchronous. C IMPLICIT INTEGER*4 (S) EXTERNAL IO$_REWIND COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CALL T_CHECK(LDRV) IF(LFIRST(LDRV))CALL T_ASSG(LDRV) NBY(LDRV) = 0 I = SYS$QIO(%VAL(IFLAG(LDRV)),%VAL(ICHAN(LDRV)),IO$_REWIND, 1IOSB(1,LDRV),,, 1,,,,,) IF(MOD(I,8).EQ.1)RETURN CALL ERRMES(I) CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_RWND COULDN''T SET EF') ISTAT(LDRV)=2 RETURN END SUBROUTINE T_SKPF(LDRV,NUMBER) C C RAW TAPE I/O C CALL WITH: C CALL T_SKPF(LDRV,NUMBER) C where C LDRV is magtape drive number, eg 0 for MTA0: C NUMBER is the number of files to skip C C Also, execution is asynchronous. C IMPLICIT INTEGER*4 (S) EXTERNAL IO$_SKIPFILE COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CALL T_CHECK(LDRV) IF(LFIRST(LDRV))CALL T_ASSG(LDRV) NBY(LDRV) = 0 I = SYS$QIO(%VAL(IFLAG(LDRV)),%VAL(ICHAN(LDRV)),IO$_SKIPFILE, 1IOSB(1,LDRV),,, 1%VAL(NUMBER),,,,,) IF(MOD(I,8).EQ.1)RETURN CALL ERRMES(I) CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_SKPF COULDN''T SET EF') ISTAT(LDRV)=2 RETURN END SUBROUTINE T_SKPR(LDRV,NUMBER) C C RAW TAPE I/O C CALL WITH: C CALL T_SKPR(LDRV,NUMBER) C where C LDRV is magtape drive number, eg 0 for MTA0: C NUMBER is the number of files to skip C C Also, execution is asynchronous. C IMPLICIT INTEGER*4 (S) EXTERNAL IO$_SKIPRECORD COMMON/T_COM/IOSB(2,0:1),ISTAT(0:1),LFIRST(0:1),ICHAN(0:1) COMMON/T_COM/IFLAG(0:1),NBY(0:1) LOGICAL LFIRST CALL T_CHECK(LDRV) IF(LFIRST(LDRV))CALL T_ASSG(LDRV) NBY(LDRV) = 0 I = SYS$QIO(%VAL(IFLAG(LDRV)),%VAL(ICHAN(LDRV)),IO$_SKIPRECORD, 1IOSB(1,LDRV),,, 1%VAL(NUMBER),,,,,) IF(MOD(I,8).EQ.1)RETURN CALL ERRMES(I) CALL IFERR(SYS$SETEF(%VAL(IFLAG(LDRV))), . 'T_SKPR COULDN''T SET EF') ISTAT(LDRV)=2 RETURN END SUBROUTINE T_CHECK(LDRV) IF((LDRV.GE.0).AND.(LDRV.LE.1))RETURN TYPE *,'ILLEGAL VALUE OF LDRV IN TAPEIO :',LDRV STOP END