// BFSBase.Bcpl - Alto Basic File System
// Copyright Xerox Corporation 1979, 1981, 1982
// Last modified March 28, 1982  4:47 PM by Boggs

// N O T E  The whole disk object depends on errors of any kind stopping
// subsequent transfers.  For example, WriteBlock will in general write
// a page from the stream buffer, write a few pages from core, and READ
// the last page into the stream buffer.  If the disk is allowed to continue
// down its chain, even though an error occurred on the first (write of
// stream buffer), the stream buffer will become clobbered with bad data
// from the last page.  Retrying will write bad data into the first page!

get "AltoFileSys.d"	// Definitions for structures in the file system
get "AltoDefs.d"	// Definitions of Alto-specific places and things
get "Disks.d"		// Definitions for the disk object
get "Bfs.d"		// Definitions for the Diablo 31/44 disk

external
[
// outgoing procedures
BfsInitializeCbStorage; BfsDoDiskCommand; BfsGetCb
BFSActOnPages; BFSVirtualDA; BFSRealDA
DefaultBfsErrorRtn; BFSNonEx; BfsMakeFpFromLabel

// incoming procedures
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
RealDiskDA; VirtualDiskDA
Zero; MoveBlock; Usc; Idle; ReturnTo; Noop
DefaultArgs; SysErr

// incoming statics from BFSML
oneBits; freePageId
]

manifest BFSrestore = 525b

compileif newname debug then [ manifest [ debug = false ] ]

//"Bcpl/f BfsBase.bcpl debug/M"  Compiles code to:
// Call BFSEvent(cb) each time a cb is cleaned up.
//  Sends a Pup Event Report on cb.
//  See BFSEvent.bcpl for details.
// If RandomNumber & 77b ls BFSErrorRate then fake an error in cb
//  0 => no errors
//  40b => 50% of KCBs end with an error
//  100b => solid errors

compileif debug then
[
external [ BFSEvent ]
static [ BFSErrorRate ]
]

//----------------------------------------------------------------------------
let BFSVirtualDA(disk, lvRealDA) = valof
//----------------------------------------------------------------------------
[
let realDA = @lvRealDA
if realDA eq 0 then resultis eofDA
resultis (((((realDA<<DA.disk * disk>>BFSDSK.nTracks) + realDA<<DA.track) *
 disk>>BFSDSK.nHeads) + realDA<<DA.head) *
 disk>>BFSDSK.nSectors) + realDA<<DA.sector
]

//----------------------------------------------------------------------------
and BFSRealDA(disk, virtualDA, lvRealDA) = valof
//----------------------------------------------------------------------------
[
// Div(x) returns virtualDA/x and leaves the remainder in virtualDA
let Div = table
   [
    55001b	// sta 3 savedPC,2
    25005b	// lda 1 secondArg,2
   155000b	// mov 2 3
   111000b	// mov 0 2
   102460b	// mkzero 0 0
    61021b	// div
    77400b	//  swat
   171000b	// mov 3 2
    45005b	// sta 1 secondArg,2
    35001b	// lda 3 savedPC,2
     1401b	// jmp 1,3
   ]

lvRealDA!0 = 0
if virtualDA ne eofDA then
   [
   lvRealDA>>DA.sector = Div(disk>>BFSDSK.nSectors)
   lvRealDA>>DA.head = Div(disk>>BFSDSK.nHeads)
   lvRealDA>>DA.track = Div(disk>>BFSDSK.nTracks)
   lvRealDA>>DA.disk = virtualDA
   ]

// Return true if disk address appears legal.
resultis Usc(virtualDA, disk>>BFSDSK.nDisks) ls 0
]

//----------------------------------------------------------------------------
and BFSNonEx(disk) be SysErr(disk, ecNoCreationAbility)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and DefaultBfsErrorRtn(addr, cb, errNo) be SysErr(0, errNo, cb)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and BfsInitializeCbStorage(disk, cbz, firstPage, length, retry, errorRtn;
     numargs na) be
//----------------------------------------------------------------------------
// Init the cbz such that subsequently it can be used for BFS transfers
[
if na ge 4 then
   [
   Zero(cbz, length)
   cbz>>CBZ.length = length
   cbz>>CBZ.errorRtn = na ge 6 & errorRtn? errorRtn, lv DefaultBfsErrorRtn
   cbz>>CBZ.retry = retry
   cbz>>CBZ.cleanupRoutine = Noop
   ]
cbz>>CBZ.disk = disk
cbz>>CBZ.currentPage = firstPage
cbz>>CBZ.queueHead = lv cbz>>CBZ.head	// for backward compatibility
let cb = lv cbz>>BFSCBZ.CBs
cbz>>CBZ.head = cb
   [
   cbz>>CBZ.tail = cb
   cb>>CB.cbz = cbz
   cb>>CB.status = DSTfreeStatus
   cb = cb+lCB
   if cb+lCB gr cbz+cbz>>CBZ.length then cb = 0
   cbz>>CBZ.tail>>CB.nextCB = cb
   ] repeatuntil cb eq 0
]

