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