! K Yarwood has some text describing these routines from an operational point
! of view. And the filename is ERCC10.TEXTFILE_FTODTEXT
const string (19) vsn="04 Mar 85"
const integer sectsi=32 {pgs}
const integer bitmap pages=5
const string (5) index file="SS#INDEX", bmfile="SS#BITMAP"
const integer ixpages=16
record format parmf(integer dest, srce, p1, p2, p3, p4, p5, p6)
record format srcf(integer nextfreebyte, txtrelst, maxbytes, zero)
record format daf(integer sectsi, nsects, lastsect, spare, integer array da(0:255))
record format shortdaf(integer sectsi, nsects, lastsect, spare, integer array da(0:15))
record format faf(string (6) user, string (15) file,
integer fsys, record (shortdaf) fda)
record format fff(integer nfiles, record (faf) array f(1:255))
external routine spec dout(record (parmf) name p)
external routine spec dout11(record (parmf) name p)
external integer fn spec dsysad(integer type, adr, fsys)
external integer fn spec dcreate(string (6) user, string (15) file, integer fsys, nkb, type)
external integer fn spec ddestroy(string (31) file index, file, string (8) date,
integer fsys, type)
external integer fn spec exist(string (255) s)
system routine spec phex(integer i)
external integer fn spec fbase(integer name lo, hi, integer fsys)
external integer fn spec bin(string (255) s)
external routine spec rdint(integer name i)
external integer fn spec rdfilead(string (255) s)
external integer fn spec nwfilead(string (255) s, integer pages)
external routine spec ddelay(integer secs)
external routine spec disconnect(string (255) s)
external routine spec prompt(string (255) s)
external routine spec ucstrg(string name s)
external integer fn spec uinfi(integer i)
external string fn spec uinfs(integer i)
external integer fn spec derror(string name txt)
system string fn spec itos(integer value)
system string fn spec htos(integer i, pl)
external routine spec destroy(string (255) s)
dynamic integer fn spec dgetda(string (6) user, string (15) file, integer fsys, adr)
record format discdataf(integer start, bitsize, nntstart, nntsize, nnttop, nnthash,
indexstart, filestart, end)
integer fn fbase2(integer fsys, adr)
!
! This returns the characteristics of an on-line disc in a record
! of format DATAF at address ADR
integer j, lob, hib, type, k
record (discdataf) name data
const integer toptype= 5
const integer array bitsize(1:top type)= X'1000'(2), X'2000'(2), X'5000'
const integer array nntstart(1:top type)= X'7000'(4), X'A000'
const integer array nntsize(1:top type)= X'4000'(4), X'1FF8'
const integer array nnttop(1:top type)= 1364(4), 681
const integer array nnthash(1:top type)= 1361(4), 667
const byte array indexstart(1:top type)= 12(5)
const integer array filestart(1:top type)= 1024(5)
const integer array hi(1:top type)= X'3F1F', X'59F3', X'8F6F',
X'B3E7', X'24797'
j=fbase(lob, hib, fsys)
result =j unless j=0
type=-1
cycle k=1, 1, top type
type=k and exit if hib=hi(k)
repeat
result =8 if type<0
data==record(adr)
data_start=lob
data_bitsize=bitsize(type)
data_nntstart=nntstart(type)
data_nntsize=nntsize(type)
data_nnttop=nnttop(type)
data_nnthash=nnthash(type)
data_indexstart=index start(type)
data_filestart=file start(type)
data_end=hib
result =0
end ; ! FBASE2
routine wrs(string (255) s)
printstring(s)
newline
end ; ! WRS
!
!------------------------------------------------------------------------
!
routine wrsn(string (255) s, integer n)
printstring(s)
write(n, 1)
newline
end ; ! WRSN
routine wrsnt(string (255) s, integer n, type)
integer j
switch sw(0:3)
! type & 3 = 0 decimal if small else hex
! 1 decimal
! 2 hex
! 3 decimal and hex
! type & 4 = 1 dont put NL at end
! type & X70 gives number of digits, 0=8
printstring(s)
space
->sw(type&3)
sw(0):->sw(2) unless -256<=n<=255
sw(3):
sw(1):printstring(itos(n))
->out if type&2=0
sw(2):printstring("X'")
j=type>>4&7
j=8 if j=0
printstring(htos(n, j))
out:
newline if type&4=0
end ; ! OF WRSNT
!------------------------------------------------------------------------
!
routine vvderrs(string (255) s, integer j)
string (255) txt
return if j=0
j=derror(txt)
printstring(s)
space
wrs(txt)
end ; ! VVDERRS
!
!------------------------------------------------------------------------
!
routine error
integer j
string (255) txt
j=derror(txt)
wrs(txt)
end ; ! error
integer fn yn(string (255) pp, integer a, b)
integer ch
string (255) s
if a=b=0 then a='Y' and b='N'
prompt(pp)
cycle
ucstrg(s)
ch=charno(s, 1)
exit if ch=a or ch=b
repeat
result =ch
end {yn}
integer fn move section(integer fsys1, startp1, fsys2, startp2, epgs)
integer fromdev, fsys, bitno, relpage, move flag, rw, fail
integer j
integer name f, page
record (parmf) p
unless startp1>>19=0 and startp2>>19=0 start
wrsnt("MVSC P1", startp1, 6)
wrsnt(" P2", startp2, 2)
result =25
finish
printstring("MOVE SECTION ")
write(fsys1, 1); space; phex(startp1); write(fsys2, 1); space; phex(startp2)
write(epgs, 1)
newline
! printstring("Moving..")
! newline
from dev=2; ! disc
if fsys1=-1 start
fromdev=5; ! "LP"
startp1=0
finish
!
! OUT TO LOCAL CONTROLLER TO CHECK THAT THE BLOCK WHOSE START PAGE IS
! "PAGE" IS NOT STILL ACTIVE. THIS IS BECAUSE AN ORDINARY DISCONNECT DOES
! NOT WAIT UNTIL ALL PAGE-OUTS ARE COMPLETE.
! But we suppress this check for UNPRG, so that we can unprg active software
! without messages. This is indicated by the TOP BIT being set in FSYS1.
! (This feature is used only by function DPRGP).
j=0
f==fsys1
page==startp1
l:
if j=0 start
j=1
f==fsys2
page==startp2
->l
finish
p=0
p_dest=X'00240000'
p_p1=X'00020000'!(fromdev<<24)!epgs
p_p2=fsys1
p_p3=startp1
p_p4=fsys2
p_p5=startp2
p_p6=M'KYAR'
if epgs<5 then dout11(p) else dout(p)
move flag=p_p1
!-----------------------------------------------------------------------
! About the BULK MOVER:
! CALLED ON SERVICE 36 TO TRANSFERS GROUPS OF PAGES BETWEEN *
! FAST DEVICES. REPLIES ARE ON SERVICE 37. *
! FAST DEVICE TYPES ARE:- *
! DEV=1 DRUM (SPECIFIED AS SERVICE & PAGE IN AMEM ) *
! DEV=2 DISCFILE (SPECIFIED AS [MNEMONIC OR LVN] & PAGE) *
! DEV=3 ARCHTAPE (SPECIFIED AS SERVICE(PREPOSND BY VOLUMS)) *
! DEV=4 TAPE (SPECIFIED AS STRING(6)LAB,BYTE CHAP NO) *
! DEV=5 FUNNY (READS GIVE ZERO PAGE,WRITES IN HEX TO LP) *
! DEV=6 SINK (THROWS AWAY INPUT FOR TAPE CHECKING) *
! *
! CAN HANDLE UP TO FOUR MOVES AT A TIME. EACH MOVE USES *
! ONE BUFFER AND APART FROM CLEARS ONLY HAS ONE TRANSFER *
! OUTSTANDING AT ANY ONE TIME TIME. *
! ALL WRITES ARE CHECKED BY RE-READING *
! Failure flags (returned in P_P1) are as follows (at least *
! for moves to/from disc): *
! *
! P_P1 = RW<<24 ! FAIL<<16 ! RELPAGE *
! *
! where RW = 1 means a READ failed *
! 2 means a WRITE failed. *
! FAIL = flag from PDISC: *
! 1 = transferred with errors (i.e. cyclic *
! check fails) *
! 2 = request rejected *
! 3 = transfer not effected (e.g. flagged *
! track encountered) *
! and RELPAGE = relative page no of failing page, counting *
! first page of request as one. *
!----------------------------------------------------------------------
result =0 if move flag=0
rw=move flag>>24
fail=(move flag>>16)&255
relpage=move flag&X'FFFF'
if ((rw=1 and fsys1>=0) or rw=2) and (fail=1 or fail=3) start
if rw=1 start
fsys=fsys1
bitno=startp1
finish else start
fsys=fsys2
bitno=startp2
finish
printstring("bad page(1, fsys, bitno+relpage-1)")
printstring(" Fsys="); write(fsys, 1); space
printstring(" Page "); phex(bitno+relpage-1)
newline
finish
result =25
end ; ! MOVE SECTION
routine fred
printstring("There are two flavours: A. Move pages from a given disc address on an on-line
")
printstring(" (but not necessarily CCKed) disc into a file in
")
printstring(" the caller's index.
"); printstring(" B. Complete a pseudo-import onto DEVV98 (first part of
")
printstring(" import is done with command FILESTODISC).
")
end {fred}
routine spec finish import
!-------------------------------------------------------------------------------
external routine disctofile(string (255) s)
integer from fsys, to fsys, pages, sect, j, pgs, startpage, endpage, totpgs, relpg, ch
string (63) file
record (daf) darec
fred
ch=yn("Which flavour? ", 'A', 'B')
if ch='B' then finish import and return
prompt("From Fsys: ")
rdint(from fsys)
prompt("Start pageno: ")
rdint(startpage)
prompt("No of pages: ")
rdint(pages)
endpage=startpage+pages-1
prompt("To file: ")
ucstrg(file)
if exist(file)#0 start
ch=yn(file." exists. Destroy? ", 0, 0)
if ch='N' then return
destroy(file)
finish
to fsys=uinfi(1)
j=dcreate(uinfs(1), file, to fsys, pages<<2 {Param is Kbytes}, 4 {zero it})
if j#0 start
vvderrs("DCREATE", j)
return
finish
j=dgetda(uinfs(1), file, to fsys, addr(darec))
if j#0 start
vvderrs("DGETDA", j)
return
finish
totpgs=0
relpg=0
for sect=0, 1, darec_nsects-1 cycle
if sect=darec_nsects-1 then pgs=darec_lastsect else pgs=sectsi
j=move section(from fsys, startpage+relpg, to fsys, darec_da(sect)<<8>>8, pgs)
if j#0 start
printstring("Flag ")
write(j, 1)
printstring(" from MOVE SECTION")
newline
return
finish
relpg=relpg+sectsi
totpgs=totpgs+pgs
repeat
printstring("DISCTOFILE finished.")
write(totpgs, 4)
printstring(" pages moved")
newline
end {disc to file}
!-------------------------------------------------------------------------------
external routine filestodisc(string (255) s)
integer to fsys, from fsys, j, ixfad, lo, hi, totsects, reclen, bmfad, xexit, sect, fileno, pgs,
freesects, bmptr, nfiles
integer startp1, lastsect, bmpg
string (63) user, file
record (discdataf) data
record (fff) name f
record (faf) ff
record (faf) name fent
record (srcf) name h
record (daf) darec, bitmap darec
printstring("Version ".vsn)
newline
! Make an index file
ixfad=nwfilead(index file, ixpages)
if ixfad=0 start
printstring("[Failed to create an index file]")
newline
return
finish
if exist(bmfile)#0 start
!printstring(bmfile." already exists.")
!newline
!j=yn("Destroy? ", 0, 0)
{%if j='Y' %then} destroy(bmfile)
finish
! Make a file to hold a copy of the bitmap of the destination disc
j=dcreate(uinfs(1), bmfile, uinfi(1), bitmap pages<<2 {Param is Kbytes}, 4 {zero it})
if j#0 start
vvderrs("DCREATE", j)
return
finish
j=dgetda(uinfs(1), bm file, uinfi(1), addr(bitmap darec))
if j#0 start
vvderrs("DGETDA", j)
return
finish
h==record(ixfad)
h_maxbytes=ixpages<<12
f==record(ixfad+h_txtrelst)
h_nextfreebyte=addr(f_f(1))-ixfad
reclen=sizeof(ff)
prompt("To Fsys: ")
cycle
rdint(to fsys)
if to fsys#98 start
printstring("Fsys must be on-line, NOT CCKed, and must be 98 !!")
newline
finish else exit
repeat
j=fbase2(to fsys, addr(data))
if j#0 start
printstring("FBASE fails for fsys"); write(to fsys, 1)
printstring(" Flag ="); write(j, 1)
printstring(" Is the disc on-line?")
newline
finish
lo=(data_start+data_filestart)>>3; ! byte offset from start of bitmap of the
! first bit which is available for
! allocation to user files
hi=data_end; ! END OF USER FILES
hi=(hi-(sectsi-1))&(¬(sectsi-1))
hi=hi>>3
bmpg=data_start
! Get bitmap for "ToFsys"
printstring("Get bitmap for FSYS"); write(TO fsys,1)
newline
j=move section(to fsys, bmpg, uinfi(1), bitmap darec_da(0)<<8>>8, bitmap pages)
if j#0 start
printstring("Flag ")
write(j, 1)
printstring(" from MOVE SECTION")
newline
return
finish
bmfad=rdfilead(bmfile)
return if bmfad=0
prompt("From Fsys: ")
rdint(from fsys)
printstring("In the following cycle of collecting filenames for transfer, you can type
""FSYS=n"" to change the current From Fsys. The last-specified username is
remembered.")
newline
prompt("File/.END/FSYS=n: ")
user=""
xexit=0
totsects=0
cycle
ucstrg(s)
if length(s)>=2 and substring(s, 1, 2)=".E" start
s=uinfs(1).".".index file
xexit=1
from fsys=uinfi(1)
finish
if length(s)>5 and substring(s, 1, 5)="FSYS=" start
s=substring(s, 6, length(s))
j=bin(s)
if 0<=j<=99 then from fsys=j else printstring("Invalid Fsys number") and newline
continue
finish
if s->user.(".").file and length(user)=6 and file#"" start
printstring("Current username is ".user)
newline
finish else if user="" start
printstring("Give full username.filename to start with")
newline
continue
finish else file=s
j=dgetda(user, file, from fsys, addr(darec))
if j#0 start
vvderrs("Flag from DGETDA", j)
printstring("[Is the ""From"" FSYS correct?]")
newline
continue
finish else start
if darec_nsects>16 start
printstring("Sorry: can only handle files having fewer than 16
sections, and this one")
newline
printstring("has"); write(darec_nsects, 1)
newline
continue
finish
f_nfiles=f_nfiles+1
f_f(f_nfiles)_user=user
f_f(f_nfiles)_file=file
f_f(f_nfiles)_fsys=from fsys
f_f(f_nfiles)_fda<-darec
totsects=totsects+darec_nsects
h_nextfreebyte=h_nextfreebyte+reclen
printstring("File ".user.".".file)
spaces(12-length(file))
printstring("from fsys"); write(from fsys, 1)
printstring(":"); write(darec_nsects, 1); printstring(" section")
if darec_nsects>1 then printstring("s")
newline
if h_nextfreebyte+reclen>h_maxbytes start
printstring("The file of file-descriptors is now full")
newline
exit
finish
finish
repeat until xexit#0
nfiles=f_nfiles
! We do not want to retrieve the index file (it's disc address will be
! wrong, because it's written out before it's disc address is updated.
! So we decrement the count on disc.
f_nfiles=f_nfiles-1
write(nfiles-1, 4)
printstring(" files (plus index file),")
write(totsects, 4)
printstring(" sections, to be moved")
newline
return if nfiles=0
! Are there enough free sects on To Fsys?
free sects=0
bmptr=hi+4
cycle
bmptr=bmptr-4
if integer(bmfad+bmptr)=0 then free sects=free sects+1
repeat until {free sects>=totsects %or}bmptr=lo
if free sects<totsects then printstring("...but only") else printstring("There are")
write(free sects, 4)
printstring(" free sections on To Fsys")
newline
return if free sects<totsects
!--------------------------- So move the files ----------------------------------
bmptr=hi+4
for fileno=1, 1, nfiles cycle
fent==f_f(fileno)
user=fent_user
file=fent_file
from fsys=fent_fsys
lastsect=fent_fda_nsects-1
for sect=0, 1, lastsect cycle
! Find a hole (from top)
cycle
bmptr=bmptr-4
exit if integer(bmfad+bmptr)=0
repeat until bmptr<=lo {shouldn't be!}
if bmptr<=lo start
printstring("What? No free sections ??")
newline
return
finish
if sect=lastsect then pgs=fent_fda_lastsect else pgs=sectsi
startp1=fent_fda_da(sect)<<8>>8
if fileno=nfiles start
printstring("We are DISCONNECTing the index file and DDELAYing 15 secs")
newline
disconnect(index file)
ddelay(15)
finish
j=move section(from fsys, startp1, to fsys, bmptr<<3, pgs)
if j#0 start
printstring("Move Section fails"); write(j, 1)
printstring(" for file number"); write(fileno, 1)
newline
return
finish
! Place disc address into the record entry in the index file.
! This is, of course, too late in the case of the index file itself.
! We print out the disc address for the operator to type in to the
! FINISHIMPORT program (DISCTOFILE).
if file=index file and user=uinfs(1) start
printstring("The key disc address, to be given to the FINISHIMPORT program is:")
s=htos(bmptr<<3, 8)
while length(s)>2 and charno(s, 1)='0' cycle
s=substring(s, 2, length(s))
repeat
newlines(2)
spaces(15); printstring("************"); newline
spaces(15); printstring("* X".s); spaces(7-length(s)); printstring("*")
newline
spaces(15); printstring("************"); newlines(2)
finish else fent_fda_da(sect)=(to fsys<<24)!(bmptr<<3)
repeat {sects in file}
printstring("File no"); write(fileno, 1)
printstring(" ".user.".".file); spaces(12-length(file))
printstring("moved OK")
newline
repeat {files}
printstring("FILESTODISC completed OK")
newline
end {filestodisc}
!-------------------------------------------------------------------------------
external routine finish import
! This routine runs on the DEVV98 system
integer from fsys, to fsys, pages, sect, j, pgs, startpage, endpage, totpgs, relpg, ch, base page
integer ixfad, lo, hi, ixstartp, bmptr, fileno, bmfad, lastsect, nerrs, prevsect, discad,
srce fsys, err
string (63) file, user, wk
record (daf) darec, ix darec
integer array bitmap(0:5119)
record (discdataf) data
record (fff) name f
record (faf) name ff
record (faf) name fent
record (srcf) name h
file=uinfs(1).".".index file
if exist(file)#0 start
printstring(file." already exists.")
newline
j=yn("Destroy? ", 0, 0)
if j='Y' then destroy(file)
finish
! First re-create the index file. Not to exceed one section.
j=dcreate(uinfs(1), index file, uinfi(1), ixpages<<2 {Param is Kbytes}, 4 {zero it})
if j#0 start
vvderrs("DCREATE", j)
return
finish
j=dgetda(uinfs(1), index file, uinfi(1), addr(ix darec))
if j#0 start
vvderrs("DGETDA", j)
return
finish
ixstartp=ix darec_da(0)<<8>>8
prompt("Into what Fsys? ")
rdint(to fsys)
printstring("[Source fsys is 98]")
newline
srce fsys=98
bmfad=addr(bitmap(0))
j=dsysad(0, bmfad, srce fsys)
if j#0 start
printstring("Source fsys(98) not available? DSYSAD flag =")
write(j, 1)
newline
return
finish
prompt("Give the hex key printed by FILESTODISC: ")
rdint(base page)
j=fbase2(srce fsys, addr(data))
if j#0 start
printstring("Flag"); write(j, 1)
printstring(" from FBASE2. Is disc on-line??")
newline
return
finish
lo=data_start+data_filestart; ! START DISC ADDR OF USER FILES
hi=data_end; ! END DISC ADDR OF USER FILES
hi=(hi-(sectsi-1))&(¬(sectsi-1))
! First retrieve the index file
j=move section(srce fsys, base page, uinfi(1), ixstartp, ixpages)
if j#0 start
printstring("Move Section fails"); write(j, 1)
newline
return
finish
ixfad=rdfilead(index file)
return if ixfad=0
f==record(ixfad+integer(ixfad+4))
! Prove that the index file is valid and all bits are unset for imported file pages
nerrs=0
prevsect=10000000 {using this to show that sect addrs are monotonically decreasing}
write(f_nfiles, 1)
printstring(" files to be moved")
newline
unless 0<f_nfiles<=100 start
write(f_nfiles, 1)
printstring(" files to be moved? Too many? Invalid index file??")
newline
return
finish
! Continue to check "index" validity
for fileno=1, 1, f_nfiles cycle
ff==f_f(fileno)
unless 0<length(ff_user)<=6 and 0<length(ff_file)<=11 start
printstring("****index file error********")
newline
monitor
return
finish
user=ff_user
file=ff_file
printstring("File no"); write(fileno, 1)
printstring(" ".user.".".file)
write(ff_fda_nsects, 12-length(file))
printstring(" sections,")
write((ff_fda_nsects-1)*sectsi+ff_fda_lastsect, 1); printstring(" pages")
newline
lastsect=ff_fda_nsects-1
for sect=0, 1, lastsect cycle
! Show that bits are not set.
discad=ff_fda_da(sect)<<8>>8
err=0
if integer(bmfad+discad>>3)#0 start
err=1
nerrs=nerrs+1
printstring("***********bits set********")
newline
finish
unless discad<prevsect start
err=1
nerrs=nerrs+1
printstring("Section addresses not monotonically decreasing")
newline
finish
unless discad>lo start
err=1
nerrs=nerrs+1
printstring("********** Disc address below file-start address ***")
newline
finish
if err#0 start
printstring("Discad: ")
phex(discad); newline
finish
prevsect=discad
exit if nerrs>10
repeat {sects in file}
exit if nerrs>10
repeat {files}
if nerrs#0 start
printstring("At least")
write(nerrs, 1)
printstring(" errors found. Cannot continue")
newline
return
finish else start
printstring("Starting to move files")
newline
finish
! Move the files. Start at lowest to minimise risk of overwriting own
! files on a very full disc
for fileno=f_nfiles, -1, 1 cycle
ff==f_f(fileno)
user=ff_user
file=ff_file
wk=user.".".file
pages=(ff_fda_nsects-1)*sectsi+ff_fda_lastsect
recreate:
j=dcreate(user, file, to fsys, pages<<2 {Param is Kbytes}, 4 {zero it})
if j=37 start
printstring("User ".user." not found (on Fsys"); write(to fsys, 1)
printstring(")."); newline
ch=yn("Give alternative?y/n", 0, 0)
if ch='N' start
printstring("File omitted")
newline
continue
finish else start
prompt("Username: ")
ucstrg(user) until length(user)=6
->recreate
finish
finish
if j=16 start
printstring(wk." exists on fsys ".itos(to fsys))
newline
ch=yn("Destroy?", 0, 0)
if ch='N' start
printstring("File not moved")
newline
continue
finish
j=ddestroy(user, file, "", to fsys, 0)
if j=0 then ->recreate
vvderrs(wk, j)
return
finish
if j#0 start
vvderrs(wk, j)
return
finish
j=dgetda(user, file, to fsys, addr(darec))
if j#0 start
vvderrs(wk, j)
return
finish
for sect=0, 1, ff_fda_nsects-1 cycle
if sect=lastsect then pgs=ff_fda_lastsect else pgs=sectsi
j=move section(srce fsys, ff_fda_da(sect)<<8>>8, to fsys, darec_da(sect)<<8>>8, pgs)
if j#0 start
printstring("Move Section fails"); write(j, 1)
printstring(" fo file number"); write(fileno, 1)
newline
return
finish
repeat {sects in file}
printstring("File no"); write(fileno, 1)
printstring(" ".user.".".file); spaces(12-length(file))
printstring("moved OK")
newline
repeat {files}
printstring("FILESTODISC completed")
newline
end {finish import}
external routine filetodisc(string (255) s)
filestodisc(s)
end {filetodisc}
external routine disctofiles(string (255) s)
disctofile(s)
end {disctofiles}
end of file