-- File: AltoPRDriver.mesa
--  Edit: BLyon  January 16, 1981  1:33 PM
--  Edit: HGM  February 17, 1981  6:00 AM
--  Edit: L. Stewart  February 20, 1980  4:24 PM

DIRECTORY
  BcplOps USING [CleanupReason],
  BitBltDefs USING [BBptr, BBTableSpace, AlignedBBTable, BITBLT],
  ImageDefs USING [
    CleanupItem, AddCleanupProcedure, RemoveCleanupProcedure, AllReasons],
  InlineDefs USING [COPY],
  Process USING [Detach, DisableTimeout, MsecToTicks, SetPriority, SetTimeout],
  Put USING [Line],
  Storage USING [Node, Free],
  String USING [AppendString, AppendDecimal],
  Time USING [AppendCurrent],
  Alto1822Defs,
  AltoPRDefs,
  BufferDefs,
  AltoRam USING [Shorten, GetTicks, msPerTick],
  StatsDefs USING [StatBump, StatIncr, StatCounterIndex],
  CommFlags USING [doStats],
  CommUtilDefs USING [AddInterruptHandler, RemoveInterruptHandler],
  DriverDefs USING [
    PacketRadioStats, GetGiantVector, Glitch, GetInputBuffer, MaybeGetFreeBuffer,
    Network, NetworkObject, AddDeviceToChain, PutOnGlobalDoneQueue,
    PutOnGlobalInputQueue],
  DriverTypes USING [prEncapsulationOffset, prEncapsulationBytes],
  PupTypes USING [allHosts, PupErrorCode],
  SpecialSystem USING [HostNumber];

