!***********************************************************************
!*
!* Program to read VME/B tapes
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXIII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger channel = 1
constantinteger nullstream = 80
constantinteger blocksize = 4116
constantinteger ssdatafiletype = 4
constantinteger sspdfiletype = 6
constantstring (1) snl = "
"
!
!
!***********************************************************************
!*
!* Record formats
!*
!***********************************************************************
!
recordformat hf(integer dataend,datastart,filesize,filetype,
sum,datetime,format,records)
recordformat rf(integer conad,filetype,datastart,dataend)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec connect(string (31) file,integer mode,hole,
prot,record (rf)name r,integername flag)
systemroutinespec define(integer chan,string (31) iden,
integername afd,flag)
systemroutinespec destroy(string (31) file,integername flag)
systemroutinespec disconnect(string (31) file,integername flag)
systemroutinespec etoi(integer ad,l)
systemstringfunctionspec failuremessage(integer mess)
externalstringfunctionspec interrupt
systemstringfunctionspec itos(integer n)
systemroutinespec modpdfile(integer ep,string (31) pdfile,
string (11) member,string (31) infile,
integername flag)
systemroutinespec move(integer length,from,to)
systemroutinespec newgen(string (31) file,newfile,integername flag)
systemstringfunctionspec nexttemp
systemroutinespec outfile(string (31) file,integer size,hole,
prot,integername conad,flag)
systemintegerfunctionspec parmap
externalroutinespec prompt(string (255) s)
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec rename(string (31) file,newfile,integername flag)
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
externalroutinespec ssfoff
systemroutinespec trim(string (31) file,integername flag)
systemroutinespec uctranslate(integer ad,len)
externalintegerfunctionspec uinfi(integer entry)
!
externalroutinespec clear(string (255) s)
externalroutinespec convert(string (255) s)
!
!
!***********************************************************************
!*
!* References to magnetic tape interface routines
!*
!***********************************************************************
!
externalroutinespec askmag(integer channel,string (7) vol,
integername flag)
externalroutinespec readmag(integer channel,ad,integername len,flag)
externalroutinespec skipmag(integer channel,n)
externalroutinespec skiptmmag(integer channel,n)
externalroutinespec rewindmag(integer channel)
externalroutinespec unloadmag(integer channel)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
string (255)function specmessage(integer flag)
string (255) s
switch sw(1000:1007)
!
-> sw(flag)
!
sw(1000): s = "Catastrophic failure"; -> out
sw(1001): s = "Failed to claim tape"; -> out
sw(1002): s = "Tape read error"; -> out
sw(1003): s = "No HDR1 where expected"; -> out
sw(1004): s = "Unexpected tape mark"; -> out
sw(1005): s = "No tape mark where expected"; -> out
sw(1006): s = "Invalid number"; -> out
sw(1007): s = "Invalid reply"; -> out
!
out:
result = " ".s.snl
end ; ! of specmessage
!
!-----------------------------------------------------------------------
!
routine fail(integer flag)
printstring(snl."READBTAPE fails -")
if flag < 1000 then start
printstring(failuremessage(flag))
else
printstring(specmessage(flag))
finish
ssfoff
clear(itos(nullstream))
set return code(flag)
stop
end ; ! of fail
!
!-----------------------------------------------------------------------
!
routine readline(stringname s)
integer c
!
s = ""
cycle
cycle
readsymbol(c)
exit if c = nl
s <- s.tostring(c)
repeat
while length(s) > 0 and charno(s,length(s)) = ' ' cycle
length(s) = length(s) - 1
repeat
exit unless s = ""
repeat
uctranslate(addr(s)+1,length(s))
end ; ! of readline
!
!-----------------------------------------------------------------------
!
routine newpd(stringname pdfile,integername max)
integer flag
string (15) s
record (rf)rr
!
cycle
if pdfile = "" then start
prompt("Pdfile name: ")
readline(pdfile)
finish
!
connect(pdfile,1,0,0,rr,flag)
if flag = 218 then start ; ! Pdfile does not exist - create it
modpdfile(4,pdfile,"","",flag)
if flag = 0 then start
connect(pdfile,1,0,0,rr,flag)
printstring("Creating ".pdfile.snl)
finish
finish
if flag = 0 and rr_filetype # sspdfiletype then start
setfname(pdfile)
flag = 267; ! Invalid filetype
finish
if flag # 0 then start
if uinfi(2) # 1 then start ; ! Not interactive
fail(flag)
finish
printstring(failuremessage(flag))
pdfile = ""
finish else exit
repeat
!
prompt("Max members? ")
cycle
readline(s)
max = pstoi(s)
if max <= 0 then start ; ! Number not valid
if uinfi(2) # 1 then fail(1006);! Not interactive
printstring("Invalid number".snl)
finish else exit
repeat
!
end ; ! of newpd
!
!-----------------------------------------------------------------------
!
integerfunction checkstop
string (15) s
!
s = interrupt
uctranslate(addr(s)+1,length(s))
if s # "STOP" then result = no
printstring("Stop requested".snl)
result = yes
end ; ! of checkstop
!
!
!***********************************************************************
!*
!* R E A D B T A P E
!*
!***********************************************************************
!
externalroutine readbtape(string (255) parms)
integer flag,ad,maxfsize,conad,i,pd,converting,searching,pdindex,ptr
integer fileno,len,cdisp,lastdisp,rlen,max,blocks,pdmaxindex,mt claimed
integer afd
string (6) tape
string (10) tempfile,tempfile2,searchfile,ffile
string (11) pdfile,member
string (16) tapefile
string (31) file
string (255) s
record (hf)name r
byteintegerarray b(0:blocksize-1)
!
s = interrupt; ! Clear any outstanding one
mt claimed = no
maxfsize = (uinfi(6)+1)*1024
pdfile = ""
pd = no
searching = no
converting = no
pdindex = 0
fileno = 0
!
setpar(parms)
if parmap & 1 = 0 or parmap > 7 then start
flag = 263; ! Wrong number of parameters
-> err
finish
tape <- spar(1)
if parmap & 2 # 0 then start
searching = yes
searchfile = spar(2)
finish
if parmap & 4 # 0 then start
pd = yes
pdfile = spar(3)
finish
tempfile = "T#".nexttemp
tempfile2 = "T#".nexttemp
define(nullstream,".NULL",afd,flag)
!
askmag(channel,tape,flag)
if flag # 0 then start
flag = 1001; ! Failed to claim tape
-> err
finish
mt claimed = yes
rewindmag(channel)
skipmag(channel,1); ! Skip over label
!
if pd = yes then newpd(pdfile,pdmaxindex)
!
prompt("Source convert? ")
cycle
readline(s)
i = charno(s,1)
exit if i = 'Y' or i = 'N'
if uinfi(2) # 1 then start ; ! Not interactive
fail(1007); ! Invalid reply
finish
repeat
if i = 'Y' then converting = yes else converting = no
ad = addr(b(0))
!
cycle ; ! Main loop
len = 96
readmag(channel,ad,len,flag); ! The HDR1 label
if flag = 1 then start
printstring("End of tape".snl)
exit
finish
if flag # 0 then start
flag = 1002; ! Tape read error
-> err
finish
move(4,addr(b(6)),addr(i))
if i # c'HDR1' then start
flag = 1003; ! No HDR1 where expected
-> err
finish
fileno = fileno + 1
etoi(addr(b(10)),16); ! File name
b(9) = 16
tapefile = string(addr(b(9)))
while charno(tapefile,length(tapefile)) = ' ' cycle
length(tapefile) = length(tapefile) - 1
repeat
if searching = no = pd then start
printstring("File ".itos(fileno)." ".tapefile.snl)
finish
if searching = yes then start
if searchfile = tapefile then start
printstring(snl.searchfile." found at file ".itos(fileno))
newline
if pdfile # "" then start
printstring(snl."Filling ".pdfile." from file ")
printstring(itos(fileno)." onwards".snl)
searching = no
finish
else
skiptmmag(channel,3)
exit if checkstop = yes
continue
finish
finish
!
! Get past HDR2,UHL,TM
!
for i = 1,1,3 cycle
readmag(channel,ad,len,flag)
if flag = 1 and i < 3 then start
flag = 1004; ! Unexpected tapemark
-> err
finish
repeat
if flag # 1 then start
flag = 1005; ! No tape mark where expected
-> err
finish
!
len = 96
if pd = no then start
exit if checkstop = yes
prompt("EMASfilename: ")
readline(file)
if file = "" then start
skiptmmag(channel,2)
continue
finish
if file = ".END" then start
printstring(snl."Stop".snl)
exit
finish
finish
outfile(tempfile,maxfsize,0,0,conad,flag)
-> err if flag # 0
r == record(conad)
r_filetype = ssdatafiletype
r_format = (4096<<16)!x'22'; ! E V4096
r_records = 0
ptr = r_datastart
max = r_filesize
!
blocks = 0
cycle
len = blocksize
readmag(channel,ad,len,flag)
exit if flag = 1
blocks = blocks + 1
if flag # 0 then start
flag = 1002; ! Tape read error
-> err
finish
lastdisp = b(6)<<8+b(7)+6
cdisp = 8
cycle
rlen = b(cdisp)<<8 + b(cdisp + 1) - 4
exit if rlen < 0
if ptr + rlen + 2 > max then start
printstring("File ".tapefile." is too large".snl)
skiptmmag(channel,2)
-> loop
finish
i = rlen + 2
move(2,addr(i)+2,conad+ptr)
move(rlen,addr(b(cdisp+4)),conad+ptr+2)
ptr = ptr + rlen + 2
r_records = r_records + 1
r_dataend = ptr
cdisp = cdisp + rlen + 4
repeat until cdisp > lastdisp
repeat
!
trim(tempfile,flag)
if converting = yes then start
selectoutput(nullstream)
convert(tempfile.",".tempfile2)
selectoutput(0)
ffile = tempfile2
finish else ffile = tempfile
printstring(tapefile." - ".itos(blocks)." block")
if blocks # 1 then printsymbol('s')
printstring(" read".snl.snl)
length(tapefile) = 11 if length(tapefile) > 11
if pd = yes then start
modpdfile(2,pdfile,tapefile,"",flag)
! Delete any existing member
modpdfile(1,pdfile,tapefile,ffile,flag)
! Insert member
if flag = 280 then start ; ! User individual file limit exceeded
printstring("Pdfile ".pdfile." is full".snl)
disconnect(pdfile,flag)
pdfile = ""
newpd(pdfile,pdmaxindex)
modpdfile(2,pdfile,tapefile,"",flag)
! Delete any existing member
modpdfile(1,pdfile,tapefile,ffile,flag)
finish
-> err if flag # 0
else
if file -> file.("_").member then start
modpdfile(2,file,member,"",flag)
! Delete any existing member
modpdfile(1,file,member,ffile,flag)
else
rename(ffile,file,flag)
if flag = 219 then newgen(ffile,file,flag)
finish
-> err if flag # 0
finish
skiptmmag(channel,1); ! Skip to next file
if pd = yes then start
pdindex = pdindex + 1
if pdindex >= pdmaxindex then start
printstring("Max number of files read into ".pdfile.snl)
pdfile = ""
newpd(pdfile,pdmaxindex)
pdindex = 0
finish
finish
!
if searching = yes then start
printstring("File found".snl)
exit
finish
!
exit if checkstop = yes
!
loop:
repeat
!
unloadmag(channel)
if pd = yes then disconnect(pdfile,flag)
destroy(tempfile,flag)
destroy(tempfile2,flag)
ssfoff
clear(itos(nullstream))
set return code(0)
stop
!
err:
unloadmag(channel) if mt claimed = yes
fail(flag)
end ; ! of readbtape
endoffile