Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SUBROUTINE MTOPEN(NAME,CHANNEL,STATUS)
C
C	This subroutine will use the VAX/VMS system services
C	to open a magtape drive and return the channel number
C	assigned to it.  If an error occurs, the STATUS code
C	will be even.
C
	CHARACTER*64 DEVNAME
	INTEGER*2 DEVLEN
	CHARACTER*(*) NAME
	INTEGER*4 CHANNEL,STATUS
	INTEGER*4 SYS$ASSIGN
C
	CALL STR$UPCASE(DEVNAME,NAME)
	DEVLEN = MIN(64,LEN(NAME))
	STATUS = SYS$ASSIGN(DEVNAME(1:DEVLEN),CHANNEL,,)
	RETURN
	END

	SUBROUTINE MTCLOS(CHANNEL,STATUS)
C
C	This subroutine will use the VAX/VMS system services
C	to close the magtape drive previously opened by MTOPEN.
C	If an error occurs, the STATUS code will be even.
C
	INTEGER*4 CHANNEL,STATUS
	INTEGER*4 SYS$DASSGN
C
	STATUS = SYS$DASSGN(%VAL(CHANNEL))
	RETURN
	END

	SUBROUTINE MTSKPF(CHANNEL,COUNT,STATUS)
C
C	This subroutine will use the VAX/VMS system services
C	to skip the magtape the specified number of files for
C	a tape drive previously opened by MTOPEN.  If an error
C	occurs, the STATUS code will be even.
C
	INTEGER*4 CHANNEL,COUNT,STATUS
	INTEGER*4 IOSB(2)
	INTEGER*2 IOSB2(4)
	EQUIVALENCE (IOSB,IOSB2)
C
	EXTERNAL IO$_SKIPFILE,MT$M_BOT
C
	IF (COUNT.LE.0) THEN
	 CALL MTCONT(CHANNEL,IO$_SKIPFILE,COUNT-1,IOSB,STATUS)
10	FORMAT(' Skipped',I5,' Save-sets')
	 IF (IAND(%LOC(MT$M_BOT),IOSB(2)).EQ.0) THEN
	  TYPE 10, MIN(0,-IOSB2(2)+1)
	  CALL MTCONT(CHANNEL,IO$_SKIPFILE,1,IOSB,STATUS)
	 ELSE
	  TYPE 10, MIN(0,-IOSB2(2))
	 ENDIF
	ELSE
	 CALL MTCONT(CHANNEL,IO$_SKIPFILE,COUNT,IOSB,STATUS)
	 TYPE 10, IOSB2(2)
	ENDIF
	CALL MTSTAT(IOSB)
	RETURN
	END

	SUBROUTINE MTSKPR(CHANNEL,COUNT,STATUS)
C
C	This subroutine will use the VAX/VMS system services
C	to skip the magtape the specified number of records for
C	a tape drive previously opened by MTOPEN.  If an error
C	occurs, the STATUS code will be even.
C
	INTEGER*4 CHANNEL,COUNT,STATUS
	INTEGER*4 IOSB(2)
	INTEGER*2 IOSB2(4)
	EQUIVALENCE (IOSB,IOSB2)
C
	EXTERNAL IO$_SKIPRECORD
C
	CALL MTCONT(CHANNEL,IO$_SKIPRECORD,COUNT,IOSB,STATUS)
	TYPE 10, SIGN(IOSB2(2),COUNT)
10	FORMAT(' Skipped',I5,' records')
	CALL MTSTAT(IOSB)
	RETURN
	END

	SUBROUTINE MTCONT(CHANNEL,ACTION,COUNT,IOSB,STATUS)
C
C	This subroutine is used by MTSKPF and MTSKPR to
C	do the actual work of skipping on the magtape.
C	This will interpret the system and magtape status
C	codes and print the appropriate messages.
C
	INTEGER*4 CHANNEL,ACTION,COUNT,STATUS
	INTEGER*2 IOSB(4)
C
C
	INTEGER*4 SYS$QIOW
	EXTERNAL IO$_SENSEMODE
