!***********************************************************************
!*
!* Program to print a summary of an IBM labelled tape
!*
!* R.D. Eager University of Kent MCMLXXXIII
!*
!***********************************************************************
!
constantinteger version = 2; ! Major version number
constantinteger edit = 0; ! Edit number within major version
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger maxblocklength = 12288
constantinteger tapechan = 1; ! Tape interface channel number
constantinteger ochan = 60; ! Channel used for output
constantinteger ok = 0, tapemark = 1
constantstring (1) snl = "
"
constantstring (10)blank = " "
constantstring (4)array st(0:4) = c
" 200"," 556"," 800","1600","6250"
constantstring (15)array flagmess(-1:2) = c
"wrong length","data block","tape mark","tape read error"
!
!
!***********************************************************************
!*
!* Record formats
!*
!***********************************************************************
!
recordformat fdf(integer link,dsnum,byteinteger status,accessroute,
valid action,cur state,mode of use,mode,file org,
dev code,rec type,flags,lm,rm,integer asvar,arec,
recsize,minrec,maxrec,maxsize,lastrec,conad,currec,
cur,end,transfers,darecnum,cursize,datastart,
string (31) iden,integer keydesc0,keydesc1,
recsizedesc0,recsizedesc1,byteinteger f77flag,
f77form,f77access,f77status,integer f77recl,f77nrec,
idaddr,byteinteger f77blank,f77ufd,spare1,spare2)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec define(integer chan,string (31) iden,
integername afd,flag)
systemroutinespec etoi(integer ad,l)
systemstringfunctionspec failuremessage(integer mess)
externalintegerfunctionspec instream
systemintegerfunctionspec iocp(integer ep,parm)
systemstringfunctionspec itos(integer n)
systemintegermapspec mapssfd(integer dsnum)
externalintegerfunctionspec outstream
systemintegerfunctionspec parmap
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
!
!
!
!***********************************************************************
!*
!* Magnetic tape utility routines
!*
!***********************************************************************
!
externalroutinespec openmag(integer channel,string (7) vol)
externalroutinespec readmag(integer channel,ad,integername len,flag)
externalroutinespec rewindmag(integer channel)
externalroutinespec skiptmmag(integer channel,n)
externalroutinespec unloadmag(integer channel)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
routine clearstream(integer chan)
! Clears out a channel definition, but does not give an error if the
! channel was not defined.
record (fdf)name f
!
if mapssfd(chan) # 0 then start
f == record(mapssfd(chan))
if f_status = 0 then start
mapssfd(chan) = 0
f_dsnum = 0; ! Mark descriptor as free
finish
finish
end ; ! of clearstream
!
!-----------------------------------------------------------------------
!
routine closestream(integer chan)
! Private version of 'closestream'. Does not give an error if the
! operation fails.
integer flag
!
return unless instream # chan # outstream
flag = iocp(16,chan)
end ; ! of closestream
!
!-----------------------------------------------------------------------
!
routine fail(integer n)
unloadmag(tapechan)
selectoutput(0)
printstring(snl."IBMSUM fails -".failuremessage(n))
set return code(n)
clearstream(ochan)
stop
end ; ! of fail
!
!-----------------------------------------------------------------------
!
routine error(integer i,string (4) s)
string (255) mes
!
mes = flagmess(i)
if i < 2 then start
if i = -1 then start
mes = mes." ".s." block"
else
mes = mes." instead of ".s
finish
mes = "Tape format error - ".mes
finish
printstring(snl.snl.mes.snl)
end ; ! of error
!
!-----------------------------------------------------------------------
!
integerfunction readblk(integer ad,stringname sad,string (4) s,
integername flag)
integer len
string (4) s1
string (80) bin
!
len = maxblocklength
readmag(tapechan,ad,len,flag)
if flag = 0 then etoi(ad,len)
if flag > 2 then flag = 2; ! Treat all failures the same
if flag = 1 and s = "HDR1" then result = tapemark
if s = "*TM*" then start
if flag = 1 then result = tapemark else error(1,s)
else
if charno(s,3) = 'F' then start
s1 = "EOV".substring(s,4,4)
else
s1 = "????"
finish
unless flag = 0 and (sad->(s).bin or c
sad -> (s1).bin) and len = 80 then start
flag = -1 if flag = 0 and (sad -> (s).bin or sad -> (s1).bin)
error(flag,"")
finish
finish
result = ok
end ; ! of readblk
!
!-----------------------------------------------------------------------
!
routine chars(string (63) s,integer ad,from,to)
integer i,j,k
!
j = 0
printstring(s)
for i = from,1,to cycle
k = byteinteger(ad+i-1)
if j = 0 = k - '0' then space else start
! Suppress leading spaces
j = 1
printsymbol(k)
finish
repeat
end ; ! of chars
!
!
!***********************************************************************
!*
!* I B M S U M
!*
!***********************************************************************
!
externalroutine ibmsum(string (255) parms)
integer ad,flag,i,gversion,afd
string (5) null
string (6) vol
string (23) s
stringname sad
byteintegerarray in(0:maxblocklength)
!
define(ochan,".OUT",afd,flag); ! Default
-> err if flag # 0
setpar(parms)
if parmap & 1 = 0 then start
flag = 263; ! Wrong number of parameters
-> err
finish
vol = spar(1)
gversion = no
if parmap & 4 # 0 then start
s = spar(3)
if charno(s,1) = 'Y' then gversion = yes
finish
if parmap & 2 # 0 then start
define(ochan,spar(2),afd,flag)
-> err if flag # 0
finish
!
null = "00000"
charno(null,i) = 0 for i = 1,1,5
!
sad == string(addr(in(0)))
in(0) = 80
ad = addr(in(1))
openmag(tapechan,vol)
rewindmag(tapechan)
if readblk(ad,sad,"VOL1",flag) # ok then start
flag = 233; ! General error
setfname("Invalid tape format")
-> err
finish
!
if gversion = yes then start
printstring("Version: E".itos(version).".".itos(edit).snl)
finish
selectoutput(ochan)
newlines(3)
chars("Summary of IBM standard labelled multi-file tape ",ad,5,10)
s = substring(sad,42,51); ! Tape owner
if s # blank then start
newline
spaces(20)
printstring("Owned by ".s)
finish
!
newlines(2)
printstring(c
" Label Data Set Creation Expiry Record Record Block ". c
"No. of Tape".snl.c
" Name Date Date Format Length Size ". c
"Blocks Density".snl.c
" (bytes) (bytes) ". c
" (bpi)".snl.snl)
!
cycle
exit if readblk(ad,sad,"HDR1",flag) = tapemark
! Logical end of tape
exit if flag # 0
chars(" ",ad,32,35); ! Label
printstring(" ".substring(sad,5,21))
! DSN
chars(" ",ad,45,47); ! Creation day
chars("/19",ad,43,44); ! Creation year
s = substring(sad,49,53)
if s = blank or s = null then start
printstring(" not set")
else
chars(" ",ad,51,53)
chars("/19",ad,49,50); ! Expiry day and year
finish
exit if readblk(ad,sad,"HDR2",flag) # ok
if in(39) = 'R' then start
s = "BS"
else
s = substring(sad,39,39)." "
finish
printstring(" ".substring(sad,5,5).s)
! Record format
if in(5) = 'V' or in(5) = 'U' then s = "M" else s = " "
chars(" ",ad,11,15); ! Record length
printstring(s)
if in(5) = 'V' then s = "M" else s = " "
chars(" ",ad,6,10); ! Blocksize
printstring(s)
if in(16) = ' ' then s = "" else s = st(in(16)-'0')
! Tape density
exit if readblk(ad,sad,"*TM*",flag) # tapemark
skiptmmag(tapechan,1); ! Skip the body of the file
exit if readblk(ad,sad,"EOF1",flag) # ok
chars("",ad,55,60)
exit if readblk(ad,sad,"EOF2",flag) # ok
exit if readblk(ad,sad,"*TM*",flag) # tapemark
printstring(" ".s.snl)
repeat
!
newlines(2)
printstring("End of tape summary".snl)
selectoutput(0)
closestream(ochan)
clearstream(ochan)
unloadmag(tapechan)
set return code(0)
return
!
err:
fail(flag)
end ; ! of ibmsum
endoffile