-- file SymbolCache.Mesa
-- last edited by Bruce, August 27, 1980  6:21 PM

DIRECTORY
  AltoDefs: TYPE USING [PageSize],
  SegmentDefs USING [FileSegmentObject, InsufficientVM],
  Segments: TYPE USING [
    Address, SHandle, SegmentAddress, SwapIn, SwapOut, Unlock, SwapProblem],
  Symbols: TYPE USING [HTIndex, HTRecord, MDIndex],
  SymbolPack: TYPE USING [
    bb, cacheInfo, ctxb, extb, extLimit, fgTable, hashVec, ht, link, ltb,
    mainCtx, mdb, mdLimit, notifier, NullNotifier, seb, sourceFile, ssb,
    stHandle, tb],
  SymbolSegment: TYPE USING [ExtIndex, FGHeader, STHeader],
  SymbolTable: TYPE USING [Base],
  Storage: TYPE USING [Node],
  Table: TYPE USING [Base];

SymbolCache: PROGRAM
    IMPORTS initial: SymbolPack, SegmentDefs, Segments, Storage
    EXPORTS SymbolTable =
  BEGIN

  -- public interface

  Object: PUBLIC TYPE = SegmentDefs.FileSegmentObject;
  Handle: TYPE = Segments.SHandle;

  Missing: PUBLIC ERROR [Handle] = CODE;

  TableForSegment: PUBLIC PROC [seg: Segments.SHandle] RETURNS [Handle] = {
    RETURN [seg]};

  SegmentForTable: PUBLIC PROC [table: Handle] RETURNS [Segments.SHandle] = {
    RETURN [table]};


  IllegalBase: PUBLIC ERROR [base: SymbolTable.Base] = CODE;

  Acquire: PUBLIC PROC [handle: Handle] RETURNS [base: SymbolTable.Base] = {
    node: CachePointer;
    IF freeTables = NIL
      THEN {base _ NEW initial; START base}
      ELSE {base _ freeTables; freeTables _ freeTables.link};
    node _ MakeCacheEntry[handle];
    base.link _ busyTables;  busyTables _ base;
    InstallTable[base, node]};

  Release: PUBLIC PROC [base: SymbolTable.Base] = {
    node: CachePointer;
    cacheNode: CachePointer = base.cacheInfo;
    prev: SymbolTable.Base;
    FOR node _ header.next, node.next UNTIL node = cacheNode
      DO  IF node = free THEN ERROR IllegalBase[base]  ENDLOOP;
    prev _ NIL;
    FOR table: SymbolTable.Base _ busyTables, table.link UNTIL table = NIL
      DO
      IF table = base
	THEN {
	  IF prev # NIL THEN prev.link _ table.link ELSE busyTables _ table.link;
	  EXIT};
      prev _ table;
      REPEAT
        FINISHED => ERROR IllegalBase[base];
      ENDLOOP;
    FreeCacheEntry[cacheNode];
    base.link _ freeTables;  freeTables _ base};

  busyTables: SymbolTable.Base _ NIL;
  freeTables: SymbolTable.Base _ initial;


  cachePageLimit: CARDINAL _ 0;

  CacheSize: PUBLIC PROC RETURNS [pages: CARDINAL] = {RETURN [cachePageLimit]};

  SetCacheSize: PUBLIC PROC [pages: CARDINAL] = {
    cachePageLimit _ pages;  TrimCache[cachePageLimit]};


  suspended: BOOLEAN;

  SuspendCache: PUBLIC PROC = {
    WHILE unused # free DO ClearNode[unused _ unused.prev] ENDLOOP;
    suspended _ TRUE;
    FOR node: CachePointer _ header.next, node.next UNTIL node = free
      DO  Segments.Unlock[node.table];  Segments.SwapOut[node.table]  ENDLOOP};

  RestartCache: PUBLIC PROC = {
    IF ~suspended THEN ERROR;
    FOR node: CachePointer _ header.next, node.next UNTIL node = free
      DO Segments.SwapIn[node.table] ENDLOOP;
    FOR base: SymbolTable.Base _ busyTables, base.link UNTIL base = NIL
      DO SetBases[base, base.cacheInfo]; base.notifier[base] ENDLOOP;
    suspended _ FALSE};


