-- file Allocator.Mesa
-- last modified by Satterthwaite, July 25, 1980  4:02 PM
-- last modified by Lewis, January 29, 1981  1:15 PM
-- last modified by Paul Rovner, June 16, 1982 12:59 pm



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

Allocator: PROGRAM IMPORTS Inline, Storage EXPORTS IncludeCheckerTable =
  BEGIN

  tableRegion: IncludeCheckerTable.Region;
  nIncludeCheckerTables: CARDINAL;

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

  initialized: BOOLEAN _ FALSE;

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


  -- stack allocation from subzones

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

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

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


  Repack: PROC [table: IncludeCheckerTable.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, remainder: LONG INTEGER;
    inc, delta: INTEGER;
    newBase: IncludeCheckerTable.BaseDescriptor;
    newRegion: IncludeCheckerTable.Region;
    sum _ tableRegion.size;
    inc _ 0;
    FOR j DECREASING IN [0..nIncludeCheckerTables) 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..nIncludeCheckerTables) DO
	base[j] _ newRegion.origin + (base[j] - tableRegion.origin) ENDLOOP;
      sum _ sum + (newRegion.size - tableRegion.size);
      tableRegion _ newRegion;
      ENDLOOP;
    delta _ Inline.LongDiv[LOOPHOLE[sum, LONG CARDINAL], (10*nIncludeCheckerTables)];
    remainder _ sum - delta*nIncludeCheckerTables;
    newBase _ DESCRIPTOR[BASE[dTop] + nIncludeCheckerTables*SIZE[CARDINAL], nIncludeCheckerTables];
    newBase[0] _ base[0];
    n _ 0;
    FOR j IN [0..nIncludeCheckerTables - 1) DO
      limit[j] _ MIN[
	top[j] + delta + Inline.LongDiv[dTop[j]*LOOPHOLE[remainder, LONG CARDINAL], inc],
	  IncludeCheckerTable.Limit];
      n _ n + limit[j];
      newBase[j + 1] _ newBase[j] + limit[j];
      dTop[j] _ top[j];
      ENDLOOP;
    limit[nIncludeCheckerTables - 1] _ MIN[tableRegion.size - n, IncludeCheckerTable.Limit];
    dTop[nIncludeCheckerTables - 1] _ top[nIncludeCheckerTables - 1];
    top[table] _ top[table] - size;
    j _ 1;
    WHILE j < nIncludeCheckerTables DO
      i: CARDINAL;
      sb, db: IncludeCheckerTable.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 = nIncludeCheckerTables 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..nIncludeCheckerTables) 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..IncludeCheckerTable.Limit),
    fLink(1): CIndex,
    bLink(2): CIndex];

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

  NullChunkIndex: CIndex = FIRST[CIndex];

  chunkRover: CIndex;

  GetChunk: PUBLIC PROC [size: CARDINAL] RETURNS [IncludeCheckerTable.Index] = {
    cb: IncludeCheckerTable.Base = base[IncludeCheckerTable.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[IncludeCheckerTable.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[IncludeCheckerTable.chunkType, size];
    END;
    base[IncludeCheckerTable.chunkType][q].free _ FALSE;
    RETURN[q]};

  FreeChunk: PUBLIC PROC [index: IncludeCheckerTable.Index, size: CARDINAL] = {
    cb: IncludeCheckerTable.Base = base[IncludeCheckerTable.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: IncludeCheckerTable.Notifier, link: POINTER TO NotifyNode];

  notifyList: POINTER TO NotifyNode;

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

  DropNotify: PUBLIC PROC [proc: IncludeCheckerTable.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: IncludeCheckerTable.Region, weights: DESCRIPTOR FOR ARRAY OF CARDINAL] = {
    origin: IncludeCheckerTable.Base;
    d, sum, nW: CARDINAL;
    i: IncludeCheckerTable.Selector;
    IF initialized THEN Destroy[];
    nIncludeCheckerTables _ LENGTH[weights];
    tableRegion _ SetDescriptors[region];
    sum _ 0;
    FOR i IN [0..nIncludeCheckerTables) DO sum _ sum + weights[i] ENDLOOP;
    nW _ tableRegion.size;
    origin _ tableRegion.origin + nW;
    FOR i DECREASING IN [0..nIncludeCheckerTables) 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: IncludeCheckerTable.Region] RETURNS [update: IncludeCheckerTable.Region] = {
    sizeBases: CARDINAL = nIncludeCheckerTables*SIZE[IncludeCheckerTable.Base];
    sizeBounds: CARDINAL = nIncludeCheckerTables*SIZE[CARDINAL];
    prefixSize: CARDINAL = 2*sizeBases + 3*sizeBounds;
    IF prefixSize > region.size THEN ERROR Failure[0];
    base _ DESCRIPTOR[region.origin, nIncludeCheckerTables];
    limit _ DESCRIPTOR[BASE[base] + sizeBases, nIncludeCheckerTables];
    top _ DESCRIPTOR[BASE[limit] + sizeBounds, nIncludeCheckerTables];
    dTop _ DESCRIPTOR[BASE[top] + sizeBounds, nIncludeCheckerTables];
    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.