-- file SymbolCache.mesa
-- last edited by Satterthwaite, May 24, 1982 10:31 am
-- last edited by Paul Rovner, February 10, 1983 12:16 pm

DIRECTORY
  Environment: TYPE USING [wordsPerPage],
  File: TYPE USING [ID, ShowCapability, Unknown],
  FileSegment: TYPE USING [Span],
  Heap: TYPE USING [systemZone],
  Space: TYPE USING [
    Activate, Handle, nullHandle, virtualMemory,
    Create, CreateUniformSwapUnits, Delete, Error, LongPointer, Map],
  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 [Base, ExtIndex, FGHeader, STHeader],
  SymbolTable: TYPE USING [Base, Handle, anySpan];

SymbolCache: MONITOR  -- protects the cache of global frames for symbol tables
    IMPORTS initial: SymbolPack, File, Heap, Space
    EXPORTS SymbolTable = {

  -- public interface

  Handle: TYPE = SymbolTable.Handle;

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


  Acquire: PUBLIC ENTRY PROC [handle: Handle] RETURNS [base: SymbolTable.Base] = {
    ENABLE UNWIND => {NULL};
    node: CachePointer;
    IF freeTables = NIL THEN {base _ NEW initial; Bump[@stats.nNew]; START base}
    ELSE {base _ freeTables; freeTables _ freeTables.link};
    node _ MakeCacheEntry[handle];
    base.link _ busyTables;  busyTables _ base;
    InstallTable[base, node]};

  Release: PUBLIC ENTRY PROC [base: SymbolTable.Base] = {
    ENABLE UNWIND => {NULL};
    cacheNode: CachePointer = base.cacheInfo;
    prev: SymbolTable.Base;
    Bump[@stats.nRelease];
    FOR node: CachePointer _ 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};


  Locked: PUBLIC ERROR [handle: SymbolTable.Handle, nLocks: NAT] = CODE;

  Forget: PUBLIC ENTRY PROC [handle: SymbolTable.Handle] = {
    ENABLE UNWIND => {NULL};
    
    FID: PROC [h: SymbolTable.Handle] RETURNS [File.ID] = INLINE {
      RETURN [h.file.ShowCapability[].fID]};
      
    OverLap: PROC [s1, s2: FileSegment.Span] RETURNS [BOOL] = INLINE {
      RETURN [IF s1.base <= s2.base
        THEN s1.base + s1.pages > s2.base
        ELSE s1.base < s2.base + s2.pages]};
      
    fileId: File.ID = FID[handle];
    nLocks: NAT _ 0;
    prev: CachePointer;
    FOR node: CachePointer _ unused.prev, prev UNTIL node = header DO
      prev _ node.prev;
      IF fileId = FID[node.table] AND (
       handle.span = SymbolTable.anySpan OR OverLap[handle.span, node.table.span]) THEN {
        IF node.refCount # 0 THEN nLocks _ nLocks + node.refCount
        ELSE ReleaseCacheEntry[node]};
      ENDLOOP;
    IF nLocks # 0 THEN ERROR Locked[handle, nLocks]};
    
    
  busyTables: SymbolTable.Base _ NIL;
  freeTables: SymbolTable.Base _ initial;

  symbolMasterSpace: Space.Handle _ Space.nullHandle;
  cachePageLimit: CARDINAL _ 0;  -- number of pages in symbolMasterSpace

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

  SetCacheSize: PUBLIC ENTRY PROC [pages: CARDINAL] = {
    ENABLE UNWIND => NULL;
    IF symbolMasterSpace # Space.nullHandle THEN RETURN;
    cachePageLimit _ pages;
    symbolMasterSpace _ Space.Create[size: pages, parent: Space.virtualMemory];
    };


-- statistics

  takingStatistics: BOOLEAN = TRUE;
  Count: TYPE = LONG CARDINAL _ 0;
  stats: RECORD [nAcquire, nNew, nRelease: Count] _ [];

  Bump: PROC [p: POINTER TO Count, delta: Count _ 1] = INLINE {
    IF takingStatistics THEN p^ _ p^ + delta};


-- internal cache management

  initialNodes: NAT = 15;
  maxNodes: NAT = 255;

  CacheNode: TYPE = RECORD [
    prev, next: CachePointer,
    table: Handle,
    space: Space.Handle _ Space.nullHandle,
    refCount: [0..maxNodes] _ 0,
    nUses: NAT _ 0];

  CachePointer: TYPE = LONG POINTER TO CacheNode;

  header, free, unused: CachePointer;
  nNodes: [0..maxNodes];
  mappedPages: 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: INTERNAL 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 => {
                IF node = free THEN free _ node.next;  Detach[node]};
              FINISHED => {node _ GetEmptyNode[];  node.table _ handle};
            ENDLOOP;
          IF node.space = Space.nullHandle THEN {
            pages: CARDINAL = handle.span.pages;
            node.space _ TrimCache[pages];
            IF node.space = Space.nullHandle
             THEN node.space _ Space.Create[size: pages, parent: Space.virtualMemory];
            IF pages > 15 THEN Space.CreateUniformSwapUnits[parent: node.space, size: 8];
            node.space.Map[window: [file: node.table.file, base: node.table.span.base]
                        ! Space.Error, File.Unknown => {ERROR Missing[handle]}];
            mappedPages _ mappedPages + pages};
      Insert[node, free]};
      ENDLOOP;
    node.refCount _ node.refCount+1;  node.nUses _ node.nUses + 1;
    node.space.Activate[];
    RETURN};

  FreeCacheEntry: INTERNAL PROC [node: CachePointer] = {
    IF (node.refCount _ node.refCount-1) = 0 THEN {
      position: CachePointer;
      Detach[node];
      FOR position _ free, position.next UNTIL position = unused DO
        IF node.nUses >= position.nUses THEN EXIT;
        ENDLOOP;
      Insert[node, position];
      IF position = free THEN free _ node}};

  ReleaseCacheEntry: INTERNAL PROC [node: CachePointer] = {
    IF node = free THEN free _ node.next;
    ClearNode[node];
    Detach[node];
    Insert[node, unused]; unused _ node};
    
  GetEmptyNode: INTERNAL PROC RETURNS [node: CachePointer] = {
    IF free = header OR (unused = header AND nNodes < maxNodes) THEN {
      node _ (Heap.systemZone).NEW[CacheNode];  nNodes _ nNodes + 1}
    ELSE {
      node _ unused;
      IF node = header THEN {
        IF node = free THEN free _ node.prev;
        unused _ node.prev;  ClearNode[node]};
      unused _ node.next;
      IF node = free THEN free _ node.next;
      Detach[node]};
    RETURN};

  Detach: INTERNAL PROC [node: CachePointer] = {
    node.prev.next _ node.next;  node.next.prev _ node.prev};

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

  -- try to create a Space in symbolMasterSpace; clear enough nodes to do so
  TrimCache: INTERNAL PROC [pages: CARDINAL] 
        RETURNS[space: Space.Handle _ Space.nullHandle] = {  
    DO
      space _ Space.Create[size: pages, parent: symbolMasterSpace ! ANY => CONTINUE];
      IF space # Space.nullHandle OR unused = free THEN RETURN;
      ClearNode[unused _ unused.prev]
    ENDLOOP};

  ClearNode: INTERNAL PROC [node: CachePointer] = {
    found: BOOL _ FALSE;
    IF node.space # Space.nullHandle THEN {
      Space.Delete[node.space];
      node.space _ Space.nullHandle;
      mappedPages _ mappedPages - node.table.span.pages};
    node.refCount _ node.nUses _ 0};