C
	STATUS = SYS$QIOW(,%VAL(CHANNEL),ACTION,IOSB,,
	1 ,%VAL(COUNT),,,,,)
	IF (.NOT.STATUS) THEN
	 CALL ERRORM(STATUS)
	ELSE IF (.NOT.IOSB(1)) THEN
	 STATUS = IOSB(1)
	 CALL ERRORM(STATUS)
	ENDIF
	RETURN
	END

	SUBROUTINE MTSTAT(IOSB)
C
C	This subroutine will examine the I/O status block
C	supplied and print the appropriate messages.
C
	INTEGER*4 IOSB(2)
C
	EXTERNAL MT$M_LOST,MT$M_EOT,MT$M_BOT
	EXTERNAL MTIO_LOST,MTIO_EOT,MTIO_BOT
C
	IF (IAND(%LOC(MT$M_LOST),IOSB(2)).NE.0)
	1 CALL ERRORM(%LOC(MTIO_LOST))
	IF (IAND(%LOC(MT$M_EOT),IOSB(2)).NE.0)
	1 CALL ERRORM(%LOC(MTIO_EOT))
	IF (IAND(%LOC(MT$M_BOT),IOSB(2)).NE.0)
	1 CALL ERRORM(%LOC(MTIO_BOT))
C
	RETURN
	END

	SUBROUTINE MTREAD(CHANNEL,BUFFER,BUFLEN,ACTLEN,STATUS)
C
C	This subroutine will read a magtape that has been opened
C	by the MTOPEN subroutine.  It will read in one record from
C	the tape into BUFFER, and set ACTLEN to the number of bytes
C	actually read.  STATUS will get the return status from the
C	VAX/VMS $QIOW call.
C
	INTEGER*4 CHANNEL,BUFLEN,ACTLEN,STATUS
	BYTE BUFFER(1)
C NB: BUFFER is dimensioned 1 due to FORTRAN problems...it should be
C dimensioned to BUFLEN.
C
	INTEGER*4 SYS$QIOW
	INTEGER*2 IOSB(4)
	EXTERNAL IO$_READLBLK
C
	STATUS = SYS$QIOW(,%VAL(CHANNEL),IO$_READLBLK,IOSB,,
	1 ,BUFFER,%VAL(BUFLEN),,,,)
	ACTLEN = IOSB(2)
	IF (.NOT.STATUS) THEN
	 CALL ERRORM(STATUS)
	ELSE
	 IF (.NOT.IOSB(1)) THEN
	  STATUS = IOSB(1)
	  CALL ERRORM(STATUS)
	 ENDIF
	ENDIF
	CALL MTSTAT(IOSB)
	RETURN
	END

	SUBROUTINE MTWRIT(CHANNEL,BUFFER,BUFLEN,ACTLEN,STATUS)
C
C	This subroutine will write a magtape that has been opened
C	by the MTOPEN subroutine.  It will write out one record from
C	BUFFER to the tape, and set ACTLEN to the number of bytes
C	actually written.  STATUS will get the return status from the
C	VAX/VMS $QIOW call.
C
	INTEGER*4 CHANNEL,BUFLEN,ACTLEN,STATUS
	BYTE BUFFER(1)
C NB: BUFFER is dimensioned 1 due to FORTRAN problems...it should be
C dimensioned to BUFLEN.
C
	INTEGER*4 SYS$QIOW
	INTEGER*2 IOSB(4)
	EXTERNAL IO$_WRITELBLK
C
	STATUS = SYS$QIOW(,%VAL(CHANNEL),IO$_WRITELBLK,IOSB,,
	1 ,BUFFER,%VAL(BUFLEN),,,,)
	ACTLEN = IOSB(2)
	IF (.NOT.STATUS) THEN
	 CALL ERRORM(STATUS)
	ELSE
	 IF (.NOT.IOSB(1)) THEN
	  STATUS = IOSB(1)
	  CALL ERRORM(STATUS)
	 ENDIF
	ENDIF
	CALL MTSTAT(IOSB)
	RETURN
	END