-- internal cache management

  CacheNodes: CARDINAL = 15;
  MaxCacheNodes: CARDINAL = 255;
  LockTime: CARDINAL = 1;

  CacheNode: TYPE = RECORD[
    prev, next: CachePointer,
    table: Handle,
    locked: BOOLEAN,
    refCount: [0..MaxCacheNodes]];

  CachePointer: TYPE = POINTER TO CacheNode;

  header, free, unused: CachePointer;
  lockedPages: CARDINAL;


  --    C A C H E   O R G A N I Z A T I O N

  -- The cache keeps track of segments in CacheNodes.  The CacheNodes are
  -- kept in a doubly-linked list and organized in three groups, separated
  -- by three pointers: header, free, and unused.  Ordered by the link
  -- next, the list is organized as follows:
  --   (header .. free)		nodes attached to frames,
  --   [free .. unused)		nodes with segment but no frame,
  --   [unused .. header)	empty and available,


  MakeCacheEntry: PROC [handle: Handle] RETURNS [node: CachePointer] = {
    FOR node _ header.next, node.next UNTIL node = free
      DO
      IF node.table = handle THEN GO TO allocated;
      REPEAT
        allocated =>  NULL;
        FINISHED => {
          FOR node _ free, node.next UNTIL node = unused
	    DO
            IF node.table = handle THEN GO TO unflushed;
            REPEAT
              unflushed => Detach[node];
              FINISHED => {node _ GetEmptyNode[];  node.table _ handle};
	    ENDLOOP;
	  IF ~node.locked
	    THEN {
	      retried: BOOLEAN _ FALSE;
	      TrimCache[MAX[cachePageLimit, handle.pages] - handle.pages];
	      Segments.SwapIn[handle !
		Segments.SwapProblem[] => ERROR Missing[handle];
		SegmentDefs.InsufficientVM =>
		  IF ~retried THEN {SuspendCache[]; RestartCache[]; retried _ TRUE; RESUME}];
	      node.locked _ TRUE;
	      lockedPages _ lockedPages + handle.pages};
          Insert[node, free]};
      ENDLOOP;
    node.refCount _ node.refCount+1;  RETURN};

  FreeCacheEntry: PROC [node: CachePointer] = {
    IF (node.refCount _ node.refCount-1) = 0
      THEN {
	Detach[node];  ReleaseLock[node];
	Insert[node, free];  free _ node}};

  GetEmptyNode: PROC RETURNS [node: CachePointer] = {
    IF free = header
      THEN node _ Storage.Node[SIZE[CacheNode]]
      ELSE {
	IF unused = header THEN ClearNode[unused _ unused.prev];
	node _ unused;  Detach[node]};
    node.refCount _ 0;  node.locked _ FALSE;
    RETURN};

  Detach: PROC [node: CachePointer] = {
    IF node = free THEN free _ free.next;
    IF node = unused THEN unused _ unused.next;
    node.prev.next _ node.next;  node.next.prev _ node.prev};

  Insert: PROC [node, position: CachePointer] = {
    node.prev _ position.prev;  node.prev.next _ node;
    node.next _ position;  position.prev _ node};

  TrimCache: PROC [size: CARDINAL] = {
    WHILE (lockedPages > size OR size = 0) AND unused # free
      DO ReleaseLock[unused _ unused.prev] ENDLOOP};

  ReleaseLock: PROC [node: CachePointer] = {
    IF node.locked
      THEN {
	node.table.inuse _ TRUE;
	Segments.Unlock[node.table];  node.locked _ FALSE;
	lockedPages _ lockedPages - node.table.pages}};

  ClearNode: PROC [node: CachePointer] = {
    ReleaseLock[node];  --Segments.SwapOut[node.table]--};


-- symbol table setup

  InstallTable: PROC [base: SymbolTable.Base, node: CachePointer] = {
    SetBases[base, node];  base.notifier _ base.NullNotifier};

  SetBases: PROC [base: SymbolTable.Base, node: CachePointer] = {
    b: Segments.Address = Segments.SegmentAddress[node.table];
    tB: Table.Base = LOOPHOLE[b];
    p: LONG POINTER TO SymbolSegment.STHeader = b;
    q: LONG POINTER TO SymbolSegment.FGHeader;
    base.cacheInfo _ node;
    base.hashVec _ b+p.hvBlock.offset;
    base.ht _ DESCRIPTOR[b+p.htBlock.offset, p.htBlock.size/SIZE[Symbols.HTRecord]];
    base.ssb _ b + p.ssBlock.offset;
    base.seb _ tB + p.seBlock.offset;
    base.ctxb _ tB + p.ctxBlock.offset;
    base.mdb _ tB + p.mdBlock.offset;
    base.bb _ tB + p.bodyBlock.offset;
    base.tb _ tB + p.treeBlock.offset;
    base.ltb _ tB + p.litBlock.offset;
    base.extb _ tB + p.extBlock.offset;
    base.mdLimit _ FIRST[Symbols.MDIndex] + p.mdBlock.size;
    base.extLimit _ FIRST[SymbolSegment.ExtIndex] + p.extBlock.size;
    base.mainCtx _ p.outerCtx;  base.stHandle _ p;
    IF p.fgRelPgBase = 0 OR node.table.pages <= p.fgRelPgBase
      THEN {base.sourceFile _ NIL; base.fgTable _ NIL}
      ELSE {
	offset: CARDINAL = LOOPHOLE[
	  @(NIL[POINTER TO SymbolSegment.FGHeader]).sourceFile];
	q _ b + p.fgRelPgBase*AltoDefs.PageSize;
	base.sourceFile _ (b + p.fgRelPgBase*AltoDefs.PageSize) + offset;
	base.fgTable _ DESCRIPTOR[
	    b + p.fgRelPgBase*AltoDefs.PageSize + q.offset, q.length]}};

-- initialization

  CacheEntries: ARRAY [0..CacheNodes] OF CacheNode;

  Init: PROC = {
    START initial;  initial.link _ NIL;
    FOR j: INTEGER [0..CacheNodes] IN [0..CacheNodes]
      DO
      CacheEntries[j].next _ @CacheEntries[IF j=CacheNodes THEN 0 ELSE j+1];
      CacheEntries[j].prev _ @CacheEntries[IF j=0 THEN CacheNodes ELSE j-1];
      ENDLOOP;
    header _ @CacheEntries[0];
    free _ unused _ header.next;
    lockedPages _ 0;  suspended _ FALSE};

  Init[];

  END.