// 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)&#37
   goodData=1 lshift (dataCycle&#17)
   if (dataCycle&#20) 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