!***********************************************************************
!*
!* Magnetic tape support routines for utility programs
!*
!* R.R. McLeod ERCC MCMLXXVIII
!* R.D. Eager UKC MCMLXXX
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* 16/11/79 - Accept tape claims with '?' as the last character of the
!* volume name: this means 'load with optional ring'.
!* - Different handling of failures: if flag is 2, then a
!* catastrophic failure has occurred (deck powered off, etc):
!* if flag is 1, then a hardware fault has occurred - allow
!* MAXFAULTCOUNT of these on a channel, then abandon.
!* 03/01/80 - Additional routines DENSITYMAG, MODEMAG (DENSITYMT,
!* MODEMT) to enable use of 800 bpi tapes, and 1900
!* series compress/expand mode tapes.
!* - Channel number now given in diagnostics.
!* - Corrected code for '*' and '?' checks on volume name.
!* - Additional routine ASKMAG (ASKMT) for requesting a tape,
!* whilst retaining control if it not available.
!* 08/04/80 - Correction to code of ASKMAG, to return zero flag at BT.
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
CONSTINTEGER MAXCHAN = 8
CONSTINTEGER MAXFAULTCOUNT = 10; ! Abandon after 10 hardware faults
!
!
!***********************************************************************
!*
!* Own variables
!*
!***********************************************************************
!
OWNINTEGERARRAY MODE(1:MAXCHAN); ! Read/write mode words
OWNINTEGERARRAY CONT(1:MAXCHAN) = 0(MAXCHAN); ! Control words
OWNINTEGERARRAY SNO(1:MAXCHAN) = -1(MAXCHAN); ! Service numbers
OWNINTEGERARRAY FAULTCOUNT(1:MAXCHAN); ! Count of hardware faults
OWNSTRING (6)ARRAY VOL(1:MAXCHAN); ! Volume identifiers
!
!
!***********************************************************************
!*
!* External references
!*
!***********************************************************************
!
EXTERNALINTEGERFNSPEC DMAG CLAIM(STRING (6) TSN,INTEGERNAME SNO,C
INTEGER REQ,MODE)
EXTERNALINTEGERFNSPEC DMAG IO(INTEGERNAME REPLY FLAG,CONTROL,LEN,C
INTEGER TYPE,SNO,ADR)
SYSTEMSTRINGFNSPEC ITOS(INTEGER N)
ROUTINESPEC SKIPTMMAG(INTEGER CHAN,N)
!
!
!***********************************************************************
!*
!* Internal routines
!*
!***********************************************************************
!
ROUTINE FAIL(STRING (255) S,INTEGER CHAN)
SELECTOUTPUT(0)
NEWLINES(2)
PRINTSTRING("*** Error - ".S." - channel ".ITOS(CHAN)." ***")
NEWLINE
MONITOR
STOP
END ; ! of FAIL
!
!
ROUTINE CHECK CHANNEL(INTEGER CHAN)
UNLESS 1 <= CHAN <= MAXCHAN THEN FAIL("Invalid channel",CHAN)
END ; ! of CHECK CHANNEL
!
!
ROUTINE CHECK CLAIMED(INTEGER CHAN)
IF SNO(CHAN) < 0 THEN FAIL("Tape not claimed",CHAN)
END ; ! of CHECK CLAIMED
!
!
ROUTINE RECORDFAULT(INTEGER CHAN,INTEGERNAME FLAG)
IF FLAG = 2 THEN FAIL("Catastrophic tape failure",CHAN)
IF FAULTCOUNT(CHAN) >= MAXFAULTCOUNT THEN START
FAIL("More than ".ITOS(MAXFAULTCOUNT)." tape failures",CHAN)
FINISH
FAULTCOUNT(CHAN) = FAULTCOUNT(CHAN) + 1
FLAG = 2; ! For return to user
END ; ! of RECORDFAULT
!
!
!***********************************************************************
!*
!* T H E S U P P O R T R O U T I N E S
!*
!***********************************************************************
!
EXTERNALROUTINE DENSITYMAG(INTEGER CHAN,DENSITY)
CHECK CHANNEL(CHAN)
IF DENSITY = 800 THEN START
CONT(CHAN) = CONT(CHAN)!X'80'; ! Insert '800 bpi' control bit
FINISH ELSE START
IF DENSITY = 1600 THEN START
CONT(CHAN) = CONT(CHAN) & X'7F'; ! Remove '800 bpi' control bit
FINISH ELSE FAIL("Invalid density",CHAN)
FINISH
END ; ! of DENSITYMAG
!
!
EXTERNALROUTINE MODEMAG(INTEGER CHAN,TMODE)
CHECK CHANNEL(CHAN)
IF TMODE = 1900 THEN START
CONT(CHAN) = CONT(CHAN)!X'40'; ! Insert compress/expand control bit
FINISH ELSE START
IF TMODE = 2900 THEN START
CONT(CHAN) = CONT(CHAN) & X'BF'; ! Remove compress/expand control bit
FINISH ELSE FAIL("Invalid mode", CHAN)
FINISH
END ; ! of MODEMAG
!
!
EXTERNALROUTINE ASKMAG(INTEGER CHAN,STRING (7) S,INTEGERNAME FLAG)
INTEGER DFLAG,CONTROL,LEN
!
CHECK CHANNEL(CHAN)
IF SNO(CHAN) >= 0 THEN FAIL("Channel already in use",CHAN)
S = " " IF LENGTH(S) = 0
IF CHARNO(S,LENGTH(S)) = '?' THEN START ; ! Select optional ring
MODE(CHAN) = 3
LENGTH(S) = LENGTH(S) - 1
FINISH ELSE START
IF CHARNO(S,LENGTH(S)) = '*' THEN START ; ! Select read/write or read only
MODE(CHAN) = 2
LENGTH(S) = LENGTH(S) - 1
FINISH ELSE START
MODE(CHAN) = 1
FINISH
FINISH
UNLESS 1 <= LENGTH(S) <= 6 THEN FAIL("Invalid volume label",CHAN)
WHILE LENGTH(S) < 6 THEN S = S." "
VOL(CHAN) = S
FLAG = DMAG CLAIM(S,SNO(CHAN),0,MODE(CHAN))
RETURN IF FLAG # 0
IF MODE(CHAN) = 3 THEN MODE(CHAN) = 2; ! If ring optional, let user beware
FAULTCOUNT(CHAN) = 0; ! Reset count of faults
CONTROL = CONT(CHAN); ! Set mode and/or density
DFLAG = DMAG IO(FLAG,CONTROL,LEN,6,SNO(CHAN),0); ! Rewind to BT to set mode and/or density
IF DFLAG > 7 THEN FAIL("DMAG IO fails in ASKMAG",CHAN)
IF FLAG = 4 THEN FLAG = 0; ! Advisory flag only
END ; ! of ASKMAG
!
!
EXTERNALROUTINE OPENMAG(INTEGER CHAN,STRING (7) S)
INTEGER FLAG
!
ASKMAG(CHAN,S,FLAG)
IF FLAG # 0 THEN FAIL("Failure to claim tape",CHAN)
END ; ! of OPENMAG
!
!
EXTERNALROUTINE UNLOADMAG(INTEGER CHAN)
INTEGER FLAG
!
CHECK CHANNEL(CHAN)
RETURN IF SNO(CHAN) < 0
FLAG = DMAG CLAIM(VOL(CHAN),SNO(CHAN),1,MODE(CHAN)); ! Give back tape
VOL(CHAN) = ""
SNO(CHAN) = -1
CONT(CHAN) = 0; ! Reset density and mode
END ; ! of UNLOADMAG
!
!
EXTERNALROUTINE READMAG(INTEGER CHAN,AD,INTEGERNAME LEN,FLAG)
INTEGER DFLAG,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
IF LEN <= 0 THEN FAIL("Invalid length for read",CHAN)
CONTROL = 4; ! Ignore short block indication
DFLAG = DMAG IO(FLAG,CONTROL,LEN,1,SNO(CHAN),AD)
IF DFLAG > 7 THEN FAIL("DMAG IO fails in READMAG",CHAN)
IF FLAG # 0 THEN START
IF FLAG = 4 THEN START ; ! Hit tape mark
SKIPTMMAG(CHAN,1); ! Skip over tape mark
FLAG = 1
FINISH ELSE RECORDFAULT(CHAN,FLAG); ! Read failure
FINISH
END ; ! of READMAG
!
!
EXTERNALROUTINE WRITEMAG(INTEGER CHAN,AD,LEN,INTEGERNAME FLAG)
INTEGER DFLAG,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
IF MODE(CHAN) = 1 THEN FAIL("Writing not allowed",CHAN)
CONTROL = 0
DFLAG = DMAG IO(FLAG,CONTROL,LEN,2,SNO(CHAN),AD)
IF DFLAG > 7 THEN FAIL("DMAG IO fails in WRITEMAG",CHAN)
IF FLAG # 0 THEN RECORDFAULT(CHAN,FLAG)
END ; ! of WRITEMAG
!
!
EXTERNALROUTINE WRITETMMAG(INTEGER CHAN,INTEGERNAME FLAG)
INTEGER DFLAG,LEN,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
IF MODE(CHAN) = 1 THEN FAIL("Writing not allowed",CHAN)
CONTROL = 0
DFLAG = DMAG IO(FLAG,CONTROL,LEN,10,SNO(CHAN),0)
IF DFLAG > 7 THEN FAIL("DMAG IO fails in WRITETMMAG",CHAN)
IF FLAG # 0 THEN RECORDFAULT(CHAN,FLAG)
END ; ! of WRITETMMAG
!
!
EXTERNALROUTINE REWINDMAG(INTEGER CHAN)
INTEGER DFLAG,FLAG,LEN,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
CONTROL = 0
DFLAG = DMAG IO(FLAG,CONTROL,LEN,6,SNO(CHAN),CONTROL)
IF DFLAG > 7 THEN FAIL("DMAG IO fails in REWINDMAG",CHAN)
END ; ! of REWINDMAG
!
!
EXTERNALROUTINE SKIPMAG(INTEGER CHAN,N)
! Skips N blocks (a tape mark counting as a block) backwards or forwards
INTEGER FLAG,DIRECTION,I,DFLAG,LEN,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
RETURN IF N = 0; ! Null call
IF N > 0 THEN DIRECTION = 1 ELSE N = -N AND DIRECTION = -1
CYCLE I = 1,1,N
CONTROL = 0
LEN = DIRECTION
DFLAG = DMAG IO(FLAG,CONTROL,LEN,8,SNO(CHAN),0); ! Try to skip one block
IF DFLAG > 7 THEN FAIL("DMAG IO fails in SKIPMAG",CHAN)
IF 1 <= FLAG <= 2 THEN RECORDFAULT(CHAN,FLAG)
IF FLAG = 4 THEN START ; ! Found tape mark
CONTROL = 1; ! Treat tape mark as block
LEN = DIRECTION
DFLAG = DMAG IO(FLAG,CONTROL,LEN,9,SNO(CHAN),0); ! Try to skip the tape mark
IF DFLAG > 7 THEN FAIL("DMAG IO fails in SKIPMAG",CHAN)
IF 1 <= FLAG <= 2 THEN RECORDFAULT(CHAN,FLAG)
FINISH
REPEAT
END ; ! of SKIPMAG
!
!
EXTERNALROUTINE SKIPTMMAG(INTEGER CHAN,N)
INTEGER FLAG,DFLAG,LEN,DIRECTION,I,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
IF N = 0 THEN RETURN ; ! Null call
IF N > 0 THEN DIRECTION = 1 ELSE N = -N AND DIRECTION = -1
CYCLE I = 1,1,N
CONTROL = 1; ! Treat tape mark as block
LEN = DIRECTION
DFLAG = DMAG IO(FLAG,CONTROL,LEN,9,SNO(CHAN),0)
IF DFLAG > 7 THEN FAIL("DMAG IO fails in SKIPTMMAG",CHAN)
IF 1 <= FLAG <= 2 THEN RECORDFAULT(CHAN,FLAG)
REPEAT
END ; ! of SKIPTMMAG
!
!
EXTERNALROUTINE FSKIPTMMAG(INTEGER CHAN,N,INTEGERNAME FLAG)
INTEGER DFLAG,LEN,CONTROL
!
CHECK CHANNEL(CHAN)
CHECK CLAIMED(CHAN)
IF N = 0 THEN RETURN ; ! Null call
CONTROL = 1; ! Treat tape mark as block
LEN = N; ! Number of tapemarks to skip
DFLAG = DMAG IO(FLAG,CONTROL,LEN,9,SNO(CHAN),0)
IF DFLAG > 7 THEN FAIL("DMAG IO fails in SKIPTMMAG",CHAN)
IF 1 <= FLAG <= 2 THEN RECORDFAULT(CHAN,FLAG)
IF FLAG = 4 THEN FLAG = 1; ! Found double tape mark before skipping enough
END ; ! of FSKIPTMMAG
!
!
!***********************************************************************
!*
!* Routines for back-compatibility
!*
!***********************************************************************
!
EXTERNALROUTINE ASKMT(STRING (7) VOL,INTEGERNAME FLAG)
ASKMAG(1,VOL,FLAG)
END ; ! of ASKMAG
!
!
EXTERNALROUTINE OPENMT(STRING (7) VOL)
OPENMAG(1,VOL)
END ; ! of OPENMT
!
!
EXTERNALROUTINE UNLOADMT
UNLOADMAG(1)
END ; ! of UNLOADMT
!
!
EXTERNALROUTINE REWINDMT
REWINDMAG(1)
END ; ! of REWINDMT
!
!
EXTERNALROUTINE READMT(INTEGER AD,INTEGERNAME LEN,FLAG)
READMAG(1,AD,LEN,FLAG)
END ; ! of READMT
!
!
EXTERNALROUTINE WRITEMT(INTEGER AD,LEN,INTEGERNAME FLAG)
WRITEMAG(1,AD,LEN,FLAG)
END ; ! of WRITEMT
!
!
EXTERNALROUTINE WRITETMMT(INTEGERNAME FLAG)
WRITETMMAG(1,FLAG)
END ; ! of WRITETMMT
!
!
EXTERNALROUTINE SKIPMT(INTEGER N)
SKIPMAG(1,N)
END ; ! of SKIPTM
!
!
EXTERNALROUTINE SKIPTMMT(INTEGER N)
SKIPTMMAG(1,N)
END ; ! of SKIPTMMT
!
!
EXTERNALROUTINE FSKIPTMMT(INTEGER N,INTEGERNAME FLAG)
FSKIPTMMAG(1,N,FLAG)
END ; ! of FSKIPTMMT
!
!
EXTERNALROUTINE DENSITYMT(INTEGER DENSITY)
DENSITYMAG(1,DENSITY)
END ; ! of SETMT
!
!
EXTERNALROUTINE MODEMT(INTEGER TMODE)
MODEMAG(1,TMODE)
END ; ! of MODEMT
ENDOFFILE