// TfuExercise.bcpl
// For exercising Trident disk file system -- this is useful because
// it runs the drives in ways that Triex cannot
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified May 1, 1981 6:10 PM by Taft
get "AltoFileSys.d"
get "Disks.d"
get "Tfs.d"
get "Streams.d"
//outgoing procedure
external Exercise
//incoming procedures
external
[
//TFU utils
PrintEther
//TFS
TFSInit
TFSClose
//Random
Random
//Template
PutTemplate
//OS
OpenFile
Closes
DeleteFile
Resets
FileLength
PositionPage
PositionPtr
ReadBlock
WriteBlock
Puts
Gets
Endofs
Ws;Wns;Wss;Wos
MoveBlock
SetBlock
Zero
Usc
DoubleAdd
CallSwat; SysErr
// incoming statics
z //Zone for all the work...
dMachine
dsp
keys
]
// internal statics
static
[
dataCycle //Tells what kind of data to write
checkIt //non-zero=>write consistent data
//=2, check data when reading as well
exerciseErrorStop
exerciseErrorCount
]
manifest nDrives = 8
manifest nDisks = 3*nDrives
//----------------------------------------------------------------------------
let Exercise(nPasses, driveVec, check) = valof
//----------------------------------------------------------------------------
[
checkIt=check
let mpDiskCount = vec nDisks; Zero(mpDiskCount, nDisks)
// make the files to use for testing
for i = 0 to nDrives-1 do if driveVec!i then
[
mpDiskCount!i = MakeExerciseFiles(i)
if mpDiskCount!i ne 0 then
[
mpDiskCount!(nDrives+i) = MakeExerciseFiles(#400+i)
mpDiskCount!(2*nDrives+i) = MakeExerciseFiles(#1000+i)
]
]
// now make the test:
for pass=1 to nPasses do for d=0 to nDisks-1 do if mpDiskCount!d then
[Drive
let mainDrive = MapDrive(d)
let mainDisk=GetDisk(mainDrive)
PutTemplate(dsp, "*nDrive $O, pass $D:", mainDrive, pass)
if mainDisk eq 0 then CallSwat("Cannot it known disk -- a")
for mainFile=1 to mpDiskCount!d do
[
if PokeUser(pass) then [ d=nDisks; pass=nPasses; break ]
// do something to mainFile on mainDisk
let what=GRan(2)
test what eq 0 then what=4 or what=GRan(4)
PutTemplate(dsp, " $C$D", table [ $W; $R; $P; $D; $C ] ! what, mainFile)
switchon what into
[
case 0: case 1: case 2:
FileOp(what, mainFile, mainDisk)
endcase
case 3: DeleteOneFile(mainFile, mainDisk)
MakeOneFile(mainFile, mainDisk)
endcase
case 4:
[
// copy from some other file. One third the time, on another drive
let w=GRan(2)
let od=d
if w eq 0 then
[
od=GRan(nDisks) repeatuntil mpDiskCount!od ne 0
]
let odisk=mainDisk
let oDrive = MapDrive(od)
let oFile = GRan(mpDiskCount!od)+1
PutTemplate(dsp, "←$D", oFile)
if oDrive ne mainDrive then
[
PutTemplate(dsp, "[$O]", oDrive)
odisk=GetDisk(oDrive)
if odisk eq 0 then CallSwat("Cannot init known disk -- b")
]
FileOp(10, mainFile, mainDisk, oFile, odisk)
if odisk ne mainDisk then TFSClose(odisk)
endcase
]
]
PrintEther(dsp)
]
TFSClose(mainDisk)
]Drive
// now delete all the test files
for i=0 to nDisks-1 do if mpDiskCount!i ne 0 then
DeleteExerciseFiles(MapDrive(i), mpDiskCount!i)
PutTemplate(dsp, "*nThere were $D errors.*n", exerciseErrorCount)
]
//----------------------------------------------------------------------------
and FileOp(op, f1, disk1, f2, disk2) be
//----------------------------------------------------------------------------
[
let fn=vec 10
MakeFn(f1, fn)
let s1=OpenFile(fn, 0, 0,0,0,ExerciseError,z,0,disk1)
let s2=0
if op ge 10 then
[
MakeFn(f2, fn)
s2=OpenFile(fn, 0, 0,0,0,ExerciseError,z,0,disk2)
]
switchon op into
[
case 0: //Write stuff into the file
case 1: //Read entire file
case 10: //Copy from f1 to f2
[
TransferData(op, s1, s2)
endcase
]
case 2: //Do some page positioning
[
let fl=vec 1
let npages=GetNPages(s1)
for i=0 to 20 do
[
let pPage=GRan(npages)+1
PositionPage(s1, pPage)
let a=Gets(s1)
if checkIt eq 2 & a ne pPage then CheckError(lv a, pPage, 0)
PositionPtr(s1, 1023*2)
if GRan(2) then Puts(s1, a) //To cause a write
]
endcase
]
]
Closes(s1)
if s2 then Closes(s2)
]
// Transfer a bunch of data. Go for entire length of s1 (file).
// Op=0 (write), 1 (read), 10 (copy s1 to s2).
// If checking, read and copy will compare data.
// If checking, write guarantees constant data for file.
//----------------------------------------------------------------------------
and TransferData(op, s1, s2) be
//----------------------------------------------------------------------------
[
let buf=@#335
let bos=lv buf - 3000
@#335=bos
let buflen=bos-10-buf
let goodData=0
if op eq 0 & checkIt ne 0 then
[
dataCycle=(dataCycle+1)%
goodData=1 lshift (dataCycle)
if (dataCycle) ne 0 then goodData=not goodData
]
let fl=vec 1
GetNPages(s1, fl)
// Convert fl to words--will count remaining words to do
fl!1=((fl!1 rshift 1)+(fl!0 lshift 15)); fl!0=(fl!0 rshift 1)
let cp=vec 1
Zero(cp, 2)
while fl!0 ne 0 % fl!1 ne 0 do
[
let docount=buflen
if fl!0 eq 0 & Usc(fl!1, buflen) le 0 then docount=fl!1
let written=false
test op eq 0
ifso
[
if checkIt ne 0 then SprinkleData(buf, docount, cp, goodData, true)
WriteBlock(s1, buf, docount)
written=true
]
ifnot
[
ReadBlock(s1, buf, docount)
if checkIt eq 2 then goodData=SprinkleData(buf, docount, cp, goodData, false)
if op eq 10 then
[
WriteBlock(s2, buf, docount)
written=true
]
]
//Check to be sure no one clobbered data while it was being
// written!
if written ne 0 & checkIt eq 2 then
SprinkleData(buf, docount, cp, goodData, false)
let donec=vec 1; donec!0=-1; donec!1=-docount;
DoubleAdd(fl, donec)
donec!0=0; donec!1=docount
DoubleAdd(cp, donec)
]
@#335=buf
]
// When known data is written on a file, the first word is the page
// number, then come 1022 words of constant data, and then the
// page number again. But because the buffer in core is not
// aligned on page boundaries, the setting and checking of it
// is a bit messy!
//----------------------------------------------------------------------------
and SprinkleData(buf, buflen, cp, goodData, write) = valof
//----------------------------------------------------------------------------
[
// Following 3 in order for TFU microcode
let p=nil
let val=nil
let nWords=nil
let page=(cp!0 lshift 6)+(cp!1 rshift 10)+1
let phase=(cp!1) & #1777
p=buf-phase
let bufend=buf+buflen
[ // repeat
for s=0 to 2 do if p ne bufend then
[
nWords=(s eq 1)? 1022, 1
if Usc(p+nWords, buf) gr 0 then
[
if Usc(p, buf) ls 0 then [ nWords=nWords-(buf-p); p=buf ]
if Usc(p+nWords, bufend) gr 0 then nWords=bufend-p
val=(s eq 1)? goodData, page
test write then SetBlock(p, val, nWords) or
[
let pOffset=0
if s eq 2 then pOffset=1023
if s eq 1 then
[
// I wish to hell I understood what this does --EAT
pOffset=1
let error=true
for i=0 to 1 do
for j=0 to 15 do
[
let bitv=(1 lshift j)
if i then bitv=not bitv
if bitv eq p!0 then error=false
]
if error then CheckError(p, 1, pOffset)
if goodData eq 0 then [ goodData=p!0; val=goodData ]
]
[ // repeat
// Compare nWords, starting at p, to value val.
// Return ans=0 if ok, otherwise pointer to bad spot.
let ans=Compare(lv p)
if ans ne 0 then [ CheckError(ans, val, pOffset+ans-p); loop ]
break
] repeat
]
]
p=p+nWords
]
page=page+1
] repeatuntil p eq bufend
resultis goodData
]
//----------------------------------------------------------------------------
and Compare(p) = valof
//----------------------------------------------------------------------------
// p!0 is starting address, p!1 value to compare with, p!2 count.
// Returns 0 if ok; otherwise address of first bad word.
[
Compare = dMachine?
table
[ // If D-machine, must do compare in software
#55001 // sta 3 1 2
#115000 // mov 0 3
#25401 // lda 1 1 3
#21402 // lda 0 2 3
#41002 // sta 0 2 2
#35400 // lda 3 0 3
#21400 //loop: lda 0 0 3
#106414 // sub# 0 1 szr
#405 // jmp err
#175400 // inc 3 3
#15002 // dsz 2 2
#773 // jmp loop
#102401 // sub 0 0 skp
#161000 //err: mov 3 0
#35001 // lda 3 1 2
#1401 // jmp 1 3
],
table
[ // If Alto, call microcode compare subroutine
#24403 // lda 1 .+3
#61010 // jmpram
#1401 // jmp 1 3
#23
]
resultis Compare(p)
]
//----------------------------------------------------------------------------
and CheckError(adr, goodVal, blockOffset) be
//----------------------------------------------------------------------------
[
let badVal=@adr
PutTemplate(dsp, "[Data check error: $UO s/b $UO at $UO]",
badVal, goodVal, blockOffset)
ExerciseError(nil, 0)
@adr=goodVal
]
//----------------------------------------------------------------------------
and ExerciseError(s, code, cb) be
//----------------------------------------------------------------------------
[
if code ne 0 then
[
test code eq ecUnRecovDiskError
ifso
[
PutTemplate(dsp, "[Disk error: $D, KCB=", code)
for i = 0 to lKCB-1 do
PutTemplate(dsp, " $UO", (lv cb>>CB.diskAddress)!i)
Wss(dsp,"]")
]
ifnot
[ SysErr(s, code, cb); return ]
]
if exerciseErrorStop then Gets(keys)
exerciseErrorCount=exerciseErrorCount+1
]
// Make "test.001" etc, and return # of files made...
//----------------------------------------------------------------------------
and MakeExerciseFiles(drive) =valof
//----------------------------------------------------------------------------
[
let disk=GetDisk(drive)
if disk eq 0 then resultis 0
PutTemplate(dsp, "*nMaking files on drive $O", drive)
let fnumber=0
[
let kd=disk>>DSK.diskKd
let fp=kd>>KDH.freePages //See how many pages left
if PokeUser(fnumber) ne 0 % Usc(fp, 450) le 0 then break
fnumber=fnumber+1
MakeOneFile(fnumber, disk)
TFSClose(disk) //Force bit table out
disk=GetDisk(drive)
if disk eq 0 then CallSwat("Cannot init known disk -- c")
Wss(dsp, "."); PrintEther(dsp)
] repeat
TFSClose(disk)
resultis fnumber
]
//----------------------------------------------------------------------------
and DeleteExerciseFiles(drive, n) be
//----------------------------------------------------------------------------
[
let disk=GetDisk(drive)
if disk eq 0 then return
PutTemplate(dsp, "*nDeleting files on drive $O", drive)
for i=1 to n do
[
DeleteOneFile(i, disk)
Wss(dsp, "."); PrintEther(dsp)
]
TFSClose(disk)
]
//----------------------------------------------------------------------------
and MakeOneFile(i, disk) be
//----------------------------------------------------------------------------
[
let fn=vec 10
MakeFn(i, fn)
let s=OpenFile(fn, 0, 0,0,0,ExerciseError,z,0,disk)
PositionPage(s, 430)
if checkIt then TransferData(0, s)
Closes(s)
]
//----------------------------------------------------------------------------
and DeleteOneFile(i, disk) be
//----------------------------------------------------------------------------
[
let fn=vec 10
MakeFn(i, fn)
DeleteFile(fn, 0,ExerciseError,z,0,disk)
]
//----------------------------------------------------------------------------
and MakeFn(i, fn) be
//----------------------------------------------------------------------------
[
MoveBlock(fn, "test.xxx", 5)
let div=100
for j=6 to 8 do
[
fn>>STRING.char↑j=$0+(i/div)
i=i rem div
div=div/10
]
]
//----------------------------------------------------------------------------
and GetNPages(s1, fl; numargs na) = valof
//----------------------------------------------------------------------------
[
let tfl=vec 1
if na eq 1 then fl=tfl
FileLength(s1, fl); Resets(s1)
let npages= (fl!0 lshift 5)+(fl!1 rshift 11) //2048 bytes per page
if npages ne 429 then ExerciseError(nil, 1)
resultis npages
]
//----------------------------------------------------------------------------
and GetDisk(drive) = TFSInit(z, true, drive)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and GRan(modulus) = (Random() rshift 1) rem modulus
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and MapDrive(n) = #400*(n/nDrives) + n rem nDrives
//----------------------------------------------------------------------------
// See if operator wants to stop things
//----------------------------------------------------------------------------
and PokeUser(pass) = valof
//----------------------------------------------------------------------------
[
unless Endofs(keys) then
[
Gets(keys)
PutTemplate(dsp, "[Pass $D; command:", pass)
let c=Gets(keys)
if c ge $a & c le $z then c=c-$a+$A
Puts(dsp, c); Wss(dsp,"]")
switchon c into
[
case $Q: resultis true
case $S: exerciseErrorStop = true; endcase
default: Puts(dsp, $?)
]
]
resultis false
]
// Debugging aid for finding infrequent errors in TFSTryDisk.
// Repeatedly calls and checks answer until mouse button pushed.
//----------------------------------------------------------------------------
and RTD(drive, answer) = valof
//----------------------------------------------------------------------------
[
external [ TFSTryDisk ]
let a=TFSTryDisk(drive)
if a ne answer then resultis a
] repeatuntil (@#177030&7) ne 7 //Mouse key pushed