-- symbol table setup

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

  SetBases: INTERNAL PROC [base: SymbolTable.Base, node: CachePointer] = {
    b: LONG POINTER = node.space.LongPointer[];
    tB: SymbolSegment.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.span.pages <= p.fgRelPgBase THEN {
      base.sourceFile _ NIL; base.fgTable _ NIL}
    ELSE {
      offset: CARDINAL = LOOPHOLE[@(NIL[POINTER TO SymbolSegment.FGHeader]).sourceFile];
      q _ b + p.fgRelPgBase*Environment.wordsPerPage;
      base.sourceFile _ (b + p.fgRelPgBase*Environment.wordsPerPage) + offset;
      base.fgTable _ DESCRIPTOR[b + p.fgRelPgBase*Environment.wordsPerPage + q.offset, q.length]}};

-- initialization

  Init: ENTRY PROC = {
    START initial;  initial.link _ NIL;
    header _ (Heap.systemZone).NEW[CacheNode];
    header.next _ header.prev _ header;
    nNodes _ 1;
    FOR j: NAT IN [0..initialNodes) DO
      node: CachePointer _ (Heap.systemZone).NEW[CacheNode];
      Insert[node, header];
      nNodes _ nNodes + 1;
      ENDLOOP;
    free _ unused _ header.next;
    mappedPages _ 0};

  Init[];

  }.