// 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()
]