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