//---------------------------------------------------------------------------
and BfsDoDiskCommand(disk, cb, CA, DA, fp, pageNumber, action,
    nextCb; numargs na) be
//---------------------------------------------------------------------------
// Expects command and label to both be zeroed on entry, or
//  otherwise appropriately initialized
[
let cbz = cb>>CB.cbz

// Setup header, label, and data block addresses
cb>>CB.headerAddress = lv cb>>CB.header
let la = cb>>CB.labelAddress
if la eq 0 then
   [
   la = na ge 8 & nextCb? lv nextCb>>CB.diskAddress, lv cb>>CB.label
   cb>>CB.labelAddress = la
   ]
cb>>CB.dataAddress = CA

//* Nobody uses interrupts, and it's unlikely that this would work if
//* anyone tried to.
//* if cb>>CB.normalWakeups eq 0 then
//*    cb>>CB.normalWakeups = cbz>>CBZ.normalWakeups
//* if cb>>CB.errorWakeups eq 0 then
//*    cb>>CB.errorWakeups = cbz>>CBZ.errorWakeups

// Setup for label compare
la>>DL.fileId.serialNumber.word1 = fp>>FP.serialNumber.word1
la>>DL.fileId.serialNumber.word2 = fp>>FP.serialNumber.word2
la>>DL.fileId.version = fp>>FP.version
la>>DL.pageNumber = pageNumber
cb>>CB.truePageNumber = pageNumber

// Possibly put in the disk address for this command.
// DA eq fillInDA means it is already set up, or will be filled
//  in from the previous label transfer.
if DA ne fillInDA then RealDiskDA(disk, DA, lv cb>>CB.diskAddress)

// fill in command, checking for illegal actions
let act = action - diskMagic
if Usc(act, 6) gr 0 then
   test action eq BFSrestore
      ifso
         [
         cb>>CB.diskAddress.restore = 1
         cb>>CB.diskAddress.track = 0
         act = DCseekOnly-diskMagic
         ]
      ifnot SysErr(action, ecBadAction)
cb>>CB.command = (table
   [ readHLD; readLD; readD; writeHLD; writeLD; writeD; seekOnly ])!act

cb>>CB.command.exchangeDisks = (disk>>DSK.driveNumber) // <<DriveNumber.drive
cb>>CB.command.partition = (disk>>DSK.driveNumber)<<DriveNumber.partition

// BfsDoDiskCommand (cont'd)

// Enqueue the KCB on the disk command chain
//* DisableInterrupts()
let p = @diskCommand
if p ne 0 then
   [
      [
      let np = p>>CB.link
      if np eq 0 break
      p = np
      ] repeat
   p>>CB.link = cb
   ]

// If there are no disk commands queued at the moment, be very careful
// about plopping down a pointer to our cb.  We must be sure that the
// previous cb for this zone has NOT encountered an error (it's OK
// if it is free or has been transferred already, but not OK if there
// is an error or if it has not been transferred at all)
if @diskCommand eq 0 then
   [
   // take from head, add to tail => tail newest
   let prevCb = cbz>>CBZ.head? cbz>>CBZ.tail, 0
   let stat = prevCb>>CB.status & DSTgoodStatusMask
   if prevCb eq 0 % (stat ne 0 & (stat & DSTerrorBits) eq 0) then
      @diskCommand = cb
   ]
//* EnableInterrupts()

// Put this CB on the tail of the available queue
cb>>CB.nextCB = 0
test cbz>>CBZ.head eq 0
   ifso cbz>>CBZ.head = cb
   ifnot cbz>>CBZ.tail>>CB.nextCB = cb
cbz>>CBZ.tail = cb
]

//---------------------------------------------------------------------------
and BfsMakeFpFromLabel(fp, la) be
//---------------------------------------------------------------------------
[
fp>>FP.serialNumber.word1 = la>>DL.fileId.serialNumber.word1
fp>>FP.serialNumber.word2 = la>>DL.fileId.serialNumber.word2
fp>>FP.version = la>>DL.fileId.version
]

