-- File: DiskRequestor.mesa
-- Last edited by Levin:  30-Apr-81 16:21:09

DIRECTORY
  AltoDefs USING [BytesPerPage, PageNumber],
  ControlDefs USING [FrameHandle, NullFrame],
  DiskIODefs USING [
    CompletionProcedure, CompletionStatus, DiskRequest, eofvDA, FID,
    fillInvDA, NormalCompletionProcedure, RequestError, RequestID, vDA,
    VerboseCompletionProcedure],
  DiskIOPrivate USING [
    CB, CBPtr, DA, DCs, DL, DS, DSfakeStatus, DSgoodStatus, DSmaskStatus,
    EnqueueCB, EnqueueForDisk, FreeCB, GetCBs,
    InvalidDA, IOSynch, loggingEnabled, MaskDS, nSafetyDCBs, SimulateCompletion,
    SpliceLists, SynchRecord, sysDisk, VirtualDA],
  FrameOps USING [GetReturnLink, MyLocalFrame, SetReturnFrame],
  Inline USING [DIVMOD],
  ProcessDefs USING [Detach];

DiskRequestor: MONITOR LOCKS synch.LOCK USING synch: DiskIOPrivate.IOSynch
  IMPORTS DiskIOPrivate, FrameOps, Inline, ProcessDefs
  EXPORTS DiskIODefs, DiskIOPrivate =

  BEGIN OPEN DiskIODefs, DiskIOPrivate;

  -- Global Variables --

  scratchPage: PUBLIC POINTER;
  maxOps: PUBLIC CARDINAL;

  -- Statistics Logging --

  diskReads, diskWrites: PUBLIC LONG CARDINAL;

  -- Miscellaneous Declarations --

  BytesPerDiskPage: CARDINAL = AltoDefs.BytesPerPage;

  notLastSkip: RequestID = 10101B;
  lastSkip: RequestID = 50403B;
  dummyID: RequestID = 112233B;

  ImpossibleStatus: ERROR = CODE;
  ImpossibleRequestID: ERROR = CODE;

  -- Externally Visible Procedures --

  InitiateDiskIO: PUBLIC PROCEDURE [operation: POINTER TO DiskRequest] =
    -- initiates the requested disk transfers and returns to the caller.  The
    -- CompletionProcedure in the argument DiskRequest is invoked as each
    -- transfer terminates.
    BEGIN
    ValidateRequest[operation];
    WITH op: operation SELECT FROM
      DoNothing => RETURN;
      SeekOnly => -- not implemented yet --NULL;
      ENDCASE =>
	BEGIN
	xferTail, skipTail: CBPtr;
	[xferTail, skipTail] _ BuildXferChain[operation];
	IF skipTail = NIL THEN {EnqueueForDisk[@xferTail]; RETURN};
	EnqueueXferChain[operation, xferTail, skipTail];
	END;
    END;

  BogusRequest: PUBLIC ERROR [reason: RequestError, operation: POINTER TO DiskRequest] =
    CODE;

  DiskError: PUBLIC ERROR [status: CompletionStatus] = CODE;

  -- Internal Procedures --

  ValidateRequest: PROCEDURE [operation: POINTER TO DiskRequest] =
    -- checks that the argument DiskRequest is valid, and raises BogusRequest if
    -- it isn't.
    BEGIN
    maxvda: vDA _ MaxLegalvDA[];

    MaxLegalvDA: PROCEDURE RETURNS [vDA] =
      -- returns the maximum legal vDA for the current disk structure.
      BEGIN
      RETURN[
	VirtualDA[
	  DA[sysDisk.sectors - 1, sysDisk.tracks - 1, sysDisk.heads - 1,
	     sysDisk.disks - 1, 0]]]
      END;

    CheckvDA: PROCEDURE [vda: vDA] RETURNS [isFillIn: BOOLEAN] =
      -- validates a virtual disk address.  (This validation is not intended to
      -- be complete, but rather serves only as a blunder check).
      BEGIN
      IF isFillIn _ (vda = fillInvDA) THEN RETURN;
      IF vda = eofvDA OR vda > maxvda THEN ERROR BogusRequest[badvDA, operation];
      END;

    CheckStrictvDA: PROCEDURE [vda: vDA, allowEOF: BOOLEAN]
      RETURNS [isEOF: BOOLEAN] =
      -- checks that vda is a legitimate one (fillInvDA is not permitted).
      BEGIN
      IF vda = fillInvDA THEN ERROR BogusRequest[illegalvDASequence, operation];
      IF isEOF _ (vda = eofvDA) THEN
	IF allowEOF THEN RETURN ELSE ERROR BogusRequest[badvDA, operation];
      END;

    EnsureLegalvDASequence: PROCEDURE [noFillIns: BOOLEAN] =
      -- ensures that fillInvDAs appear only where permitted.
      BEGIN
      first: CARDINAL _ 0;
      nXfers: CARDINAL _ LENGTH[operation.xfers];
      i: CARDINAL;
      IF nXfers = 0 THEN ERROR BogusRequest[illegalTransfer, operation];
      IF noFillIns THEN
	BEGIN
	IF operation.pagesToSkip ~= 0 THEN GO TO IllegalSequence;
	FOR i IN [0..nXfers) DO
	  [] _ CheckStrictvDA[operation.xfers[i].diskAddress, FALSE];
	  ENDLOOP;
	RETURN
	END;
      IF operation.pagesToSkip ~= 0 THEN
	[] _ CheckStrictvDA[operation.firstPagevDA, FALSE]
      ELSE
	BEGIN
	[] _ CheckStrictvDA[operation.xfers[0].diskAddress, FALSE];
	FOR i IN [1..nXfers) DO
	  IF CheckvDA[operation.xfers[i].diskAddress] THEN {first _ i + 1; EXIT};
	  REPEAT FINISHED => RETURN;
	  ENDLOOP;
	END;
      FOR i IN [first..nXfers) DO
	IF ~CheckvDA[operation.xfers[i].diskAddress] THEN GO TO IllegalSequence;
	ENDLOOP;
      EXITS IllegalSequence => ERROR BogusRequest[illegalvDASequence, operation];
      END;

    WITH op: operation SELECT FROM
      DoNothing => RETURN;
      SeekOnly =>
	BEGIN
	IF LENGTH[op.xfers] ~= 0 THEN ERROR BogusRequest[illegalTransfer, operation];
	[] _ CheckStrictvDA[op.firstPagevDA, FALSE];
	END;
      ReadLD, ReadD, WriteD =>
	BEGIN
	EnsureLegalvDASequence[noFillIns: FALSE];
	IF LENGTH[op.xfers] > maxOps - nSafetyDCBs THEN GO TO TooManyXfers;
	END;
      WriteHLD, WriteLD =>
	BEGIN
	EnsureLegalvDASequence[noFillIns: TRUE];
	[] _ CheckStrictvDA[op.next, TRUE];
	[] _ CheckStrictvDA[op.prev, TRUE];
	IF LENGTH[op.xfers] > maxOps THEN GO TO TooManyXfers;
	END;
      ReadHLD =>
	BEGIN
	EnsureLegalvDASequence[noFillIns: TRUE];
	IF LENGTH[op.xfers] > maxOps THEN GO TO TooManyXfers;
	END;
      ENDCASE;
    EXITS TooManyXfers => ERROR BogusRequest[tooManyTransfers, operation];
    END;

  BuildXferChain: PROCEDURE [operation: POINTER TO DiskRequest]
    RETURNS [xferTail, skipTail: CBPtr] =
    -- (synchronously) constructs the chain of transfer CBs required by 'operation'.
    BEGIN
    thisCB: CBPtr;
    page: AltoDefs.PageNumber _ operation.firstPage + operation.pagesToSkip;
    label: POINTER TO DL;
    thisvDA: vDA;
    nXfers: CARDINAL = LENGTH[operation.xfers];
    last: CARDINAL = nXfers - 1;
    lastIsFillin: BOOLEAN = (operation.xfers[last].diskAddress = fillInvDA);
    i: CARDINAL;

    FillLabelAndCB: PROCEDURE =
      -- prepares 'thisCB' for execution.
      BEGIN
      thisCB.headerAddress _ @thisCB.header;
      thisCB.labelAddress _ label;
      thisCB.dataAddress _ operation.xfers[i].buffer;
      IF loggingEnabled THEN
	SELECT operation.action FROM
	  ReadHLD, ReadLD, ReadD => diskReads _ diskReads + 1;
	  WriteHLD, WriteLD, WriteD => diskWrites _ diskWrites + 1;
	  ENDCASE;
      thisCB.command _ DCs[operation.action];
      thisCB.requestID _ operation.xfers[i].id;
      thisCB.postProc _ operation.proc;
      thisCB.omitRestore _ operation.noRestore;
      label.page _ page;
      page _ page + 1;
      label.fileID _ LOOPHOLE[operation.fileID];
      WITH op: operation SELECT FROM
	WriteLD, WriteHLD =>
	  BEGIN
	  label.prev _ RealDA[IF i = 0 THEN op.prev ELSE op.xfers[i - 1].diskAddress];
	  label.next _ RealDA[IF i = last THEN op.next ELSE op.xfers[i + 1].diskAddress];
	  label.bytes _ IF i = last AND op.next = eofvDA THEN op.lastByteCount
			ELSE BytesPerDiskPage;
	  END;
	ENDCASE;
      END;

    IF operation.pagesToSkip = 0 THEN
      BEGIN
      xferTail _ GetCBs[n: (IF lastIsFillin THEN nXfers + 1 ELSE nXfers), wait: TRUE];
      skipTail _ NIL;
      END
    ELSE
      BEGIN
      xferTail _ GetCBs[n: nXfers + nSafetyDCBs, wait: TRUE];
      skipTail _ xferTail.nextOnQueue;
      xferTail.nextOnQueue _ skipTail.nextOnQueue.nextOnQueue;
      skipTail.nextOnQueue.nextOnQueue _ skipTail;
      END;
    thisCB _ xferTail.nextOnQueue;
    thisvDA _ operation.xfers[0].diskAddress;
    FOR i _ 0, i + 1 DO
      nextvDA: vDA;
      IF thisvDA ~= fillInvDA THEN thisCB.header.diskAddress _ RealDA[thisvDA];
      label _ @thisCB.label;
      IF i = last THEN EXIT;
      nextvDA _ operation.xfers[i + 1].diskAddress;
      IF nextvDA = fillInvDA THEN
        label _ LOOPHOLE[@thisCB.nextOnQueue.header.diskAddress];
      FillLabelAndCB[];
      thisCB.nextCB _ thisCB.nextOnQueue; thisCB _ thisCB.nextOnQueue;
      thisvDA _ nextvDA;
      ENDLOOP;
    IF lastIsFillin THEN
      BEGIN
      label _ LOOPHOLE[@thisCB.nextOnQueue.header];
      FillLabelAndCB[];
      thisCB.nextCB _ thisCB.nextOnQueue;
      thisCB _ thisCB.nextOnQueue;
      -- The extra CB allocated for the label of the last chained CB is now appended
      -- to the command chain.  It will initiate a seek to the predecessor of the
      -- last transferred page, which, at worst, will cause the heads to move to a
      -- new cylinder.  This kludge makes it easy to recover the extra CB at the
      -- proper time, at the possible expense of some potentially unnecessary arm motion.
      thisCB.command _ DCs[SeekOnly];
      thisCB.requestID _ dummyID;
      thisCB.postProc _ [normal[DummyCompletionProc]];
      END
    ELSE FillLabelAndCB[];
    END;

  EnqueueXferChain: PROCEDURE [operation: POINTER TO DiskRequest, xTail, sTail: CBPtr] =
    -- outer shell for DoXferEnqueuing.
    BEGIN
    frame: ControlDefs.FrameHandle;

    DoXferEnqueuing: PROCEDURE RETURNS [frame: ControlDefs.FrameHandle] =
      -- does the work of skipping pages from 'firstPage', whose vDA is known,
      -- up to the page preceding the one specified in 'xfers[0]'.  It then enqueues
      -- the xfer chain and exits.
      BEGIN
      thisCB, labelCB: CBPtr;
      page: AltoDefs.PageNumber _ operation.firstPage;
      last: AltoDefs.PageNumber _ operation.firstPage + operation.pagesToSkip - 1;
      label: POINTER TO DL;
      fileID: FID _ operation.fileID;
      nonXferID: RequestID _ operation.nonXferID;
      userPostProc: CompletionProcedure _ operation.proc;
      ourPostProc: CompletionProcedure _ userPostProc;
      noRestore: BOOLEAN _ operation.noRestore;
      synch: SynchRecord;
      skipTail: CBPtr _ sTail;
      xferTail: CBPtr _ xTail;
      Returnee: PROCEDURE [ControlDefs.FrameHandle];

      PrepareAndEnqueueThisCB: PROCEDURE =
	-- sets up 'thisCB' as part of a skip chain.
	BEGIN
	thisCB.headerAddress _ @thisCB.header;
	thisCB.labelAddress _ label;
	thisCB.dataAddress _ scratchPage;
	IF loggingEnabled THEN diskReads _ diskReads + 1;
	thisCB.command _ DCs[ReadD];
	SetPostProcAndID[thisCB];
	thisCB.omitRestore _ noRestore;
	label.page _ page;
	page _ page + 1;
	label.fileID _ LOOPHOLE[fileID];
	IF skipTail ~= NIL THEN skipTail.nextCB _ thisCB;
	EnqueueCB[@skipTail, thisCB];
	END;

      SetPostProcAndID: PROCEDURE [cb: CBPtr] =
	-- fills in cb.postProc and cb.requestID.
	BEGIN
 	cb.requestID _
	  IF (cb.postProc _ ourPostProc) = userPostProc THEN nonXferID ELSE notLastSkip;
        END;

      ResetPostProcs: PROCEDURE =
	-- recomputes the postProc and requestID fields for all cb's on skipTail.
	BEGIN
	cb: CBPtr _ skipTail;
	IF cb = NIL THEN RETURN;
	DO
	  SetPostProcAndID[cb];
	  IF (cb _ cb.nextOnQueue) = skipTail THEN EXIT;
	  ENDLOOP;
	END;

      SkipChecker: VerboseCompletionProcedure =
	-- invoked when an asynchronously queued skip request has completed.
	BEGIN
	WITH userPostProc: userPostProc SELECT FROM
	  verbose => userPostProc.proc[nonXferID, status, header, label];
	  ENDCASE;
	IF id = lastSkip THEN DoNotify[@synch, status];
	END;

      DoNotify: ENTRY PROCEDURE [synch: IOSynch, status: CompletionStatus] =
        INLINE
	-- wake up EnqueueAndWait, passing the status of the last CB that it enqueued.
	{synch.status _ status; NOTIFY synch.lastDone};

      EnqueueAndWait: ENTRY PROCEDURE [synch: IOSynch]
        RETURNS [CompletionStatus] = INLINE
	-- enqueues skipTail, waits until skips are complete, then returns the outcome.
	BEGIN
	synch.status _ noStatus; synch.lastDone.timeout _ 0;
	skipTail.requestID _ lastSkip;
	EnqueueForDisk[@skipTail];
	skipTail _ NIL;
	WHILE synch.status = noStatus DO WAIT synch.lastDone; ENDLOOP;
	RETURN[synch.status]
	END;

      BEGIN
      -- inner block so 'SpliceAndEnqueueXfers' can access local variables of this frame
      frame _ ControlDefs.NullFrame;
      thisCB _ skipTail.nextOnQueue;
      labelCB _ skipTail;
      skipTail _ NIL;
      thisCB.header.diskAddress _ RealDA[operation.firstPagevDA];
      WHILE page < last DO
	label _ LOOPHOLE[@labelCB.header.diskAddress];
	PrepareAndEnqueueThisCB[];
	thisCB _ labelCB;
	IF (labelCB _ GetCBs[n: 1, wait: FALSE]) = NIL THEN EXIT;
	REPEAT FINISHED => {FreeCB[labelCB]; GO TO SpliceAndEnqueueXfers};
	ENDLOOP;
      -- If control comes here, we have insufficient CBs available to build the
      -- entire chain now.  We fork a process to wait for more.  However, in order
      -- to keep our frame around, we have to do some fancy shuffling of return
      -- links.  The dirty deed is done by the next three lines of code plus
      -- 'ShuffleLinks'.
      frame _ FrameOps.MyLocalFrame[];
      Returnee _ LOOPHOLE[FrameOps.GetReturnLink[]];
      Returnee[frame];
      -- The code below is actually executed in a different process.  When it
      -- has completed, control will exit to the Mesa runtime system's process
      -- destruction machinery.
      ourPostProc _ CompletionProcedure[verbose[SkipChecker]];
      ResetPostProcs[];
      WHILE page < last DO
	IF (labelCB _ GetCBs[n: 1, wait: FALSE]) = NIL THEN
	  BEGIN
	  IF skipTail ~= NIL AND EnqueueAndWait[@synch] ~= ok THEN
	    GO TO ErrorWhileSkipping;
	  labelCB _ GetCBs[n: 1, wait: TRUE];
	  END;
	label _ LOOPHOLE[@labelCB.header.diskAddress];
	PrepareAndEnqueueThisCB[];
	thisCB _ labelCB;
	REPEAT
	  FINISHED =>
	    {ourPostProc _ userPostProc; ResetPostProcs[]; GO TO SpliceAndEnqueueXfers};
	ENDLOOP;
      EXITS
	SpliceAndEnqueueXfers =>
	  BEGIN
	  label _ LOOPHOLE[@xferTail.nextOnQueue.header.diskAddress];
	  PrepareAndEnqueueThisCB[];
	  skipTail.nextCB _ xferTail.nextOnQueue;
	  SpliceLists[@skipTail, @xferTail];
	  EnqueueForDisk[@skipTail];
	  END;
	ErrorWhileSkipping => {FreeCB[thisCB]; SimulateCompletion[@xferTail]};
      END; -- inner block for 'SpliceAndEnqueueXfers'

      END;

    ShuffleLinks: PROCEDURE [frame: ControlDefs.FrameHandle] =
      -- invoked to patch up return links for forked process.  The argument frame
      -- belongs to DoXferEnqueuing, but the forking machinery has set the return
      -- link of ShuffleLinks to be the process destruction code.  We patch
      -- ShuffleLinks to return to DoXferEnqueueing, and patch DoXferEnqueuing
      -- to return to the process destroyer.  Clear?
      BEGIN
      frame.returnlink _ FrameOps.GetReturnLink[];
      FrameOps.SetReturnFrame[frame];
      END;

    frame _ DoXferEnqueuing[];
    IF frame ~= ControlDefs.NullFrame THEN ProcessDefs.Detach[FORK ShuffleLinks[frame]];
    END;

  RealDA: PUBLIC PROCEDURE [v: vDA] RETURNS [da: DA] =
    BEGIN
    i: CARDINAL _ v;
    da _ DA[0, 0, 0, 0, 0];
    IF v # eofvDA THEN
      BEGIN
      [i, da.sector] _ Inline.DIVMOD[i, sysDisk.sectors];
      [i, da.head] _ Inline.DIVMOD[i, sysDisk.heads];
      [i, da.track] _ Inline.DIVMOD[i, sysDisk.tracks];
      [i, da.disk] _ Inline.DIVMOD[i, sysDisk.disks];
      IF i # 0 THEN da _ InvalidDA;
      END;
    END;

  TransformStatus: PUBLIC PROCEDURE [status: DS] RETURNS [CompletionStatus] =
    -- This procedure maps hardware status information to a simpler form for
    -- completion procedures to handle.
    BEGIN
    SELECT MaskDS[status, DSmaskStatus] FROM
      DSgoodStatus => RETURN[ok];
      DSfakeStatus => RETURN[neverStarted];
      ENDCASE;
    SELECT status.finalStatus FROM
      CheckError => RETURN[checkError];
      IllegalSector => RETURN[badDiskAddress];
      ENDCASE;
    IF status.seekFailed = 1 THEN RETURN[seekFailure];
    IF status.notReady = 1 THEN RETURN[diskOffline];
    IF status.checksumError = 1 THEN RETURN[checksumError];
    IF status.dataLate = 1 THEN RETURN[dataLate];
    ERROR ImpossibleStatus
    END;

  DummyCompletionProc: NormalCompletionProcedure =
    -- This procedure is invoked only when the relevant CB is the "extra" one
    -- required to hold the label for the last legitimate CB in a linked-label chain.
    {IF id ~= dummyID THEN ERROR ImpossibleRequestID}; 

  END.