-- Copyright (C) 1986  by Xerox Corporation. All rights reserved. 
-- BucketAllocImpl.mesa
-- MEW		 2-Mar-86 12:39:45

DIRECTORY
  BucketAlloc,
  Heap;

BucketAllocImpl: MONITOR IMPORTS Heap EXPORTS BucketAlloc =
  BEGIN

  BucketRec: TYPE = RECORD [
    first: LONG POINTER TO LONG POINTER,
    size: CARDINAL,
    info: BucketAlloc.BucketInfo];

  BucketSeq: TYPE = RECORD [SEQUENCE length: CARDINAL OF BucketRec];

  BigNode: TYPE = LONG POINTER TO BigNodeRec;
  BigNodeRec: TYPE = RECORD [size: CARDINAL, ptr: LONG POINTER, next: BigNode];
  bigList: BigNode ← NIL;

  zone: UNCOUNTED ZONE;
  b: LONG POINTER TO BucketSeq;

  Initialize: PUBLIC ENTRY PROCEDURE [
    z: UNCOUNTED ZONE,
    buckets: LONG DESCRIPTOR FOR ARRAY OF BucketAlloc.BucketInfo] =
    BEGIN
    zone ← z;
    b ← z.NEW[BucketSeq [LENGTH[buckets]]];
    FOR i: CARDINAL IN [0..LENGTH[buckets]) DO
      b[i] ← [first: NIL, size: 0, info: buckets[i]];
      IF buckets[i].nodeSize < SIZE[LONG POINTER] THEN
        b[i].info.nodeSize ← SIZE[LONG POINTER];
      FOR j: CARDINAL IN [0..buckets[i].initialBucketSize) DO
        p: LONG POINTER TO LONG POINTER;
        p ← Heap.MakeNode[z, buckets[i].nodeSize];
        p↑ ← b[i].first;
        b[i].first ← p;
        ENDLOOP;
      b[i].size ← buckets[i].initialBucketSize;
      ENDLOOP;

    -- Now Sort These
    FOR i: CARDINAL IN [1..LENGTH[buckets]) DO
      current: BucketRec = b[i];
      FOR j: CARDINAL DECREASING IN [0..i - 1] DO
        IF current.info.nodeSize >= b[j].info.nodeSize THEN {
          b[j + 1] ← current; EXIT};
        b[j + 1] ← b[j];
        ENDLOOP
      ENDLOOP;
    END;

  Reset: PUBLIC PROCEDURE =
    BEGIN
    FOR i: CARDINAL IN [0..b.length) DO
      IF b[i].size > b[i].info.initialBucketSize THEN
        FOR j: CARDINAL IN [0..(b[i].info.initialBucketSize - b[i].size)) DO
          ptr: LONG POINTER TO LONG POINTER ← b[i].first;
          b[i].first ← ptr↑;
          zone.FREE[@ptr];
          ENDLOOP
      ELSE
        FOR j: CARDINAL IN [b[i].size..b[i].info.initialBucketSize) DO
          p: LONG POINTER TO LONG POINTER;
          p ← Heap.MakeNode[zone, b[i].info.nodeSize];
          p↑ ← b[i].first;
          b[i].first ← p;
          ENDLOOP;
      b[i].size ← b[i].info.initialBucketSize;
      ENDLOOP
    END;

  Destroy: PUBLIC PROCEDURE =
    BEGIN
    FOR i: CARDINAL IN [0..b.length) DO
      p, next: LONG POINTER TO LONG POINTER;
      FOR p ← b[i].first, next WHILE p # NIL DO next ← p↑; zone.FREE[@p]; ENDLOOP;
      ENDLOOP
    END;

  Alloc: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [p: LONG POINTER] =
    BEGIN
    bucket: LONG POINTER TO BucketRec ← FindBucket[size];
    IF bucket.info.nodeSize < size THEN {  -- bigger than the biggest bucket
      big: BigNode ← zone.NEW[BigNodeRec];
      p ← Heap.MakeNode[zone, size];
      big↑ ← [size: size, ptr: p, next: bigList];
      bigList ← big;
      RETURN[p]};
    IF bucket.first # NIL THEN {
      p ← bucket.first;
      bucket.first ← bucket.first↑;
      bucket.size ← bucket.size - 1;
      RETURN[p]}
    ELSE RETURN[Heap.MakeNode[zone, bucket.info.nodeSize]]
    END;

  Free: PUBLIC PROCEDURE [p: LONG POINTER TO LONG POINTER, size: CARDINAL] =
    BEGIN
    bucket: LONG POINTER TO BucketRec ← FindBucket[size];
    IF bucket.info.nodeSize < size THEN {  -- bigger than the biggest bucket
      big: BigNode;
      FOR big ← bigList, big.next WHILE big # NIL DO
        IF big.ptr = p↑ THEN {
          IF big # bigList THEN ERROR;  -- ASSERT big = bigList
          bigList ← big.next;
          Heap.FreeNode[zone, p↑];
          p↑ ← NIL;
          zone.FREE[@big];
          RETURN};
        IF big.next.ptr = p↑ THEN {
          big.next ← big.next.next;
          Heap.FreeNode[zone, p↑];
          p↑ ← NIL;
          zone.FREE[@big];
          RETURN}
        ENDLOOP;
      };
    IF bucket.size >= bucket.info.maxBucketSize THEN {
      Heap.FreeNode[zone, p↑]; p↑ ← NIL; RETURN}
    ELSE {
      LOOPHOLE[p↑, LONG POINTER TO LONG POINTER]↑ ← bucket.first;
      bucket.first ← LOOPHOLE[p↑, LONG POINTER TO LONG POINTER];
      bucket.size ← bucket.size + 1}
    END;

  FindBucket: PROCEDURE [size: CARDINAL]
    RETURNS [l: LONG POINTER TO BucketRec ← NIL] =
    BEGIN
    low, high, mid: CARDINAL;
    IF b[0].info.nodeSize >= size THEN RETURN[@b[0]];
    IF b[b.length - 1].info.nodeSize <= size THEN RETURN[@b[b.length - 1]];
    low ← 0;
    high ← b.length - 1;
    FOR mid ← (low + high) / 2, (low + high) / 2 WHILE high >= low DO
      IF b[mid].info.nodeSize = size THEN RETURN[@b[mid]];
      IF b[mid].info.nodeSize > size THEN {
        IF b[mid - 1].info.nodeSize = size THEN RETURN[@b[mid - 1]];
        IF b[mid - 1].info.nodeSize < size THEN RETURN[@b[mid]];
        high ← mid - 1}
      ELSE {
        IF b[mid + 1].info.nodeSize >= size THEN RETURN[@b[mid + 1]];
        low ← mid + 1}
      ENDLOOP;
    END;

  END..