//---------------------------------------------------------------------------
and BfsGetCb(disk, cbz, dontClear, returnIfNoCB; numargs na) = valof
//---------------------------------------------------------------------------
// Here we wait for a transfer to complete.  If, for some reason, 521
// (diskCommand) has been zeroed, which means that disk has
// gone idle without executing this command, we fake an error
// in this command in order to get the rest of this (BfsGetCb) code
// executed.  The zone will be rebuilt, and the transfer re-queued.
// This means that several callers of the Bfs active at once
// (i.e., disk commands from several zones are queued) should all
// work: if no errors happen during transfer, everything is fine.  If
// errors occur in one zone, all will stop.  Then, as the control
// blocks become "cleaned up," we will eventually find, in each
// zone, one that was not executed (and with the disk idle).  So the
// mechanism for "faking" an error (DSTfakeError) will cause
// the proper transfers to be re-queued.
[
// Find the next CB
let cb = cbz>>CBZ.head
if cb eq 0 test na ge 4 & returnIfNoCB
   ifso resultis 0
   ifnot SysErr(cbz, ecBfsQueue)

// Here is where we wait for completion
   [
   if (cb>>CB.status & DSTdoneBits) ne 0 break
   test @diskCommand eq 0 & (cb>>CB.status & DSTdoneBits) eq 0
      ifso cb>>CB.status = DSTfakeError
      ifnot if na ge 4 & returnIfNoCB resultis 0
   Idle()  //Let someone else in
   ] repeat

// Dequeue it
cbz>>CBZ.head = cb>>CB.nextCB

// Remove seal
cb>>CB.command.shortSeal = 0

// This block returns true iff the cb corresponds to a completed transfer.
if valof
   [
   // There are various ways that cb can be found usable:
   let s = cb>>CB.status & DSTgoodStatusMask
   if s eq DSTfreeStatus resultis false

   compileif debug then
      [
      BFSEvent(cb)
      if BFSErrorRate ne 0 then
         [              //  rclk; mov 1 0; jmp 1,3
         let r = (table [ 61003b; 121000b; 1401b ])()
         r = r rshift ((table [ 61014b; 1401b ])()<<VERS.eng gr 1? 2, 6)
         if (r & 77b) ls BFSErrorRate then s = 0
         ]
      ]

   // Restore commands can only be initiated from within BfsGetCb,
   //  so this is our command, not the client's.  Treat cb as free.
   if cb>>CB.diskAddress.restore eq 1 resultis false

   if s eq DSTgoodStatus resultis true

// BfsGetCb (cont'd)

   // Error.  Wait for the disk to stop spinning before starting recovery.
   until @diskCommand eq 0 do Idle()

   // Alto IIs get lots of data late errors.  McCreight & Boggs
   //  conjecture that there is a missing TASK in the microcode somewhere.
   // A small piece of hardware and a logic analyzer are needed to find it.
   // In the mean time, we will just retry data lates forever...
   let ec = cbz>>BFSCBZ.bfsErrorCount
   if cb>>CB.status.dataLate eq 0 then cbz>>BFSCBZ.bfsErrorCount = ec +1
   if cbz>>BFSCBZ.bfsErrorCount ge disk>>DSK.retryCount then
      [
      let errorRtn = cbz>>CBZ.errorRtn
      (@errorRtn)(errorRtn, cb, ecUnRecovDiskError)
      resultis true  //If errorRtn returns, act like command completed OK
      ]

   cbz>>CBZ.errorDA = VirtualDiskDA(disk, lv cb>>CB.diskAddress)
   if cb>>CB.status.finalStatus eq checkError then
      cbz>>BFSCBZ.sawCheckError = true

   // Now rebuild the cbz:
   InitializeDiskCBZ(disk, cbz, cb>>CB.truePageNumber)

   // If the error count is large enough, initiate a restore.
   // Note that the command is issued, but we do not wait to
   //  be sure that it completes.
   if ec gr (disk>>DSK.retryCount rshift 1) then
      [
      @diskAddress = -1
      DoDiskCommand(disk, GetDiskCb(disk, cbz), 0, cbz>>CBZ.errorDA, 0,
       cbz>>CBZ.currentPage, BFSrestore)
      ]
   ReturnTo(cbz>>CBZ.retry)
   ] then
   [
   // cb was for a successfully completed transfer.
   // Move some useful stuff from label to cbz, then call cleanup routine.
   cbz>>CBZ.currentNumChars = cb>>CB.labelAddress>>DL.numChars
   cbz>>CBZ.nextDA = VirtualDiskDA(disk, lv cb>>CB.labelAddress>>DL.next)
   cbz>>CBZ.errorCount = 0  //also clears BFSCBZ.sawCheckError
   cbz>>CBZ.cleanupRoutine(disk, cb, cbz)
   ]
unless na ge 3 & dontClear do Zero(cb, lVarCB)
resultis cb
]

