-- File: DiskDriver.mesa
-- Last edited by Levin: 13-May-81 9:33:28
DIRECTORY
DiskIODefs USING [
eofvDA, NormalCompletionProcedure, vDA, vDH, vDL, VerboseCompletionProcedure],
DiskIOPrivate USING [
CB, CBPtr, CBQueueTail, DA, DC, DCs, DCunseal, DISK, diskInterruptLevel, DL, DS,
DSdone, DSfakeStatus, DSgoodStatus, DSmaskStatus, InvalidDA, loggingEnabled, MaskDS,
RequestID, TransformStatus, WriteErrorToLog],
Inline USING [BITSHIFT],
MiscDefs USING [Zero],
ProcessDefs USING [
DefaultPriority, Detach, DisableInterrupts, EnableInterrupts, Priority],
ProcessOps USING [ISetPriority];
DiskDriver: MONITOR
IMPORTS DiskIOPrivate, Inline, MiscDefs, ProcessDefs, ProcessOps
EXPORTS DiskIOPrivate =
BEGIN OPEN DiskIOPrivate;
-- Global (Monitored) Variables --
-- Note: In principle, there are three separate monitors here, but it is
-- too much of a nuisance to make three separate modules for them. Accordingly,
-- they all share the same monitor lock, at some (minute) decrease in potential
-- parallelism.
freeHead: CBPtr; -- singly-linked, LIFO queue
cbAvailable: CONDITION;
busyTail, completedTail: CBPtr; -- circular, singly-linked, FIFO queues; points to end
diskInterruptCV, longTermWait: CONDITION;
interruptHandlerToDie: BOOLEAN;
completionsExist: CONDITION;
completerToDie: BOOLEAN;
-- Global (Unmonitored) Variables --
sysDisk: PUBLIC DISK;
-- Miscellaneous Declarations --
controllersPointer: POINTER TO CBPtr = LOOPHOLE[521B];
lastDA: POINTER TO DA = LOOPHOLE[523B];
nil: CBPtr = LOOPHOLE[0]; -- controller's representation of end-of-list
diskProcessPriority: ProcessDefs.Priority = 2;
diskInterruptBit: WORD = Inline.BITSHIFT[1, diskInterruptLevel];
maxErrors: CARDINAL = 10 + 5; -- 5 is for restores; see RetryFailingCB
CompleterDone: ERROR = CODE;
totalErrors: CARDINAL; -- statistics only
-- Externally Visible Procedures --
-- Free Queue Management --
GetCBs: PUBLIC PROCEDURE [n: CARDINAL, wait: BOOLEAN] RETURNS [cb: CBPtr] =
-- allocates 'n' CBs and initializes them. If the requested number of CBs is not
-- available and 'wait' is TRUE, GetCBs will wait until the request can be
-- satisfied. If 'wait' is FALSE, GetCBs will return NIL. The CBs will be
-- circularly linked together through their 'nextOnQueue' field.
BEGIN
DequeueFreeCBs: ENTRY PROCEDURE = INLINE
-- does the work of dequeuing the requested CBs.
BEGIN
last: CBPtr;
DO
cb ← freeHead;
THROUGH [0..n) DO
IF cb = NIL THEN EXIT;
last ← cb;
cb ← cb.nextOnQueue;
REPEAT
FINISHED => -- n CBs found; fix up links
BEGIN
cb ← freeHead;
freeHead ← last.nextOnQueue;
last.nextOnQueue ← cb;
RETURN
END;
ENDLOOP;
IF wait THEN WAIT cbAvailable ELSE RETURN;
ENDLOOP;
END;
DequeueFreeCBs[];
IF cb ~= NIL THEN
THROUGH [0..n) DO
next: CBPtr = cb.nextOnQueue;
MiscDefs.Zero[cb, SIZE[CB]];
cb.nextOnQueue ← next;
cb.normalWakeups ← cb.errorWakeups ← diskInterruptBit;
cb.status ← DSfakeStatus; -- for error recovery purposes
cb ← next;
ENDLOOP;
END;
FreeCB: PUBLIC ENTRY PROCEDURE [cb: CBPtr] =
-- frees the argument CB.
{cb.nextOnQueue ← freeHead; freeHead ← cb; NOTIFY cbAvailable};
-- General Queue Management --
EnqueueCB: PUBLIC PROCEDURE [tail: CBQueueTail, cb: CBPtr] =
-- adds the argument CB to the end of the list identified by 'tail'.
BEGIN
IF tail↑ = NIL THEN cb.nextOnQueue ← cb
ELSE {cb.nextOnQueue ← tail↑.nextOnQueue; tail↑.nextOnQueue ← cb};
tail↑ ← cb;
END;
DequeueCB: PUBLIC PROCEDURE [tail: CBQueueTail] RETURNS [cb: CBPtr] =
-- removes the front CB from the list identified by tail and returns it.
BEGIN
prev: CBPtr ← tail↑;
IF (cb ← prev.nextOnQueue) = prev THEN tail↑ ← NIL
ELSE prev.nextOnQueue ← cb.nextOnQueue;
END;
SpliceLists: PUBLIC PROCEDURE [first, second: CBQueueTail] =
-- appends the second list to the first.
BEGIN
IF second↑ = NIL THEN RETURN;
IF first↑ ~= NIL THEN
BEGIN
head: CBPtr ← first↑.nextOnQueue;
first↑.nextOnQueue ← second↑.nextOnQueue;
second↑.nextOnQueue ← head;
END;
first↑ ← second↑;
second↑ ← NIL;
END;
-- CB Initiation and Completion --
EnqueueForDisk: PUBLIC ENTRY PROCEDURE [cbList: CBQueueTail] =
-- enters the argument list of CBs on the list of current tasks. It is assumed
-- that the 'nextCB' fields have already been filled in, and thus the blocks are
-- linearly linked through 'nextCB' and circularly linked through 'nextOnQueue'.
-- There is no need to wake up the disk interrupt process, for if an error occurs
-- such that we never receive an interrupt from these CBs, the timeout on
-- diskInterruptCV will eventually awaken the interrupt handler and cause it to
-- retry the failing operation.
BEGIN
IF cbList↑ ~= NIL THEN
BEGIN
oldBusyTail: CBPtr = busyTail;
SpliceLists[@busyTail, cbList];
IF oldBusyTail = NIL THEN AddToControllerQueue[busyTail.nextOnQueue];
END;
END;
SimulateCompletion: PUBLIC ENTRY PROCEDURE [cbList: CBQueueTail] =
-- moves the argument queue to the completed list. It is assumed that cb.status
-- is meaningful (in particular, DSfakeStatus).
BEGIN
IF cbList↑ = NIL THEN RETURN;
SpliceLists[@completedTail, cbList];
NOTIFY completionsExist;
END;
-- Disk Address Conversion --
VirtualDA: PUBLIC PROCEDURE [da: DA] RETURNS [DiskIODefs.vDA] =
BEGIN
RETURN[
IF da = DA[0, 0, 0, 0, 0] THEN DiskIODefs.eofvDA
ELSE DiskIODefs.vDA[
((da.disk*sysDisk.tracks + da.track)*sysDisk.heads +
da.head)*sysDisk.sectors + da.sector]];
END;
-- Interrupt Handler --
DiskInterruptHandler: PUBLIC ENTRY PROCEDURE =
-- this procedure is forked as a separate process by the initialization code. It
-- waits for disk operations to complete, then moves them to the completion queue
-- for processing by the completion process.
BEGIN
originalCommand: DC;
errorCount: [0..maxErrors] ← 0;
ProcessCompletedCBs: INTERNAL PROCEDURE = INLINE
BEGIN
cb: CBPtr;
maskedStatus: DS;
RetryAction: TYPE = {giveUp, retryHead, retryAll};
RequeueCompletedCB: PROCEDURE = INLINE
BEGIN
-- optimized form of: EnqueueCB[@completedTail, DequeueCB[@busyTail]]
IF busyTail = cb THEN busyTail ← NIL
ELSE busyTail.nextOnQueue ← cb.nextOnQueue;
IF completedTail = NIL THEN cb.nextOnQueue ← cb
ELSE
{cb.nextOnQueue ← completedTail.nextOnQueue; completedTail.nextOnQueue ← cb};
completedTail ← cb;
END;
PrepareRetry: PROCEDURE RETURNS [action: RetryAction] = INLINE
-- dataLate is always retried and doesn't bump errorCount (or totalErrors).
BEGIN
action ← retryAll;
IF maskedStatus.dataLate = 0 THEN
BEGIN
SELECT errorCount FROM
0 =>
BEGIN
originalCommand ← cb.command;
IF ~cb.omitRestore AND loggingEnabled THEN LogError[cb];
END;
maxErrors => RETURN[giveUp];
> maxErrors/3 => -- 3 because the interlaced restores increment errorCount
BEGIN
lastDA↑ ← InvalidDA;
IF cb.omitRestore THEN RETURN[giveUp];
IF (cb.header.diskAddress.restore ← 1 - cb.header.diskAddress.restore) = 0
THEN cb.command ← originalCommand
ELSE {cb.command ← DCs[SeekOnly]; action ← retryHead};
END;
ENDCASE;
errorCount ← errorCount + 1;
END;
cb.status ← DSfakeStatus;
IF cb.command.label = DiskCheck THEN
-- bad bits may have been read into fillIn words; reset to zero
BEGIN
label: POINTER TO DL = cb.labelAddress;
label.next ← label.prev ← DA[0,0,0,0,0]; label.bytes ← 0;
cb.header.packID ← 0;
END;
END;
UNTIL busyTail = NIL DO
IF (cb ← busyTail.nextOnQueue).status.done = DSdone THEN
BEGIN
maskedStatus ← MaskDS[cb.status, DSmaskStatus];
IF maskedStatus = DSgoodStatus AND cb.header.diskAddress.restore = 0 THEN
RequeueCompletedCB[]
ELSE
SELECT PrepareRetry[] FROM
retryHead => {RequeueHeadOfBusyListForDisk[]; EXIT};
retryAll => {RequeueEntireBusyListForDisk[]; EXIT};
ENDCASE => -- giveUp
-- A permanent error has occurred in 'cb'. Because of potential
-- chaining, it is unsafe to allow the remaining CBs on the busy list
-- to execute. We therefore append everything on the busy list to
-- the completed list. (Note that busyTail becomes NIL as a side effect
-- of this operation.) The first element appended, namely 'cb', will
-- have cb.status.done = DSdone, with error bits elsewhere in cb.status.
-- The remaining elements will have cb.status.done = DSfake (see GetCB),
-- alerting the completion procedure that the operation was inhibited
-- because of a previous error.
SpliceLists[first: @completedTail, second: @busyTail];
errorCount ← 0;
NOTIFY completionsExist;
END
ELSE
BEGIN
-- Nothing has completed, successfully or otherwise. This can arise
-- in one of two ways:
-- 1) No errors have occurred and we have caught up with the
-- controller (i.e., we have processed all blocks that have completed,
-- but more blocks remain to be executed, since busyTail is non-NIL).
-- In this case, the controller should still be running on a command
-- chain including our block, and therefore controllersPointer↑ should
-- be non-nil. We simply exit, expecting a subsequent interrupt or
-- case 2, below.
-- 2) An error may have occurred in some other disk request on the
-- controller's CB list but preceding the first element of our busy list.
-- In this case, the controller has definitely gone idle
-- (controllersPointer↑ is nil) and we should restart everything on the
-- busy list. In principle, therefore, we can distinguish the cases by
-- examining controllersPointer↑. In practice, however, we must worry
-- about a possible race condition. If controllersPointer↑ is non-nil,
-- it may be because the controller has already started some other
-- command chain (provided by another module) after an error prevented
-- our busy list from being executed. We will incorrectly assume that
-- our chain is still on the list (case 1, above) and block without
-- restarting it. Eventually, however, the disk will go idle and we
-- will recognize the true situation and restart the chain. The timeout
-- on diskInterruptCV will provide us with periodic wakeups which will
-- cause us to keep interrogating controllersPointer↑. Although this
-- seems kludgy, we note the standard BFS has the same problem when
-- multiple CBZones are in use.
IF controllersPointer↑ = nil THEN RequeueEntireBusyListForDisk[];
EXIT
END;
ENDLOOP;
END;
SetPriority[diskProcessPriority];
DO
IF busyTail = NIL THEN
BEGIN
IF interruptHandlerToDie THEN EXIT;
WAIT longTermWait;
END
ELSE WAIT diskInterruptCV;
IF busyTail ~= NIL THEN ProcessCompletedCBs[];
ENDLOOP;
END;
FinalizeInterruptHandler: PUBLIC ENTRY PROCEDURE =
-- shuts down the interrupt handling process. Note: the JOIN is done elsewhere,
-- outside the monitor lock.
{interruptHandlerToDie ← TRUE; NOTIFY longTermWait};
-- Disk Interrupt Completer --
Completer: PUBLIC PROCEDURE =
-- The separation of Completer and CompleterBody is an unfortunate necessity, because
-- RETURN WITH ERROR doesn't do the right thing in an inline procedure (after
-- unlocking the monitor, it should be equivalent to ERROR). However, because we
-- want GetCompletedCB to be an inline and because it must test completerToDie
-- within the monitor lock, we can't use anything else (UNWIND has worse problems).
-- Eventually, CompleterBody could be declared to be INLINE as well, but for now we
-- waste an extra frame.
{CompleterBody[ ! CompleterDone => CONTINUE]};
FinalizeCompleter: PUBLIC ENTRY PROCEDURE =
-- shuts down the completer process. Note: the JOIN is done elsewhere, outside
-- the monitor lock.
{completerToDie ← TRUE; NOTIFY completionsExist};
-- Private Procedures --
-- Controller Queue Management --
AddToControllerQueue: INTERNAL PROCEDURE [cbList: CBPtr] =
-- appends the argument cbList to the disk controller's queue. If this module had
-- the exclusive right to add CBs to the controller's queue, it would not be
-- necessary to execute this procedure with interrupts disabled. However, we must
-- guarantee that the queue is not modified (i.e., no links between CBs are altered)
-- during the race condition tests at the end of the procedure. Obviously, if this
-- module were the only one manipulating the queue, we could ensure this requirement
-- with a monitor (indeed, AddToControllerQueue must be an internal procedure).
-- Sadly, however, the Mesa swapper, BFS, and StreamScan logic may also add CBs to
-- the controller's queue, so we have no way to synchronize except by disabling
-- interrupts. Sigh...
BEGIN
last: CBPtr;
ProcessDefs.DisableInterrupts[];
BEGIN
IF (last ← controllersPointer↑) = nil THEN GO TO StartController
ELSE
DO
next: CBPtr;
IF (next ← last.nextCB) = nil THEN {last.nextCB ← cbList; EXIT};
last ← next;
ENDLOOP;
-- We may have lost a race with the disk controller, since it may have gone idle
-- without executing the CB we just enqueued. If we lost the race AND the
-- controller went idle normally (i.e., no error occurred, we start the controller
-- up again. Note: 'last' is still valid because interrupts are disabled, and
-- consequently the cb pointed to by 'last' cannot have been reused yet.
IF controllersPointer↑ = nil AND MaskDS[last.status, DSmaskStatus] = DSgoodStatus
THEN GO TO StartController;
EXITS StartController => controllersPointer↑ ← cbList;
END;
ProcessDefs.EnableInterrupts[];
NOTIFY longTermWait;
END;
-- Interrupt Handler Procedures --
RequeueEntireBusyListForDisk: INTERNAL PROCEDURE =
-- adds all CBs on the busy list to the controller's queue.
BEGIN
cb: CBPtr ← busyTail.nextOnQueue;
next: CBPtr;
UNTIL (next ← cb.nextOnQueue) = busyTail.nextOnQueue DO
cb.nextCB ← next; cb ← next; ENDLOOP;
cb.nextCB ← nil;
AddToControllerQueue[next];
END;
RequeueHeadOfBusyListForDisk: INTERNAL PROCEDURE = INLINE
-- adds the CB at the front of the busy list to the controller's queue.
BEGIN
head: CBPtr = busyTail.nextOnQueue;
head.nextCB ← nil;
AddToControllerQueue[head];
END;
SetPriority: PROCEDURE [p: ProcessDefs.Priority] = {ProcessOps.ISetPriority[p]};
LogError: PROCEDURE [cb: CBPtr] =
-- records the occurrence of a (possibly recoverable) error.
BEGIN OPEN ProcessDefs;
LogIt: PROCEDURE [copiedCB: CB] =
BEGIN
SetPriority[DefaultPriority];
WriteErrorToLog[@copiedCB];
END;
totalErrors ← totalErrors + 1;
Detach[FORK LogIt[cb↑]];
END;
-- Completer Procedures --
CompleterBody: PROCEDURE =
-- This procedure is forked as a separate process by the initialization code. It
-- has two purposes: (1) to free the disk interrupt process as soon as possible,
-- and (2) to invoke completion procedures at a priority lower than interrupt
-- level. If the Mesa system were able to tolerate swapping at interrupt level,
-- completion procedures could be invoked directly without altering the process
-- priority. We could also do so if we could be certain that all completion
-- procedures (and everything they invoke) are locked in core. Rather than assume
-- this, we instead lower the priority of this process to the normal user level
-- before invoking them.
BEGIN OPEN DiskIODefs;
DO
cb: CBPtr;
requestID: RequestID;
status: DS;
SetPriority[diskProcessPriority];
cb ← GetCompletedCB[];
requestID ← cb.requestID;
status ← cb.status;
WITH p: cb.postProc SELECT FROM
normal =>
BEGIN
proc: NormalCompletionProcedure ← p.proc;
FreeCB[cb];
SetPriority[ProcessDefs.DefaultPriority];
proc[requestID, TransformStatus[status]];
END;
verbose =>
BEGIN
proc: VerboseCompletionProcedure ← p.proc;
header: vDH ← LOOPHOLE[cb.headerAddress↑];
label: vDL ← LOOPHOLE[cb.labelAddress↑];
header.diskAddress ← VirtualDA[cb.headerAddress.diskAddress];
label.next ← VirtualDA[cb.labelAddress.next];
label.prev ← VirtualDA[cb.labelAddress.prev];
FreeCB[cb];
SetPriority[ProcessDefs.DefaultPriority];
proc[requestID, TransformStatus[status], @header, @label];
END;
ENDCASE;
ENDLOOP;
END;
GetCompletedCB: ENTRY PROCEDURE RETURNS [cb: CBPtr] = INLINE
-- waits for a CB to complete, then removes it from the completed list and
-- returns it.
BEGIN
WHILE completedTail = NIL DO
IF completerToDie THEN RETURN WITH ERROR CompleterDone;
WAIT completionsExist;
ENDLOOP;
cb ← DequeueCB[@completedTail];
cb.command.seal ← DCunseal;
END;
END.