-- TeledebugImpl.mesa
-- This is an initial, ugly, ugly, implementation.
-- Last Edited by: Taft, May 24, 1983 11:55 am

DIRECTORY
  DeviceTypes USING [sa4000],
  Environment USING [PageNumber, wordsPerPage],
  Inline USING [BITAND, LongCOPY, LongDivMod, LowHalf],
  MiniEthernetDefs USING [ActivateDriver, KillDriver, RecvPacket, ReturnPacket],
  PageMap USING [Assoc, GetF, Value, valueVacant],
  PilotDisk USING [Label],
  PilotMP USING [cGermDeviceError, Code, cTeledebugServer],
  ProcessorFace USING [SetMP],
  PupTypes,
  TeledebugProtocol,
  SA4000Face,
  Teledebug,
  Utilities USING [LongPointerFromPage];

TeledebugImpl: PROGRAM
  IMPORTS Inline, MiniEthernetDefs, PageMap, ProcessorFace, SA4000Face, Utilities
  EXPORTS Teledebug
  SHARES PageMap =
  BEGIN

  -- Ethernet buffer.  This is merely storage for MiniDriver
  bufSize: CARDINAL = 300;
  fudge: CARDINAL = 30;
  eBuff: ARRAY [0..bufSize + fudge + 3) OF UNSPECIFIED;
  eBuffer: POINTER = Inline.BITAND[@eBuff + 3, 177774B];
  etherIOCBSize: CARDINAL = 30;

  Error: SIGNAL [PilotMP.Code] = CODE;

  -- "Locals" to Debug and RunDisk
  MyPup: TYPE = RECORD [
    SELECT OVERLAID * FROM
      a => [coreStoreRequest: TeledebugProtocol.CoreStoreRequest],
      b => [coreStoreAcknowledgement: TeledebugProtocol.CoreStoreAcknowledgement],
      c => [coreFetchRequest: TeledebugProtocol.CoreFetchRequest],
      d => [coreFetchAcknowledgement: TeledebugProtocol.CoreFetchAcknowledgement],
      e => [diskStoreRequest: TeledebugProtocol.DiskStoreRequest],
      f => [diskStoreAcknowledgement: TeledebugProtocol.DiskStoreAcknowledgement],
      g => [diskFetchAcknowledgement: TeledebugProtocol.DiskFetchAcknowledgement],
      h => [diskAddressSetRequest: TeledebugProtocol.DiskAddressSetRequest],
      i => [diskAddressSetAcknowledgement:
            TeledebugProtocol.DiskAddressSetAcknowledgement],
      ENDCASE];

  diskAddressPup: TeledebugProtocol.DiskAddressSetRequest;
  bytes: INTEGER;
  id: PupTypes.Pair;
  pAllocateNext: LONG POINTER TO UNSPECIFIED; -- iocb's and stuff in first 64K
  pup: MyPup;
  sa4000IOCB: LONG POINTER TO SA4000Face.Operation;
  sender: PupTypes.PupAddress;
  temp: CARDINAL;
  type: PupTypes.PupType;

  Debug: PUBLIC PROC [
    scratchPage: Environment.PageNumber,
    dFirst64KStorage: LONG DESCRIPTOR FOR ARRAY OF WORD] =
    BEGIN
    Allocate: PROC [size: CARDINAL] RETURNS [lp: LONG POINTER TO UNSPECIFIED] =
      {pAllocateNext _ (lp _ pAllocateNext) + LONG[((size + 15)/16)*16]};
    LongTime: PROC RETURNS [BOOLEAN] = {RETURN[FALSE]};
    SetNoLabel: PROC [p: LONG POINTER] =
      BEGIN OPEN Inline;
      p^ _ -1; LongCOPY[from: p, to: p + 1, nwords: SIZE[TeledebugProtocol.Label] - 1];
      END;

    ProcessorFace.SetMP[PilotMP.cTeledebugServer];
    pAllocateNext _ BASE[dFirst64KStorage]; -- reset first 64K allocator
    SA4000Face.Initialize[0, Inline.LowHalf[Allocate[SA4000Face.globalStateSize]]];
    sa4000IOCB _ Allocate[SA4000Face.operationSize];
    IF ~MiniEthernetDefs.ActivateDriver[
        eBuffer, bufSize, Allocate[etherIOCBSize], TRUE] THEN
      Error[PilotMP.cGermDeviceError];
    DO
      sender _ [[0], [0], [0, 0]]; -- talk to anybody
      [bytes, id, type] _ MiniEthernetDefs.RecvPacket[
        @sender, TeledebugProtocol.teleSwatSocket, @pup, SIZE[MyPup], LongTime];
      SELECT type FROM
        TeledebugProtocol.coreFetchRequest =>
          BEGIN OPEN p: pup.coreFetchAcknowledgement;
          IF bytes # (2*SIZE[TeledebugProtocol.CoreFetchRequest]) THEN LOOP;
          IF ~IsVacant[p.page] THEN
            BEGIN
            p.flags _ LOOPHOLE[GetF[p.page]];
            Inline.LongCOPY[
              from: LPFromPage[p.page], to: @p.data, nwords: Environment.wordsPerPage];
            Assoc[p.page, LOOPHOLE[p.flags]];
            END
          ELSE p.flags _ TeledebugProtocol.vacantFlag;
          bytes _ 2*TeledebugProtocol.coreFetchAcknowledgementSize;
          END;
        TeledebugProtocol.coreStoreRequest =>
          BEGIN OPEN p: pup.coreStoreRequest;
          IF bytes # (2*SIZE[TeledebugProtocol.CoreStoreRequest]) THEN LOOP;
          IF ~IsVacant[p.page] THEN
            BEGIN
            MakeWritable[p.page];
            Inline.LongCOPY[
              to: LPFromPage[p.page], from: @p.data, nwords: Environment.wordsPerPage];
            Assoc[p.page, LOOPHOLE[p.flags]];
            END
          ELSE p.flags _ TeledebugProtocol.vacantFlag;
          bytes _ 2*TeledebugProtocol.coreStoreAcknowledgementSize;
          END;
        TeledebugProtocol.diskAddressSetRequest =>
          BEGIN
          IF bytes # (2*SIZE[TeledebugProtocol.DiskAddressSetRequest]) THEN LOOP;
          Inline.LongCOPY[  -- just save it.
            to: @diskAddressPup, from: @pup.diskAddressSetRequest,
            nwords: SIZE[TeledebugProtocol.DiskAddressSetRequest]];
          END;
        TeledebugProtocol.diskFetchRequest =>
          BEGIN OPEN p: pup.diskFetchAcknowledgement;
          SELECT bytes FROM
            0 => NULL;
            2*SIZE[TeledebugProtocol.DiskAddressSetRequest] =>
              Inline.LongCOPY[                          -- save disk address request.
        	       to: @diskAddressPup, from: @pup.diskAddressSetRequest,
        	       nwords: SIZE[TeledebugProtocol.DiskAddressSetRequest]];
            ENDCASE => LOOP;  -- illegal request
          IF ~RunDisk[vrr, scratchPage, @p.label, @p.data] THEN SetNoLabel[@p.label];
          bytes _ 2*TeledebugProtocol.diskFetchAcknowledgementSize;
          END;
        TeledebugProtocol.diskStoreRequest =>
          BEGIN OPEN p: pup.diskStoreRequest;
          IF bytes # (2*SIZE[TeledebugProtocol.DiskStoreRequest]) THEN LOOP;
          IF ~RunDisk[vvw, scratchPage, @p.label, @p.data] THEN
            SetNoLabel[@pup.diskStoreAcknowledgement.label];
          bytes _ 2*TeledebugProtocol.diskStoreAcknowledgementSize;
          END;
        TeledebugProtocol.go =>
          BEGIN
          GoConfirm: PROC RETURNS [BOOLEAN] = INLINE
            BEGIN
            tenSecondsCount: CARDINAL = LAST[CARDINAL];
            MiniEthernetDefs.ReturnPacket[TeledebugProtocol.acknowledgement, @pup, 0];
            temp _ tenSecondsCount;
            [bytes, id, type] _ MiniEthernetDefs.RecvPacket[
              @sender, TeledebugProtocol.teleSwatSocket, @pup, SIZE[MyPup], TenSeconds];
            -- also check id??? (what to do if wrong)
            RETURN[bytes = -1 OR type = TeledebugProtocol.goReply];
            END;
          TenSeconds: PROC RETURNS [BOOLEAN] = {RETURN[(temp _ temp - 1) = 0]};
          IF bytes = 0 AND GoConfirm[] THEN {MiniEthernetDefs.KillDriver[]; RETURN}
          ELSE LOOP; -- unexpected respose; ignore
          END;
        ENDCASE => LOOP;
      -- Send ack
      MiniEthernetDefs.ReturnPacket[TeledebugProtocol.acknowledgement, @pup, bytes];
      ENDLOOP;
    END;

  RunDisk: PROC [
    c: SA4000Face.Command, scratchPage: Environment.PageNumber,
    labelP, dataP: POINTER] RETURNS [BOOLEAN] =
    BEGIN OPEN o: sa4000IOCB, SA4000Face;
    IF diskAddressPup.device # DeviceTypes.sa4000 THEN RETURN[FALSE];
    o.device _ nullDeviceHandle;
    THROUGH [0..diskAddressPup.deviceOrdinal] DO
      IF (o.device _ GetNextDevice[o.device]) = nullDeviceHandle THEN RETURN[FALSE];
      ENDLOOP;
    [quotient: temp, remainder: o.clientHeader.sector] _ Inline.LongDivMod[
      num: diskAddressPup.page, den: GetDeviceAttributes[o.device].sectorsPerTrack];
    o.clientHeader.head _ temp MOD GetDeviceAttributes[o.device].movingHeads;
    o.clientHeader.cylinder _ temp/GetDeviceAttributes[o.device].movingHeads;
    o.labelPtr _ labelP; o.dataPtr _ LPFromPage[LONG[scratchPage]];
    o.incrementDataPtr _ FALSE; o.command _ c; o.pageCount _ 1;
    IF c = vvw THEN
      Inline.LongCOPY[from: LONG[dataP], to: o.dataPtr, nwords: Environment.wordsPerPage];
    THROUGH [0..8) DO
      SA4000Face.Initiate[sa4000IOCB];
      DO
        SELECT SA4000Face.Poll[sa4000IOCB] FROM
          inProgress => LOOP;
          goodCompletion =>
            BEGIN
            IF c = vrr THEN Inline.LongCOPY[
        	       to: LONG[dataP], from: o.dataPtr, nwords: Environment.wordsPerPage];
            RETURN[TRUE];
            END;
          ENDCASE --ERROR-- => EXIT;
        ENDLOOP;
      ENDLOOP;
    RETURN[FALSE];
    END;

  -- Long page number operations 

  maxVirtualPages: LONG CARDINAL = 77777B; -- de-burn this constant someday

  Assoc: PROC [page: LONG CARDINAL, value: PageMap.Value] =
    INLINE {PageMap.Assoc[Inline.LowHalf[page], value]};

  GetF: PROC [page: LONG CARDINAL] RETURNS [PageMap.Value] =
    INLINE {RETURN[PageMap.GetF[Inline.LowHalf[page]]]};

  IsVacant: PROC [page: LONG CARDINAL] RETURNS [BOOLEAN] =
    BEGIN OPEN Inline;
    IF page > maxVirtualPages THEN RETURN[TRUE];
    RETURN[BITAND[GetF[page], PageMap.valueVacant] = PageMap.valueVacant];
    END;

  LPFromPage: PROC [p: LONG CARDINAL] RETURNS [LONG POINTER] =
    INLINE {RETURN[Utilities.LongPointerFromPage[Inline.LowHalf[p]]]};

  MakeWritable: PROC [page: LONG CARDINAL] =
    {v: PageMap.Value _ GetF[page]; v.flags.writeProtected _ FALSE; Assoc[page, v]};

  END.

LOG
Time: March 21, 1980  6:58 PM	By: Forrest	Action: Create file
Time: March 24, 1980  11:45 AM	By: Forrest	Action: initialize sender, fix maxVirtualPages
Time: April 1, 1980  2:53 PM	By: Forrest	Action: Add Disk Implementation
Time: April 7, 1980  7:11 PM	By: Forrest	Action: Added SetDiskAddress+Fetch enhancement
Time: April 10, 1980  12:19 PM	By: Forrest	Action: RCPProtocol => TeledebugProtocol
Time: April 22, 1980  5:41 PM	By: McJones	Action: Add avoidCleanup: TRUE to ActivateDriver call
Time: June 25, 1980  4:21 PM	By: McJones	Action: OISDisk=>PilotDisk; OISProcessorFace=>ProcessorFace; SA4000Face.Operation: clientLabel+diskLabel=>labelPtr
Time: September 17, 1980  12:45 PM	By: Forrest	Action: change to use returnPacket; zero socket each trip around loop; use GetF, Utilities.LongPointerFromPage
May 24, 1983 11:53 am  Taft  Fix bug in IsVacant