-- 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.