const string (20) vsn="IMAP12 25 Mar 85"
const string (11) rlogfile="REPAIRFLOG"
const integer undefined=0, defined=1, selected=2
const integer logstream=28
own integer logstate=undefined
const integer no=0, yes= 1
const integer segshift=18
own integer rel lo ind bit; ! leave 12 Epages for BITMAP, NNT etc
own integer nnttop
own integer rel lo file bit; ! files allocated from here
const integer readonly{1}=1, testandreplace{2}=2, amendbplist{4}=4
const integer maxerr=11
const integer {errors from IMAPF}fsys not on line= B'1',
{and bits set in } missed users = B'10',
{array describing } duplicate users = B'100',
{problems } indx pgs in bad list = B'1000',
index hdr corrupt = B'10000',
should not occur = B'100000',
xnnt done = B'1000000',
restore from secure = B'10000000',
ignore entry = B'100000000',
appeared from nowhere= B'1000000000',
was in bad plist = B'10000000000',
read bitmap etc fail = B'100000000000'
const integer array error bits(1:maxerr)= c
fsys not on line ,
missed users ,
duplicate users ,
indx pgs in bad list ,
index hdr corrupt ,
should not occur ,
xnnt done ,
restore from secure ,
ignore entry ,
appeared from nowhere,
was in bad plist
const string (25) array error texts(1:maxerr)= c
"fsys not on line ",
"missed users ",
"duplicate users ",
"indx pgs in bad list ",
"index hdr corrupt ",
"should not occur ",
"xnnt done ",
"restore from secure ",
"ignore entry ",
"appeared from nowhere",
"was in bad plist "
const integer {actions for IMAPF}indexmap=b'1',
locateuser = B'10',
do bad pages = B'100',
empty bad length ks = B'1000'
const integer {Actions for TESTSINGLEPAGEFN}readwriterewrite= 1,
updatebplist = 2
const string name date=x'80C0003F', time=x'80C0004B'
const string (6) not known="NotKnn"
!<COMF
!
! This is the Supervisor Communications Record Format, defined in EMAS
! 2900 Supervisor Note 15.
!
record format cdrf(byte integer dap no, dap blks, dap process, dap state, integer dap1,
dap int)
!
record format comf(integer ocptype, ipldev, sblks, sepgs, ndiscs, dlvnaddr, gpctabsize, gpca,
sfctabsize, sfca, sfck, dirsite, dcodeda, suplvn, tojday, date0, date1, date2, time0, time1,
time2, epagesize, users, cattad, servaad, byte integer nsacs, resv1, sacport1, sacport0,
nocps, resv2, ocpport1, ocpport0, integer itint, contypea, gpcconfa, fpcconfa, sfcconfa,
blkaddr, ration, smacs, trans, long integer kmon, integer ditaddr, smacpos, supvsn, pstva,
secsfrmn, secstocd, sync1dest, sync2dest, asyncdest, maxprocs, kinstrs, elaphead, commsreca,
storeaad, procaad, sfcctad, drumtad, tslice, feps, maxcbt, performad,
record (cdrf) array cdr(1:2), integer lstl, lstb, pstl, pstb, hkeys, hoot, sim, clkx, clky,
clkz, hbit, slaveoff, inhssr, sdr1, sdr2, sdr3, sdr4, sesr, hoffbit, blockzbit, blkshift,
blksize, end)
!
const record (comf) name com= X'80000000' + 48 << 18
!>
!<DISCDATAF
!
record format discdataf(integer start, bitsize, nntstart, nntsize, nnttop, nnthash,
indexstart, filestart, end)
!
! This format is used in the procedure FBASE2 to return a record giving
! addresses and lengths of the various parts of the disc.
!
! START indicates whether an IPL disc or not, value X40 or X800
!
! BITSIZE size of the bitmap, X1000, X2000 or X5000
!
! NNTSTART where the NNT starts
!
! NNTSIZE the size of the name-number table, X1000, X2000 or X4000
!
! NNTTOP the NNT is a record array declared 0:n, this is n: 340, 681 or 1364
!
! NNTHASH the largest prime less than NNTTOP, 331, 677 or 1361
!
! INDEXSTART the total number of pages used for bitmaps and NNTs
!
! FILESTART the number of pages used for bitmaps, NNTs and indexes
!
! END the highest numbered page
!>
!<FF
record format ff(integer sdstart, pdstart, fdstart, sema, reserve1, reserve2, semano,
restores, string (6) owner, byte integer size, string (11) name, byte integer fsys,
fiphead, tempfiles, eep, integer files, maxfile, maxkb, cherfiles, cherkb, totkb, tempkb,
chksum, files0, files1, afiles, atotkb, asema, byte integer attributes, day42)
! only 26 more bytes spare
! PDSTART etc Add to FINDAD to get addr of array
! FILES Number of usable files, ie not 'oldgens'
!>
!<HH
record format hf(string (6) owner, byte integer mark, integer spare1, msgsema, spare2,
spare3, inuts, iinstrs, byte integer acr, dirvsn, sigmon, passfails, imax, bmax, tmax,
stkkb, iuse, buse, isessm, gpfsys, fsys, sb0, sb1, type, integer top, dwspk, bwspk, binstrs,
trying, dinstrs, iptrns, bptrns, imsecs, bmsecs, nkbin, nkbout, mail count, connectt, dirmon,
lastlogon, last non int start, tell rej, dwspdt, bwspdt, spare4, spare5, dapsecs, si3,
long integer dwsp, bwsp, string (6) gpholdr, string (31) surname, delivery,
string (18) batchss, basefile, startf, testss, string (11) logfile, main,
string (15) defaultlp, string (63) data, string (6) supervisor,
string (15) gateway access id)
!>
!<NNF
! Note: This program is using the MARKER field of this record in the NNTCopy array
record format nnf(string (6) name, byte integer kb, tag, marker, half integer indno)
!>
!<PARMF
!
! The standard format for system messages
record format parmf(integer dest, srce, (integer p1, p2, p3, p4, p5, p6 or string (23) s))
!>
own record (nnf) array nnc(0:1364)
own record (nnf) array nnt(0:1364)
const integer maxprobs=255
record format prof(integer indno, problem, string (6) user)
own record (prof) array problem indexes(0:maxprobs)
own integer nprobs=0
own integer count= 0
record format pgf(byte integer array pg(0:4095))
external routine spec rstrg(string name s)
external routine spec dump(integer start, finish, printst, lim)
external routine spec rdint(integer name i)
external routine spec prompt(string (15) s)
external routine spec clear(string (255) s)
external routine spec define(string (255) s)
external integer fn spec rdfilead(string (255) s)
external routine spec disconnect(string (255) s)
external string fn spec itos alias "S#ITOS"(integer i)
external string fn spec htos alias "S#HTOS"(integer i, pl)
external routine spec phex alias "S#PHEX"(integer i)
external string fn spec uinfs(integer i)
external integer fn spec uinfi(integer i)
external routine spec dout(record (parmf) name p)
external routine spec dpon(record (parmf) name p)
external integer fn spec testsinglepagefn(integer action, fsys, disc page no,
integer name readflag, writeflag, setbpflag)
external integer fn spec bad page(integer type, fsys, bitno)
external integer fn spec derror(string name txt)
external integer fn spec dninda(integer fsys, indno, integer name indad)
dynamic integer fn spec dreplaceindex(integer fsys, indno, fromaddr)
external integer fn spec dsysad(integer type, adr, fsys)
external integer fn spec fbase(integer name lo, hi, integer fsys)
external routine spec fill alias "S#FILL"(integer len, from, char)
external routine spec get av fsys(integer name n, integer array name a)
dynamic integer fn spec dsfi(string (6) user, integer fsys, type, set, adr)
external integer fn spec dfstatus(string (31) file index, file, integer fsys, act, value)
dynamic integer fn spec dnewuser(string (6) user, integer fsys, nkb)
dynamic integer fn spec dnew arch index(string (6) user, integer fsys, kbytes)
external routine spec uctranslate alias "S#UCTRANSLATE"(integer adr, len)
own record (discdataf) fsys data
!------------------------------------------------------------------------
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 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
!
!------------------------------------------------------------------------
!
routine set rlog noarch
integer j
j=dfstatus(uinfs(1), rlogfile, uinfi(1), 17, 1)
if j#0 start
printstring("DFSTATUS fails for ".rlogfile)
printstring(" flag ="); write(j, 1)
newline
finish
end {set rlog noarch}
integer fn get fsys(integer name fsys)
integer j, k, n, online
integer array a(0:99)
get av fsys(n, a)
fsys=-1
while not (0<=fsys<=99) cycle
prompt("Fsys: ")
rdint(fsys)
repeat
! Check that FSYS is in fact online
online=0
cycle k=0, 1, n-1
if a(k)=fsys then online=1 and exit
repeat
if online=0 start ; ! disc not available
wrs("Disc not on-line")
result =fsys not on line
finish
j=fbase2(fsys, addr(fsys data))
if j#0 start
wrsn("Fundamentally FBASE2 fails ", j)
result =j
finish
result =0
end {get fsys}
routine print indno(integer indno, add)
printstring("Index no ".itos(indno)."(dec) X".htos(indno, 4))
printstring(" Disc pageno X".htos(fsys data_start+indno>>2, 5))
if add#0 then printstring(" size X".htos(add, 4))
end {print indno}
routine narrow dump(integer indad, indno)
integer i, k, to, kkk
print indno(indno, 0)
newline
if logstate=selected start
printstring("Dump from index position:")
newline
to=indad+4096
if to>>segshift#indad>>segshift then to=to>>segshift<<segshift {don't go above seg bdy}
dump(indad, to, indad, 32)
finish else start
printstring("Dump of 64 bytes from")
printstring(" index position:")
newline
for i=0, 16, 48 cycle
for k=0, 4, 12 cycle
for kkk=0, 1, 3 cycle
printstring(htos(byteinteger(indad+i+k+kkk), 2))
repeat
! i.e. phex(integer(indad+i+k)) - bypasses unassigned check
space
repeat
newline
repeat
finish
end {narrow dump}
routine spec select repair log
routine spec select zero
routine dee slash(string (23) s)
record (parmf) p
string (39) s1, s2
s1="Doing a D/".s
wrs(s1)
p_dest=x'0032000E'
p_srce=7
string(addr(p_p1))="D/".s
dout(p)
s2=string(addr(p_p1)) {The reply}
wrs(s2)
p_dest=x'320007'
p_srce=0
dpon(p); ! UPDATE OPERLOG
select repair log
wrs(s1)
wrs(s2)
select zero
end ; ! dee slash
routine define repair log
if logstate#undefined then return
define(itos(logstream).",".rlogfile."-MOD")
logstate=defined
select repair log
printstring("**START ".time." ".date)
newline
printstring("REPAIR FSYS version ".vsn)
newline
printstring("COM_USERS=".itos(com_users))
newline
select zero
end {define repair log}
routine select repair log
integer original logstate
original logstate=logstate
if logstate=selected then return else if logstate=undefined then define repair log
select output(logstream)
logstate=selected
if original logstate=undefined start
printstring("??Initialisation??")
newline
finish
end {select repair log)}
routine select zero
return if logstate#selected
select output(0)
logstate=defined
end {select zero}
routine close repair log
integer fad
if logstate=undefined then return
select repair log
printstring("**END ".time)
newline
select zero
close stream(logstream)
clear(itos(logstream))
logstate=undefined
fad=rdfilead(rlogfile)
if fad>0 and integer(fad)>128<<12 start
printstring("REPAIRFLOG contains 128Kbytes or more.")
newline
printstring("Suggest RENAME, DESTROY or ARCHIVE")
newline
printstring("of same")
newline
disconnect(rlogfile)
finish
set rlog noarch
end {close repair log}
!-------------------------------------------------------------------------------
integer fn replace 2k index(integer fsys, indno, fromaddr)
integer j, k, indad
j=dninda(fsys, indno, indad)
if 97#j>0 start
for k=1, 1, 2 cycle
printstring("DNINDA fails ".itos(j))
newline
select repair log
repeat
select zero
result =99
finish
select repair log
printstring("REPLACE 2K INDEX ")
print indno(indno, x'400')
newline
printstring("Old contents")
newline
narrow dump(indad, indno)
select zero
unless fsys data_indexstart<<2<=indno<fsys data_filestart<<2 start
printstring("Attempt to ""replace index"" outside index area REJECTED")
printstring(" Index number X".htos(indno, 3))
newline
j=99
finish else start
j=dreplace index(fsys, indno, fromaddr) {replaces 1K of index area}
j=j!dreplace index(fsys, indno+1, fromaddr+x'400')
if j#0 start
for k=1, 1, 2 cycle
wrs("DREPLACE INDEX fails ".itos(j))
select repair log
repeat
select zero
result =j
finish
j=dninda(fsys, indno, indad)
if 97#j>0 start
for k=1, 1, 2 cycle
printstring("DNINDA fails ".itos(j))
newline
select repair log
repeat
select zero
result =99
finish
for k=0, 4, x'7fc' cycle
if integer(indad+k)#integer(fromaddr+k) start
printstring("Eeeek!! REPLACE INDEX??? ".htos(k, 4))
newline
narrow dump(indad, indno)
printstring("--------------------------")
narrow dump(fromaddr, indno)
exit
finish
repeat
finish
result =j
end {replace index}
!-------------------------------------------------------------------------------
routine add problem(string (6) user, integer indno, problem)
integer j
own integer msg given=0
record (prof) name p
j=0
while j<nprobs cycle
p==problem indexes(j)
if p_user=user and p_indno=indno start
p_problem=p_problem!problem
return
finish
j=j+1
repeat
if nprobs>=maxprobs start
if msg given#0 then return
wrs("Too many corrupt/duplicate or missing indexes !!!!")
wrs(" Clear and re-prime FSYS ??")
msg given=1
return
finish
p==problem indexes(nprobs)
nprobs=nprobs+1
p_user<-user
p_indno=indno
p_problem=problem
end ; ! add problem
!
!------------------------------------------------------------------------
!
integer fn index bad(string (6) user)
integer j
record (prof) name p
j=0
while j<nprobs cycle
p==problem indexes(j)
if p_user=user then result =1 {index bad for USER}
j=j+1
repeat
result =0 {user not found in BAD list}
end ; ! index bad
!
!------------------------------------------------------------------------
!
routine recreate index(string (6) user, integer fsys)
integer nkb, j, maxkb, maxfile, maxproi, maxprob, maxprot
if user="SPOOLR" then nkb=12 else nkb=8
maxfile=x'4000'
maxkb=x'8000'
maxproi=1; maxprob=1; maxprot=1
j=dnewuser(user, fsys, nkb)
vvderrs(user." DNEWUSER", j)
return if j#0
j=dnew archindex(user, fsys, 4)
vvderrs(user." DNEW ARCH INDEX", j)
j=dsfi(user, fsys, 12, 1, addr(maxfile))
vvderrs(user." Set maxfile", j)
j=dsfi(user, fsys, 11, 1, addr(maxkb))
vvderrs(user." Set max Kb", j)
j=dsfi(user, fsys, 14, 1, addr(maxproi))
vvderrs(user." Set process concurrencies", j)
wrs("Create index for ".user." completed")
end ; ! recreate index
!
!------------------------------------------------------------------------
!
integer fn whos missing(integer fsys)
integer pt, flag
flag=0
cycle pt=0, 1, nnttop
unless length(nnc(pt)_name)<6 start
wrs("NNT corruption problem? ") if nnc(pt)_marker#0
wrsn(nnc(pt)_name." missed,FSYS", fsys)
wrs("(file index)") if nnc(pt)_tag>0
flag=1
add problem(nnc(pt)_name, nnc(pt)_indno, missed users)
finish
repeat
result =flag
end ; ! WHOS MISSING
!
!------------------------------------------------------------------------
!
integer fn enter name(string (6) user, string (11) name, integer kb, indno,
integer name nntindno)
!
! CHECKS THAT NAME IS IN NNT
! REMOVES ENTRY FROM COPY
! COMMENTS ON AND INSERTS ANY NEW USERS
! RESULT 14 IF NAME ALREADY PRESENT WITH DIFFERENT INDEX
! RESULT = 0 OK
! 1 User appeared from nowhere
! 14 Duplicate
integer pt
record (nnf) name nn
cycle pt=0, 1, nnttop
nn==nnt(pt)
if user=nn_name start
if name="" start {looking for a main index}
if nn_tag=0 start {this entry is for a main index}
if indno=nn_indno start
nnc(pt)_name=""
result =0
finish else start
nntindno=nn_indno
nnc(pt)_marker=1 {to help with the clarity of the reports}
result =14 {duplicate}
finish
finish
finish else start
if nn_tag>0 start {this entry is for a file index}
if indno=nn_indno start
nnc(pt)_name=""
result =0
finish
finish
finish
finish
repeat
result =1
end ; ! ENTER NAME
!
!------------------------------------------------------------------------
!
integer fn imapf(integer name fsys, string (6) locateu, integer actions)
integer j, k, avail pgs, indno, hi, add, done, badp, flag, was bad
integer type, pno, errors, problem bits, a neverindex noticed, warn1count
integer good, ch, indad, locate flag, lastpno
integer readflag, writeflag, setbpflag
string (6) user
string (11) name
record (hf) name h
record (ff) name f
record (pgf) empty4k
routine pcount(integer type, kb)
const string (39) array text(1:9)= c
{1} "EMPTY 2-Kbyte blocks",
{2} "bad character usernames",
{3} "duplicate username/NNT entry corrupt",
{4} "good indexes",
{5} "bad length usernames",
{6} "bad size (H_TOP) indexes",
{7} "index pge in bad pgs list",
{8} "index appeared from nowhere",
{9} "good file indexes"
const half integer array problem(1:8)= 0, index hdr corrupt {2},
duplicate users {3},
0, index hdr corrupt(2) {5-6},
indx pgs in bad list {7},
appeared from nowhere {8}
string (31) ss
! type: 98765 4321
const integer bad=b'00111101100'
own integer prev=-1, prevkb, ino, pno
if bad&(1<<type)#0 start
errors=1 if type#7 {bad pgs list entry not nec bad}
add problem(user, indno, problem(type))
problem bits=problem bits!problem(type)
finish
if logstate#undefined {i.e. only for REPAIRFSYS} and type#0 and type#1 and type#4 and c
type#9 start
select repair log
print indno(indno, 0)
printstring(" ".text(type))
newline
select zero
finish
return if actions&locateuser#0 or actions&indexmap=0
if prev=type and (4#type#9 or kb=prevkb) then count=count+1 else start
if prev>0 start
printstring("X".htos(ino, 3))
spaces(8)
printstring("X".htos(pno, 3))
if bad&(1<<prev)#0 then ss=" **** " else ss=" "
printstring(ss)
write(count, 4)
printstring(" ")
ss=text(prev)
if count=1 start
ch=charno(ss, length(ss))
if ch='s' then length(ss)=length(ss)-1
if substring(ss, length(ss)-1, length(ss))="xe" then length(ss)=length(ss)-1
finish
printstring(ss)
if prev=3 {duplicate/corrupt NNT indno} start
spaces(10)
printstring("Indno in NNT = X")
printstring(htos(kb, 3))
finish
if prev=4 or prev=9 start
printstring(" of length")
write(prevkb, 2)
printstring(" Kbytes")
finish
newline
finish
count=1
ino=indno
pno=fsys data_start+ino>>2
prevkb=kb
if type>0 then prev=type else prev=-1
finish
end ; ! PCOUNT
!
!-------------------------------- body of fn IMAPF -----------------------------
!
a neverindex noticed=no
warn1count=0
fill(1024, addr(empty4k), 0)
string(addr(empty4k))="EMPTY"
problem bits=0
locate flag=0
rel lo ind bit=fsys data_indexstart
nnttop=fsys data_nnttop
rel lo file bit=fsys data_filestart
if actions&indexmap#0 start
! Start off by test-reading the pages below the start of the indexes proper,namely
! the bit-map, badpages-map, NNT etc. If any of these fail to read, jack out
! to give the option of test-read-writing them using the TESTPAGERANGE program
j=0
for pno=fsys data_start, 1, rel lo ind bit-1 cycle
j=j!testsinglepagefn(0 {readonly}, fsys, pno, readflag, writeflag, setbpflag)
if readflag#0 start
printstring("Read fails for pgno X".htos(pno, 5))
newline
finish
repeat
if j#0 start
printstring("Consider using the")
newline
printstring("TESTPAGERANGE progam")
newline
printstring("to sort these pages")
newline
result =read bitmap etc fail
finish
finish
errors=0
j=dsysad(1, addr(nnt(0)), fsys)
if j#0 start
error
result =should not occur
finish
cycle j=0, 1, nnttop
nnc(j)=nnt(j)
nnc(j)_marker=0 {set one if DUPLICATE remarked}
repeat
if actions&indexmap#0 start
wrs("Index no Disc page no")
finish
done=0
avail pgs=fsys data_end-fsysdata_start-rel lofilebit
indno=rel loindbit<<2-2
hi=rel lo file bit<<2-2; ! last half page
lastpno=fsys data_start+rel loindbit-1
add=x'800'
until indno>=hi cycle
add=x'800' unless add=x'800' or (x'1000'<=add<=x'8000' and add&x'fff'=0)
indno=indno+add>>10
! Set defaults for the following time round
user=not known
was bad=0
add=x'800'; ! a half page
pno=fsys data_start+(indno>>2)
if actions&indexmap#0 start
! This next cycle ensures that any pages between lastpno and pno are
! tested, and avoids testing pno more than once (for more than one index
! per page).
for j=lastpno+1, 1, pno cycle
k=testsinglepagefn(0 {readonly}!updatebplist, fsys, j, readflag, writeflag, setbpflag)
if k#0 start
printstring("TESTSINGLEPAGE failed")
newline
printstring("for pageno X".htos(j, 5))
newline
finish
repeat
LASTPNO=PNO
finish
badp=bad page(3, fsys, pno); ! test: 1=bad, 0=good
if badp=yes and actions&do bad pages#0 and indno&3=0 start
flag=testsinglepagefn(readwriterewrite!updatebplist, fsys, pno, readflag, writeflag,
setbpflag) {Replaces original if poss}
select repair log
print indno(indno, x'1000')
printstring(" was BAD. TESTBADPAGES ")
if flag=0 then printstring("succeeded") else printstring("failed")
newline
select zero
if flag=0 start
badp=bad page(3, fsys, pno)
{Now we hope (indeed expect) it's not in the bad pages list}
was bad=1
finish
finish
if badp=yes start
pcount(7, 0)
print indno(indno, 0)
wrs(" has bit set in bad pages list")
add=(4-indno&2)<<10; ! to get to next page
continue
finish
j=dninda(fsys, indno, indad)
if 97#j>0 then result =should not occur
h==record(indad)
if h_owner="NEVER" start
if a neverindex noticed=no start
wrs("Commencing ""NEVER""-indexes at ")
print indno(indno, add)
newline
a neverindex noticed=yes
finish
pcount(1, 0)
continue
finish
if a neverindex noticed=yes start
if warn1count>16 start
wrs("***Thoroughly screwed above ""NEVER""")
wrs("***Check abondoned")
exit
finish
wrs("***Something found after ""NEVER"" at ")
narrow dump(indad, indno)
warn1count=warn1count+1
finish
if h_owner="EMPTY" start
pcount(1, 0)
continue
finish
good=4 {good index}
if length(h_owner)=6 start
! User index
user=h_owner
name=""
type=4
add=h_top
finish else start
! File index
f==record(indad)
unless length(f_owner)=6 and 0<length(f_name)<12 then good=5 {bad length name}
user<-f_owner
name<-f_name
type=9
add=f_size<<9
finish
if good=4 {good index} start
cycle j=1, 1, 6
ch=charno(user, j)
good=2 {bad chs} unless 'A'<=ch<='Z' or '0'<=ch<='9'
repeat
good=6 {bad size} unless add=x'800' or (x'1000'<=add<=x'8000' and add&X'FFF'=0)
! Does index perchance cross segment boundary?
if indad>>segshift#(indad+add-1)>>segshift start
wrs("***Index crosses segment boundary !!!")
good=6
finish
if good#4 {i.e. index not good} start
pcount(good, 0)
! If the index WAS in the bad pages list, but is now OK, having
! had a successful TESBADPAGE done, then we must still get rid
! of the index if users have come on the system (unless the
! index got into the bad pages list SINCE the IPL, of course,
! but we have no way of knowing about that), because the user
! would have been MISSED and the space occupied by his files
! could have been re-used.
if com_users>2 and was bad#0 then add problem(user, indno, was in bad plist)
if actions&indexmap#0 then narrow dump(indad, indno)
continue
finish
if actions&locateuser#0 and user=locateu start
locate flag=1
printstring(user)
spaces(2)
phex(indno)
spaces(2)
phex(add)
if type=9 start
printstring(" file index: ")
printstring(name)
finish
newline
finish
j=enter name(user, name, add>>10, indno, k{for indno from NNT})
if j=0 then pcount(type, add>>10) else start
errors=1; ! to include "from nowhere"
if j=14 {duplicate} then pcount(3, k) else pcount(8, 0) {appeared from nowhere}
finish
finish {good=4} else start
! name invalid or something
flag=1
if actions&empty bad length ks#0 start
flag=replace 2k index(fsys, indno, addr(empty4k))
error unless flag=0
finish
good=1 if flag=0
pcount(good, 0)
finish
repeat
errors=errors!whos missing(fsys)
pcount(0, 0); ! last count and re-initialise
if actions&locateuser#0=locate flag start
wrs("Nothing found for ".locateu)
finish
if errors#0 and actions&indexmap#0 start
wrs("****************ERRORS on Fsys ".itos(fsys)."****************")
finish
result =problem bits
end ; ! imapf
!-------------------------------------------------------------------------------
routine warn
printstring("************************************
"); printstring("WARNING. Do not run this program
"); printstring("unless you believe you know what
"); printstring("you are doing! In particular: do
"); printstring("not let a missed index be repaired
"); printstring("back to good health, other than by
"); printstring("repriming from SECURE, if any FILE
"); printstring("HAS BEEN CREATED SINCE CCK.
"); printstring("***********************************
");
end {warn}
!
!------------------------------------------------------------------------
!
external routine imap(string (255) s)
integer i, fsys
wrs(vsn)
i=get fsys(fsys)
return if i#0
i=imapf(fsys, "", indexmap)
end ; ! imap
!------------------------------------------------------------------------
external routine locateindex(string (255) user)
! This routine should be required only exceptionally. It can be used to locate
! an index for a given username.
integer i, fsys
wrs(vsn)
while length(user)#6 cycle
prompt("Give Username to be found: ")
rstrg(user)
repeat
uctranslate(addr(user)+1, 6)
i=get fsys(fsys)
return if i#0
i=imapf(fsys, user, locateuser)
end ; ! locateindex
!
!------------------------------------------------------------------------
!
external routine repair fsys(string (255) s)
! This routine reports on, then gets rid of, all indexes and name-number tables
! entries which look peculiar (duplicate, missed, bad header etc.)
integer i, j, k, problems, fsys, flag
string (6) procowner
record (prof) name p, q
record (pgf) empty page
wrs(vsn)
fill(4096, addr(empty page), 0)
for j=0, X'800', X'800' cycle
string(addr(empty page)+j)="EMPTY"
repeat
procowner=uinfs(1)
if com_users>2 then warn
define repair log
! FIRST PASS
! First pass attempts to read and re-write indexes whose page numbers are in the
! bad pages list (and hence to clear them from the bad pages list if the read
! and re-write are successful).
i=get fsys(fsys)
return if i#0
problems=imapf(fsys, "", do bad pages!indexmap)
if problems=read bitmap etc fail then return
if {fsys=uinfi(1) %or}index bad(uinfs(1))#0 start
for i=0, 1, 7 cycle
printch(7) {bel}
for j=0, 1, 9 cycle ; printch(0); repeat
repeat
newline
if fsys=uinfi(1) then wrs("Do not REPAIR the FSYS on which you are running !!!") else c
wrs("Owner of this program has duplicate index - copy it to another index !!!")
finish else start
! SECOND PASS
! If there were any bad pages, or if there were any "duplicate" usernames, we
! go over the fsys again, looking for (more) duplicate/missed.
select repair log
printstring("Second pass: looking for (any)(more)")
newline
printstring("duplicate/missed users")
if problems&(indx pgs in bad list!duplicate users)#0 start
problems=problems!imapf(fsys, "", 0)
finish else printstring(" OMITTED (none)")
newline
select zero
! Meanwhile, the record array PROBLEM USERS has been filled with lots of
! information about the bad indexes.
! Now we get rid of all remaining problem indexes, by writing "EMPTY" in their index
! pages and removing their name-number table entries.
j=0
while j<nprobs cycle
p==problem indexes(j)
if p_user#not known start
if p_problem&(missed users!was in bad plist)#0 start
dee slash("XNNT ".p_user." ".itos(fsys))
p_problem=p_problem!restore from secure!xnnt done
finish
if p_problem&appeared from nowhere#0 start
p_problem=p_problem!restore from secure
finish
if p_problem&duplicate users#0 start
dee slash("XNNT ".p_user." ".itos(fsys)) if p_problem&xnnt done=0
p_problem=p_problem!xnnt done!restore from secure
! Go to end of list marking entries for same username as 'xnnt done'
! so as not to try to do them a second time (cosmetic)
k=j+1
while k<nprobs cycle
q==problem indexes(k)
if q_user=p_user then q_problem=q_problem!xnnt done!ignore entry
k=k+1
repeat
finish
finish
if p_problem&indx pgs in bad list=0 start
{only if not (still) marked as "bad"}
flag=replace 2k index(fsys, p_indno, addr(empty page))
if flag>0 start
error
finish else start
wrs("Index number X".htos(p_indno, 3)." ""EMPTY-ed""")
finish
finish
j=j+1
repeat
! THIRD PASS
! Replacing 1K areas with the EMPTY pattern will have left following adjacent
! areas which also need emptying (number of such areas potentially unknown, as
! we assume we may not know the size of the index which formerly occupied the
! space). So we go through again, to make the consequent "bad length name" areas
! "EMPTY".
j=imapf(fsys, "", empty bad length ks)
! Finally, we report on usernames treated/deleted, and re-create VOLUMS/
! SPOOLR/MAILER indexes if necessary.
j=-1
while j<nprobs cycle
j=j+1
p==problem indexes(j)
continue if p_problem&ignore entry#0
if p_user="SPOOLR" or p_user="VOLUMS" or p_user="MAILER" start
recreate index(p_user, fsys)
finish else start
if p_problem&restore from secure#0=0 start
wrs("Restore user ".p_user." from SECURE tape and re-prime files")
finish
finish
repeat
for k=1, 1, 2 cycle {once to terminal, once to repair log}
printstring("Summary of affected usernames")
newline
i=0
j=-1
while j<nprobs cycle
j=j+1
p==problem indexes(j)
if p_problem&ignore entry=0 and length(p_user)=6 start
if p_problem&restore from secure#0 then printstring("*") else printstring(" ")
printstring(p_user." ")
i=i+1
if i>4 then newline and i=0
finish
repeat
newline
printstring("""*""==>Must RECREATE")
newline
select repair log
repeat
select zero
newlines(2)
wrs("REPAIRFSYS completed. Logfile=".procowner.".".rlogfile)
if com_users<=2 {DIRECT+MANAGR} start
wrs("Now close down and re-IPL (unless more FSYSes are first to be repaired)")
finish
finish
close repair log
end ; ! repair fsys
!
!------------------------------------------------------------------------
!
const integer show=1, empty=2
routine show or empty(integer sh or em)
! This routine may be used either to inspect odd pages of the index area for a
! given FSYS or to write the 'EMPTY' pattern ditto. It does not do any writing
! which will not be obvious from the wee dumps and 'yes/no' prompts.
integer fsys, indad, j, k, base, iad, ch, indno, online, currpage, currno
integer pchanged
string (255) s
byte integer array aa(0:x'A000')
routine show page(integer base, indno, msno)
integer len, j
const string (71) ss1= c
"Here are the current contents of the page around the 2-Kbyte boundaries"
const string (71) ss2= c
"Summary of page just altered"
return if base<0 or (msno=2 and pchanged=0)
if msno=1 then wrs(ss1) and len=32 else wrs(ss2) and len=16
for j=0, 2, 2 cycle
wrs("Index number X".htos(indno>>2<<2+j, 3))
dump(base, base+len, base, 16)
newline
base=base+x'800'
repeat
end ; ! SHOW PAGE
wrs(vsn)
k=get fsys(fsys)
return if k#0
if sh or em=empty start
wrs("Note: this program will optionally write ""EMPTY""")
wrs(" at the specified 2-Kbyte boundary in the index area")
finish
currpage=-1; currno=0
iad=addr(aa(0))
fill(1024, iad, 0)
string(iad)="EMPTY"
cycle
prompt("Indexno: ")
rdint(indno)
exit if indno<0
j=dninda(fsys, indno, indad)
if j>0 start
error
continue
finish
base=indad>>12<<12
if base#currpage start
show page(currpage, currno, 2)
show page(base, indno, 1)
currno=indno
pchanged=0
currpage=base
finish
if sh or em=empty start
wrs("Empty the 2-Kbytes ?")
prompt("Y/N: ")
rstrg(s)
ch=charno(s, 1)&(¬32); ! lower to upper case
if ch='Y' start
j=replace 2k index(fsys, indno, iad)
if j>0 start
error
finish else wrs("Done ") and pchanged=1
finish else wrs("Abandoned")
finish
wrs("Give -1 to terminate the program")
repeat
show page(currpage, currno, 2)
end ; ! show or empty
!
!------------------------------------------------------------------------
!
external routine show index(string (255) s)
show or empty(show)
end ; ! show index
!
!------------------------------------------------------------------------
!
external routine emptyi(string (255) s)
show or empty(empty)
end ; ! emptyi
!
!------------------------------------------------------------------------
!
end of file