-- File: DispatcherImpl.mesa - last edit:
-- AOF                 27-Nov-87 12:01:19
-- SMA                 21-May-86 11:05:15
-- Copyright (C) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved. 

DIRECTORY
  Buffer USING [
    Buffer, Dequeue, Enqueue, QueueCleanup, QueueInitialize, QueueObject,
    Type],
  --ByteBlt USING [ByteBlt],
  CommPriorities USING [receiver],
  --Environment USING [Block],
  Protocol1 USING [
    Action, ProtocolFamily, FamilyUnit, DecapsulatorProc, Matrix, Matrices,
    MatrixRecord, FamilyIndex, UniqueName, Family, EncapsulatorProc],
  CommFlags USING [doDebug],
  CommHeap USING [zone],
  CommunicationInternal USING [],
  Driver USING [
    GetDeviceChain, Glitch, Device, ReturnFreeBuffer],
  Inline USING [LongCOPY],
  Process USING [Abort, DisableTimeout, EnableAborts, Pause, SetPriority],
  SpecialCommunication USING [SpyProc, SpyType];

DispatcherImpl: MONITOR
  IMPORTS Buffer, <<ByteBlt,>> CommHeap, Driver, Inline, Process
  EXPORTS
    Buffer, Protocol1, CommunicationInternal, Driver, SpecialCommunication =
  BEGIN

  -- EXPORTed TYPEs
  Device: PUBLIC TYPE = Driver.Device;
  --ERRORS
  NoVacancy: PUBLIC ERROR = CODE;
  NotInterested: PUBLIC ERROR = CODE;

  mainFork: PROCESS;
  dispatcherReady: CONDITION;
  globalInputQueue: Buffer.QueueObject;
  globalOutputQueue: Buffer.QueueObject;
  orphanSpy: SpecialCommunication.SpyProc ← NIL;

  condo: Condo ← [0, ALL[NIL]];  --family housing project
  Condo: TYPE = RECORD[
    occupied: Protocol1.FamilyIndex ← 0,  --current occupation
    unit: ARRAY Protocol1.FamilyIndex OF Protocol1.Family];

  MemberSupport: TYPE = RECORD[
    SEQUENCE COMPUTED Protocol1.FamilyIndex OF Protocol1.MatrixRecord];

  uniqueAvail: PACKED ARRAY Protocol1.ProtocolFamily OF BOOLEAN ← [
    ns: FALSE, pup: FALSE, arpa: FALSE, osi: FALSE, upt1: TRUE, upt2: TRUE];

  BadSource: ERROR = CODE;
  NameNotAssigned: ERROR = CODE;
  TenentRegistered: ERROR = CODE;
  InvalidPacketType: ERROR = CODE;
  TenentNotRegistered: PUBLIC << Protocol1 >> ERROR = CODE;

  --CONSTANT
  unitSize: CARDINAL = SIZE[Protocol1.MatrixRecord];

  AcquireUniqueName: PUBLIC ENTRY PROC RETURNS[name: Protocol1.UniqueName] =
    BEGIN
    --There are only two unattached family names.  How tough can this be?
    SELECT TRUE FROM
      uniqueAvail[upt1] => {uniqueAvail[upt1] ← FALSE; RETURN[upt1]};
      uniqueAvail[upt2] => {uniqueAvail[upt2] ← FALSE; RETURN[upt2]};
      ENDCASE => RETURN WITH ERROR NoVacancy;
    END;  --AcquireUniqueName

  AddFamilyMember: PUBLIC PROC[driver: Device, matrix: Protocol1.Matrix] =
    --Add new support for this driver
    BEGIN
    EnterMonitor: ENTRY PROC =
      BEGIN
      rich: LONG POINTER TO MemberSupport;
      poor: LONG DESCRIPTOR FOR Protocol1.Matrices ← driver.matrix;
      base: Protocol1.Matrix ← @poor[0];  --this variable is overloaded
      length: Protocol1.FamilyIndex ← LENGTH[poor];
      THROUGH[0..length) DO
	IF base.family = matrix.family THEN  --overlaying old family
	  BEGIN
	  rich ← LOOPHOLE[@poor[0]];  --the rich share space with the poor
	  action ← modify;  --that's what we are doing
	  EXIT;  --our work is done
	  END;
	base ← base + unitSize;  --try next family in unit
	REPEAT FINISHED =>
	  BEGIN
	  rich ← CommHeap.zone.NEW[MemberSupport[length + 1]];  --new living space
	  IF BASE[poor] # NIL THEN
	    BEGIN
	    base ← @poor[0];  --this is were the poor live(d)
	    Inline.LongCOPY[to: rich, from: base, nwords: unitSize * length];
	    CommHeap.zone.FREE[@base];  --toss the poor
	    END;
	  base ← @rich[length];  --that's where the new family lives
	  length ← SUCC[length];  --in a new, modern and larger unit
	  action ← add;  --this is a new family member
	  END;
	ENDLOOP;
  
      base↑ ← [
	family: matrix.family,
	context: matrix.context,
	encapsulator: matrix.encapsulator,
	decapsulator: matrix.decapsulator];
      driver.matrix ← DESCRIPTOR[rich, length];  --move in the rich
      driver.receiveBufferLen ← MAX[--keep track of largest used
        driver.receiveBufferLen, matrix.family.maxBufferSize];
      END;  --EnterMonitor

    action: Protocol1.Action;

    EnterMonitor[];  --get the data base changes out of the way
    matrix.family.stateChanged[driver, matrix.context, action];  --tell family

    END;  --AddFamilyMember

  GetFamilyUnit: PUBLIC ENTRY PROC[name: Protocol1.ProtocolFamily]
    RETURNS[family: Protocol1.Family] =
    BEGIN
    FOR i: Protocol1.FamilyIndex IN[0..condo.occupied) DO
      IF condo.unit[i].name = name THEN RETURN[condo.unit[i]];
      REPEAT FINISHED => ERROR TenentNotRegistered;
      ENDLOOP;
    END;  --GetFamilyUnit

  EvictFamily: PUBLIC ENTRY PROC[name: Protocol1.ProtocolFamily] =
    BEGIN
    driver: Device;
    un: Protocol1.FamilyIndex ← FIRST[Protocol1.FamilyIndex];  --compression
    census: CARDINAL = condo.occupied;  --make copy so we can modify original
    --This will be a noop of the family 'name' doesn't exist
    FOR fi: Protocol1.FamilyIndex IN [0..census) DO
      family: Protocol1.Family ← condo.unit[fi];
      IF family.name = name THEN
        BEGIN  --collapse this unit out of condo (only one match)
	family.status ← dead;  --turn on the gas, thus the prediction
	Process.Pause[1];  --wait for gas to take affect
	FOR driver ← Driver.GetDeviceChain[], driver.next UNTIL driver = NIL DO
	  RemoveFamilyMemberInternal[driver, family];  --remove members first
	  ENDLOOP;
	condo.occupied ← condo.occupied - 1;  --moved to Miami
	condo.unit[fi] ← NIL;  --sorta like repainting the rooms
	END
      ELSE {condo.unit[un] ← family; un ← SUCC[un]};  --compress
      ENDLOOP;
    END;  --EvictFamily
  
  RegisterFamily: PUBLIC PROC[family: Protocol1.Family] =
    BEGIN
    EnterMonitor: ENTRY PROC = --INLINE
      BEGIN
      FOR fi IN[0..condo.occupied) DO
	IF condo.unit[fi].name = family.name THEN EXIT;  --overlay old
	REPEAT FINISHED =>
	  {fi ← condo.occupied; condo.occupied ← condo.occupied + 1};
	ENDLOOP;
      condo.unit[fi] ← family;  --the family is now living in the condo
      END;  --EnterMonitor
    fi: Protocol1.FamilyIndex;

    SELECT TRUE FROM
      (~CommFlags.doDebug) => NULL;
      (family.name ~IN Protocol1.ProtocolFamily), (uniqueAvail[family.name]) =>
        Driver.Glitch[NameNotAssigned];
      ENDCASE;

    EnterMonitor[];  --set up the condo

    END;  --RegisterFamily

  ReleaseUniqueName: PUBLIC ENTRY PROC[name: Protocol1.UniqueName] =
    BEGIN

    IF CommFlags.doDebug THEN
      BEGIN
      IF ~uniqueAvail[name] THEN Driver.Glitch[NameNotAssigned];

      FOR i: Protocol1.FamilyIndex IN[0..condo.occupied) DO
	IF condo.unit[i].name = name THEN Driver.Glitch[TenentRegistered];
	ENDLOOP;
      END;

    uniqueAvail[name] ← TRUE;  --now it's available again
    END;  --ReleaseUniqueName

  RemoveFamilyMember: PUBLIC ENTRY PROC[
    driver: Device, family: Protocol1.Family] =
    {RemoveFamilyMemberInternal[driver, family]};

  RemoveFamilyMemberInternal: PRIVATE INTERNAL PROC[
    driver: Device, family: Protocol1.Family] =
    BEGIN
    length: Protocol1.FamilyIndex;
    bPoor, bRich: Protocol1.Matrix;
    poor: LONG POINTER TO MemberSupport;
    rich: LONG DESCRIPTOR FOR Protocol1.Matrices ← driver.matrix;

    bRich ← @rich[0];
    THROUGH[0..LENGTH[rich]) DO
      --just checking for family existance
      IF bRich.family = family THEN EXIT;  --and found it
      bRich ← bRich + unitSize;
      REPEAT FINISHED => RETURN;  --there's nothing to do here
      ENDLOOP;

    IF (length ← LENGTH[rich] - 1) = 0 THEN poor ← NIL
    ELSE
      BEGIN
      poor ← CommHeap.zone.NEW[MemberSupport[length]];
      bPoor ← @poor[0]; bRich ← @rich[0];  --need starting points
      THROUGH[0..LENGTH[rich]) DO
	IF bRich.family # family THEN
	  {bPoor↑ ← bRich↑; bPoor ← bPoor + unitSize};
	bRich ← bRich + unitSize;
	ENDLOOP;
      END;

    family.stateChanged[driver, bRich.context, remove];  --toss the bum
    bRich ← @rich[0]; CommHeap.zone.FREE[@bRich];  --raze the rich
    driver.matrix ← DESCRIPTOR[poor, length];  --replace with poor

    IF (poor # NIL) AND (family.maxBufferSize > driver.receiveBufferLen) THEN
      BEGIN
      maxSeen: CARDINAL ← 0;  --nice number to compare against
      bPoor ← @poor[0];  --get a starting value
      THROUGH[0..length) DO
        maxSeen ← MAX[maxSeen, bPoor.family.maxBufferSize];
	bPoor ← bPoor + unitSize;
        ENDLOOP;
      driver.receiveBufferLen ← maxSeen;  --smash it back 
      END;
    END;  --RemoveFamilyMemberInternal
    
    
  Ripple: PROC [b: Buffer.Buffer, alignment: {forClient, forDriver}] = {};
    <<
    BEGIN
    <<
    Like the fine wine, it's now time.

    If we're rippling for the client, then we want b.highLayer.startIndex to be
    zero. That's assuming that most (all) protocols we implement are either
    word aligned or simply don't care. If we're rippling for the client, the
    buffer was last touched by a driver. So, we should ripple it up (increasing
    values of addresses). We assert that this buffer has aleady been decapsulated
    and that b.linkLayer = [@b.bufferBody, 0, SIZE[{encapsulation}]] and that
    b.highLayer = [@{start of data}, n, n + {data length}];

    If we're rippling for the driver, we want b.linkLayer.startIndex to be
    zero. Our drivers (faces) really don't like byte aligned things, so we
    move it around here in just one spot to make life simple(r). And, since the
    client was the last one to touch this buffer, we will ripple the bits down
    (decreasing values of indexes).
    >>
    LoopHole: TYPE = LONG POINTER TO PhoneeBlock;
    PhoneeBlock: TYPE = RECORD[b: LONG INTEGER, start, stop: INTEGER];
    AJust: PROC[p: LONG POINTER TO Environment.Block, ap, ai: INTEGER] = INLINE
      {OPEN r: LOOPHOLE[p, LoopHole]; r ← [r.b + ap, r.start + ai, r.stop + ai]};
    to, from: Environment.Block;
    SELECT alignment FROM
      (forClient) =>
        BEGIN
	si: INTEGER = b.highLayer.startIndex;
	IF (si MOD 2) = 0 THEN AJust[@b.highLayer, (si / 2), -si]
	ELSE
	  BEGIN
	  to ← from ← [
	    b.linkLayer.blockPointer, b.linkLayer.startIndex,
	    b.linkLayer.startIndex + b.fo.driver.length];
	  to ← [
	    from.blockPointer, from.startIndex + 3, from.stopIndexPlusOne + 3];
	  AJust[@b.linkLayer, 1, 1];  --result link layer will be odd
	  AJust[@b.highLayer, (si + 1) / 2, -si];  --high layer will be zero
	  [] ← ByteBlt.ByteBlt[to: to, from: from, overLap: move];
	  END;
	END;
      (forDriver) =>
        BEGIN
	si: INTEGER = b.linkLayer.startIndex;
	IF (si MOD 2) = 0 THEN AJust[@b.linkLayer, -((si + 1) / 2), -si]
	ELSE
	  BEGIN
	  to ← from ← [
	    b.linkLayer.blockPointer, b.linkLayer.startIndex,
	    b.linkLayer.startIndex + b.fo.driver.length];
	  AJust[LONG[@to], -((si + 1) / 2), -si];
	  AJust[@b.linkLayer, -((si + 1) / 2), -si];  --link layer will be zero
	  AJust[@b.highLayer, -((si + 1) / 2), si];  --high layer will be odd
	  [] ← ByteBlt.ByteBlt[to: to, from: from, overLap: move];
	  END;
	END;
      ENDCASE;
    END;  --Ripple
  >>
    

  EncapsulateAndTransmit: PUBLIC Protocol1.EncapsulatorProc =
    BEGIN
    --ASSUMPTION: b.fo.network and b.fo.type are set properly
    type: Buffer.Type ← b.fo.type;
    driver: Device ← b.fo.network;
    unit: LONG POINTER TO Protocol1.MatrixRecord ← @driver.matrix[0];
    IF ~driver.alive THEN
      {b.fo.status ← noRouteToNetwork; PutOnGlobalDoneQueue[b]; RETURN};
    THROUGH[0..LENGTH[driver.matrix]) DO
      SELECT TRUE FROM
        (unit.family.name # type) => NULL;  --go to next one
	(unit.family.status = alive) =>  --and it's healthy
	  BEGIN
	  b.fo.context ← unit.context;  --set context for encapsulation
	  unit.encapsulator[b, immediate];  --call the encapsulation code
	  IF unit.family.spy # NIL THEN b ← unit.family.spy[b, send];
	 SELECT TRUE FROM
	    (b = NIL) => RETURN;  --spy proc consumed our buffer!
	    <<(b.linkLayer.startIndex # 0) => Ripple[b, forDriver];>>
	    ENDCASE;
	  driver.sendRawBuffer[b];
	  RETURN;  --then get out of the loop
	  END;
	ENDCASE => EXIT;  --found family, but it was dead
      unit ← unit + unitSize;  --next apartment
      ENDLOOP;
    OrphanEncapsulate[b];
    END;  --EncapsulateAndTransmit

  SetMaximumBufferSize: PUBLIC <<Protocol1>> ENTRY PROC[
    driver: Device, family: Protocol1.Family, size: CARDINAL] =
    BEGIN
    <<
    Lots of semantics here.
    1) Both 'driver' and 'family' are specified
       o family.maxBufferSize ← size
       o driver.receiveBufferLen ← MAX family.maxBufferSize for all families
         supported by 'driver'
    2) ('driver' = NIL) => driver = all drivers that support 'family'
    3) ('family' = NIL) => family = all families in the condo
    >>
    EachHouse: INTERNAL PROC[family: Protocol1.Family] =
      BEGIN
      IF driver = NIL THEN
        FOR driver ← Driver.GetDeviceChain[], driver.next UNTIL driver = NIL DO
	  driver.receiveBufferLen ← TakeCensus[driver]; ENDLOOP
      ELSE driver.receiveBufferLen ← TakeCensus[driver]; 
      END;  --EachHouse

    TakeCensus: INTERNAL PROC[driver: Device] RETURNS[census: NATURAL ← size] =
      BEGIN
      length: NATURAL = LENGTH[driver.matrix];  --number of houses
      house: LONG POINTER TO Protocol1.MatrixRecord ← @driver.matrix[0];
      THROUGH[0..length) DO
	census ← MAX[census, house.family.maxBufferSize];  --compare sizes
	house ← house + SIZE[Protocol1.MatrixRecord];  --go to next house
        ENDLOOP;
      END;  --TakeCensus

    IF family = NIL THEN
      FOR i: Protocol1.FamilyIndex IN[0..condo.occupied) DO
        EachHouse[condo.unit[i]]; ENDLOOP
    ELSE {family.maxBufferSize ← size; EachHouse[family]};

    END;  --SetMaximumBufferSize

  SetSpyProc: PUBLIC ENTRY PROC [
    spy: SpecialCommunication.SpyProc, name: SpecialCommunication.SpyType]
    RETURNS [oldSpy: SpecialCommunication.SpyProc] =
    BEGIN
    IF name = orphan THEN {oldSpy ← orphanSpy; orphanSpy ← spy}
    ELSE
      FOR fi: Protocol1.FamilyIndex IN[0..condo.occupied) DO
	IF condo.unit[fi].name = name THEN
	  {oldSpy ← condo.unit[fi].spy; condo.unit[fi].spy ← spy};
	ENDLOOP;
    END;  --SetSpyProc

  OrphanDecapsulate: PROC[b: Buffer.Buffer] =
    BEGIN
    IF orphanSpy # NIL THEN b ← orphanSpy[b, receive];
    IF b # NIL THEN b.requeueProcedure[b];
    END;  --OrphanDecapsulate

  OrphanEncapsulate: PROC[b: Buffer.Buffer] =
    BEGIN
    b.fo.status ← aborted;
    IF orphanSpy # NIL THEN b ← orphanSpy[b, send];
    IF b # NIL THEN b.requeueProcedure[b];
    END;  --OrphanEncapsulate

  DispatcherOn: PUBLIC PROC =
    BEGIN
    orphanSpy ← NIL;
    Buffer.QueueInitialize[@globalInputQueue];
    Buffer.QueueInitialize[@globalOutputQueue];
    mainFork ← FORK MainDispatcher[];
    END;

  DispatcherOff: PUBLIC PROC =
    BEGIN
    IF condo.occupied # 0 THEN Driver.Glitch[TenentRegistered];
    Process.Abort[mainFork]; JOIN mainFork;
    Buffer.QueueCleanup[@globalInputQueue];
    Buffer.QueueCleanup[@globalOutputQueue];
    END;

  PutOnGlobalInputQueue: PUBLIC ENTRY PROC[b: Buffer.Buffer] =
    {Buffer.Enqueue[@globalInputQueue, b]; NOTIFY dispatcherReady};

  PutOnGlobalDoneQueue: PUBLIC PROC[b: Buffer.Buffer] =
    BEGIN

    LockedDone: ENTRY PROC = INLINE
      {Buffer.Enqueue[@globalOutputQueue, b]; NOTIFY dispatcherReady};

    SELECT TRUE FROM
      (b.requeueProcedure # Driver.ReturnFreeBuffer), (b.fo.allNets) =>
        BEGIN
	<<IF b.highLayer.startIndex # 0 THEN Ripple[b, forClient];>>
	LockedDone[];
	END;
      ENDCASE => Driver.ReturnFreeBuffer[b];
    END;

  MainDispatcher: PUBLIC PROC =
    BEGIN

    GrabOutputBuffer: ENTRY PROC = INLINE
      {b ← Buffer.Dequeue[@globalOutputQueue]};
    GrabInputBuffer: ENTRY PROC = INLINE
      {b ← Buffer.Dequeue[@globalInputQueue]};
    CheckQueuesAndWait: ENTRY PROC = INLINE
      BEGIN
      ENABLE UNWIND => NULL;
      SELECT TRUE FROM
        (globalInputQueue.length # 0) => NULL;
        (globalOutputQueue.length # 0) => NULL;
        ENDCASE => WAIT dispatcherReady;
    END;  --CheckQueuesAndWait

    b: Buffer.Buffer;
    network: Device;
    unit: Protocol1.Matrix;
    Process.SetPriority[CommPriorities.receiver];
    --UNTIL ABORTED-- DO
      ENABLE ABORTED => EXIT;

      WHILE globalOutputQueue.length # 0 DO
	--process send buffers first, they should be fast and easy
	GrabOutputBuffer[];

	WHILE b.fo.allNets --OR pickUpNextBuffer OR done-- DO
	  network ← NARROW[b.fo.network, Device];  --test last net dead case
	  IF network = NIL THEN GOTO done;  --shouldn't even be here
	  b.fo.network ← network ← NARROW[network.next, Device];  --advance
	  IF network = NIL THEN GOTO done;  --done now, huh
	  IF network.alive THEN
	    BEGIN
	    unit ← @network.matrix[0];
	    THROUGH[0..LENGTH[network.matrix]) DO
	      family: Protocol1.Family ← unit.family;
	      SELECT TRUE FROM
		(b.fo.type # family.name) => {unit ← unit + unitSize; LOOP};
		(family.status # alive) => EXIT;  --family in no position to use
		ENDCASE =>
		  BEGIN
		  b.fo.context ← unit.context; family.broadcast[b];
		  GOTO pickUpNextBuffer;  --as soon as we find a family
		  END;
	      --this driver doesn't support family - does the next?
	      ENDLOOP;
	    END;
	  REPEAT
	    pickUpNextBuffer => NULL;  --b was rebroadcasted
	    done =>
	      {b.fo.context ← NIL; b.fo.allNets ← FALSE; b.requeueProcedure[b]};
	    FINISHED =>
	      {b.fo.context ← NIL; b.fo.allNets ← FALSE; b.requeueProcedure[b]};
	  ENDLOOP;  --WHILE b.fo.allNets

	ENDLOOP;  --WHILE globalOutputQueue.length # 0

      IF globalInputQueue.length # 0 THEN
	BEGIN
	GrabInputBuffer[];  --get buffer from driver
	unit ← @NARROW[b.fo.network, Device].matrix[0];

	-- give it to the right router, and it requeues the buffer
	THROUGH[0..LENGTH[NARROW[b.fo.network, Device].matrix]) DO
	  IF unit.family.status = dead THEN LOOP;  --can't use this one
	  b.fo.context ← unit.context;  --copy in context
	  SELECT (b.fo.type ← unit.decapsulator[b]) FROM
	    (vagrant) => NULL;  --failed - try next family on block
	    (orphan) => {OrphanDecapsulate[b]; EXIT};  --bad at level-0
	    ENDCASE =>
	      BEGIN  --that's the one
	      <<IF b.highLayer.startIndex # 0 THEN Ripple[b, forClient];>>
	      IF unit.family.spy # NIL THEN b ← unit.family.spy[b, receive];
	      IF b # NIL THEN unit.family.receive[b];
	      EXIT;
	      END;
	  unit ← unit + unitSize;  --next unit
	  REPEAT FINISHED => {b.fo.type ← orphan; OrphanDecapsulate[b]};
	  ENDLOOP; 
	  
	END;

      CheckQueuesAndWait[];  --see if we should loop again right away

      ENDLOOP;

    END;

  -- initialization
  Process.DisableTimeout[@dispatcherReady];
  Process.EnableAborts[@dispatcherReady];

  END.  -- DispatcherImpl module

LOG

14-May-84 16:11:41  AOF  Post Klamath
 4-Apr-85 15:54:56  AOF  Tidying up the condo when tenant moves out
26-Jun-85 14:58:32  AOF  call stateChanged proc when removing family members
26-Jul-85 13:11:08  AOF  UNWIND => NULL in CheckQueuesAndWait
21-Oct-85 13:19:37  AOF  UNWIND => Rework of dispatcher's outQ processing
 9-Apr-86 16:27:39  AOF  Processing of buffers with .allNets =TRUE
 7-May-86 12:22:15  AOF  ....and check for b.allNets first
 9-May-86 15:59:53  SMA  Support for different sizes of encapsulation.
17-Jun-86 18:36:11  AOF  Families recording their buffer size requirements.
28-Aug-86 10:46:17  AOF  Use priorityPilotRealtimeSwappable priority
12-Nov-86 18:30:55  AOF  Ripple wine and odd aligment buffers
11-Feb-87 18:08:12  AOF  AR 10254: Dangling pointer in DispatcherImpl (James)
23-Sep-87  9:42:01  AOF  Remove the Ripple code
19-Oct-87 12:44:11  AOF  Remove the Ripple code some more better
27-Nov-87 12:00:30  AOF  AR #12346 - Scanning the matrix to set length down.