!***********************************************************************
!*
!* Program to read files from a DEC RSX-11 tape
!*
!* R.D. Eager University of Kent MCMLXXXIII
!*
!***********************************************************************
!
constantinteger version = 4; ! Major version number
constantinteger edit = 0; ! Edit number within major version
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger channel = 1
constantinteger ascii = 0, binary = 1, default = 2
constantinteger fixed = 1, variable = 2
constantinteger sscharfiletype = 3
constantinteger ssdatafiletype = 4
constantinteger bufsize = 4096; ! Size of tape buffer
constantinteger maxaction = 8
constantbyteintegerarray actions(1:maxaction) = c
'E','P','H','L','V','A','B','T'
constantbyteintegerarray monc(0:11) = c
31,28,31,30,31,30,31,31,30,31,30,31
constantstring (1) snl = "
"
constantstring (3)array mons(0:11) = c
"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat hf(integer dataend,datastart,filesize,filetype,
sum,datetime,format,records)
recordformat rf(integer conad,filetype,datastart,dataend)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec changefilesize(string (31) file,
integer newsize,integername flag)
systemroutinespec connect(string (31) file,integer mode,hole,
prot,record (rf)name r,integername flag)
externalstringfunctionspec date
systemroutinespec destroy(string (31) file,integername flag)
systemroutinespec disconnect(string (31) file,integername flag)
systemstringfunctionspec failuremessage(integer mess)
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)
systemstringfunctionspec nexttemp
systemroutinespec outfile(string (31) file,integer size,hole,
prot,integername conad,flag)
externalintegerfunctionspec outpos
systemintegerfunctionspec parmap
externalroutinespec prompt(string (255) s)
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
externalstringfunctionspec time
systemroutinespec trim(string (31) file,integername flag)
systemroutinespec uctranslate(integer ad,len)
!
externalroutinespec define(string (255) s)
!
!
!***********************************************************************
!*
!* Magnetic tape interface routines
!*
!***********************************************************************
!
externalroutinespec askmag(integer channel,string (7) vol,
integername flag)
externalroutinespec readmag(integer channel,ad,integername len,flag)
externalroutinespec rewindmag(integer channel)
externalroutinespec skipmag(integer channel,n)
externalroutinespec skiptmmag(integer channel,n)
externalroutinespec unloadmag(integer channel)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
stringfunction specmessage(integer n)
switch sw(1000:1000)
!
-> sw(n)
!
sw(1000): result = "Failed to claim tape"
end ; ! of specmessage
!
!
routine fail(integer n)
string (255) s
!
selectoutput(0)
if n < 1000 then s = failuremessage(n) else s = specmessage(n)
printstring(snl."RSXPIP fails -".s)
unloadmag(channel)
set return code(n)
stop
end ; ! of fail
!
!
routine reset
rewindmag(channel)
skipmag(channel,1)
end ; ! of reset
!
!
routine skiptm(integer n)
integer i
!
skiptmmag(channel,1) for i = 1,1,n
end ; ! of skiptm
!
!
routine fixname(string (31) file,stringname dest)
string (31) name,ext,dname,dext
!
if file -> file.(";") then start ; finish
unless file -> name.(".").ext then start
name = file
ext = ""
finish
unless dest -> dname.(".").dext then start
dname = dest
dext = ""
finish
if dext = "*" then dext = ext
if dname = "*" then dname = name
dest = dname
if dext # "" then dest <- dest.".".dext
end ; ! of fixname
!
!
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
!
!
integerfunction match(stringname s,integer gen,stringname mask)
integer mgen
string (31) mname,mext,mgens,name,ext
!
unless mask -> mname.(".").mext then start
mname = mask
mext = ""
finish
if mext -> mext.(";").mgens then start
if mgens = "*" then mgen = -1 else mgen = pstoi(mgens)
finish else mgen = -1
unless s -> name.(".").ext then start
name = s
ext = ""
finish
!
unless mname = name or mname = "*" then result = no
unless mext = ext or mext = "*" then result = no
unless mgen = gen or mgen = -1 then result = no
result = yes
end ; ! of match
!
!
integerfunction checkswitch(integer c)
integer i
!
for i = 1,1,maxaction cycle
if c = actions(i) then result = i
repeat
result = -1
end ; ! of checkswitch
!
!
routine getcommand(integername type,stringname srce,dest)
integer l
string (63) line
string (255) work1,work2
!
type = 0
readline(line)
line = work1.work2 while line -> work1.(" ").work2
l = length(line)
if l >= 2 then start
if charno(line,l-1) = '/' then start
type = checkswitch(charno(line,l))
length(line) = l - 2
finish
finish
if line -> work1.("/").work2 then start
type = -1
return
finish
!
if line -> work1.("=").work2 then start
dest <- work1
srce <- work2
finish else start
dest = ""
srce <- line
finish
end ; ! of getcommand
!
!
integerfunction wild(string (31) s)
if s -> s.("*") then result = yes
result = no
end ; ! of wild
!
!
stringfunction vdate(integer n)
integer year,month,m
string (2) y
string (9) s
!
year = n//1000
n = n - year*1000
month = 0
cycle
m = monc(month)
if month = 1 and year//4*4 = year then m = m + 1
exit if n <= m
month = month + 1
n = n - m
repeat
s = itos(n)
y = itos(year)
if length(y) = 1 then y = "0".y
if length(s) = 1 then s = "0".s
result = s."-".mons(month)."-".y
end ; ! of vdate
!
!
routine printhelp
printstring("
Program call is: RSXPIP(tape[,commands])
Command format is: destination=source/switch
where one or two items may be null.
")
printstring("
File specs are: name.ext;version
where ext and/or version may be omitted. Any
component may be replaced by an asterisk to form a
'wildcard' file specification.
")
printstring("
Switches are: /E - exit from RSXPIP.
/P - set current pdfile.")
printstring("
/H - print this help text.
/L - give a directory of all or part of the tape.
/V - display version number of RSXPIP.")
printstring("
/A - without filespec, set ASCII mode for
subsequent transfers. With filespec, set
ASCII mode for current transfer only.")
printstring("
/B - without filespec, set binary mode for
subsequent transfers. With filespec, set
binary mode for current transfer only.")
printstring("
/T - without filespec, set mode as given in
tape file for subsequent transfers. With
filespec, use mode in file for current
transfer only.
")
end ; ! of printhelp
!
!
routine directory(stringname mask)
integer ad,len,flag,i,gen,adw,blocks,files,wildcard
string (255) work
byteintegerarray buf(0:bufsize-1)
!
ad = addr(buf(0))
adw = addr(work) + 1
!
rewindmag(channel)
len = bufsize
readmag(channel,ad,len,flag)
move(6,ad+4,adw)
length(work) = 6
while charno(work,length(work)) = ' ' cycle
length(work) = length(work) - 1
repeat
printstring(snl.snl."Directory MT:[".work."]".snl)
printstring(date." ".time.snl.snl)
!
wildcard = wild(mask)
files = 0
blocks = 0
cycle
len = bufsize
readmag(channel,ad,len,flag)
if flag = 1 then exit
if flag > 1 then start
printstring("?Tape read error".snl)
reset
return
finish
move(4,ad,addr(i))
if i # m'HDR1' then start
printstring("?HDR1 not found when expected".snl)
reset
return
finish
move(2,ad+39,adw)
length(work) = 2
gen = pstoi(work) + 1
length(work) = 17
move(17,ad+4,adw)
for i = 17,-1,1 cycle
if charno(work,i) # ' ' then exit
length(work) = length(work) - 1
repeat
if match(work,gen,mask) = no then start
skiptm(3)
continue
finish
printstring(work)
printstring(";".itos(gen))
spaces(20-outpos)
skiptm(2)
len = bufsize
readmag(channel,ad,len,flag)
move(4,ad,addr(i))
if i # m'EOF1' then start
printstring("?EOF1 not found where expected".snl)
reset
return
finish
move(6,ad+54,adw)
length(work) = 6
i = pstoi(work); ! Number of blocks
blocks = blocks + i
printstring(itos(i).".")
spaces(31-outpos)
move(5,ad+42,adw)
length(work) = 5
printstring(vdate(pstoi(work)).snl)
files = files + 1
exit if wildcard = no
skiptmmag(channel,1)
repeat
!
printstring(snl."Total of ".itos(blocks)."./".itos(blocks).". blocks")
printstring(" in ".itos(files).". files".snl.snl)
end ; ! of directory
!
!
routine transfer(stringname srce,dest,pdfile,integer mode)
integer i,c,pd,rewound,ad,len,flag,gen,records,ptr,conad,adt,iptr
integer reclen,fmode,wildcard,recmax,rectype
string (31) out,temp,temp1,name,ext,destc
byteintegerarray buf(0:bufsize-1)
record (rf) rr
record (hf)name r
!
if dest = "" then start
if pdfile = "" then dest = "*.*" else dest = "*"
finish
for i = 1,1,length(dest) cycle
c = charno(dest,i)
if 'a' <= c <= 'z' then c = c - 'a' + 'A'
charno(dest,i) = c
repeat
for i = 1,1,length(srce) cycle
c = charno(srce,i)
if c = '#' then c = '.'
if 'a' <= c <= 'z' then c = c - 'a' + 'A'
charno(srce,i) = c
repeat
!
ad = addr(buf(0))
adt = addr(temp) + 1
if wild(srce) = yes then start
wildcard = yes
reset
rewound = yes
finish else start
wildcard = no
rewound = no
finish
!
cycle
len = bufsize
readmag(channel,ad,len,flag)
if flag > 1 then start
printstring("?Tape read error".snl)
reset
return
finish
if flag = 1 then start
reset
if rewound = no then start
rewound = yes
continue
finish
if wildcard = no then printstring("?File not found".snl)
return
finish
move(4,ad,addr(i))
if i # m'HDR1' then start
printstring("?HDR1 not found when expected".snl)
reset
return
finish
move(2,ad+39,adt)
length(temp) = 2
gen = pstoi(temp) + 1
length(temp) = 17
move(17,ad+4,adt)
for i = 17,-1,1 cycle
if charno(temp,i) # ' ' then exit
length(temp) = length(temp) - 1
repeat
if match(temp,gen,srce) = no then start
skiptm(3)
continue
finish
!
fmode = mode
recmax = 16388
rectype = variable
len = bufsize
readmag(channel,ad,len,flag)
if flag > 1 then start
printstring("?Tape read error".snl)
reset
return
finish
if flag # 1 then start
move(4,ad,addr(i))
if i # m'HDR2' then start
printstring("?HDR2 not found when expected".snl)
reset
return
finish
if fmode = default then start
if buf(4) = 'D' and buf(36) = ' ' then start
fmode = ascii
finish else fmode = binary
finish
if fmode = binary then start
move(5,ad+10,addr(temp1)+1)
length(temp1) = 5
recmax = pstoi(temp1)
if buf(4) = 'F' then rectype = fixed
if rectype = variable then recmax = recmax - 4
finish
skiptmmag(channel,1)
finish else start
if fmode = default then fmode = binary
finish
destc <- dest
fixname(temp,destc)
if wildcard = yes then start
printstring("[".destc."]".snl)
finish
if length(destc) > 11 then length(destc) = 11
unless destc -> name.(".").ext then start
name = destc
ext = ""
finish
if ext # "" then name <- name."#".ext
out = name
if pdfile # "" then start
out = "T#".nexttemp
pd = yes
finish else pd = no
outfile(out,4096,0,0,conad,flag)
if flag # 0 then start
printstring("%".failuremessage(flag))
skiptm(2)
continue
finish
r == record(conad)
if fmode = ascii then start
r_filetype = sscharfiletype
finish else start
r_filetype = ssdatafiletype
r_format = (recmax << 16) ! rectype
finish
ptr = r_dataend
records = 0
!
cycle
len = bufsize
readmag(channel,ad,len,flag)
if flag > 1 then start
printstring("?Tape read error".snl)
destroy(out,flag)
reset
return
finish
if flag = 1 then exit ; ! End of file
iptr = 0
cycle
exit if iptr = len; ! Last record was exact fit
i = buf(iptr)
if i = '^' then exit ; ! No more records in block
if rectype = variable then start
move(4,ad+iptr,adt)
length(temp) = 4
reclen = pstoi(temp)
if iptr + reclen > len then start
printstring("?Spanned records not supported".snl)
skiptmmag(channel,1)
exit
finish
iptr = iptr + 4
reclen = reclen - 4
if reclen < 0 then exit
if fmode = binary then start
reclen = reclen + 2
finish else reclen = reclen + 1
finish else reclen = recmax
if ptr + reclen >= r_filesize then start
i = (r_filesize+131072) & (¬131071)
changefilesize(out,i,flag)
if flag = 261 then start ;! VM hole too small
disconnect(out,flag)
changefilesize(out,i,flag)
if flag = 0 then connect(out,3,0,0,rr,flag)
if flag = 0 then start
conad = rr_conad
r == record(conad); ! Re-map - it may have moved
finish
finish
if flag # 0 then start
printstring("?".failuremessage(flag))
skiptm(2)
return
finish
r_filesize = i
finish
if fmode = ascii then start
move(reclen-1,ad+iptr,conad+ptr)
byteinteger(conad+ptr+reclen-1) = nl
iptr = iptr + reclen - 1
finish else start
if rectype = variable then start
halfinteger(conad+ptr) = reclen
move(reclen-2,ad+iptr,conad+ptr+2)
iptr = iptr + reclen - 2
finish else start
move(reclen,ad+iptr,conad+ptr)
iptr = iptr + reclen
finish
records = records + 1
finish
ptr = ptr + reclen
repeat
repeat
!
r_records = records
r_dataend = ptr
trim(out,flag)
skiptmmag(channel,1)
!
if pd = yes then start
connect(pdfile,0,0,0,rr,flag)
if flag = 218 then start ; ! Create pdfile
modpdfile(4,pdfile,"","",flag)
if flag # 0 then start
printstring("?".failuremessage(flag))
return
finish
finish
modpdfile(2,pdfile,name,"",flag); ! Delete any existing member of same name
modpdfile(1,pdfile,name,out,flag);! Insert new member
if flag # 0 then start
printstring("?".failuremessage(flag))
return
finish
destroy(out,flag)
finish else start
disconnect(out,flag)
finish
unless wildcard = yes then exit
repeat
end ; ! of transfer
!
!
!***********************************************************************
!*
!* R S X P I P
!*
!***********************************************************************
!
externalroutine rsxpip(string (255) parms)
integer flag,type,mode
string (6) vol
string (11) pdfile
string (31) input,srce,dest
switch sw(0:maxaction)
!
set return code(9999); ! In case of catastrophic failure
setpar(parms)
if parmap > 3 then fail(263); ! Wrong number of parameters
vol <- spar(1)
input <- spar(2)
if vol = "" then fail(263); ! Wrong number of parameters
if input = "" then input = ".IN"
define("1,".input)
selectinput(1)
!
askmag(channel,vol,flag)
if flag # 0 then fail(1000); ! Failed to claim tape
reset
!
pdfile = ""
mode = default
prompt("*")
cycle
getcommand(type,srce,dest)
if type < 0 or (type = 0 and srce = "") then start
printstring("?Illegal command".snl)
continue
finish
-> sw(type)
!
sw(0):
transfer(srce,dest,pdfile,mode)
continue
!
sw(1): ! /E
exit
!
sw(2): ! /P
pdfile <- srce
if dest # "" then start
printstring("%File ".dest." ignored".snl)
finish
continue
!
sw(3): ! /H
unless srce = "" = dest then start
printstring("%Files ignored".snl)
finish
printhelp
continue
!
sw(4): ! /L
if dest # "" then start
printstring("%File ".dest." ignored".snl)
finish
if srce = "" then srce = "*.*;*"
directory(srce)
reset
continue
!
sw(5): ! /V
unless srce = "" = dest then start
printstring("%Files ignored".snl)
finish
printstring("Version: E".itos(version).".".itos(edit).snl)
continue
!
sw(6): ! /A
if srce # "" then start
transfer(srce,dest,pdfile,ascii)
continue
finish
unless dest = "" then start
printstring("%File ".dest." ignored".snl)
finish
mode = ascii
continue
!
sw(7): ! /B
if srce # "" then start
transfer(srce,dest,pdfile,binary)
continue
finish
unless dest = "" then start
printstring("%File ".dest." ignored".snl)
finish
mode = binary
continue
!
sw(8): ! /T
if srce # "" then start
transfer(srce,dest,pdfile,default)
continue
finish
unless dest = "" then start
printstring("%File ".dest." ignored".snl)
finish
mode = default
continue
repeat
!
unloadmag(channel)
set return code(0)
end ; ! of rsxpip
endoffile