// BFSTestEx.bcpl -- Exercise command. Derived from TFUExercise.bcpl.
// Copyright Xerox Corporation 1982
// Last modified March 28, 1982 4:05 PM by Boggs
get "AltoFileSys.d"
get "Disks.d"
get "BFS.d"
external
[
// outgoing procedures
Exercise; uBlockCheck
// incoming procedures from OS modules
BFSInit; CloseDisk; OpenFile; DeleteFile
Closes; Resets; Puts; Gets; Endofs
FileLength; PositionPage; PositionPtr
ReadBlock; WriteBlock; BlockCheck; XferError
PutTemplate; Ws; GetNumber; Confirm
Allocate; Free; MoveBlock; SetBlock; Zero
DoubleAdd; CallSwat; Random; EtherRcvr
Idle; MyIdle; Noop
// incoming statics
keys; dsp; sysZone; sysDisk
]
static
[
dataCycle //data pattern generator state
errorStop
errorCount
]
manifest
[
filePages = 101 //length of test files
// file operations
opWrite = 0
opRead = 1
opPosition = 2
opDelete = 3
opCopy = 4
maxOp = 4
]
structure String: [ length byte; char↑1,1 byte ]
//----------------------------------------------------------------------------
let Exercise() be
//----------------------------------------------------------------------------
[
// Ask the user about her intentions
sysDisk = BFSInit(sysZone, true, 0)
if sysDisk eq 0 then
[
Ws("*NCan't init the disk. Is it on? Is it formatted (use ERASE)?")
return
]
let nPasses = GetNumber(". How many passes? ", 10)
Idle = MyIdle
EtherRcvr(true)
// make the test files
Ws("*NCreating files ")
let nFiles = 0
[
nFiles = nFiles +1
CreateOneFile(nFiles)
PutTemplate(dsp, "$D ", nFiles)
] repeatwhile sysDisk>>BFSDSK.freePages ugr filePages+20
for pass = 1 to nPasses do
[
PutTemplate(dsp, "*N*NPass $UD: ", pass)
for file = 1 to nFiles do
[
unless Endofs(keys) do
[
Gets(keys)
Ws("[Command: ")
switchon Gets(keys) into
[
case $Q: case $q:
[ Ws("Quit] "); pass = nPasses; break ]
case $S: case $s:
[ Ws("Stop On Error] "); errorStop = true; endcase ]
default:
[ Ws("? StopOnError or Quit] "); endcase ]
]
]
let op, opName, oFile, s1, s2 = MRandom(maxOp+1), nil, nil, 0, 0
s1 = op eq opDelete? 0, OpenOneFile(file)
switchon op into
[
case opWrite: [ opName = "Write"; docase -1 ]
case opRead: [ opName = "Read"; docase -1 ]
case opCopy:
[
oFile = MRandom(nFiles)+1 repeatwhile oFile eq file
s2 = OpenOneFile(oFile)
opName = "Copy"; docase -1
]
case -1:
[
PutTemplate(dsp, "$S $D ", opName, file)
if op eq opCopy then PutTemplate(dsp, "to $D ", oFile)
TransferData(op, s1, s2)
endcase
]
// Exercise (cont'd)
case opPosition:
[
PutTemplate(dsp, "Position $D ", file)
let npages = GetNPages(s1)
for i = 0 to 20 do
[
let pPage = MRandom(npages) +1
PositionPage(s1, pPage)
let a = Gets(s1)
if a ne pPage then CheckError(lv a, pPage, 0)
PositionPtr(s1, (BFSwordsPerPage-1)*2)
if MRandom(3) then Puts(s1, a)//one third of time cause a write
]
endcase
]
case opDelete:
[
PutTemplate(dsp, "Delete $D ", file)
DeleteOneFile(file); CreateOneFile(file)
endcase
]
]
if s1 then Closes(s1)
if s2 then Closes(s2)
] //file loop
] //pass loop
// now delete all the test files
Ws("*N*NDeleting files ")
for file = 1 to nFiles do
[ DeleteOneFile(file); PutTemplate(dsp, "$D ", file) ]
CloseDisk(sysDisk)
EtherRcvr(false)
Idle = Noop
PutTemplate(dsp, "*NThere were $UD errors.", errorCount)
]
//----------------------------------------------------------------------------
and TransferData(op, s1, s2) be
//----------------------------------------------------------------------------
// Transfer a bunch of data. Go for entire length of s1 file.
[
// Allocate a BIG buffer:
let bufLen = 77777B
let buf = Allocate(sysZone, bufLen, lv bufLen)
if buf eq 0 then buf = Allocate(sysZone, bufLen)
let goodData = 0
if op eq opWrite then
[
dataCycle = (dataCycle+1) & 37B
goodData = 1 lshift (dataCycle & 17B)
if (dataCycle & 20B) ne 0 then goodData = not goodData
]
let fl = vec 1; GetNPages(s1, fl)
// Convert fl from bytes 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 & fl!1 ule bufLen then doCount = fl!1
let written = false
test op eq opWrite
ifso //write s1
[
SprinkleData(buf, doCount, cp, goodData, true)
WriteBlock(s1, buf, doCount)
SprinkleData(buf, doCount, cp, goodData, false)
]
ifnot //read s1, may write s2
[
ReadBlock(s1, buf, doCount)
goodData = SprinkleData(buf, doCount, cp, goodData, false)
if op eq opCopy then //write s2
[
WriteBlock(s2, buf, doCount)
SprinkleData(buf, doCount, cp, goodData, false)
]
]
// double subtract doCount from fl
let donec = vec 1; donec!0 = -1; donec!1 = -doCount;
DoubleAdd(fl, donec)
// double add doCount to cp
donec!0 = 0; donec!1 = doCount
DoubleAdd(cp, donec)
]
Free(sysZone, buf)
]
//----------------------------------------------------------------------------
and SprinkleData(buf, bufLen, cp, goodData, write) = valof
//----------------------------------------------------------------------------
// When known data is written on a file, the first word is the page
// number, then come 254 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!
[
let page = cp!0 lshift 8 + cp!1 rshift 8 +1
let phase = (cp!1) & BFSwordsPerPage-1
// Following 3 in order for microcode
let p, val, nWords = buf-phase, nil, nil
let bufEnd = buf+bufLen
[ //repeatuntil p eq bufEnd
for s = 0 to 2 do if p ne bufEnd then
[
// s=0 => first word of page. Contains page number.
// s=1 => body of page. Contains goodData.
// s=2 => last word of page. Contains page number.
nWords = s eq 1? BFSwordsPerPage-2, 1
if p+nWords ugr buf then
[
if p uls buf then [ nWords = nWords-(buf-p); p = buf ]
if p+nWords ugr bufEnd then nWords = bufEnd-p
val = s eq 1? goodData, page
test write
ifso SetBlock(p, val, nWords)
ifnot
[
let pOffset = 0 //s = 0
if s eq 2 then pOffset = BFSwordsPerPage-1
if s eq 1 then
[
pOffset = 1
// If goodData is zero, we don't know what the pattern
// should be. All patterns have all but one bit on
// or all but one bit off; check that this is so, then
// assume that this must be the pattern.
if goodData eq 0 then
[
let error = true
for i = 0 to 1 do for j = 0 to 15 do
[
let bitV = 1 lshift j
if i ne 0 then bitV = not bitV
if bitV eq p!0 then error = false
]
if error then CheckError(p, 1, pOffset)
goodData = p!0
val = goodData
]
]
// Compare nWords, starting at p, to value val.
// Return 0 if ok, otherwise pointer to first diff.
let ans = BlockCheck(lv p) //only report first diff
if ans ne 0 then CheckError(ans, val, pOffset+ans-p)
]
]
p = p+nWords
]
page = page+1
] repeatuntil p eq bufEnd
resultis goodData
]
//----------------------------------------------------------------------------
and MRandom(modulus) = (Random() & 77777B) rem modulus
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and uBlockCheck(lvP) = (table [ 63400B; 1401B ])(lvP)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and BlockCheck(lvP) = valof
//----------------------------------------------------------------------------
[
let address, value, count = lvP!0, lvP!1, lvP!2
for i = 0 to count-1 if address!i ne value resultis address+i
resultis 0
]
//----------------------------------------------------------------------------
and CheckError(adr, goodVal, blockOffset) be
//----------------------------------------------------------------------------
[
PutTemplate(dsp, "[Data error: $UOb s/b $UOb at $UOb]",
@adr, goodVal, blockOffset)
@adr = goodVal
FinishError()
]
//----------------------------------------------------------------------------
and GetNPages(s, fl; numargs na) = valof
//----------------------------------------------------------------------------
// Puts s1's length in bytes in fl!0 and fl!1.
// Returns s1's length in pages.
[
let tfl = vec 1
if na eq 1 then fl = tfl
FileLength(s, fl)
Resets(s)
let npages = fl!0 lshift 7 + fl!1 rshift 9 //512 bytes per page
if npages ne filePages-1 then
[
Ws("[File length error]")
FinishError()
]
resultis npages
]
//----------------------------------------------------------------------------
and FinishError() be
//----------------------------------------------------------------------------
[
if errorStop then [ Ws(" Type any character to proceed "); Gets(keys) ]
errorCount = errorCount +1
]
//----------------------------------------------------------------------------
and OpenOneFile(i) = valof
//----------------------------------------------------------------------------
[
let fn = vec 10; MakeFn(i, fn)
resultis OpenFile(fn, 0, 0, 0, 0, ExSysErr)
]
//----------------------------------------------------------------------------
and CreateOneFile(i) be
//----------------------------------------------------------------------------
[
let s = OpenOneFile(i)
PositionPage(s, filePages)
TransferData(opWrite, s)
Closes(s)
]
//----------------------------------------------------------------------------
and DeleteOneFile(i) be
//----------------------------------------------------------------------------
[
let fn = vec 10; MakeFn(i, fn)
DeleteFile(fn, 0, ExSysErr)
]
//----------------------------------------------------------------------------
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 ExSysErr(nil, code, cb) be
//----------------------------------------------------------------------------
[
test code eq ecUnRecovDiskError
ifso XferError(nil, cb, nil)
ifnot PutTemplate(dsp, "[SysErr code $UD]", code)
FinishError()
]