-- File: BufferMgr.mesa - last edit:
-- AOF                  2-Feb-88 17:16:27
-- MI                   1-Aug-86 15:23:15
-- SMA                 27-May-86 11:44:29
-- Copyright (C) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved. 

DIRECTORY
  Buffer USING [
    AccessHandle, AccessObject, Buffer, BufferObject, Function,
    Queue, Type, PoolType],
  BufferOps,
  CommFlags USING [doDebug, doStats],
  CommHeap USING [zone],
  CommPriorities USING [realtime],
  CommunicationInternal USING [],
  CommUtil USING [AllocateBuffers, FreeBuffers],
  Driver USING [Glitch, Device, nilDevice],
  Environment USING [bitsPerWord, bytesPerPage, bytesPerWord],
  Frame USING [GetReturnFrame, ReadGlobalLink],
  Inline USING [BITAND, BITNOT],
  Process USING [
    Abort, DisableAborts, DisableTimeout, EnableAborts, InitializeCondition,
    SetPriority, SetTimeout, TicksToMsec, GetPriority, Priority],
  Stats USING [StatIncr],
  System USING [GetClockPulses, MicrosecondsToPulses];

BufferMgr: MONITOR
  IMPORTS
    CommHeap, CommUtil, Driver, Frame, Inline, Process,
    Stats, System
  EXPORTS Buffer, BufferOps, CommunicationInternal, Driver =
  BEGIN
  
  <<
  This should be ample space for any encapsulation.  Be careful - changing it to 
  something that is not a multiple of 4 word (8 bytes) will make the alignment
  fall apart.
  >>
  dataLinkReserve: PUBLIC <<Buffer>> CARDINAL ← 32; -- Bytes
  maxUserDataSize: PUBLIC <<Buffer>> CARDINAL ← 1500; -- Bytes
  
  <<
  ** Degree of 'size' is now byte **
  ** Following constant should be even number **
  These constants is used multiple buffer sizes implementation
  >>
  
  -- In bytes of the respective buffers at the PHYSICAL layer.
  bufferSize: ARRAY SizeHint OF CARDINAL = [
    smallBuffer: 274,	-- maxSNAPacket
    mediumBuffer: 576,	-- maxIDPBytesPerPacket
    largeBuffer: 1024,	-- arbitrary intermediate
    maxBuffer: 1500];	-- maxEthernetPacket

  bpw: CARDINAL = Environment.bytesPerWord;
  bpp: CARDINAL = Environment.bytesPerPage;
  phonyQueue: Buffer.Queue = LOOPHOLE[LAST[LONG CARDINAL]];
  maxBuffersPerCluster: NATURAL[1..Environment.bitsPerWord] = 5;
  
  fudgeFactor: CARDINAL = 8;		-- Bytes. Extra bytes in buffers
  d0Alignment: CARDINAL = 8;		-- Bytes. Quad word (almost) required
  daybreakAlignment: CARDINAL = 54;	-- Bytes. Don't page break closer than this (Daybreak)

  Device: PUBLIC TYPE = Driver.Device;
  Cluster: PUBLIC TYPE = LONG POINTER TO ClusterObject;
  -- Field doomed has been removed since only SetSizes used to set this value
  ClusterObject: TYPE = MACHINE DEPENDENT RECORD[
    next(0): Cluster ← NIL,  -- Objects are linked together
    order(2): CARDINAL,  -- And they are ordered
    time(3): LONG CARDINAL ← TRASH,  -- System.GetClockPulses last returned
    useMap(5), mask(6): UseMap,  -- Map and Mask of buffers free/used
    hint(7): SizeHint ← TRASH,  --size if buffers in this cluster
    slot(8): SEQUENCE buffers(8): CARDINAL OF Buffer.Buffer];

  SizeHint: TYPE = BufferOps.SizeHint;
  BasePointer: TYPE = LONG BASE POINTER;
  Use: TYPE = MACHINE DEPENDENT{used(0), free(1)};
  UseMap: TYPE = PACKED ARRAY CARDINAL[0..Environment.bitsPerWord) OF Use;

  biasing: BOOLEAN = TRUE;  -- Keep 'n' buffers free at all times

  <<
  Since bufferSize defined as constance, syspool.bufferSize has been removed.
  And buffersAvailable changed its type in order to support multiple buffer size.
  >>

  syspool: PUBLIC RECORD[
    cache: ARRAY SizeHint OF Cluster,  -- Best chance to find free buffer
    cluster: RECORD[head, tail: Cluster, count: CARDINAL],  -- List of clusters
    send, receive, sendInUse, receiveInUse, freeBias,  -- Current events
    buffersRequested, buffersAllocated: CARDINAL,
    buffersAvailable: ARRAY SizeHint OF CARDINAL ← ALL[0],
    access: Buffer.AccessHandle,  -- Head of linked list
    scanInterval, lastTime: LONG CARDINAL,  -- Times in Pulses,
    clusterAgeLimit, lostBufferLimit: LONG CARDINAL,  -- Times in Pulses & msecs
    defaultSendBuffers, defaultReceiveBuffers, leaked: CARDINAL,
    freeBuffer, fault: CONDITION, flag: BOOLEAN, hint: SizeHint,
    allocator: PROCESS];

  QueueScrambled: ERROR = CODE;
  PoolTypeBroken: ERROR = CODE;
  NotInitialized: ERROR = CODE;
  QueueSealBroken: ERROR = CODE;
  AccessSealBroken: ERROR = CODE;
  BufferSealBroken: ERROR = CODE;
  BufferNeverFreed: ERROR = CODE;
  BufferFreedTwice: ERROR = CODE;
  ClusterNotOrdered: ERROR = CODE;
  OtherClientsActive: ERROR = CODE;
  ClusterNotDeletable: ERROR = CODE;
  RequestedSizeTooLarge: ERROR = CODE;
  SystemBufferPoolConfused: ERROR = CODE;
  DontKnowHowToAllocateBuffer: ERROR = CODE;

  -- Procedures which added for multiple buffer size support
  
  SizeToSizeHint: PROC [size: CARDINAL] RETURNS [hint: SizeHint] = INLINE
    BEGIN
    SELECT size FROM
      <= bufferSize[smallBuffer] => hint ← smallBuffer;
      <= bufferSize[mediumBuffer] => hint ← mediumBuffer;
      <= bufferSize[largeBuffer] => hint ← largeBuffer;
      <= bufferSize[maxBuffer] => hint ← maxBuffer;
      ENDCASE => Driver.Glitch[RequestedSizeTooLarge];
    END;  --SizeToSizeHint

  SizeHintToSize: PROC [hint: SizeHint] RETURNS [size: CARDINAL] = INLINE BEGIN
    RETURN[bufferSize[hint]];
    END;  --SizeToSizeHint

  AllUsed: INTERNAL PROC [c: Cluster] RETURNS [BOOLEAN] = INLINE BEGIN
    RETURN [Inline.BITAND[c.useMap, c.mask] = 0];
    END;  --AllUsed

  AllFree: INTERNAL PROC [c: Cluster] RETURNS [BOOLEAN] = INLINE BEGIN
    RETURN [Inline.BITAND[Inline.BITNOT[c.useMap], c.mask] = 0];
    END;  --AllFree

  MakeBufferAvailable: INTERNAL PROC [hint: SizeHint] = INLINE BEGIN
    syspool.buffersAvailable[hint] ← syspool.buffersAvailable[hint] + 1;
    END;  --MakeBufferAvailable

  MakeBufferUnavailable: INTERNAL PROC [hint: SizeHint] = INLINE
    {syspool.buffersAvailable[hint] ← syspool.buffersAvailable[hint] - 1};

  GetSizes: PUBLIC PROC RETURNS [ARRAY BufferOps.SizeHint OF CARDINAL] =
    {RETURN[bufferSize]};

  << SetSizes has been removed when multiple buffers supported >>

  GetIntervals: PUBLIC PROC
    RETURNS[ARRAY BufferOps.Intervals OF LONG CARDINAL] = BEGIN
    RETURN[[
      scan: syspool.scanInterval,
      aging: syspool.clusterAgeLimit,
      lost: syspool.lostBufferLimit]];
    END; --GetIntervals

  SetIntervals: PUBLIC PROC[
    interval: ARRAY BufferOps.Intervals OF LONG CARDINAL] = BEGIN
    syspool.scanInterval ← interval[scan];
    syspool.clusterAgeLimit ← interval[aging];
    syspool.lostBufferLimit ← interval[lost];
    END;  --SetIntervals

  GetDefaults: PUBLIC PROC
    RETURNS[ARRAY BufferOps.Defaults OF CARDINAL] = BEGIN
    RETURN[[
      syspool.defaultSendBuffers,
      syspool.defaultReceiveBuffers,
      syspool.freeBias]];
    END;   --GetDefaults

  SetDefaults: PUBLIC PROC[default: ARRAY BufferOps.Defaults OF CARDINAL] = BEGIN
    syspool.defaultSendBuffers ← default[send];
    syspool.defaultReceiveBuffers ← default[receive];
    syspool.freeBias ← default[bias];
    END; --SetDefaults

  GetStatistics: PUBLIC PROC
    RETURNS[ARRAY BufferOps.Statistics OF CARDINAL] = BEGIN
    totalBuffersAvailable: CARDINAL ← 0;
    
    -- Get sum of available buffers
    FOR h: SizeHint IN SizeHint DO
      totalBuffersAvailable ← totalBuffersAvailable + syspool.buffersAvailable[h];
      ENDLOOP;
    RETURN[[
      syspool.buffersRequested, syspool.buffersAllocated,
      totalBuffersAvailable, syspool.send, syspool.receive,
      syspool.sendInUse, syspool.receiveInUse]];
    END;  --GetStatistics
    
  BuffersLeft: PUBLIC PROC[aH: Buffer.AccessHandle] RETURNS[CARDINAL] =
    {RETURN[(aH.receive - aH.receiveInUse) + (aH.send - aH.sendInUse)]};
  SendBuffersLeft: PUBLIC PROC[aH: Buffer.AccessHandle] RETURNS[CARDINAL] =
    {RETURN[(aH.send - aH.sendInUse)]};
  ReceiveBuffersLeft: PUBLIC PROC[aH: Buffer.AccessHandle] RETURNS[CARDINAL] =
    {RETURN[(aH.receive - aH.receiveInUse)]};

  DataBytesPerRawBuffer: PUBLIC PROC [b: Buffer.Buffer] RETURNS [CARDINAL] = {
    c: Cluster ← b.fo.cluster;
    RETURN[bufferSize[c.hint]]};
  
  --THE QUEUE MANAGEMENT PACKAGE

  CreditReceiveBuffer: PUBLIC ENTRY PROC[
    aH: Buffer.AccessHandle, b: Buffer.Buffer]
    RETURNS [gotCredit: BOOLEAN] =
    BEGIN
    IF CommFlags.doDebug  THEN
      BEGIN
      IF aH.seal ~IN Buffer.PoolType[normalPool..listenPool] THEN
	Driver.Glitch[PoolTypeBroken];
      IF b.fo.currentOwner # NIL THEN Driver.Glitch[QueueScrambled];
      END;
    IF (gotCredit ← aH.receiveInUse < aH.receive) THEN
      BEGIN
      aH.receiveInUse ← aH.receiveInUse + 1;
      syspool.receiveInUse ← syspool.receiveInUse + 1;
      b.fo.currentOwner ← aH;
      b.fo.function ← receive;
      IF CommFlags.doDebug THEN
        b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
      END
    ELSE IF CommFlags.doStats THEN Stats.StatIncr[statNoCredit];
    END;  --CreditReceiveBuffer

  Dequeue, DequeuePup, DequeueNS, DequeueSpp: PUBLIC PROC[
    q: Buffer.Queue] RETURNS [b: Buffer.Buffer] =
    BEGIN
    IF CommFlags.doDebug THEN
      SELECT TRUE FROM
        (q = NIL) => Driver.Glitch[QueueScrambled];
        (q.seal # queueSeal) => Driver.Glitch[QueueSealBroken];
	(q.length > 256) => Driver.Glitch[QueueScrambled];
	ENDCASE;
    IF (b ← q.first) = NIL THEN
      BEGIN
      IF CommFlags.doDebug AND q.length # 0 THEN Driver.Glitch[QueueScrambled];
      IF CommFlags.doStats THEN Stats.StatIncr[statDequeueNIL];
      RETURN;
      END;
    IF (q.first ← q.first.fo.next) = NIL THEN q.last ← NIL;
    q.length ← q.length - 1;
    IF CommFlags.doStats THEN Stats.StatIncr[statDequeue];
    IF CommFlags.doDebug THEN
      BEGIN
      SELECT TRUE FROM
        (b.fo.queue # q) => Driver.Glitch[QueueScrambled];
	(b.fo.seal # bufferSeal) => Driver.Glitch[BufferSealBroken];
	(q.length # 0 AND (q.first = NIL OR q.last = NIL)) =>
	  Driver.Glitch[QueueScrambled];
	ENDCASE;
      b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
      END;
    b.fo.queue ← NIL;
    b.fo.next ← NIL;
    END;  --Dequeue, DequeuePup, DequeueNS, DequeueSpp

  Enqueue, EnqueuePup, EnqueueNS, EnqueueSpp: PUBLIC PROC[
    q: Buffer.Queue, b: Buffer.Buffer] =
    BEGIN
    IF CommFlags.doDebug THEN
      SELECT TRUE FROM
        (q.seal # queueSeal) => Driver.Glitch[QueueSealBroken];
	(b.fo.seal # bufferSeal) => Driver.Glitch[BufferSealBroken];
	(b.fo.queue # NIL) => Driver.Glitch[QueueScrambled];
	(q.length # 0 AND (q.first = NIL OR q.last = NIL)) =>
	  Driver.Glitch[QueueScrambled];
	(q.length > 256) => Driver.Glitch[QueueScrambled];
	ENDCASE => b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
    b.fo.next ← NIL;
    IF CommFlags.doStats THEN Stats.StatIncr[statEnqueue];
    IF q.first = NIL THEN q.first ← b ELSE q.last.fo.next ← b;
    q.last ← b;
    b.fo.queue ← q;
    q.length ← q.length + 1;
    END;  --Enqueue

  ExtractFromQueue, ExtractPupFromQueue, ExtractNSFromQueue,
    ExtractSppFromQueue: PUBLIC PROC[q: Buffer.Queue, b: Buffer.Buffer]
    RETURNS [Buffer.Buffer] =
    BEGIN
    previousB, currentB: Buffer.Buffer;
    IF CommFlags.doDebug THEN
      SELECT TRUE FROM
        (q = NIL) => Driver.Glitch[QueueScrambled];
	(b = NIL) => Driver.Glitch[QueueScrambled];
        (q.seal # queueSeal) => Driver.Glitch[QueueSealBroken];
	(b.fo.seal # bufferSeal) => Driver.Glitch[BufferSealBroken];
	ENDCASE;
    previousB ← NIL;
    currentB ← q.first;
    UNTIL currentB = b DO
      IF currentB = NIL THEN EXIT;
      previousB ← currentB;
      currentB ← currentB.fo.next;
      ENDLOOP;
    IF currentB # NIL THEN
      BEGIN
      --remove this buffer from the queue
      IF CommFlags.doDebug AND currentB.fo.seal # bufferSeal THEN
        Driver.Glitch[BufferSealBroken];
      IF currentB = q.first THEN q.first ← currentB.fo.next;
      IF currentB = q.last THEN q.last ← previousB;
      IF previousB # NIL THEN previousB.fo.next ← currentB.fo.next;
      q.length ← q.length - 1;
      currentB.fo.queue ← NIL;
      currentB.fo.next ← NIL;
      IF CommFlags.doDebug THEN
        b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
      IF CommFlags.doStats THEN Stats.StatIncr[statXqueue];
      END
    ELSE IF CommFlags.doStats THEN Stats.StatIncr[statXqueueNIL];
    RETURN[currentB];
    END;  --ExtractFromQueue

  QueueCleanup: PUBLIC PROC[q: Buffer.Queue] =
    {b: Buffer.Buffer; UNTIL (b ← Dequeue[q]) = NIL DO ReturnBuffer[b]; ENDLOOP};

  QueueInitialize: PUBLIC PROC[q: Buffer.Queue] =
    {q↑ ← [length: 0, first: NIL, last: NIL, seal: queueSeal]};

  --BUFFER MANAGEMENT ROUTINES

  AllocateNewClusterLocked: ENTRY PROC[tail: Cluster] =
    BEGIN
    order: NATURAL;
    -- Link new cluster to end of list and set its order
    IF syspool.cluster.tail = NIL THEN
      {syspool.cluster.head ← tail; order ← 1}
    ELSE {syspool.cluster.tail.next ← tail;
      order ← syspool.cluster.tail.order + 1};
    syspool.cluster.tail ← tail;
    tail.order ← order;

    -- Keep up bookeeping 
    syspool.cluster.count ← syspool.cluster.count + 1;
    syspool.buffersAllocated ← syspool.buffersAllocated + tail.buffers;
    
    -- Make all created buffers in cluster available
    FOR index: NATURAL IN[0..tail.buffers) DO
      MakeBufferAvailable[tail.hint];
      ENDLOOP;

    syspool.flag ← FALSE;  -- Reset to avoid looping
    IF syspool.cache[syspool.hint] = NIL THEN
      syspool.cache[syspool.hint] ← tail;  --first time with this size 
    BROADCAST syspool.freeBuffer;  -- Tell the world, "New buffers!"
    END;  --AllocateNewClusterLocked

  AllocateNewClusterUnlocked: PROC[hint: SizeHint] RETURNS[tail: Cluster] =
    BEGIN
    -- Define buffer combinations for cluster assuming homogeneous cluster
    ClusterInfo: TYPE = RECORD [count: CARDINAL, hint: SizeHint];
      
    clusterInfoArray: ARRAY SizeHint OF ClusterInfo = [
      smallBuffer: [5, smallBuffer],
      mediumBuffer: [5, mediumBuffer],
      largeBuffer: [3, largeBuffer],
      maxBuffer: [3, maxBuffer]];

    base: BasePointer;
    clusterInfo: ClusterInfo;
    clusterByteSize, surplus, index: CARDINAL;
    offsets: ARRAY [0..maxBuffersPerCluster) OF
      BasePointer RELATIVE POINTER TO Buffer.BufferObject;
  
    IF syspool.flag THEN BEGIN
      IF CommFlags.doStats THEN Stats.StatIncr[statAddCluster];

      <<
      This is buffer alignment.  It is not really documented anywhere else but
      is implemented here a way that satisfies D0s (aka Dolphins), DLions and
      Daybreaks.
      D0s require that the user data starts on a 3 MOD 4 boundary.
      DLions don't seem to care one way or the other
      Daybreaks can't have the buffer start less than 54 bytes from the next
      page break.
      Note that we are safe in only doing the quad word alignment for the D0
      once, since the added values 'bytesPerPage / bytesPerWord' and
      'dataLinkReserve / bytesPerWord' are multiples of 4 word. If
      dataLinkReserve is changed so that this is no longer true, the
      alignment will fall apart!
      >>
      
      -- Determine cluster size and each buffer's offset
      clusterInfo ← clusterInfoArray[hint];
      
      clusterByteSize ← SIZE[ClusterObject[clusterInfo.count]] * bpw;
      FOR index IN [0..clusterInfo.count) DO
	-- Add fixed fields of buffer
	clusterByteSize ← clusterByteSize + SIZE[Buffer.BufferObject] * bpw;
	-- Check D0 alignment
	clusterByteSize ← clusterByteSize + d0Alignment -
	  clusterByteSize MOD d0Alignment;
	-- Check Daybreak alignment
	surplus ← clusterByteSize MOD bpp;
	IF surplus > bpp - daybreakAlignment THEN
	  clusterByteSize ← clusterByteSize + (bpp - surplus);  --skip page+
	-- Assign offsets by WORDs. If clusterByteSize is odd number,
	-- it doesn't work...
	offsets[index] ← LOOPHOLE[clusterByteSize / bpw -
	  SIZE[Buffer.BufferObject]];
	-- Add buffer sizes
	clusterByteSize ← clusterByteSize + dataLinkReserve +
	  bufferSize[clusterInfo.hint] + fudgeFactor;
	ENDLOOP;

      -- Allocate Cluster by WORDs. If clusterByteSize is odd number,
      -- it doesn't work...
      tail ← base ← CommUtil.AllocateBuffers[nbytes: clusterByteSize];

      -- Initialize cluster here
      tail.next ← NIL;
      tail.time ← System.GetClockPulses[];
      tail.useMap ← tail.mask ← ALL[used];
      -- Set buffer count. Same as @tail.buffers ← buffersPerCluster
      -- Which is not allowed  by compiler
      LOOPHOLE[@tail.buffers, LONG POINTER TO CARDINAL]↑ ← clusterInfo.count;
      tail.hint ← clusterInfo.hint;
      -- Set hint and buffer pointer for each buffer slot
      -- And make it available
      FOR index IN [0..clusterInfo.count) DO
	tail.slot[index] ← @base[offsets[index]];
	tail.useMap[index] ← tail.mask[index] ← free;
	ENDLOOP;
  
      -- Initialize buffers
      FOR index IN [0..tail.buffers) DO
	InitializeBuffer[tail, index, tail.slot[index]];
	ENDLOOP;
      END;
    END;  --AllocateNewClusterUnlocked

  AllocateNewCluster: PROC =
    BEGIN
    <<
    This broken in three parts.
    The first part is the procedure that is forked. Since it is always around
    we try to keep the local frame small.
    The second part is the one that does the most work. It has a fairly large
    local frame, but doesn't get called all that often.
    The third part is monitored. It gets called only to link the resources to
    the global state.
    >>
    WaitForRequest: ENTRY PROC = INLINE
      {ENABLE UNWIND => NULL; UNTIL syspool.flag DO WAIT syspool.fault; ENDLOOP};

    --UNTIL ABORTED-- DO
      ENABLE ABORTED => EXIT;
      WaitForRequest[];  --small monitored proc to get rolling
      AllocateNewClusterLocked[AllocateNewClusterUnlocked[syspool.hint]];
      ENDLOOP;
    END;  --AllocateNewCluster

  InitializeBuffer: PROC[c: Cluster, i: CARDINAL, b: Buffer.Buffer] = BEGIN
    b.fo ← [
      next: NIL, slot: i, currentOwner: NIL, queue: phonyQueue,
      status: pending, cluster: c, seal: bufferSeal, network: Driver.nilDevice,
      context: NIL, time: [0], allNets: FALSE, bypassZeroNet: FALSE,
      type: vagrant, function: free, tries: 0, debug: 0,
      driver: [length: 0, iocb: NIL, faceStatus: other[0]]];
    END;  --InitializeBuffer

  DestroyPool: PUBLIC ENTRY PROC[aH: Buffer.AccessHandle] =
    BEGIN
    <<
    Delete the accounting object pointed to by aH, after making sure that
    all the buffers being used by that object have been returned.  If after
    a period of time all the buffers cannot be accounted for - Glitch!
    >>
    match: Buffer.AccessHandle;
    previous: Buffer.AccessHandle ← NIL;
    seal: Buffer.PoolType ← aH.seal;  --save the current seal
    start: LONG CARDINAL ← System.GetClockPulses[];  --start now

    IF CommFlags.doDebug AND
      (seal ~IN Buffer.PoolType[normalPool..listenPool]) THEN
        Driver.Glitch[AccessSealBroken];

    aH.seal ← unsealed;  --smash it so it can't be used
    Process.DisableAborts[@aH.clientFreeBuffer];  --don't let him hurt us
    Process.SetTimeout[@aH.clientFreeBuffer, 10];  --solicit wakeups
    FOR looptime: CARDINAL ← 0, looptime + Process.TicksToMsec[10]
      UNTIL (aH.sendInUse + aH.receiveInUse) = 0 DO
      WAIT aH.clientFreeBuffer;
      SELECT TRUE FROM
        (looptime < CARDINAL[syspool.lostBufferLimit]) => NULL;
	(CommFlags.doDebug) => Driver.Glitch[BufferNeverFreed];
	ENDCASE => {SmashTheRequeueProc[aH]; EXIT};
      ENDLOOP;
    FOR match ← syspool.access, match.next UNTIL match = NIL DO
      IF match = aH THEN EXIT ELSE previous ← match;
      REPEAT FINISHED => Driver.Glitch[SystemBufferPoolConfused];
      ENDLOOP;

    IF previous = NIL THEN syspool.access ← aH.next
    ELSE previous.next ← aH.next;  --delink from list
    IF seal # listenPool THEN
      BEGIN
      syspool.send ← syspool.send - aH.send;
      syspool.receive ← syspool.receive - aH.receive;
      syspool.buffersRequested ← syspool.buffersRequested - aH.send - aH.receive;
      END;
    CommHeap.zone.FREE[@aH];  --gone
    END;  --DestroyPool

  DestroySystemBufferPool: PUBLIC --ENTRY-- PROC =
    BEGIN
    LockAndDestroyClusters: ENTRY PROC =
      BEGIN
      UNTIL syspool.cluster.count = 0 DO
	c: Cluster ← syspool.cluster.head;
	IF ~AllFree[c] THEN {WAIT syspool.freeBuffer; LOOP};
	syspool.cluster.count ← syspool.cluster.count - 1;
	syspool.cluster.head ← c.next; CommUtil.FreeBuffers[c];
	ENDLOOP;
      syspool.cluster ← [NIL, NIL, 0];
      END;  --LockAndDestroyClusters
    IF syspool.access = NIL THEN Driver.Glitch[SystemBufferPoolConfused];
    IF syspool.access.next # NIL THEN Driver.Glitch[OtherClientsActive];
    Process.Abort[syspool.allocator]; JOIN syspool.allocator;
    Process.DisableAborts[@syspool.freeBuffer];
    DestroyPool[syspool.access];
    LockAndDestroyClusters[];
    syspool.access ← NIL; syspool.cache ← ALL[NIL];
    END;  --DestroySystemBufferPool

  GetInputBuffer: PUBLIC <<Driver>> ENTRY PROC[
    wait: BOOLEAN, minimumSize: CARDINAL] RETURNS[b: Buffer.Buffer] =
    BEGIN
    <<
    Used by drivers to get buffers without accounting.  It also will not
    try to allocate more buffers from the Pilot Space machinery.
    >>
    ENABLE UNWIND => NULL;
    minimumSize ← minimumSize - dataLinkReserve;  --we'll give it back later
    SELECT TRUE FROM
      (b ← GetBufferInternal[SizeToSizeHint[minimumSize]]) # NIL =>
        GOTO buffer;
      (wait) =>
        BEGIN
	IF CommFlags.doStats THEN Stats.StatIncr[statBufferWaits];
	WAIT syspool.freeBuffer; --wait for someone to return buffer
	b ← GetBufferInternal[SizeToSizeHint[minimumSize]];
	IF b # NIL THEN GOTO buffer
	ELSE Stats.StatIncr[statBufferNIL];
	END;
      ENDCASE => IF CommFlags.doStats THEN Stats.StatIncr[statBufferNIL];
    EXITS
      buffer =>
        BEGIN
	IF CommFlags.doDebug THEN
          b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
	b.fo.type ← vagrant; b.fo.function ← driver;
	IF CommFlags.doStats THEN Stats.StatIncr[statGetFullBuffer];
        END;
    END;  --GetInputBuffer

  GetBuffer: PUBLIC ENTRY PROC[
    type: Buffer.Type ← vagrant, aH: Buffer.AccessHandle,
    function: Buffer.Function, wait: BOOLEAN ← TRUE, size: CARDINAL]
    RETURNS[b: Buffer.Buffer ← NIL] =
    BEGIN
    <<
    Basic mechanism to get buffers with accounting involved.  This routine will
    WAIT if the accounting shows no buffer should be made available.  It will
    append a new cluster to the list if need it must.  This routine may return
    NIL if wait is FALSE and the client is attempting to exceed his allocation.
    >>
    <<
    Argument 'size' is the minimum index to use looking at the clusters.
    Buffer that will be returned will satisfy this 'size'.
    >>
    ENABLE UNWIND => NULL;
    system: LONG POINTER TO CARDINAL;
    reserved, inUse: LONG POINTER TO CARDINAL;

    IF CommFlags.doDebug THEN
      BEGIN
      IF syspool.cache = ALL[NIL] THEN Driver.Glitch[NotInitialized];
      IF aH.seal ~IN Buffer.PoolType[normalPool..listenPool] THEN
        Driver.Glitch[AccessSealBroken];
      END;

    SELECT function FROM
      send =>
        BEGIN
	reserved ← @aH.send;
	inUse ← @aH.sendInUse;
	system ← @syspool.sendInUse;
	END;
      receive =>
        BEGIN
	reserved ← @aH.receive;
	inUse ← @aH.receiveInUse;
	system ← @syspool.receiveInUse;
	END;
      ENDCASE => Driver.Glitch[DontKnowHowToAllocateBuffer];

      --UNTIL CODE EXITS-- DO
        SELECT TRUE FROM
	  (reserved↑ > inUse↑) =>
	    BEGIN
	    IF (b ← GetBufferInternal[SizeToSizeHint[size]]) # NIL THEN GOTO go;
	    IF wait THEN WAIT syspool.freeBuffer ELSE GOTO jail;
	    IF CommFlags.doStats THEN Stats.StatIncr[statClusterWait];
	    END;
	  (wait) => WAIT aH.clientFreeBuffer;
	  ENDCASE => GOTO jail;  --couldn't take it, huh?
	REPEAT
	  go =>
	    BEGIN
	    inUse↑ ← inUse↑ + 1; system↑ ← system↑ + 1;
	    b.fo.function ← function; b.fo.type ← type; b.fo.currentOwner ← aH;
	    IF CommFlags.doDebug THEN
	      b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
	    IF CommFlags.doStats THEN Stats.StatIncr[IF b.fo.slot = 0
	      THEN statGetSmallBuffer ELSE statGetFullBuffer];
	    END;
	  jail => IF CommFlags.doStats THEN Stats.StatIncr[statBufferNIL];
        ENDLOOP;

    END;  --GetBuffer

  GetBufferInternal: INTERNAL PROC[hisHint: SizeHint]
    RETURNS[b: Buffer.Buffer ← NIL] =
    BEGIN
    <<
    Do not seach cluster chain if it is clear that there's no buffer of that
    size. However, we can give the client a larger buffer than he asked for.
    >>
    c: Cluster;
    index, order: CARDINAL;
    FOR hint: SizeHint IN[hisHint..LAST[SizeHint]] DO

      IF (c ← syspool.cache[hint]) = NIL THEN LOOP;  --not going win here
      
      IF CommFlags.doDebug THEN order ← c.order;

      IF syspool.buffersAvailable[hint] > 0 THEN
	UNTIL c = NIL DO
	-- This statement is assuming homogeneous cluster
	-- If cluster contain different kinds of buffer,
	-- code "c.slot[0].hint = hint" have to be removed
	IF c.hint = hint AND ~AllUsed[c] THEN
	  FOR index IN[0..c.buffers) DO
	    IF c.useMap[index] = free THEN GOTO success;
	    ENDLOOP;
	c ← c.next;  --go to next element of link
	IF CommFlags.doDebug THEN
	  SELECT TRUE FROM
	    (c = NIL) => NULL;
	    (c.order <= order) => Driver.Glitch[ClusterNotOrdered];
	    ENDCASE => order ← c.order;
	ENDLOOP;
      REPEAT
	success =>
	  BEGIN
	  b ← c.slot[index]; c.useMap[index] ← used;  --check it out
	  IF CommFlags.doDebug THEN
	    BEGIN
	    IF b.fo.queue # phonyQueue THEN Driver.Glitch[QueueScrambled];
	    IF b.fo.currentOwner # NIL THEN Driver.Glitch[AccessSealBroken];
	    b.fo.queue ← NIL;  --now make it NIL so the client can use it
	    END;
	  b.requeueProcedure ← ReturnBuffer;  --reset requeue proc
	  b.requeueData ← 0;  --and smash that
	  b.fo.network ← Driver.nilDevice;  --remove previous network reference
	  b.fo.context ← NIL;  --doesn't have context at this time
	  b.fo.next ← NIL;  --cleanup forward pointers
	  b.fo.driver.iocb ← NIL;  --initialize this field
	  b.linkLayer ← [LOOPHOLE[@b.bufferBody], 0, dataLinkReserve];
	  b.highLayer ← [
	    b.linkLayer.blockPointer + (dataLinkReserve / bpw),
	    0, bufferSize[hint]];  --set's the real buffer's length
	  b.fo.driver.length ← dataLinkReserve + bufferSize[hint];
	  MakeBufferUnavailable[hint];  -- Decrement available buffer count
	  RETURN;  --with the sweet smell of success
	  END; 
      ENDLOOP;
    <<
    If we exited this loop, the we failed to allocate a buffer. Is there
    anything that can be done about it without jeopradizing the system?

    We may have enough buffers allocated, but there's no buffer large
    enough to satisfy this guy's request. That means we could allocate
    quite a few more buffers than requested, but ...
    >>
    IF syspool.buffersRequested > syspool.buffersAllocated THEN
      BEGIN
      IF ~syspool.flag THEN  --ONLY FIRST REQUEST CAN INPUT HINT
	{syspool.hint ← hisHint; syspool.flag ← TRUE};
      NOTIFY syspool.fault;
      END;
    END;  --GetBufferInternal

  MakePool: PUBLIC <<Buffer>> PROC[
    send: CARDINAL,  --number of send buffers permitted for client use   
    receive: CARDINAL,  --number of receive buffers permitted for client use
    type: Buffer.PoolType]  --type of pool => type of pool seal
    RETURNS [aH: Buffer.AccessHandle] =
    BEGIN
    <<
    Creates the accounting object for client access to the buffer machinery.
    It does not actually allocate any buffers, but does bump the counts so they
    may be allocated if the need should arise.
    >>
    Monitored: ENTRY PROC[] = INLINE
      BEGIN
      ENABLE UNWIND => NULL;
      aH.next ← syspool.access; syspool.access ← aH;  --link to begining of list
      IF type # listenPool THEN
	BEGIN
	syspool.send ← syspool.send + send;
	syspool.receive ← syspool.receive + receive;
	syspool.buffersRequested ← syspool.buffersRequested + send + receive;
	END;
      END;  --Monitored
    IF syspool.access = NIL THEN Driver.Glitch[NotInitialized];
    aH ← CommHeap.zone.NEW[Buffer.AccessObject];
    aH.seal ← type;
    aH.send ← send; aH.receive ← receive;
    aH.sendInUse ← 0; aH.receiveInUse ← 0;
    aH.frame ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
    Process.InitializeCondition[@aH.clientFreeBuffer, 0];
    Process.DisableTimeout[@aH.clientFreeBuffer];
    Process.EnableAborts[@aH.clientFreeBuffer];
    Monitored[];  --link the new object up with global
    IF CommFlags.doStats THEN Stats.StatIncr[statPoolCreated];
    END;  --MakePool

  MakeSystemBufferPool: PUBLIC PROC[extraBuffers: CARDINAL] =
    BEGIN
    LockWaitAndSetCache: ENTRY PROC = INLINE
      BEGIN
      UNTIL syspool.cluster.head # NIL DO WAIT syspool.freeBuffer; ENDLOOP;
      syspool.cache[maxBuffer] ← syspool.cluster.head;
      END;  --LockWaitAndSetCache

    IF syspool.access # NIL THEN Driver.Glitch[SystemBufferPoolConfused];

    --CREATE ACCESS OBJECT FOR SYSTEM USE
    syspool.access ← CommHeap.zone.NEW[Buffer.AccessObject];
    syspool.access.next ← NIL;  --this is the only one has .next = NIL
    syspool.access.seal ← systemPool;
    syspool.access.send ← syspool.defaultSendBuffers;
    syspool.access.receive ← syspool.defaultReceiveBuffers + extraBuffers;
    syspool.access.sendInUse ← syspool.access.receiveInUse ← 0;
    Process.InitializeCondition[@syspool.access.clientFreeBuffer, 0];
    Process.DisableTimeout[@syspool.access.clientFreeBuffer];

    --INITIALIZE SYSTEM COUNTERS, ETC
    syspool.send ← syspool.access.send;
    syspool.receive ← syspool.access.receive;
    syspool.lastTime ← System.GetClockPulses[];
    syspool.sendInUse ← syspool.receiveInUse ← syspool.leaked ← 0;
    syspool.access.frame ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
    syspool.buffersAllocated ← 0;
    syspool.buffersRequested ← syspool.access.send + syspool.access.receive;
    syspool.buffersAvailable ← ALL[0];
    Process.EnableAborts[@syspool.freeBuffer];
    IF CommFlags.doStats THEN Stats.StatIncr[statPoolCreated];

    <<SPECIAL CASE -- ACTUALLY COMMITTING THE SPACES BEHIND THE POOL>>
    BEGIN
    prio: Process.Priority ← Process.GetPriority[];
    syspool.hint ← maxBuffer;  --this is what the driver is doing
    syspool.flag ← TRUE;  -- So it allocates below
    Process.SetPriority[CommPriorities.realtime];
    syspool.allocator ← FORK AllocateNewCluster[];  --will allocate real buffers
    Process.SetPriority[prio];  --back to normal
    END;
    LockWaitAndSetCache[];
    END;  --MakeSystemBufferPool

  ReturnBuffer, ReturnFreeBuffer: PUBLIC ENTRY PROC[b: Buffer.Buffer] =
    BEGIN
    <<ENABLE UNWIND => NULL;  --generates and passes no signals>>

    hint: SizeHint;
    current: Cluster;
    slot: CARDINAL = b.fo.slot;
    aH: Buffer.AccessHandle =b.fo.currentOwner;
    IF CommFlags.doDebug  THEN
      BEGIN
      IF b.fo.function = free THEN Driver.Glitch[BufferFreedTwice];
      IF b.fo.queue # NIL THEN Driver.Glitch[QueueScrambled];
      b.fo.debug ← Frame.ReadGlobalLink[Frame.GetReturnFrame[]];
      b.fo.queue ← phonyQueue;  --make it something we know
      END;
    SELECT b.fo.function FROM
      send =>
        BEGIN
	aH.sendInUse ← aH.sendInUse - 1;
	syspool.sendInUse ← syspool.sendInUse - 1;
	NOTIFY aH.clientFreeBuffer;
	END;
      receive =>
        BEGIN
	aH.receiveInUse ← aH.receiveInUse - 1;
	syspool.receiveInUse ← syspool.receiveInUse - 1;
	NOTIFY aH.clientFreeBuffer;
	END;
      <<driver => NULL;  --in use by a driver - no access control>>  
      ENDCASE;
    current ← b.fo.cluster;  --copy cluster value from buffer
    hint ← current.hint; --get size hint
    IF CommFlags.doDebug AND current.useMap[slot] = free THEN
      Driver.Glitch[SystemBufferPoolConfused];
    current.useMap[slot] ← free;  --he's available
    b.fo.currentOwner ← NIL;  --nobody owns this sucker
    b.fo.function ← free;  --buffer in cluster and free
    BROADCAST syspool.freeBuffer;  --tell everyone something has happened

    --GENERAL POOL MAINTAINANCE
    -- Buffer's back. Make returnd buffer available
    MakeBufferAvailable[hint];
    IF (current.order < syspool.cache[hint].order) THEN
      syspool.cache[hint] ← current;  -- Set cache value back to oldest buffer

    current.time ← System.GetClockPulses[];
    IF (syspool.lastTime - current.time) > syspool.scanInterval THEN
      GeneralPoolMaintainance[hint];

    END;  --ReturnBuffer, ReturnFreeBuffer

  GeneralPoolMaintainance: INTERNAL PROC[hint: SizeHint] =
    BEGIN

    <<
    Maybe we want to keep 'n' free buffers laying around at any time.  This
    would concievably be to handle burst traffic on gateways, and might be
    reasonalbe on machines that don't believe in virtual memory.
    >>
    Bias: PROC RETURNS[BOOLEAN] = INLINE {
      RETURN[
        INTEGER[syspool.buffersAvailable[hint]] < INTEGER[syspool.freeBias]]};

    <<
    --This doesn't seem to be needed with homogeneous clusters.
    ClusterHaveThisHint: PROC RETURNS[BOOLEAN] = INLINE {
      RETURN[current.hint = hint]};
    >>

    previous: Cluster ← NIL;
    current, search: Cluster;
    syspool.lastTime ← System.GetClockPulses[];  --record for next time
    FOR search ← syspool.cluster.head, search UNTIL search = NIL DO
      current ← search;  --copy cluster to be tested
      search ← current.next;  --and get next record in list
      <<ASSERTION: previous.order < current.order < search.order>>
      IF CommFlags.doDebug THEN
        SELECT TRUE FROM
	  (previous = NIL) => NULL;  --first time through loop;
	  (previous.order >= current.order) => Driver.Glitch[ClusterNotOrdered];
	  (search = NIL) => NULL;
	  (current.order >= search.order) => Driver.Glitch[ClusterNotOrdered];
	  ENDCASE; 
      SELECT TRUE FROM
	~AllFree[current] => previous ← current;  -- All buffers not free
        ((System.GetClockPulses[] - current.time) < syspool.clusterAgeLimit) =>
	  previous ← current;  -- Not old enough
	(biasing AND Bias[] <<AND ClusterHaveThisHint[]>>) =>
	  previous ← current;  -- Just don't give it back
	ENDCASE =>
	  BEGIN
	  syspool.buffersAllocated ← syspool.buffersAllocated - current.buffers;
	  FOR slot: CARDINAL IN [0..current.buffers) DO
	    MakeBufferUnavailable[current.hint];
	    ENDLOOP;
	  IF previous = NIL THEN syspool.cluster.head ← search  --head of list
	  ELSE previous.next ← search;  --pull 'previous' out of middle
	  IF search = NIL THEN syspool.cluster.tail ← previous;  --or the end
	  <<
	  Deleting the oldest order cluster may cause us to monotonically
	  increase our cluster count until we overflow 16 bits. That would
	  take a while and would require a lot of changes in the sizes of
	  buffers being used. If it gets to be a problem, then we should
	  take time in this scan to normalize the cluster's order number
	  back to zero when we delete the cluster with the lowest order.
	  >>
	  FOR hint: SizeHint IN SizeHint DO
	    IF current = syspool.cache[hint] THEN  --did we just blow him away?
	      FOR it: Cluster ← current.next, it.next UNTIL it = NIL DO
	        IF it.hint = hint THEN {syspool.cache[hint] ← it; EXIT};
		REPEAT FINISHED => syspool.cache[hint] ← NIL;
	        ENDLOOP;
	    ENDLOOP;
	  CommUtil.FreeBuffers[current];  --delete the buffers
	  syspool.cluster.count ← syspool.cluster.count - 1;
	  END;
      ENDLOOP;
    END;  --GeneralPoolMaintainance

  SmashTheRequeueProc: INTERNAL PROC[aH: Buffer.AccessHandle] =
    BEGIN
    FOR cluster: Cluster ← syspool.cluster.head, cluster.next
      UNTIL cluster = NIL DO
      FOR i: NATURAL IN[0..cluster.buffers) DO
        IF cluster.slot[i].fo.currentOwner = aH THEN
	  cluster.slot[i].requeueProcedure ← ReturnBuffer;
	ENDLOOP;
      ENDLOOP;
    syspool.leaked ← syspool.leaked + aH.receiveInUse + aH.sendInUse;
    END;  --SmashTheRequeueProc

  --INITIALIZATION
  syspool.access ← NIL;
  syspool.cache ← ALL[NIL];
  syspool.cluster ← [NIL, NIL, 0];
  syspool.freeBias ← syspool.defaultSendBuffers ← 0;

  syspool.lostBufferLimit ← 6D4;  --msecs
  syspool.defaultReceiveBuffers ← maxBuffersPerCluster + 1;
  syspool.clusterAgeLimit ← System.MicrosecondsToPulses[30D6];
  syspool.scanInterval ← System.MicrosecondsToPulses[5D6];

  Process.EnableAborts[@syspool.fault];
  Process.DisableTimeout[@syspool.fault];
  Process.DisableTimeout[@syspool.freeBuffer];

  END.....

LOG
time - by - action
14-May-84 13:36:38  AOF  Post Klamath
25-Jul-85  9:11:35  AOF  NIL context pointer when allocating new buffers
 5-Nov-85 11:26:31  AOF  Buffer alignment for D0s, DLions & Daybreaks
15-Apr-86 16:56:01  AOF  Smash the requeueProcedure on leaked buffers
17-Apr-86 15:45:55  AOF  Correct order in checking for doomed packets
16-May-86  9:24:04  SMA  Changes for new encapsulation scheme.
23-May-86 16:01:31  SMA  Buffer alignment for new encapsulation scheme
 6-Jun-86 15:52:18  AOF  Initialize the IOCB in GetBufferInternal
17-Jun-86 18:41:32  AOF  Driver.GetInputBuffer takes size
14-Jul-86 15:17:34  MI   Changed unit of 'size' from word to byte
18-Jul-86 11:32:43  MI   Support multiple buffer size.
23-Jul-86 11:09:25  MI   Removed SetSizes and cluster.doomed.
31-Jul-86 14:43:56  MI   Changed buffer combination for cluster.
 1-Aug-86 15:22:57  MI   Changed degree of driver.length from word to byte.
20-Aug-86 11:54:41  AOF  dataLinkReserve & maxUserDataSize
17-Nov-86 13:35:10  AOF  Renaming of process priorities
20-Nov-86 11:51:22  AOF  Allocate larger than requested buffers if available
21-Nov-86 18:23:35  AOF  Set highLayer.stopIndex to be allocated buffer's length
21-Dec-86 13:49:25  AOF  maxUserDataSize set to 1518 (includes physical layer).
 7-Jan-87 16:36:38  AOF  Tweeks for MDS relief
12-Jan-87 18:05:49  AOF  More debugging code
19-Jan-87 15:16:23  AOF  Bytes, not words for AllocateBuffers
12-Feb-87 19:17:24  AOF  Tweeking .cache and fudgeFactor
 6-May-87 18:39:58  AOF  Use of phonyQueue for debugging
20-Aug-87  9:03:52  AOF  Don't include "fudgeFactor" in b.fo.driver.length
31-Aug-87  8:51:08  AOF  Don't hold monitor and allocate to make pools
31-Aug-87  8:51:08  AOF  Adjust buffer lengths (again).