-- 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..