-- file Allocator.Mesa
-- last modified by Satterthwaite, July 25, 1980  4:02 PM

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  Inline: TYPE USING [LongDiv, LongMult],
  Storage: TYPE USING [Free, Node],
  Table: TYPE USING [
    Base, BaseDescriptor, Index, Notifier, OrderedIndex, Region, Selector,
    SizeDescriptor, chunkType, Limit];

Allocator: PROGRAM IMPORTS Inline, Storage EXPORTS Table =
  BEGIN

  tableRegion: Table.Region;
  nTables: CARDINAL;

  base: Table.BaseDescriptor;
  limit: Table.SizeDescriptor;
  top, dTop: Table.SizeDescriptor;

  initialized: BOOLEAN ← FALSE;

  Overflow: PUBLIC SIGNAL RETURNS [Table.Region] = CODE;
  Failure: PUBLIC ERROR [Table.Selector] = CODE;


  -- stack allocation from subzones

  Allocate: PUBLIC PROC [table: Table.Selector, size: CARDINAL]
    RETURNS [Table.OrderedIndex] = {
    index: CARDINAL = top[table];
    newTop: CARDINAL = index + size;
    IF newTop <= limit[table] THEN top[table] ← newTop
    ELSE
      IF newTop <= Table.Limit THEN {top[table] ← newTop; Repack[table, size]}
      ELSE ERROR Failure[table];
    RETURN[FIRST[Table.OrderedIndex] + index]};

  Bounds: PUBLIC PROC [table: Table.Selector] RETURNS [Table.Base, CARDINAL] = {
    RETURN[base[table], top[table]]};

  Trim: PUBLIC PROC [table: Table.Selector, size: CARDINAL] = {
    IF size > top[table] THEN ERROR Failure[table];
    IF table = Table.chunkType THEN chunkRover ← NullChunkIndex;
    top[table] ← size};


  Repack: PROC [table: Table.Selector, size: CARDINAL] = {
    -- Garwick's Repacking algorithm (Knuth, Vol. 1, p. 245)
    -- note that d, newBase, dTop are overlaid (on sharedSpace)
    j, k, m: CARDINAL;
    n: CARDINAL;
    sum, inc, delta, remainder: INTEGER;
    newBase: Table.BaseDescriptor;
    newRegion: Table.Region;
    sum ← tableRegion.size;
    inc ← 0;
    FOR j DECREASING IN [0..nTables) DO
      sum ← sum - top[j];
      inc ← inc + (dTop[j] ← IF top[j] > dTop[j] THEN top[j] - dTop[j] ELSE 0);
      ENDLOOP;
    UNTIL sum >= MIN[tableRegion.size/32, 100B] DO
      newRegion ← SetDescriptors[SIGNAL Overflow[]];
      FOR j IN [0..nTables) DO
	base[j] ← newRegion.origin + (base[j] - tableRegion.origin) ENDLOOP;
      sum ← sum + (newRegion.size - tableRegion.size);
      tableRegion ← newRegion;
      ENDLOOP;
    delta ← CARDINAL[sum]/(10*nTables);
    remainder ← sum - delta*nTables;
    newBase ← DESCRIPTOR[BASE[dTop] + nTables*SIZE[CARDINAL], nTables];
    newBase[0] ← base[0];
    n ← 0;
    FOR j IN [0..nTables - 1) DO
      limit[j] ← MIN[
	top[j] + delta + Inline.LongDiv[Inline.LongMult[dTop[j], remainder], inc],
	  Table.Limit];
      n ← n + limit[j];
      newBase[j + 1] ← newBase[j] + limit[j];
      dTop[j] ← top[j];
      ENDLOOP;
    limit[nTables - 1] ← MIN[tableRegion.size - n, Table.Limit];
    dTop[nTables - 1] ← top[nTables - 1];
    top[table] ← top[table] - size;
    j ← 1;
    WHILE j < nTables DO
      i: CARDINAL;
      sb, db: Table.Base;
      SELECT newBase[j] FROM
	< base[j] => {
	  sb ← base[j];
	  db ← newBase[j];
	  FOR i IN [0..top[j]) DO (db + i)↑ ← (sb + i)↑ ENDLOOP;
	  base[j] ← newBase[j];
	  j ← j + 1};
	> base[j] => {
	  k ← j + 1;
	  UNTIL k = nTables OR newBase[k] <= base[k] DO k ← k + 1 ENDLOOP;
	  FOR m DECREASING IN [j..k) DO
	    sb ← base[m];
	    db ← newBase[m];
	    FOR i DECREASING IN [0..top[m]) DO (db + i)↑ ← (sb + i)↑ ENDLOOP;
	    base[m] ← newBase[m];
	    ENDLOOP;
	  j ← k};
	ENDCASE => j ← j + 1;
      ENDLOOP;
    top[table] ← top[table] + size;
    UpdateBases[]};


  -- inquiries

  WordsUsed: PUBLIC PROC RETURNS [words: CARDINAL] = {
    words ← 0;
    FOR j: CARDINAL IN [0..nTables) DO words ← words + top[j] ENDLOOP;
    RETURN};

  WordsFree: PUBLIC PROC RETURNS [words: CARDINAL] = {
    RETURN[tableRegion.size - WordsUsed[]]};


  -- linked list allocation (first subzone)

  Chunk: TYPE = MACHINE DEPENDENT RECORD [
    free(0:0..0): BOOLEAN,
    size(0:1..15): [0..Table.Limit),
    fLink(1): CIndex,
    bLink(2): CIndex];

  CIndex: TYPE = Table.Base RELATIVE POINTER [0..Table.Limit) TO Chunk;

  NullChunkIndex: CIndex = FIRST[CIndex];

  chunkRover: CIndex;

  GetChunk: PUBLIC PROC [size: CARDINAL] RETURNS [Table.Index] = {
    cb: Table.Base = base[Table.chunkType];
    p, q, next: CIndex;
    nodeSize: CARDINAL;
    n: INTEGER;
    size ← MAX[size, SIZE[Chunk]];
    BEGIN
    IF (p ← chunkRover) = NullChunkIndex THEN GO TO notFound;
    -- search for a chunk to allocate
    DO
      nodeSize ← cb[p].size;
      WHILE (next ← p + nodeSize) # LOOPHOLE[top[Table.chunkType], CIndex] AND cb[
	next].free DO
	cb[cb[next].bLink].fLink ← cb[next].fLink;
	cb[cb[next].fLink].bLink ← cb[next].bLink;
	cb[p].size ← nodeSize ← nodeSize + cb[next].size;
	chunkRover ← p; -- in case next = chunkRover

	ENDLOOP;
      SELECT n ← nodeSize - size FROM
	= 0 => {
	  IF cb[p].fLink = p THEN chunkRover ← NullChunkIndex
	  ELSE {
	    chunkRover ← cb[cb[p].bLink].fLink ← cb[p].fLink;
	    cb[cb[p].fLink].bLink ← cb[p].bLink};
	  q ← p;
	  GO TO found};
	>= SIZE[Chunk] => {
	  cb[p].size ← n; chunkRover ← p; q ← p + n; GO TO found};
	ENDCASE;
      IF (p ← cb[p].fLink) = chunkRover THEN GO TO notFound;
      ENDLOOP;
    EXITS found => NULL; notFound => q ← Allocate[Table.chunkType, size];
    END;
    base[Table.chunkType][q].free ← FALSE;
    RETURN[q]};

  FreeChunk: PUBLIC PROC [index: Table.Index, size: CARDINAL] = {
    cb: Table.Base = base[Table.chunkType];
    p: CIndex = LOOPHOLE[index];
    cb[p].size ← MAX[size, SIZE[Chunk]];
    IF chunkRover = NullChunkIndex THEN chunkRover ← cb[p].fLink ← cb[p].bLink ← p
    ELSE {
      cb[p].fLink ← cb[chunkRover].fLink;
      cb[cb[p].fLink].bLink ← p;
      cb[p].bLink ← chunkRover;
      cb[chunkRover].fLink ← p};
    cb[p].free ← TRUE};


  -- communication

  NotifyNode: TYPE = RECORD [
    notifier: Table.Notifier, link: POINTER TO NotifyNode];

  notifyList: POINTER TO NotifyNode;

  AddNotify: PUBLIC PROC [proc: Table.Notifier] = {
    p: POINTER TO NotifyNode = Storage.Node[SIZE[NotifyNode]];
    p↑ ← [notifier: proc, link: notifyList];
    notifyList ← p;
    proc[base]};

  DropNotify: PUBLIC PROC [proc: Table.Notifier] = {
    p, q: POINTER TO NotifyNode;
    IF notifyList = NIL THEN RETURN;
    p ← notifyList;
    IF p.notifier = proc THEN notifyList ← p.link
    ELSE {
      WHILE TRUE DO
	q ← p;
	p ← p.link;
	IF p = NIL THEN RETURN;
	IF p.notifier = proc THEN EXIT
	ENDLOOP;
      q.link ← p.link};
    Storage.Free[p]};

  UpdateBases: PROC = {
    FOR p: POINTER TO NotifyNode ← notifyList, p.link UNTIL p = NIL DO
      p.notifier[base] ENDLOOP};


  -- initialization, expansion and termination

  Create: PUBLIC PROC [
    region: Table.Region, weights: DESCRIPTOR FOR ARRAY OF CARDINAL] = {
    origin: Table.Base;
    d, sum, nW: CARDINAL;
    i: Table.Selector;
    IF initialized THEN Destroy[];
    nTables ← LENGTH[weights];
    tableRegion ← SetDescriptors[region];
    sum ← 0;
    FOR i IN [0..nTables) DO sum ← sum + weights[i] ENDLOOP;
    nW ← tableRegion.size;
    origin ← tableRegion.origin + nW;
    FOR i DECREASING IN [0..nTables) DO
      d ←
	IF i = 0 THEN nW
	ELSE Inline.LongDiv[Inline.LongMult[tableRegion.size, weights[i]], sum];
      origin ← origin - d;
      nW ← nW - d;
      base[i] ← origin;
      limit[i] ← d;
      top[i] ← dTop[i] ← 0;
      ENDLOOP;
    chunkRover ← NullChunkIndex;
    notifyList ← NIL;
    initialized ← TRUE};

  SetDescriptors: PROC [region: Table.Region] RETURNS [update: Table.Region] = {
    sizeBases: CARDINAL = nTables*SIZE[Table.Base];
    sizeBounds: CARDINAL = nTables*SIZE[CARDINAL];
    prefixSize: CARDINAL = 2*sizeBases + 3*sizeBounds;
    IF prefixSize > region.size THEN ERROR Failure[0];
    base ← DESCRIPTOR[region.origin, nTables];
    limit ← DESCRIPTOR[BASE[base] + sizeBases, nTables];
    top ← DESCRIPTOR[BASE[limit] + sizeBounds, nTables];
    dTop ← DESCRIPTOR[BASE[top] + sizeBounds, nTables];
    RETURN[[origin: region.origin + prefixSize, size: region.size - prefixSize]]};

  Destroy: PUBLIC PROC = {
    p, q: POINTER TO NotifyNode;
    FOR p ← notifyList, q UNTIL p = NIL DO q ← p.link; Storage.Free[p] ENDLOOP;
    initialized ← FALSE};

  END.