!***********************************************************************
!*
!* Magnetic tape support routines for utility programs
!*
!* R.R. McLeod ERCC MCMLXXVIII
!* R.D. Eager UKC MCMLXXXII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* 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)
end ; ! of DENSITYMAG
!
!
externalroutine modemag(integer chan,tmode)
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)
s = s." " while length(s) < 6
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 = 0
dflag = dmag io(flag,control,len,6,sno(chan),0); ! Rewind to BT
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 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