const string (39) vsn="25th March 1985. K Yarwood"
const integer readwriterewrite=1, updatebplist=2
! Notes on BADPAGE
! Result is 0 or 1 for GOODPAGE, being original bit value. Result greter than 1
! for other failures.
! Result is 0 for new BADPAGE.
record format parmf(integer dest, srce, p1, p2, p3, p4, p5, p6)
external string fn spec ucstring(string (255) s)
external string fn spec derrs(integer i)
dynamic routine spec prompt(string (255) s)
dynamic routine spec get av fsys(integer name n, integer array name a)
external integer fn spec dsysad(integer type, adr, fsys)
external routine spec ucstrg(string name s)
external routine spec rdint(integer name i)
const string name date=X'80C0003F', time=X'80C0004B'
external string fn spec uinfs(integer i)
external string fn spec htos alias "S#HTOS"(integer i, pl)
dynamic integer fn spec dgetda(string (6) user, string (15) file, integer fsys, adr)
external integer fn spec tpfilead(string (15) s, integer pgs)
external routine spec fill alias "S#FILL"(integer len, from, filler)
external routine spec dpon(record (parmf) name p)
external routine spec dpoff(record (parmf) name p)
external integer fn spec badpage(integer type, fsys, bitno)
external routine spec disconnect(string (255) s)
external routine spec ddelay(integer seconds)
external string fn spec interrupt
external integer fn spec uinfi(integer type)
const integer bad pages pages= 6 {enough for the forseeable, I trust}
const integer page size= 4096 {bytes}
routine newline tab
newline
spaces(10)
end {NEWLINE TAB}
routine wrss(string (255) s1, s2)
printstring(s1)
printstring(s2)
newline tab
end
routine uderrs(integer n)
wrss("FLAG =", derrs(n))
end ; ! UDERRS
!
!-------------------------------------------------------------------------------
integer fn movepage(integer frompage, fromfsys, topage, tofsys)
! USE THE BULK MOVER SERVICE 36, REPLY ON SERVICE 37
! FIRST GET DISC TYPE VIZ. SYSTEM OR OTHERWISE
! FSYSSTART IS X'800' OR X'40' RESP
! SET UP RECORD FOR DPON
record (parmf) p
p_dest=X'00240000'; ! SERVICE 36
! P_P1 == /8/8/16/ == /FROM DEV/TO DEV/E PAGES/
! DISC == 02
p_p1=X'02020001'
p_p2=fromfsys; ! FROM FSYS
p_p3=frompage; ! BITNO S#PATTERN PAGE
p_p4=tofsys; ! TO FSYS
p_p5=topage; ! BAD PAGE BITNO
p_p6=M'BADP'; ! IDENTIFIER
dpon(p)
dpoff(p)
! FAILURE FLAG IN P_P1
result =255 if (p_p1>>16)&255=2 {request rejected, eg. FSYS not online}
result =p_p1>>24
end ; ! OF MOVEPAGE
!--------------------------------- TESTSINGLEPAGEFN ----------------------------
external integer fn testsinglepagefn(integer action, fsys, bitno, integer name readflag,
writeflag, setbpflag)
! Values for ACTION 2**0 zero if read-test only is required
! set for read-test followed by pattern-write
! followed by re-write original if possible.
! 2**1 set if bad-pages-list is to be updated if possible
! Result = 0 if all actions requested are performed OK.
! Result = 1 if write-test failed (or not performed for any reason)
! page not removed from bad pages list.
! Result = 255 move request rejected (e.g. disc not online)
! More detailed flags in the %name parameters
routine spec setuppatternfile(integer name bitno, myfsys, flag)
integer flag
integer myfsys, pfbitno, bpact, j
readflag=255; writeflag=255; setbpflag=255
setuppatternfile(pfbitno, myfsys, flag)
result =255 if flag#0
readflag=movepage(bitno, fsys, pfbitno+4, myfsys); ! Take a copy if poss
if readflag=255 then result =255 {request rejected}
flag=readflag
if action&updatebplist#0 start
if readflag=0 then bpact=4 {goodpage} else bpact=1 {badpage}
j=badpage(bpact, fsys, bitno)
if 0<=j<=1 then setbpflag=0
flag=flag!setbpflag
finish
if action&readwriterewrite=0 then result =flag
! Go on to write the "worst pattern", and replace original if possible
flag=movepage(pfbitno+1, myfsys, bitno, fsys); ! test with Pattern1
if flag=0 then flag=movepage(pfbitno+2, myfsys, bitno, fsys); ! test with Pattern2
if flag=0 then flag=movepage(pfbitno+3, myfsys, bitno, fsys); ! test with Pattern3
writeflag=flag
if action&updatebplist#0 start
if readflag=writeflag=0 then bpact=4 {goodpage} else bpact=1 {badpage}
j=badpage(bpact, fsys, bitno); ! success result is 1, fail result is 0
if 0<=j<=1 {success} then setbpflag=0
finish
! Put back the original if we read it off OK.
if flag=0 {write/re-read pattern worked} and readflag=0 then c
flag=movepage(pfbitno+4, myfsys, bitno, fsys)
flag=readflag!writeflag
flag=flag!setbpflag if action&updatebplist#0
RESULT =FLAG
routine setuppatternfile(integer name bitno, myfsys, flag)
! RETURNS THE BITNO OF THE FIRST PAGE OF THE PATTERN FILE, AND ITS FSYS.
integer ad, conad, i
const string (9) opfile="S#PAT"
const string (5) empty="EMPTY"
own integer the bitno=0, my fsys own=100
string (15) file, s
record format daf(integer sectsi, nsects, lastsect, spare, integer array da(0:255))
record (daf) getdarec
flag=0
if the bitno=0 start
! Make a temporary file with a pseudo-unique name and remember the
! disc address of the first page in THE BITNO
s=time
file=opfile.substring(s, 1, 2).substring(s, 4, 5).substring(s, 7, 8)
ad=addr(getdarec)
conad=tpfilead(file, 5); ! 5 pages
if conad=0 then flag=1 and return
! PAGE 0 - IGNORE FIRST PAGE - HAS HEADERS
! PAGE 1 - X'FFFFFFFF'
! PAGE 2 - X'08CEF731'
! PAGE 3 - X'00000000' WRITE IN EMPTY STRING LATER
! PAGE 4 - Copy of original contents, if possible to read the page
cycle i=0, 4, 4092
integer(conad+X'1000'+i)=X'FFFFFFFF'
integer(conad+X'2000'+i)=X'08CEF731'
repeat
cycle i=conad+X'3000', X'400', conad+X'3C00'
string(i)=empty
repeat
disconnect(file)
ddelay(15) {to let the disc transfers complete}
flag=dgetda(uinfs(1), file, uinfi(1), ad)
if flag#0 start
uderrs(flag)
flag=1
return
finish
the bitno=getdarec_da(0)&X'00FFFFFF'
my fsys own=uinfi(1)
finish
bitno=the bitno
myfsys=my fsys own
end ; ! OF SETUPPATTERNFILE
end {testsinglepagefn}
external integer fn testbadpagefn(integer fsys, bitno)
! Result = 0 if page write-tested OK and page BITNO removed from the
! bad pages list (even if original contents not restored).
! Result = 1 if write-test failed (or not performed for any reason)
! page not removed from bad pages list.
integer j, readflag, writeflag, recordflag
printstring("Bad Page No. X"); printstring(htos(bitno, 8))
newline tab
j=testsinglepagefn(readwriterewrite!updatebplist, fsys, bitno, readflag, writeflag, recordflag)
if readflag#0 start
printstring("Take page copy fails for page X".htos(bitno, 5))
write(bitno, 1)
newline tab
finish
if writeflag#0 start
printstring("But re-writing with test patterns was successful")
newline tab
finish
if recordflag=0 {success} start
recordflag=0
printstring("Page X".htos(bitno, 5))
write(bitno, 1)
printstring(" FSYS ")
write(fsys, 1)
printstring(" bit removed from bad pages list")
newline tab
finish
if writeflag#0 start
printstring("But re-writing with test patterns was successful")
newline tab
result =1
finish
result =0
end ; ! OF TESTBADPAGEFN
external routine testbadpages(string (255) s)
integer fsys, n, bitno, flag, pagsfound, pagscleared
integer nfsys, i, j, k, ad
string (15) int
integer array map(0:bad pages pages*page size>>2 {to words})
integer array allfsys(0:99)
s=vsn
length(s)=length(s)-1 while length(s)>1 and charno(s, length(s))#'.'
length(s)=length(s)-1
printstring("TEST BAD PAGES version ".s." at ".time." on ".date)
newlines(2)
printstring("-1 for all FSYS. Int:STOP to terminate early")
newline
ad=addr(map(0))
prompt("FSYS: ")
rdint(fsys)
getavfsys(nfsys, allfsys)
nfsys=nfsys-1
if fsys>=0 then start
j=dsysad(6, ad, fsys)
uderrs(j) and return if j#0
nfsys=0
allfsys(0)=fsys
finish
newline tab
int=""
for i=0, 1, nfsys cycle
pagsfound=0
pagscleared=0
fill(bad pages pages*page size, ad, 0)
j=dsysad(6, ad, allfsys(i))
uderrs(j) and return if j#0
newline
printstring("Fsys"); write(allfsys(i), 1)
newline
for k=0, 1, ((bad pages pages*page size {to bytes})>>2 {to words})-1 cycle
unless map(k)=0 then start
n=map(k)
bitno=k<<5
while n#0 cycle
*lss_n; ! Load N into ACC
*shz_j; ! << until top bit set, no of shifts in J
*and_X'7FFFFFFF'; ! Off top bit for nex cycle
*st_n; ! Store ACC back in N for next cycle
bitno=bitno+j
! *****
pagsfound=pagsfound+1
flag=testbadpagefn(allfsys(i), bitno)
pagscleared=pagscleared+1 if flag=0
int=interrupt
int=ucstring(int)
exit if int="STOP"
repeat
finish
exit if int="STOP"
repeat
newline
write(pagsfound, 1)
printstring(" bad page")
if pagsfound#1 then printstring("s")
printstring(" found on FSYS ")
write(allfsys(i), 1)
newline
printstring("Bad-pages bit cleared for")
write(pagscleared, 1)
printstring(" of them")
newline
if i#nfsys start
printstring("---------------------------------------------------------------------------")
newline
finish
if int="STOP" then exit else start
int=interrupt
int=ucstring(int)
exit if int="STOP"
finish
repeat
printstring("TEST BAD PAGES completed")
newline tab
end ; ! TESTBADPAGES
external routine testsinglepage(string (255) s)
integer fsys, bitno, action, rw, readflag, writeflag, setbpflag, ptype, base
integer j, flag
string (63) wk
prompt("FSYS: ")
rdint(fsys) until fsys>=0
printstring("Do you want to give")
newline
printstring("a disc pageno(1) or")
newline
printstring("an index number(2) ?")
NEWLINE
prompt("1/2:")
rdint(ptype) until 1<=ptype<=2
if ptype=1 then wk="Discpageno:" else start
wk="Indexnumber:"
printstring("Is this a system disc?")
NEWLINE
prompt("Y/N:")
ucstrg(wk) until wk="Y" or wk="N"
if wk="Y" then base=x'800' else base=x'40'
finish
prompt(wk)
rdint(j)
if ptype=1 then bitno=j else bitno=base+j>>2
printstring("Read(1) or Read+rewrite(2)?")
newline
prompt("1/2:")
rdint(rw) until 1<=rw<=2
if rw=2 then action=readwriterewrite else action=0
printstring("Attempt to update badpages list?")
NEWLINE
prompt("Y/N:")
ucstrg(wk) until wk="Y" or wk="N"
if wk="Y" then action=action!updatebplist
flag=testsinglepagefn(action, fsys, bitno, readflag, writeflag, setbpflag)
if flag=255 start
printstring("Request reject")
newline
return
finish
if readflag=0 then printstring("READ performed OK") else printstring("READ failed")
newline
if rw=2 start
if writeflag=0 then printstring("REWRITE performed OK") else printstring("REWRITE failed")
newline
finish
if wk="Y" start
if setbpflag=0 then printstring("UPDATE bplist OK") else c
printstring("UPDATE bplist failed")
newline
finish
end {testsinglepage}
external routine testpagerange(string (255) s)
integer fsys, bitno, action, rw, readflag, writeflag, setbpflag, ptype, base
integer j, flag, lobit, hibit
string (63) wk
prompt("FSYS: ")
rdint(fsys) until fsys>=0
printstring("Do you want to give")
newline
printstring("disc pagenos(1) or")
newline
printstring("index numbers(2) ?")
NEWLINE
prompt("1/2:")
rdint(ptype) until 1<=ptype<=2
if ptype=1 then wk="Discpageno:" else start
wk="Indexnumber:"
printstring("Is this a system disc?")
NEWLINE
prompt("Y/N:")
ucstrg(wk) until wk="Y" or wk="N"
if wk="Y" then base=x'800' else base=x'40'
finish
prompt("Low ".wk)
rdint(j)
if ptype=1 then lobit=j else lobit=base+j>>2
prompt("High ".wk)
rdint(j)
if ptype=1 then hibit=j else hibit=base+j>>2
printstring("Read(1) or Read+rewrite(2)?")
newline
prompt("1/2:")
rdint(rw) until 1<=rw<=2
if rw=2 then action=readwriterewrite else action=0
printstring("Attempt to update badpages list?")
NEWLINE
prompt("Y/N:")
ucstrg(wk) until wk="Y" or wk="N"
if wk="Y" then action=action!updatebplist
for bitno=lobit, 1, hibit cycle
printstring("Disc pageno X".htos(bitno, 5))
write(bitno, 1); printstring("(dec)")
newline
flag=testsinglepagefn(action, fsys, bitno, readflag, writeflag, setbpflag)
if flag=255 start
printstring("Request reject")
newline
return
finish
if readflag=0 then printstring("READ performed OK") else printstring("READ failed")
newline
if rw=2 start
if writeflag=0 then printstring("REWRITE performed OK") else c
printstring("REWRITE failed")
newline
finish
if wk="Y" start
if setbpflag=0 then printstring("UPDATE bplist OK") else c
printstring("UPDATE bplist failed")
newline
finish
repeat
end {tespagerange}
external routine pagenoto indno(string (255) s)
string (63) wk
integer pgno, base, ino
prompt("For system disc(Y/N)?")
ucstrg(wk) until wk="Y" or wk="N"
if wk="Y" then base=x'800' else base=x'40'
prompt("Pageno:")
rdint(pgno)
ino=(pgno-base)<<2
printstring("Disc pagno X".htos(pgno, 5))
write(pgno, 1); printstring("(dec) is index number X".htos(ino, 4))
write(ino, 1); printstring("(dec)")
newline
end {pagenotoindno}
external routine indnotopageno(string (255) s)
string (63) wk
integer pgno, base, ino
prompt("For system disc(Y/N)?")
ucstrg(wk) until wk="Y" or wk="N"
if wk="Y" then base=x'800' else base=x'40'
prompt("Indno:")
rdint(ino)
pgno=ino>>2+base
printstring("Index no X".htos(ino, 4)); write(ino, 1)
printstring("(dec)"); newline
printstring("disc pagno X".htos(pgno, 5))
write(pgno, 1); printstring("(dec)")
newline
end {indnotopageno}
end of file