AltoPRDriver: MONITOR
  IMPORTS
    BitBltDefs, ImageDefs, InlineDefs, Process, Put, Storage, String, Time,
    BufferDefs, AltoRam, CommUtilDefs, DriverDefs, StatsDefs, Alto1822Defs,
    AltoPRDefs
  EXPORTS BufferDefs, DriverDefs, AltoPRDefs
  SHARES BufferDefs, SpecialSystem =
  BEGIN OPEN StatsDefs, BufferDefs, DriverDefs, AltoPRDefs, Alto1822Defs;

  -- EXPORTed TYPEs
  Network: PUBLIC TYPE = DriverDefs.Network;

  statPRPacketsReceived: PUBLIC StatCounterIndex;
  statPRImAliveReceived: PUBLIC StatCounterIndex;
  statPROneFragRcvd: PUBLIC StatCounterIndex;
  statPRTwoFragsRcvd: PUBLIC StatCounterIndex;
  statPRThreeFragsRcvd: PUBLIC StatCounterIndex;
  statPRWordsReceived: PUBLIC StatCounterIndex;

  statPRPacketsSent: PUBLIC StatCounterIndex;
  statPRImAliveSent: PUBLIC StatCounterIndex;
  statPROneFragSent: PUBLIC StatCounterIndex;
  statPRTwoFragsSent: PUBLIC StatCounterIndex;
  statPRThreeFragsSent: PUBLIC StatCounterIndex;
  statPRWordsSent: PUBLIC StatCounterIndex;

  statPRDuplicateFragment: PUBLIC StatCounterIndex;
  statPRAssemblyTimeout: PUBLIC StatCounterIndex;
  statPRAssemblyQOvf: PUBLIC StatCounterIndex;
  statPRInputBufferOvf: PUBLIC StatCounterIndex;

  statPRBadMagic: PUBLIC StatCounterIndex;
  statPRNotForMe: PUBLIC StatCounterIndex;
  statPRTooManyFragments: PUBLIC StatCounterIndex;
  statPRTotalTooBig: PUBLIC StatCounterIndex;
  statPREmptyFreeQueue: PUBLIC StatCounterIndex;

  statPROldPackets: PUBLIC StatCounterIndex;
  statPRPacketsSkipped: PUBLIC StatCounterIndex;
  statPRSequenceReset: PUBLIC StatCounterIndex;

  statPRLengthOvf: PUBLIC StatCounterIndex;
  statPRInvalidAddress: PUBLIC StatCounterIndex;
  statPRDestinationDown: PUBLIC StatCounterIndex;
  statPROutputQOvf: PUBLIC StatCounterIndex;
  statPRConnectionLimit: PUBLIC StatCounterIndex;
  statPROutPacketsDiscarded: PUBLIC StatCounterIndex;

  stat1822MissingInterrupt: PUBLIC StatCounterIndex;
  statPRTransferTimeout: PUBLIC StatCounterIndex;
  statPRROPsReceived: PUBLIC StatCounterIndex;
  statPRTOPsSent: PUBLIC StatCounterIndex;
  statPRImpWasDown: PUBLIC StatCounterIndex;

  --  Private Storage

  storagep1: POINTER;
  storagep2: POINTER;
  storagep3: POINTER;
  cb: POINTER TO AICommandBlock;

  myTOP: PRTOP _ [leader: prTOPLeader, startID:, endID:];
  myTOPd: AIBufferDescriptor _ [start: @myTOP, end: @myTOP + SIZE[PRTOP]];

  myInBuf: POINTER TO PRBuffer;
  myInBufd: AIBufferDescriptor;
  myOutBuf: POINTER TO PRBuffer;
  myOutBufd: AIBufferDescriptor;

  myPRAddress: PRAddress _ prInvalidAddress;
  mySequence: PRSequence _ prInitialSequenceNumber;
  myRoutes: PRRouteSet _ ALL[prNullRoute];

  defaultAssemblyQueueLimit: CARDINAL = 4;
  myVars: PRDriverVars _
    [outBufp: myOutBuf, inBufp: myInBuf, topp: @myTOP, cbp:,
      prRouteSetp: @myRoutes, prTOPInterval: 6000,
      --  = 5 minutes, these are Alto ticks
      outputTimeoutInterval: 2000/AltoRam.msPerTick,
      assemblyTimeoutInterval: 3000/AltoRam.msPerTick, imAliveInterval: 10,
      --These are seconds
      prHostAliveTimeoutInterval: 41, maxOutputQueueLength: 12,
      maxAssemblyQueueLength: defaultAssemblyQueueLimit, hiQ: @highQueue,
      loQ: @lowQueue, aQ: @assemblyQueue, youAreOK:, iHearYou:];

  maxHiPriWords: CARDINAL = (50 + 22)/2; -- 50 data bytes in a pup
  myGray1: WORD = 125252B;
  myGray2: WORD = 052525B;
  inBuf, outBuf: Buffer;
  inputMode: InputMode;
  outputMode: OutputMode;
  watchMode: WatchMode;
  lastPacketNumber: ARRAY [1..maxPRPupAddress] OF INTEGER _
    [-100, -100, -100, -100, -100];
  nextPacketNumber: ARRAY [1..maxPRPupAddress] OF INTEGER _ [1, 1, 1, 1, 1];

  youWereOK: PRAliveTable;
  cleanupItem: ImageDefs.CleanupItem _ [, ImageDefs.AllReasons, Broom];
  pleaseStop, oFlush, iFlush, topTime: BOOLEAN;

  highQueue, lowQueue, assemblyQueue: QueueObject;
  topTimer, imAliveTimer, timeSendStarted: CARDINAL;
  watcherProcess, inputInterruptProcess, outputInterruptProcess: PROCESS;
  watchTimer, inputInterrupt, outputInterrupt: CONDITION;
  inputInterruptPriority: WORD = 9;
  outputInterruptPriority: WORD = 10;
  inputInterruptChannel: WORD = 1000B; -- BITSHIFT[1,ProcessPriority];
  outputInterruptChannel: WORD = 2000B;
  controlInterruptChannel: WORD = 0B;

  myNetwork: DriverDefs.NetworkObject _
    [decapsulateBuffer: DecapsulateBuffer, encapsulatePup: EncapsulatePup,
      encapsulateOis: EncapsulateOis, sendBuffer: SendBuffer,
      forwardBuffer: ForwardBuffer, activateDriver: ActivateDriver,
      deactivateDriver: DeactivateDriver, deleteDriver: DeleteDriver,
      interrupt: InputInterrupt, index:, device: packetradio, alive: TRUE,
      speed: 9, buffers: defaultAssemblyQueueLimit, spare:, netNumber:,
      hostNumber:, next: NIL, pupStats: DriverDefs.PacketRadioStats,
      stats: @myVars];

  FragmentationError: PUBLIC ERROR = CODE;
  ImpossibleEndcase: PUBLIC ERROR = CODE;
  UnreasonableHardwareStatus: PUBLIC ERROR = CODE;
  Unexpected1822Interrupt: PUBLIC ERROR = CODE;
  QueueScrambled: PUBLIC ERROR = CODE;
  DriverNotActive: PUBLIC ERROR = CODE;
  DriverAlreadyActive: PUBLIC ERROR = CODE;
  CantMakeImageWhileActive: PUBLIC ERROR = CODE;
  UnknownPRHost: PUBLIC ERROR = CODE;

  StartInput: INTERNAL PROCEDURE [
    inputBuffer: AIBufferDescriptor, newMode: InputMode] =
    BEGIN
    inputMode _ newMode;
    cb.inputPost _ notPosted;
    cb.inputBuffer _ inputBuffer;
    StartIO[inputSioCode];
    END;

  StartOutput: INTERNAL PROCEDURE [
    outputBuffer: AIBufferDescriptor, newMode: OutputMode] =
    BEGIN
    timeSendStarted _ AltoRam.GetTicks[];
    outputMode _ newMode;
    cb.command _ turnOnLastBit;
    StartIO[controlSioCode];
    cb.outputPost _ notPosted;
    cb.outputBuffer _ outputBuffer;
    StartIO[outputSioCode];
    END;

  SetControl: PROCEDURE [command: AICommandCode] =
    BEGIN
    cb.controlPost _ notPosted;
    cb.command _ command;
    StartIO[controlSioCode];
    END;

  AcceptInputPacket: INTERNAL PROCEDURE =
    BEGIN
    IF CommFlags.doStats THEN StatIncr[statPRPacketsReceived];
    SELECT myInBuf.h.fragmentation.thisFrag FROM
      0 =>
	BEGIN
	IF inBuf.encapsulation.first THEN GOTO dupeRestart;
	inBuf.encapsulation.first _ TRUE;
	END;
      1 =>
	BEGIN
	IF inBuf.encapsulation.second THEN GOTO dupeRestart;
	inBuf.encapsulation.second _ TRUE;
	END;
      2 =>
	BEGIN
	IF inBuf.encapsulation.third THEN GOTO dupeRestart;
	inBuf.encapsulation.third _ TRUE;
	END;
      ENDCASE =>
	BEGIN
	-- This might happen because of a nasty hardware error
	--Glitch[FragmentationError];
	ReturnFreeBuffer[inBuf];
	inBuf _ NIL;
	RETURN;
	END;
    inBuf.encapsulation.numFragsRcvd _ inBuf.encapsulation.numFragsRcvd + 1;
    inBuf.length _
      inBuf.length + myInBuf.h.leader.length.packet - SIZE[PRPupHeader];
    IF inBuf.encapsulation.numFragsRcvd = myInBuf.h.fragmentation.numFrags THEN
      BEGIN
      inBuf.encapsulation.prType _ myInBuf.h.fragmentation.packetType;
      IF inBuf.encapsulation.prType = imAlive THEN
	BEGIN
	p: LONG POINTER TO PRImAliveEntry _ LOOPHOLE[@inBuf.bufferBody];
	IF p.source IN [1..maxPRPupAddress] THEN
	  BEGIN
	  myVars.iHearYou[p.source] _ myVars.prHostAliveTimeoutInterval;
	  IF p.iHeardYou[myNetwork.hostNumber] THEN
	    myVars.youAreOK[p.source] _ TRUE;
	  END;
	IF CommFlags.doStats THEN StatIncr[statPRImAliveReceived];
	ReturnFreeBuffer[inBuf];
	END
      ELSE
	BEGIN
	inBuf.network _ LONG[@myNetwork];
	inBuf.device _ packetradio;
	SELECT inBuf.encapsulation.numFragsRcvd FROM
	  1 => StatIncr[statPROneFragRcvd];
	  2 => StatIncr[statPRTwoFragsRcvd];
	  3 => StatIncr[statPRThreeFragsRcvd];
	  ENDCASE => Glitch[FragmentationError];
	IF CommFlags.doStats THEN StatBump[statPRWordsReceived, inBuf.length];
	PutOnGlobalInputQueue[inBuf];
	END;
      END
    ELSE Enqueue[@assemblyQueue, inBuf];
    inBuf _ NIL;
    EXITS
      dupeRestart =>
	BEGIN
	Enqueue[@assemblyQueue, inBuf];
	inBuf _ NIL;
	IF CommFlags.doStats THEN StatIncr[statPRDuplicateFragment];
	END;
    END;

  FindInputBuffer: INTERNAL PROCEDURE =
    BEGIN
    q: PRSequence;
    inBuf _ assemblyQueue.first;
    UNTIL inBuf = NIL DO
      q _ LOOPHOLE[inBuf.encapsulation.prSequence];
      IF myInBuf.h.leader.sequence.number = q.number AND myInBuf.h.leader.source =
	inBuf.encapsulation.prAddress THEN
	BEGIN [] _ ExtractFromQueue[@assemblyQueue, inBuf]; RETURN; END;
      inBuf _ inBuf.next;
      ENDLOOP;
    IF assemblyQueue.length > myVars.maxAssemblyQueueLength THEN --recycle buffer
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPRAssemblyQOvf];
      inBuf _ Dequeue[@assemblyQueue]; --remove from head
      GOTO setupBuffer;
      END
    ELSE
      BEGIN inBuf _ GetInputBuffer[]; IF inBuf # NIL THEN GOTO setupBuffer; END;
    EXITS
      setupBuffer =>
	BEGIN
	inBuf.encapsulation.timer _ AltoRam.GetTicks[];
	inBuf.encapsulation.numFragsRcvd _ 0;
	inBuf.encapsulation.first _ inBuf.encapsulation.second _
	  inBuf.encapsulation.third _ FALSE;
	inBuf.encapsulation.prSequence _ LOOPHOLE[PRSequence[
	  myInBuf.h.leader.sequence.number, 0]];
	inBuf.encapsulation.prAddress _ myInBuf.h.leader.source;
	inBuf.encapsulation.prLength _
	  inBuf.length - DriverTypes.prEncapsulationOffset;
	inBuf.length _ 0;
	RETURN;
	END;
    END;

  TryOutput: INTERNAL PROCEDURE =
    BEGIN
    IF topTime THEN GOTO sendTOP;
    IF outBuf # NIL THEN GOTO sendThisOne;
    DO
      SELECT TRUE FROM
	highQueue.length # 0 => outBuf _ Dequeue[@highQueue];
	lowQueue.length # 0 => outBuf _ Dequeue[@lowQueue];
	ENDCASE => BEGIN outBuf _ NIL; EXIT; END;
      mySequence.number _ mySequence.number + 1;
      outBuf.encapsulation.prSequence _ LOOPHOLE[mySequence];
      outBuf.encapsulation.numFragsTrans _ 0;
      SELECT outBuf.encapsulation.prType FROM
	imAlive => GOTO sendThisOne;
	broadcastPup =>
	  FOR i: CARDINAL IN [1..maxPRPupAddress] DO
	    IF myVars.youAreOK[i] THEN
	      BEGIN outBuf.encapsulation.prAddress _ i; GOTO sendThisOne; END;
	    ENDLOOP;
	pup =>
	  IF myVars.youAreOK[outBuf.encapsulation.prAddress] THEN
	    GOTO sendThisOne;
	ENDCASE => Glitch[ImpossibleEndcase];
      PutOnGlobalDoneQueue[outBuf];
      outBuf _ NIL;
      IF CommFlags.doStats THEN StatIncr[statPRDestinationDown];
      ENDLOOP;
    --  ELSE  nothing to do
    outputMode _ idle;
    cb.outputPost _ notPosted;
    EXITS
      sendTOP =>
	BEGIN
	IF CommFlags.doStats THEN StatIncr[statPRTOPsSent];
	StartOutput[myTOPd, sendTop];
	END;
      sendThisOne => SendWithRoute[];
    END;

  SendWithRoute: INTERNAL PROCEDURE =
    BEGIN
    q: PRSequence;
    pn: POINTER TO INTEGER;
    bufOffset, fragSize: CARDINAL;
    q _ LOOPHOLE[outBuf.encapsulation.prSequence];
    bufOffset _ outBuf.encapsulation.numFragsTrans*maxFragSize;
    IF outBuf.encapsulation.numFragsTrans = (outBuf.encapsulation.numFrags - 1)
      THEN fragSize _ outBuf.encapsulation.prLength
    ELSE fragSize _ maxFragSize;
    myOutBuf.h.leader.destination _
      outBuf.encapsulation.prAddress + prAddressBase;
    myOutBuf.h.leader.route _ myRoutes[outBuf.encapsulation.prAddress];
    myOutBuf.h.leader.sequence _ PRSequence[
      q.number, outBuf.encapsulation.numFragsTrans];
    myOutBufd.end _ @(myOutBuf.body) + fragSize;
    myOutBuf.h.leader.length.packet _ SIZE[PRPupHeader] + fragSize;
    myOutBuf.h.fragmentation.numFrags _ outBuf.encapsulation.numFrags;
    myOutBuf.h.fragmentation.thisFrag _ outBuf.encapsulation.numFragsTrans;
    myOutBuf.h.fragmentation.packetType _ outBuf.encapsulation.prType;
    pn _ @nextPacketNumber[outBuf.encapsulation.prAddress];
    myOutBuf.h.packetNumber _ pn^;
    pn^ _ pn^ + 1;

    PREncrypt[
      from: AltoRam.Shorten[
      @outBuf.encapsulation + DriverTypes.prEncapsulationOffset + bufOffset],
      to: @myOutBuf.body, count: fragSize];



    IF outBuf.encapsulation.numFragsTrans >= outBuf.encapsulation.numFrags THEN
      Glitch[FragmentationError];
    StartOutput[myOutBufd, normal];
    END;


  InputInterrupt: ENTRY PROCEDURE =
    BEGIN
    iPostData: POINTER TO AIPostStatus _ @cb.inputPost;
    bufOffset, fragSize: CARDINAL;
    lastPacketp: POINTER TO INTEGER;
    sequenceError: INTEGER;

    Process.SetPriority[3];

    UNTIL pleaseStop DO
      IF iPostData^ = notPosted THEN
	DO
	  WAIT inputInterrupt;
	  IF pleaseStop THEN RETURN;
	  IF iPostData^ # notPosted OR iFlush THEN EXIT;
	  IF CommFlags.doStats THEN StatIncr[stat1822MissingInterrupt];
	  ENDLOOP;
      BEGIN -- solely for exits clauses
      IF iFlush THEN BEGIN iFlush _ FALSE; GOTO Discard; END;
      SELECT inputMode FROM
	discard =>
	  SELECT iPostData^.mcStat FROM
	    -- iBufLenZero =>  Glitch "can't happen"

	    iBufFull => GOTO Discard;
	    allOK, iBufFullDone => -- discard complete, look at new packet
	      GOTO NewRead;
	    ENDCASE => Glitch[UnreasonableHardwareStatus];
	normal =>
	  SELECT iPostData^.mcStat FROM
	    -- iBufLenZero =>  Glitch "can't happen"

	    iBufFull => --These shouldn't happen, indicates garbage packet
	      BEGIN
	      IF CommFlags.doStats THEN StatIncr[statPRInputBufferOvf];
	      GOTO Discard;
	      END;
	    iBufFullDone =>
	      BEGIN
	      IF CommFlags.doStats THEN StatIncr[statPRInputBufferOvf];
	      GOTO NewRead;
	      END;
	    allOK =>
	      BEGIN
	      -- Try to obtain a buffer, stick under input otherwise discard
	      -- would like to do a WAIT on getbuffer, discard on timeout
	      IF myInBuf.h.leader.control = 0 THEN
		BEGIN
		IF CommFlags.doStats THEN StatIncr[statPRROPsReceived];
		GOTO NewRead;
		END;
	      IF myInBuf.h.magic # prSecretNumber OR
		myInBuf.h.leader.length.header # SIZE[PRLeader] THEN
		BEGIN
		IF CommFlags.doStats THEN StatIncr[statPRBadMagic];
		GOTO NewRead;
		END;
	      IF myInBuf.h.leader.destination # myPRAddress THEN
		BEGIN
		IF CommFlags.doStats THEN StatIncr[statPRNotForMe];
		GOTO NewRead;
		END;
	      -- ELSE probably a pup
	      IF myInBuf.h.fragmentation.thisFrag >=
		myInBuf.h.fragmentation.numFrags THEN
		BEGIN
		IF CommFlags.doStats THEN StatIncr[statPRTooManyFragments];
		GOTO NewRead;
		END;
	      -- count out-of-orderness
	      bufOffset _ myInBuf.h.leader.source - prAddressBase;
	      IF bufOffset IN [1..maxPRPupAddress] THEN
		BEGIN
		lastPacketp _ @lastPacketNumber[bufOffset];
		sequenceError _ myInBuf.h.packetNumber - lastPacketp^;
		SELECT sequenceError FROM
		  1 => lastPacketp^ _ myInBuf.h.packetNumber; -- Just right

		  IN [-9..0] => -- Duplicate or old
		    IF CommFlags.doStats THEN StatIncr[statPROldPackets];
		  IN [2..9] => -- Some apparently lost
		    BEGIN
		    IF CommFlags.doStats THEN
		      StatBump[statPRPacketsSkipped, sequenceError - 1];
		    lastPacketp^ _ myInBuf.h.packetNumber;
		    END;
		  ENDCASE =>
		    BEGIN
		    IF CommFlags.doStats THEN StatIncr[statPRSequenceReset];
		    lastPacketp^ _ myInBuf.h.packetNumber;
		    END;
		END;
	      FindInputBuffer[];
	      IF inBuf # NIL THEN
		BEGIN
		bufOffset _ myInBuf.h.fragmentation.thisFrag*maxFragSize;
		fragSize _ myInBuf.h.leader.length.packet - SIZE[PRPupHeader];
		IF bufOffset + fragSize > inBuf.encapsulation.prLength THEN
		  BEGIN
		  ReturnFreeBuffer[inBuf];
		  inBuf _ NIL;
		  IF CommFlags.doStats THEN StatIncr[statPRTotalTooBig];
		  GOTO NewRead;
		  END;
		PREncrypt[
		  from: @myInBuf.body,
		  to: AltoRam.Shorten[
		  @inBuf.encapsulation + DriverTypes.prEncapsulationOffset +
		    bufOffset], count: fragSize];
		AcceptInputPacket[];
		GOTO NewRead;
		END -- Dismiss

	      ELSE
		BEGIN
		IF CommFlags.doStats THEN StatIncr[statPREmptyFreeQueue];
		GOTO NewRead;
		END;
	      END;
	    ENDCASE => Glitch[UnreasonableHardwareStatus];
	ENDCASE => Glitch[ImpossibleEndcase];
      EXITS
	NewRead => StartInput[myInBufd, normal]; --restart input

	Discard => StartInput[myInBufd, discard]; --restart input

      END;
      ENDLOOP; --End of UNTIL pleaseStop Loop

    END; --InputInterrupt

  OutputInterrupt: ENTRY PROCEDURE =
    BEGIN
    oPostData: POINTER TO AIPostStatus _ @cb.outputPost;

    Process.SetPriority[3];

    UNTIL pleaseStop DO
      IF oPostData^ = notPosted THEN
	DO
	  WAIT outputInterrupt;
	  IF pleaseStop THEN RETURN;
	  IF oPostData^ # notPosted OR oFlush THEN EXIT;
	  IF CommFlags.doStats THEN StatIncr[stat1822MissingInterrupt];
	  ENDLOOP;



      IF oFlush THEN
	BEGIN --send NOP, then retry
	DO
	  IF outBuf # NIL THEN
	    BEGIN
	    PutOnGlobalDoneQueue[outBuf]; --discard, really
	    IF CommFlags.doStats THEN StatIncr[statPROutPacketsDiscarded];
	    END;
	  SELECT TRUE FROM
	    highQueue.length # 0 => outBuf _ Dequeue[@highQueue];
	    lowQueue.length # 0 => outBuf _ Dequeue[@lowQueue];
	    ENDCASE => BEGIN outBuf _ NIL; EXIT; END;
	  ENDLOOP;
	oFlush _ FALSE;
	StartOutput[myTOPd, sendTop];
	END -- Dismiss

      ELSE -- hardware status is OK
	BEGIN
	IF oPostData^.mcStat # allOK THEN Glitch[UnreasonableHardwareStatus];
	SELECT outputMode FROM
	  idle => Glitch[Unexpected1822Interrupt];
	  sendTop => -- Probably a nop, check queue
	    BEGIN
	    topTime _ FALSE;
	    TryOutput[]; -- Dismiss

	    END; -- Dismiss

	  normal =>
	    BEGIN
	    IF CommFlags.doStats THEN StatIncr[statPRPacketsSent];
	    IF CommFlags.doStats THEN
	      StatBump[statPRWordsSent, myOutBuf.h.leader.length.packet];
	    outBuf.encapsulation.numFragsTrans _
	      outBuf.encapsulation.numFragsTrans + 1;
	    IF outBuf.encapsulation.numFragsTrans = outBuf.encapsulation.numFrags
	      THEN
	      BEGIN -- Only for exits clauses
	      SELECT outBuf.encapsulation.prType FROM
		imAlive =>
		  BEGIN
		  IF CommFlags.doStats THEN StatIncr[statPRImAliveSent];
		  IF outBuf.encapsulation.prAddress = maxPRPupAddress THEN
		    GOTO DoneWithIt;
		  outBuf.encapsulation.prAddress _
		    outBuf.encapsulation.prAddress + 1;
		  GOTO DoNext;
		  END;
		broadcastPup, pup =>
		  BEGIN
		  IF CommFlags.doStats THEN
		    SELECT outBuf.encapsulation.numFrags FROM
		      1 => StatIncr[statPROneFragSent];
		      2 => StatIncr[statPRTwoFragsSent];
		      3 => StatIncr[statPRThreeFragsSent];
		      ENDCASE;
		  IF outBuf.encapsulation.prType = broadcastPup THEN
		    FOR i: CARDINAL IN
		      [outBuf.encapsulation.prAddress + 1..maxPRPupAddress] DO
		      IF myVars.youAreOK[i] THEN
			BEGIN
			outBuf.encapsulation.prAddress _ i;
			GOTO DoNext;
			END;
		      ENDLOOP;
		  GOTO DoneWithIt;
		  END;
		ENDCASE => Glitch[ImpossibleEndcase];
	      EXITS
		DoneWithIt =>
		  BEGIN -- done with this one
		  PutOnGlobalDoneQueue[outBuf];
		  outBuf _ NIL;
		  END;
		DoNext =>
		  BEGIN
		  outBuf.encapsulation.numFragsTrans _ 0;
		  mySequence.number _ mySequence.number + 1;
		  outBuf.encapsulation.prSequence _ LOOPHOLE[mySequence];
		  END;
	      END;
	    TryOutput[];
	    END; -- Dismiss

	  ENDCASE => Glitch[ImpossibleEndcase];
	END; --End of ELSE clause of hardware status IF

      ENDLOOP; --End of UNTIL pleaseStop loop

    END; --OutputInterrupt

  PREncrypt: PROCEDURE [from, to: POINTER, count: CARDINAL] =
    BEGIN
    bbTable: BitBltDefs.BBTableSpace;
    bbt: BitBltDefs.BBptr _ BitBltDefs.AlignedBBTable[@bbTable];
    InlineDefs.COPY[from: from, nwords: count, to: to];
    bbt^ _
      [sourcealt: FALSE, destalt: FALSE, sourcetype: gray, function: invert,
	dbca: to, dbmr: 1, dlx: 0, dty: 0, dw: 16, dh: count, sbca: from, sbmr: 1,
	slx: 0, sty: 1, -- Go backwards
	gray0: myGray1, gray1: myGray2, gray2: myGray1, gray3: myGray2];
    BitBltDefs.BITBLT[bbt];
    END;


  StartWatcher: PROCEDURE =
    BEGIN  -- Extra layer of kludgery because of Gateway startup troubles
    Process.SetPriority[1];
    watcherProcess _ FORK Watcher[];
    END;

  Watcher: ENTRY PROCEDURE =
    BEGIN
    UNTIL pleaseStop DO
      SetControl[doNothing]; --get hardware status
      BEGIN --For exits clause
      --Send a ImAlive occasionally
      IF imAliveTimer = 0 THEN
	BEGIN IF SendImAlive[] THEN imAliveTimer _ myVars.imAliveInterval; END
      ELSE imAliveTimer _ imAliveTimer - 1;
      --Timeout old ImAlive entries
      FOR i: CARDINAL IN [1..maxPRPupAddress] DO
	IF myVars.iHearYou[i] > 0 THEN
	  BEGIN
	  myVars.iHearYou[i] _ myVars.iHearYou[i] - 1;
	  IF myVars.iHearYou[i] = 0 THEN myVars.youAreOK[i] _ FALSE;
	  END;
	IF CommFlags.doStats AND myVars.youAreOK[i] # youWereOK[i] THEN
	  LogPRChange[i];
	ENDLOOP;
      youWereOK _ myVars.youAreOK;
      SELECT watchMode FROM
	normal =>
	  BEGIN
	  nextb, thisb: Buffer;
	  IF cb.controlPost.impWasDown = ON THEN
	    BEGIN
	    IF CommFlags.doStats THEN StatIncr[statPRImpWasDown];
	    GOTO Reset;
	    END;
	  --Flush stuck packets
	  IF
	    (outputMode # idle AND (AltoRam.GetTicks[] - timeSendStarted) >
	      myVars.outputTimeoutInterval) THEN
	    BEGIN
	    IF CommFlags.doStats THEN StatIncr[statPRTransferTimeout];
	    GOTO Reset;
	    END;
	  --Check for old partly assembled packets
	  nextb _ assemblyQueue.first;
	  UNTIL nextb = NIL DO
	    thisb _ nextb;
	    nextb _ thisb.next;
	    IF (AltoRam.GetTicks[] - thisb.encapsulation.timer) >
	      myVars.assemblyTimeoutInterval THEN
	      BEGIN
	      IF ExtractFromQueue[@assemblyQueue, thisb] = NIL THEN
		Glitch[QueueScrambled];
	      ReturnFreeBuffer[thisb];
	      IF CommFlags.doStats THEN StatIncr[statPRAssemblyTimeout];
	      END;
	    ENDLOOP;
	  --Send an TOP occasionally
	  IF (NOT topTime) AND (AltoRam.GetTicks[] - topTimer) >
	    myVars.prTOPInterval THEN
	    BEGIN topTimer _ AltoRam.GetTicks[]; topTime _ TRUE; END;
	  END;
	flappingRelay =>
	  BEGIN watchMode _ justFlapped; SetControl[turnOnRelay]; END;
	justFlapped => BEGIN watchMode _ normal; SetControl[tryClearIWD]; END;
	ENDCASE => Glitch[ImpossibleEndcase];
      EXITS
	Reset =>
	  BEGIN
	  watchMode _ flappingRelay;
	  oFlush _ iFlush _ TRUE;
	  SetControl[turnOffRelay];
	  SetControl[masterReset];
	  NOTIFY outputInterrupt;
	  NOTIFY inputInterrupt;
	  END;
      END;
      WAIT watchTimer;
      ENDLOOP;
    END;

  SendImAlive: INTERNAL PROCEDURE RETURNS [BOOLEAN] =
    BEGIN
    b: Buffer _ MaybeGetFreeBuffer[];
    p: LONG POINTER TO PRImAliveEntry;
    IF b = NIL THEN RETURN[FALSE];
    p _ LOOPHOLE[@b.bufferBody];
    b.encapsulation.prType _ imAlive;
    b.encapsulation.prAddress _ 1;
    b.encapsulation.numFrags _ 1;
    b.length _ SIZE[PRImAliveEntry] + 1;
    b.encapsulation.prLength _ b.length;
    b.device _ packetradio;
    p.source _ myNetwork.hostNumber;
    FOR i: CARDINAL IN [1..maxPRPupAddress] DO
      p.iHeardYou[i] _ myVars.iHearYou[i] > 0; ENDLOOP;
    Enqueue[@highQueue, b];
    IF outputMode = idle THEN TryOutput[];
    RETURN[TRUE];
    END;

  LogPRChange: INTERNAL PROCEDURE [host: CARDINAL] =
    BEGIN
    text: STRING = [100];
    Time.AppendCurrent[text];
    String.AppendString[text, "  PR Host "L];
    String.AppendDecimal[text, host];
    String.AppendString[
      text, IF myVars.youAreOK[host] THEN " up."L ELSE " down."L];
    Put.Line[NIL, text];
    END;

  DecapsulateBuffer: PROCEDURE [b: Buffer] RETURNS [BufferType] =
    BEGIN
    SELECT b.encapsulation.prType FROM
      pup, broadcastPup =>
	BEGIN
	IF 2*b.length < b.pupLength + DriverTypes.prEncapsulationBytes THEN
	  BEGIN
	  IF CommFlags.doStats THEN StatIncr[statPupsDiscarded];
	  RETURN[rejected];
	  END;
	RETURN[pup];
	END;
      ENDCASE => RETURN[rejected];
    END;

  EncapsulatePup: PROCEDURE [b: PupBuffer, destination: PupHostID] =
    BEGIN
    b.encapsulation.prType _
      IF destination = PupTypes.allHosts THEN broadcastPup ELSE pup;
    IF LOOPHOLE[destination, CARDINAL] > maxPRPupAddress THEN
      b.encapsulation.prAddress _ prInvalidAddress
    ELSE b.encapsulation.prAddress _ LOOPHOLE[destination, PRAddress];
    b.length _ (b.pupLength + 1)/2;
    END;

  EncapsulateOis: PROCEDURE [
    b: OisBuffer, destination: SpecialSystem.HostNumber] =
    BEGIN
    b.encapsulation.prType _ ois;
    b.encapsulation.prAddress _ prInvalidAddress;
    END;

  ForwardBuffer: ENTRY PROCEDURE [b: Buffer] RETURNS [PupTypes.PupErrorCode] =
    BEGIN
    n: CARDINAL;
    high: BOOLEAN;
    IF b.encapsulation.prAddress = prInvalidAddress THEN
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPRInvalidAddress];
      RETURN[cantGetTherePupErrorCode];
      END;
    IF NOT b.encapsulation.prType = broadcastPup AND NOT myVars.youAreOK[
      b.encapsulation.prAddress] THEN
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPRDestinationDown];
      RETURN[cantGetTherePupErrorCode];
      END;
    IF (highQueue.length + lowQueue.length) >= myVars.maxOutputQueueLength THEN
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPROutputQOvf];
      RETURN[gatewayResourceLimitsPupErrorCode];
      END;
    n _ CountFriends[b, @lowQueue];
    high _ b.length < maxHiPriWords AND n = 0;
    n _ n + CountFriends[b, @highQueue];
    IF n > 5 THEN
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPRConnectionLimit];
      RETURN[connectionLimitPupErrorCode];
      END;
    Send[b, high];
    RETURN[noErrorPupErrorCode];
    END;

  SendBuffer: ENTRY PROCEDURE [b: Buffer] =
    BEGIN
    IF b.encapsulation.prAddress = prInvalidAddress THEN
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPRInvalidAddress];
      PutOnGlobalDoneQueue[b];
      RETURN;
      END;
    IF (highQueue.length + lowQueue.length) >= myVars.maxOutputQueueLength THEN
      BEGIN
      IF CommFlags.doStats THEN StatIncr[statPROutputQOvf];
      PutOnGlobalDoneQueue[b];
      RETURN;
      END;
    Send[b, b.length < maxHiPriWords AND CountFriends[b, @lowQueue] = 0];
    END;

  Send: INTERNAL PROCEDURE [b: Buffer, high: BOOLEAN] =
    BEGIN
    IF pleaseStop THEN Glitch[DriverNotActive];
    SELECT b.length FROM
      <= maxOneFragSize =>
	BEGIN
	b.encapsulation.numFrags _ 1;
	b.encapsulation.prLength _ b.length;
	END;
      <= maxTwoFragSize =>
	BEGIN
	b.encapsulation.numFrags _ 2;
	b.encapsulation.prLength _ b.length - maxOneFragSize;
	END;
      <= maxThreeFragSize =>
	BEGIN
	b.encapsulation.numFrags _ 3;
	b.encapsulation.prLength _ b.length - maxTwoFragSize;
	END;
      ENDCASE =>
	BEGIN
	PutOnGlobalDoneQueue[b];
	IF CommFlags.doStats THEN StatIncr[statPRLengthOvf];
	END;
    b.device _ packetradio;
    Enqueue[IF high THEN @highQueue ELSE @lowQueue, b];
    IF outputMode = idle THEN TryOutput[];
    END;

  CountFriends: INTERNAL PROCEDURE [b: Buffer, q: Queue] RETURNS [n: CARDINAL] =
    BEGIN
    n _ 0;
    SELECT b.encapsulation.prType FROM
      imAlive => RETURN;
      pup, broadcastPup =>
	BEGIN
	pup, maybe: PupBuffer;
	pup _ LOOPHOLE[b];
	maybe _ LOOPHOLE[q.first];
	UNTIL maybe = NIL DO
	  IF
	    (maybe.encapsulation.prType = pup OR maybe.encapsulation.prType =
	      broadcastPup)
	    --  Open code the multi-word compare because it uses non-resident code.
	     AND pup.dest.net = maybe.dest.net AND pup.dest.host = maybe.dest.host
	    AND pup.dest.socket = maybe.dest.socket THEN n _ n + 1;
	  maybe _ LOOPHOLE[maybe.next];
	  ENDLOOP;
	END;
      ois =>
	BEGIN
	ois, maybe: OisBuffer;
	ois _ LOOPHOLE[b];
	maybe _ LOOPHOLE[q.first];
	UNTIL maybe = NIL DO
	  IF maybe.encapsulation.prType = ois
	    --  Again, open code the multi-word compare.
	     AND ois.ois.destination.net = maybe.ois.destination.net AND
	    ois.ois.destination.host = maybe.ois.destination.host AND
	    ois.ois.destination.socket = maybe.ois.destination.socket THEN
	    n _ n + 1;
	  maybe _ LOOPHOLE[maybe.next];
	  ENDLOOP;
	END;
      ENDCASE => Glitch[ImpossibleEndcase];
    END;

  Broom: PROCEDURE [why: BcplOps.CleanupReason] =
    BEGIN
    SELECT why FROM
      Finish, Abort, OutLd =>
	BEGIN
	cb.inputBits _ 0B;
	cb.outputBits _ 0B;
	SetControl[turnOffRelay];
	END;
      InLd =>
	BEGIN
	cb.inputBits _ inputInterruptChannel;
	cb.outputBits _ outputInterruptChannel;
	watchMode _ flappingRelay;
	END;
      Save, Checkpoint => Glitch[CantMakeImageWhileActive];
      ENDCASE;
    SetControl[masterReset];
    END;

  -- COLD code, only used when turning things on+off

  CreatePacketRadioDriver: PUBLIC PROCEDURE [host, net: CARDINAL]
    RETURNS [BOOLEAN] =
    BEGIN
    myNetwork.netNumber _ [0, net];
    myNetwork.hostNumber _ host;
    IF host NOT IN [1..maxPRPupAddress] THEN Glitch[UnknownPRHost]
    ELSE myPRAddress _ LOOPHOLE[host + prAddressBase, PRAddress];
    myTOP.startID _ myTOP.endID _ myPRAddress;
    pleaseStop _ TRUE;
    AddDeviceToChain[@myNetwork, 0];
    RETURN[TRUE];
    END;

  DeleteDriver: PROCEDURE = BEGIN END;

  ActivateDriver: PROCEDURE =
    BEGIN
    IF ~pleaseStop THEN Glitch[DriverAlreadyActive];
    storagep1 _ Storage.Node[SIZE[AICommandBlock] + 1];
    cb _ Even[storagep1];
    cb.blank _ 0;
    cb.controlPost _ cb.outputPost _ cb.inputPost _ notPosted;
    cb.inputBits _ inputInterruptChannel;
    cb.outputBits _ outputInterruptChannel;
    cb.controlBits _ controlInterruptChannel;
    myVars.cbp _ cb;
    storagep2 _ Storage.Node[SIZE[PRBuffer] + 1];
    myInBuf _ Even[storagep2];
    myInBufd.start _ myInBuf;
    myInBufd.end _ myInBuf + SIZE[PRBuffer];
    storagep3 _ Storage.Node[SIZE[PRBuffer] + 1];
    myOutBuf _ Even[storagep3];
    myOutBufd.start _ myOutBuf;
    myOutBuf.h.leader _ prPupLeader;
    myOutBuf.h.leader.source _ myPRAddress;
    myOutBuf.h.magic _ prSecretNumber;
    SetControlPtr[cb];
    SetControl[turnOffTestMode];
    SetControl[masterReset];
    outputMode _ idle;
    watchMode _ flappingRelay; --watcher will turn on relay
    pleaseStop _ oFlush _ iFlush _ FALSE;
    topTime _ TRUE;
    topTimer _ AltoRam.GetTicks[];
    imAliveTimer _ 0;
    FOR i: CARDINAL IN [1..maxPRPupAddress] DO
      myVars.youAreOK[i] _ FALSE;
      myVars.iHearYou[i] _ 0;
      youWereOK[i] _ TRUE;
      ENDLOOP;
    QueueInitialize[@highQueue];
    QueueInitialize[@lowQueue];
    QueueInitialize[@assemblyQueue];
    CommUtilDefs.AddInterruptHandler[inputInterruptPriority, @inputInterrupt, 0];
    CommUtilDefs.AddInterruptHandler[
      outputInterruptPriority, @outputInterrupt, 0];
    inBuf _ outBuf _ NIL;
    ImageDefs.AddCleanupProcedure[@cleanupItem];
    inputInterruptProcess _ FORK InputInterrupt[];
    outputInterruptProcess _ FORK OutputInterrupt[];
    Process.Detach[FORK StartWatcher[]];
    LockedStartup[];
    END;


  Even: PROCEDURE [p: POINTER] RETURNS [POINTER] =
    BEGIN IF (LOOPHOLE[p, CARDINAL] MOD 2) # 0 THEN p _ p + 1; RETURN[p]; END;

  LockedStartup: ENTRY PROCEDURE = BEGIN StartInput[myInBufd, normal]; END;

  DeactivateDriver: PROCEDURE =
    BEGIN
    IF pleaseStop THEN Glitch[DriverNotActive];
    pleaseStop _ TRUE;
    LockedKill[];
    JOIN inputInterruptProcess;
    JOIN outputInterruptProcess;
    JOIN watcherProcess;
    -- These following steps are the same as Broom[finish]
    cb.inputBits _ 0B;
    cb.outputBits _ 0B;
    SetControl[turnOffRelay];
    SetControl[masterReset];

    ImageDefs.RemoveCleanupProcedure[@cleanupItem];
    CommUtilDefs.RemoveInterruptHandler[inputInterruptPriority];
    CommUtilDefs.RemoveInterruptHandler[outputInterruptPriority];
    IF outBuf # NIL THEN PutOnGlobalDoneQueue[outBuf];
    IF inBuf # NIL THEN ReturnFreeBuffer[inBuf];
    QueueCleanup[@highQueue];
    QueueCleanup[@lowQueue];
    QueueCleanup[@assemblyQueue];
    Storage.Free[storagep1];
    Storage.Free[storagep2];
    Storage.Free[storagep3];
    END;

  LockedKill: ENTRY PROCEDURE =
    BEGIN NOTIFY inputInterrupt; NOTIFY outputInterrupt; NOTIFY watchTimer; END;

  GetPRDriverVars: PUBLIC PROCEDURE RETURNS [POINTER TO PRDriverVars] =
    BEGIN RETURN[@myVars]; END;

  -- initialization
  -- IF ~doAlto THEN Glitch[compilationMixup];

  Process.DisableTimeout[@inputInterrupt];
  Process.DisableTimeout[@outputInterrupt];
  Process.SetTimeout[@watchTimer, Process.MsecToTicks[1000]];
  IF TRUE THEN BEGIN DriverDefs.GetGiantVector[].prThings _ @myVars; END;
  SetupPRThings[];
  END.