-- file AllocImpl.mesa
-- last modified by Sweet, 19-Aug-81 12:15:12
-- last modified by Satterthwaite, December 10, 1982 11:56 am

DIRECTORY
  Alloc: TYPE USING [
    Base, Index, Limit, maxForBits, Notifier, OrderedIndex, pagesForBits,
    Selector, TableInfo],
  Environment: TYPE USING [PageCount, PageOffset, wordsPerPage],
  File: TYPE USING [
    Capability, Create, Delete, GetSize, PageCount, PageNumber, SetSize],
  FileTypes: TYPE USING [tUntypedFile],
  Heap: TYPE USING [Create, Delete],
  Inline: TYPE USING [LongDiv],
  Runtime: TYPE USING [CallDebugger],
  Space: TYPE USING [
    Create, Delete, ForceOut, GetAttributes, GetWindow, Handle, LongPointer, 
    Map, nullHandle, PageCount, PageOffset, virtualMemory, WindowOrigin],
  Volume: TYPE USING [systemID];

AllocImpl: MONITOR LOCKS h.LOCK USING h: Handle
    IMPORTS File, Heap, Inline, Runtime, Space, Volume EXPORTS Alloc = {
  OPEN Alloc;

 -- types
 
  Handle: TYPE = LONG POINTER TO InstanceData;
  
  InstanceData: PUBLIC TYPE = MONITORED RECORD [
    nTables: CARDINAL,
    fileTop: File.PageNumber,
    fileSize: CARDINAL,
    cap: File.Capability,
    z: UNCOUNTED ZONE,
    indexBits: CARDINAL,
    tileSize: CARDINAL,
    notifiers: NotifyChainHandle ← NIL,
    bases: LONG POINTER TO BaseSeq,
    spaces: LONG POINTER TO SpaceSeq,
    chunks: LONG POINTER TO ChunkSeq,
    top: SizesHandle,
    limit: LONG POINTER TO BoundSeq,
    vmPages: SizesHandle];
  
  maxItemSize: NAT = MAX[Alloc.Base.SIZE, Bound.SIZE, Space.Handle.SIZE, ChunkHandle.SIZE];
  SeqTag: TYPE = [0 .. CARDINAL.LAST/maxItemSize];	-- for faster indexing
  
  BaseSeq: TYPE = RECORD [SEQUENCE length: SeqTag OF Alloc.Base];
  SizeSeq: TYPE = RECORD [SEQUENCE length: SeqTag OF CARDINAL];
  Bound: TYPE = LONG CARDINAL;
  BoundSeq: TYPE = RECORD [SEQUENCE length: SeqTag OF Bound];
  SpaceSeq: TYPE = RECORD [SEQUENCE length: SeqTag OF Space.Handle];
  ChunkSeq: TYPE = RECORD [SEQUENCE length: SeqTag OF ChunkHandle];
    
  SizesHandle: TYPE = LONG POINTER TO SizeSeq; 


 -- signals
 
  Failure: PUBLIC ERROR [h: Handle, table: Selector] = CODE;
  Overflow: PUBLIC SIGNAL [h: Handle, table: Selector] RETURNS [extra: CARDINAL] = CODE;
  

 -- stack allocation from subzones

  Words: PUBLIC ENTRY PROC [h: Handle, table: Selector, size: CARDINAL] RETURNS [OrderedIndex] = {
    RETURN [WordsInternal[h, table, size ! UNWIND => {NULL}]]};

  WordsInternal: INTERNAL PROC [h: Handle, table: Selector, size: CARDINAL] RETURNS [OrderedIndex] = {
    index: CARDINAL = h.top[table];
    newTop: Bound = index.LONG + size; -- could overflow CARDINAL for 16 bit pointers
    IF newTop > h.limit[table] THEN {
      IF newTop > maxForBits[h.indexBits] THEN ERROR Failure[h, table];
      GrowTable[h, table, newTop]}; 
    h.top[table] ← newTop;
    RETURN [OrderedIndex.FIRST + index]};
    

 -- linked list allocation
  
  Chunk: TYPE = MACHINE DEPENDENT RECORD [
    free(0: 0..0): BOOL,
    size(0: 1..15): [0..maxForBits[15]],
    fLink(1): CIndex,
    bLink(2): CIndex];

  CIndex: TYPE = Base RELATIVE POINTER [0..Limit) TO Chunk;
  nullChunkIndex: CIndex = CIndex.FIRST;
  
  ChunkHandle: TYPE = LONG POINTER TO ChunkObject;
  ChunkObject: TYPE = RECORD [
    chunkRover: CIndex,
    firstSmall: CARDINAL,
    smallLists: SEQUENCE nSmall: CARDINAL OF CIndex];
  
  GetChunk: PUBLIC ENTRY PROC [h: Handle, size: CARDINAL, table: Selector] 
      RETURNS [Index] = {
    ENABLE UNWIND => {NULL};
    ch: ChunkHandle = h.chunks[table];
    cb: Base = h.bases[table];
    q: CIndex;
    IF ch = NIL THEN ERROR Failure[h, table];
    size ← MAX[size, Chunk.SIZE];
    BEGIN
    IF size IN [ch.firstSmall..ch.firstSmall+ch.nSmall) THEN { 
      offset: CARDINAL = size - ch.firstSmall;
      q ← ch.smallLists[offset];
      IF q # nullChunkIndex THEN {ch.smallLists[offset] ← cb[q].fLink; GO TO found}};
    q ← GetRoverChunk[cb, h.top[table], ch, size];
    IF q # nullChunkIndex THEN GO TO found;
    q ← WordsInternal[h: h, table: table, size: size ! Failure => {GO TO noneAtEnd}];
    EXITS
      noneAtEnd => {
        -- none the right size, no space at the end, and no big ones to split
	FOR s: CARDINAL IN [ch.firstSmall.. ch.firstSmall+ch.nSmall) DO
          offset: CARDINAL = s - ch.firstSmall;
          r: CIndex ← ch.smallLists[offset];
          WHILE r # nullChunkIndex DO
            next: CIndex = cb[r].fLink;
	    FreeRoverChunk[cb, ch, r, s];
	    r ← next;
	    ENDLOOP;
          ch.smallLists[offset] ← nullChunkIndex;
          ENDLOOP;
        -- now all possible merges of free nodes can happen
        q ← GetRoverChunk[cb, h.top[table], ch, size];
        IF q = nullChunkIndex THEN ERROR Failure[h, table]};
      found => NULL;
    END;
    h.bases[table][q].free ← FALSE;
    RETURN [q]};

  GetRoverChunk: INTERNAL PROC [cb: Base, top: CARDINAL, ch: ChunkHandle, size: CARDINAL] 
      RETURNS [Index] = {
    p, q, next: CIndex;
    nodeSize: CARDINAL;
    n: INTEGER;
    BEGIN
    IF (p ← ch.chunkRover) = nullChunkIndex THEN GO TO notFound;
    -- search for a chunk to allocate
    DO
      nodeSize ← cb[p].size;
      WHILE (next ← p + nodeSize) - CIndex.FIRST # top 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;
	ch.chunkRover ← p; -- in case next = chunkRover
	ENDLOOP;
      SELECT (n ← nodeSize-size) FROM
	= 0 => {
	  IF cb[p].fLink = p THEN ch.chunkRover ← nullChunkIndex
	  ELSE {
	    ch.chunkRover ← cb[cb[p].bLink].fLink ← cb[p].fLink;
	    cb[cb[p].fLink].bLink ← cb[p].bLink};
	  q ← p;
	  GO TO found};
	>= Chunk.SIZE => {
	  cb[p].size ← n; ch.chunkRover ← p; q ← p + n; GO TO found};
	ENDCASE;
      IF (p ← cb[p].fLink) = ch.chunkRover THEN GO TO notFound;
      ENDLOOP;
    EXITS
      found => NULL;
      notFound => q ← nullChunkIndex;
    END;
    RETURN [q]};

  FreeChunk: PUBLIC ENTRY PROC [
      h: Handle, index: Index, size: CARDINAL, table: Selector] = {
    ENABLE UNWIND => {NULL};
    ch: ChunkHandle = h.chunks[table];
    cb: Base = h.bases[table];
    p: CIndex = LOOPHOLE[index];
    IF ch = NIL THEN ERROR Failure[h, table];
    cb[p].size ← size ← MAX[size, Chunk.SIZE];
    IF size IN [ch.firstSmall..ch.firstSmall+ch.nSmall) THEN {
      offset: CARDINAL = size - ch.firstSmall;
      cb[p].fLink ← ch.smallLists[offset];
      ch.smallLists[offset] ← p;
      -- don't set cb[p].free ← TRUE; to avoid coalescing nodes
      cb[p].bLink ← nullChunkIndex} -- note, only singly linked
    ELSE FreeRoverChunk[cb, ch, index, size]};

  FreeRoverChunk: INTERNAL PROC [
      cb: Base, ch: ChunkHandle, index: Index, size: CARDINAL] = {
    p: CIndex = LOOPHOLE[index];
    cb[p].size ← size ← MAX[size, Chunk.SIZE];
    IF ch.chunkRover = nullChunkIndex THEN ch.chunkRover ← cb[p].fLink ← cb[p].bLink ← p
    ELSE {
      rover: CIndex = ch.chunkRover;
      cb[p].fLink ← cb[rover].fLink;
      cb[cb[p].fLink].bLink ← p;
      cb[p].bLink ← rover;
      cb[rover].fLink ← p};
    cb[p].free ← TRUE};


 -- queries
  
  Bounds: PUBLIC ENTRY PROC [h: Handle, table: Selector] RETURNS [base: Base, size: CARDINAL] = {
    RETURN [h.bases[table], h.top[table]]};

  PagesForWords: PROC [words: LONG CARDINAL] RETURNS [CARDINAL] = {
    RETURN [Inline.LongDiv[words + Environment.wordsPerPage-1, Environment.wordsPerPage]]};

  -- stack allocation from subzones

  fileTileSize: CARDINAL = 32; -- must be >= tileSize;
  
  GrowTable: INTERNAL PROC [h: Handle, table: Selector, newTop: Bound] = {
    newPages: CARDINAL = PagesForWords[newTop];
    IF newPages > h.vmPages[table] THEN {
      extra: CARDINAL = SIGNAL Overflow[h, table];
      newVM: CARDINAL = MIN[maxForBits[h.indexBits], newPages + extra];
      parent: Space.Handle = Space.Create[size: newVM, parent: Space.virtualMemory];
      oldSpace: Space.Handle = h.spaces[table];
      IF oldSpace # Space.nullHandle THEN {
	next: Space.Handle ← oldSpace.GetAttributes.lowestChild;
	FOR child: Space.Handle ← next, next UNTIL child = Space.nullHandle DO
	  window: Space.WindowOrigin = child.GetWindow;
          base: Space.PageOffset;
	  size: Space.PageCount;
	  newChild: Space.Handle;
	  [nextSibling: next, base: base, size: size] ← child.GetAttributes;
	  child.ForceOut[];
	  Space.Delete[child];
	  newChild ← Space.Create[size: size, parent: parent, base: base];
	  newChild.Map[window];
	  ENDLOOP;
        Space.Delete[oldSpace]};
      h.spaces[table] ← parent;
      h.bases[table] ← LOOPHOLE[parent.LongPointer];
      h.vmPages[table] ← newVM;
      RunNotifierChain[h]};
    DO
      AddTile[h, table, h.tileSize];
      IF newTop <= h.limit[table] THEN EXIT;
      ENDLOOP};
    
  AddTile: PROC [h: Handle, table: Selector, pages: CARDINAL] = {
    offset: CARDINAL = PagesForWords[h.limit[table]];
    space: Space.Handle;
    maxPages: CARDINAL = h.vmPages[table];
    IF pages + offset > maxPages THEN pages ← maxPages - offset;
    IF pages = 0 THEN ERROR;
    h.limit[table] ← h.limit[table] + pages*Environment.wordsPerPage;
    space ← Space.Create[size: pages, parent: h.spaces[table], base: offset];
    IF h.fileTop + pages > h.fileSize THEN  {
      IF File.GetSize[h.cap] # h.fileSize THEN Runtime.CallDebugger["SetSize bug"L];
      File.SetSize[h.cap, (h.fileSize ← h.fileSize + fileTileSize)];
      IF File.GetSize[h.cap] # h.fileSize THEN Runtime.CallDebugger["SetSize bug"L]};
    space.Map[[file: h.cap, base: h.fileTop]];
    h.fileTop ← h.fileTop + pages};

   
  -- initialization, expansion and termination

  Create: PUBLIC PROC [
        weights: DESCRIPTOR FOR ARRAY OF TableInfo, indexBits, tileSize: CARDINAL] 
      RETURNS [h: Handle] = {
    az: UNCOUNTED ZONE = Heap.Create[initial: 1]; 
    cnt: CARDINAL = weights.LENGTH;
    h ← az.NEW[InstanceData ← [
      nTables: cnt, fileTop: 0, fileSize: 0, cap: , indexBits: indexBits, z: az,
      tileSize: tileSize, notifiers: NIL,
      bases: az.NEW[BaseSeq[cnt]],
      spaces: az.NEW[SpaceSeq[cnt]],
      chunks: az.NEW[ChunkSeq[cnt]],
      top: az.NEW[SizeSeq[cnt]],
      limit: az.NEW[BoundSeq[cnt]],
      vmPages: az.NEW[SizeSeq[cnt]]]];
    IF tileSize >= fileTileSize THEN ERROR;
    FOR i: CARDINAL IN [0..cnt) DO 
      h.fileSize ← h.fileSize + weights[i].initialPages ENDLOOP;
    h.cap ← File.Create[Volume.systemID, h.fileSize, FileTypes.tUntypedFile];
    FOR i: CARDINAL IN [0..cnt) DO 
      InitTable[h, i, weights[i]] ENDLOOP};

  InitTable: PROC [h: Handle, table: Selector, info: TableInfo] = {
    max: CARDINAL = WITH w: info SELECT FROM
      TRUE => pagesForBits[h.indexBits],
      FALSE => w.initialVMemPages,
      ENDCASE => ERROR;
    iPages: CARDINAL ← info.initialPages;
    IF iPages > max OR max > pagesForBits[h.indexBits] THEN 
      ERROR Failure[h, table];
    h.vmPages[table] ← max;
    h.top[table] ← 0;  h.limit[table] ← 0;
    h.chunks[table] ← NIL;
    IF iPages = 0 THEN {
      h.spaces[table] ← Space.nullHandle; h.bases[table] ← NIL}
    ELSE {
      h.spaces[table] ← Space.Create[size: max, parent: Space.virtualMemory];
      h.bases[table] ← LOOPHOLE[h.spaces[table].LongPointer]};
    WHILE iPages # 0 DO 
      pages: CARDINAL = MIN[iPages, h.tileSize];
      AddTile[h, table, pages];
      iPages ← iPages - pages;
      ENDLOOP};

  ResetTable: PUBLIC ENTRY PROC [h: Handle, table: Selector, info: TableInfo] = {
    ENABLE UNWIND => {NULL};
    IF h.spaces[table] # Space.nullHandle THEN Space.Delete[h.spaces[table]];
    InitTable[h, table, info];
    RunNotifierChain[h]};

  Destroy: PUBLIC PROC [h: Handle] = {DestroyEntry[h]; Heap.Delete[h.z]};

  DestroyEntry: ENTRY PROC [h: Handle] = {
    ENABLE UNWIND => {NULL};
    FOR i: CARDINAL IN [0..h.nTables) DO
      h.bases[i] ← NIL ENDLOOP;
    RunNotifierChain[h];
    FOR i: CARDINAL IN [0..h.nTables) DO
      IF h.spaces[i] # Space.nullHandle THEN Space.Delete[h.spaces[i]]
      ENDLOOP;
    File.Delete[h.cap]};

  Reset: PUBLIC ENTRY PROC [h: Handle] = {
    ENABLE UNWIND => {NULL};
    FOR i: CARDINAL IN [0..h.nTables) DO 
      h.top[i] ← 0;
      ResetChunkInternal[h, i];
      ENDLOOP};

  Chunkify: PUBLIC ENTRY PROC [
      h: Handle, table: Selector, firstSmall, nSmall: CARDINAL] = {
    ENABLE UNWIND => {NULL};
    ch: ChunkHandle ← h.chunks[table];
    IF ch # NIL THEN ERROR Failure[h, table];
    ch ← h.z.NEW[ChunkObject[nSmall]];
    ch.firstSmall ← firstSmall;
    h.chunks[table] ← ch;
    ResetChunkInternal[h, table]};

  UnChunkify: PUBLIC ENTRY PROC [h: Handle, table: Selector] = {
    ENABLE UNWIND => {NULL};
    IF h.chunks[table] # NIL THEN h.z.FREE[@h.chunks[table]]};

  Trim: PUBLIC ENTRY PROC [h: Handle, table: Selector, size: CARDINAL] = {
    ENABLE UNWIND => {NULL};
    IF size <= h.top[table] THEN {h.top[table] ← size; ResetChunkInternal[h, table]}
    ELSE ERROR Failure[h, table]};

  ResetChunk: PUBLIC ENTRY PROC [h: Handle, table: Selector] = {
    ResetChunkInternal[h, table ! UNWIND => {NULL}]};
    
  ResetChunkInternal: INTERNAL PROC [h: Handle, table: Selector] = {
    ch: ChunkHandle = h.chunks[table];
    IF ch # NIL THEN {
      ch.chunkRover ← nullChunkIndex;
      FOR i: CARDINAL IN [0..ch.nSmall) DO ch.smallLists[i] ← nullChunkIndex ENDLOOP}};
    

 --   Notifier stuff
  
  NotifyNode: TYPE = RECORD [notifier: Notifier, link: NotifyChainHandle];
  NotifyChainHandle: TYPE = LONG POINTER TO NotifyNode;

  AddNotify: PUBLIC ENTRY PROC [h: Handle, proc: Notifier] = {
    ENABLE UNWIND => {NULL};
    p: NotifyChainHandle = h.z.NEW[NotifyNode ← [notifier: proc, link: h.notifiers]];
    h.notifiers ← p;
    proc[DESCRIPTOR[h.bases↑]]};

  DropNotify: PUBLIC ENTRY PROC [h: Handle, proc: Notifier] = {
    ENABLE UNWIND => {NULL};
    IF h.notifiers # NIL THEN {
      p: NotifyChainHandle ← h.notifiers;
      IF p.notifier = proc THEN h.notifiers ← p.link
      ELSE {
	q: NotifyChainHandle;
	DO
	  q ← p;
	  p ← p.link;
	  IF p = NIL THEN RETURN;
	  IF p.notifier = proc THEN EXIT
	  ENDLOOP;
	q.link ← p.link};
      h.z.FREE[@p]}};
    
  RunNotifierChain: INTERNAL PROC [h: Handle] = {
    FOR p: NotifyChainHandle ← h.notifiers, p.link UNTIL p = NIL DO
      p.notifier[DESCRIPTOR[h.bases↑]] ENDLOOP};

  }.