//---------------------------------------------------------------------------
and BFSActOnPages(disk, CAs, DAs, fp, firstPage, lastPage, action,
  lvNumChars, lastAction, fixedCA, cleanupRoutine, errorRtn,
  returnOnCheckError, hintLastPage; numargs na) = valof
//---------------------------------------------------------------------------
// Returns the page number of the last page successfully acted on.
// CAs (core addresses) and DAs (disk addresses) are vectors
//  indexed by page number (e.g. CAs!firstPage).
// The arguments following action are optional; if one of them is
//  omitted or 0, the default action is taken.
// If returnOnCheckError is true, ActOnPages returns minus (the number of
//  the last page successfully read + 100b) as soon as the disk reports a
//  check error.
[
DefaultArgs(lv na, -7, lv na, action, 0, BfsDefaultCleanupRtn,
 0, false, lastPage)

// Initialize for transfers
let result = nil
let cbz = vec CBzoneLength
InitializeDiskCBZ(disk, cbz, firstPage, CBzoneLength, Aretry, errorRtn)
cbz>>CBZ.DAs = DAs
cbz>>CBZ.cleanupRoutine = cleanupRoutine
if Usc(hintLastPage-firstPage, lastPage-firstPage) gr 0 then
   hintLastPage = lastPage  // hintLastPage not in [firstPage..lastPage]

// Each cb is used twice:
//	to hold the DL for page i-1 (if chaining), and
//	to hold the KCB for page i.
// It isn't reused until the command for page i is done, and that is
// guaranteed to be after the DL for page i-1 is no longer needed,
// since everything is done strictly sequentially by page number.

// Inside this loop, there may be disk commands pending
// (i.e. pointed to by diskCommand).  BfsDoDiskCommand 
// initiates them (also BfsGetCb may initiate a restore).  Hence
// do not simply "return" from inside the loop unless you are
// absolutely sure that no disk activity is queued.

// Note: if the hintLastPage looks reasonable and is less than lastPage,
// we transfer pages up to that point, then check to see whether the last
// page transferred really was the last page of the file.  If so, we return
// without having caused the disk to seek to cylinder 0 as a result of
// chaining forward from the last page.  If the hint was wrong, we have to
// queue up the remainder of the transfers; this costs an extra disk rotation.

// BFSActOnPages (cont'd)

Aretry:	//GetDiskCb does a non-local GOTO here when an error happens
   [
   // Get a first CB
   result = hintLastPage
   let cb = GetDiskCb(disk, cbz)
   for pageNumber = cbz>>CBZ.currentPage to hintLastPage do
      [
      if DAs!pageNumber eq eofDA then  // Last page has been fixed up
         [ result = pageNumber-1; break ]

      let thisCBaction = pageNumber eq lastPage? lastAction, action
      if thisCBaction eq DCdoNothing loop

      // Following return guarantees no disk activity, because we just
      //  returned from an error that will not yet have done a restore.
      if returnOnCheckError & cbz>>BFSCBZ.sawCheckError &
       (cbz>>BFSCBZ.bfsErrorCount ge disk>>DSK.retryCount rshift 1) then
         resultis -(pageNumber+77B)

      // If we are chaining, cause this command to fill in
      //  the disk address part of the next command.
      let nextCb = GetDiskCb(disk, cbz)
      cb>>CB.labelAddress = DAs!(pageNumber+1) eq fillInDA?
       lv nextCb>>CB.diskAddress, lv nextCb>>CB.label
      DoDiskCommand(disk, cb, (fixedCA ne 0? fixedCA, CAs!pageNumber),
       DAs!pageNumber, fp, pageNumber, thisCBaction)
      cb = nextCb
      ]
   while cbz>>CBZ.head ne 0 do GetDiskCb(disk, cbz)
   if result eq lastPage % DAs!(result+1) eq eofDA then break

   // Stopped before lastPage because hintLastPage was less than lastPage,
   // but the hint was wrong.  Ignore the hint and resume the transfer.
   hintLastPage = lastPage
   InitializeDiskCBZ(disk, cbz, result+1)
   ] repeat

@lvNumChars = cbz>>CBZ.currentNumChars
resultis result
]

//---------------------------------------------------------------------------
and BfsDefaultCleanupRtn(disk, cb, cbz) be
//---------------------------------------------------------------------------
// The default cleanupRoutine substitutes the actual virtual DA
//  for each instance of fillInDA in the DAs vector.
[
let lvDA = lv ((cbz>>CBZ.DAs)!(cb>>CB.truePageNumber))
if lvDA!1 eq fillInDA then lvDA!1 = cbz>>CBZ.nextDA
if lvDA!-1 eq fillInDA then
   lvDA!-1 = VirtualDiskDA(disk, lv cb>>CB.labelAddress>>DL.previous)
]