-- RTTCacheImpl.mesa
-- Russ Atkinson, June 28, 1982 1:32 pm

DIRECTORY
  Rope USING [Equal, ROPE],
  RTBasic USING [nullType, Type],
  RTTCache,
  SafeStorage USING [NewZone];

RTTCacheImpl: CEDAR MONITOR
  IMPORTS Rope, SafeStorage
  EXPORTS RTTCache
  = BEGIN OPEN Rope, RTBasic, RTTCache;

  InvalidIndex: PUBLIC ERROR = CODE;

  HashSize: CARDINAL = 256;
  HashRange: TYPE = CARDINAL [0..HashSize);

  IntCache: TYPE = REF IntCacheRep;
  IntCacheRep: TYPE = RECORD
    [enabled: BOOL _ TRUE,
     probes, misses, filled: INT _ 0,
     hashVec: ARRAY HashRange OF IntEntry];

  RefCache: TYPE = REF RefCacheRep;
  RefCacheRep: TYPE = RECORD
    [enabled: BOOL _ TRUE,
     probes, misses, filled: INT _ 0,
     hashVec: ARRAY HashRange OF RefEntry];

  Hash: PROC [type: Type, proc: ProcKey] RETURNS [HashRange] = {
    RETURN [(LOOPHOLE[type, CARDINAL] + LOOPHOLE[proc, CARDINAL])
                MOD HashSize];
    };

  LookupInt: PUBLIC ENTRY PROC
      [type: Type, proc: ProcKey] RETURNS [entry: IntEntry] = {
    -- comment
    ENABLE UNWIND => NULL;
    hash: HashRange _ Hash[type, proc];
    intCache.probes _ intCache.probes + 1;
    FOR entry _ intCache.hashVec[hash], entry.next WHILE entry # NIL DO
       IF entry.type = type AND entry.proc = proc THEN RETURN;
       ENDLOOP;
    entry _ pz.NEW[IntEntryRep _ [next: intCache.hashVec[hash], type: type, proc: proc]];
    intCache.hashVec[hash] _ entry;
    intCache.misses _ intCache.misses + 1;
    };

  FillIntEntry: PUBLIC ENTRY PROC
      [entry: IntEntry, value: INT] RETURNS [alreadyFull: BOOL] = {
    -- comment
    ENABLE UNWIND => NULL;
    IF NOT intCache.enabled THEN RETURN [TRUE];
    IF entry.valid THEN RETURN [TRUE];
    entry.int _ value;
    entry.valid _ TRUE;
    intCache.filled _ intCache.filled + 1;
    RETURN [FALSE]; 
    };

  ClearIntEntry: PUBLIC ENTRY PROC [entry: IntEntry] = {
    -- comment
    ENABLE UNWIND => NULL;
    IF NOT entry.valid THEN RETURN;
    entry.int _ -1;
    entry.valid _ FALSE;
    intCache.filled _ intCache.filled - 1;
    };

  GetInt: PUBLIC ENTRY PROC [entry: IntEntry] RETURNS [value: INT, valid: BOOL] = {
    -- atomically retrieves the value in the entry
    RETURN [entry.int, entry.valid];
    };

  LookupRef: PUBLIC ENTRY PROC
      [type: Type, proc: ProcKey] RETURNS [entry: RefEntry] = {
    -- comment
    ENABLE UNWIND => NULL;
    hash: HashRange _ Hash[type, proc];
    refCache.probes _ refCache.probes + 1;
    FOR entry _ refCache.hashVec[hash], entry.next WHILE entry # NIL DO
       IF entry.type = type AND entry.proc = proc THEN RETURN;
       ENDLOOP;
    entry _ pz.NEW[RefEntryRep _ [next: refCache.hashVec[hash], type: type, proc: proc]];
    refCache.hashVec[hash] _ entry;
    refCache.misses _ refCache.misses + 1;
    };

  FillRefEntry: PUBLIC ENTRY PROC
      [entry: RefEntry, value: REF] RETURNS [alreadyFull: BOOL] = {
    -- comment
    ENABLE UNWIND => NULL;
    IF NOT refCache.enabled THEN RETURN [TRUE];
    IF entry.valid THEN RETURN [TRUE];
    entry.ref _ value;
    entry.valid _ TRUE;
    refCache.filled _ refCache.filled + 1;
    RETURN [FALSE]; 
    };

  ClearRefEntry: PUBLIC ENTRY PROC [entry: RefEntry] = {
    -- comment
    ENABLE UNWIND => NULL;
    IF NOT entry.valid THEN RETURN;
    entry.ref _ NIL;
    entry.valid _ FALSE;
    refCache.filled _ refCache.filled - 1;
    };

  GetRef: PUBLIC ENTRY PROC [entry: RefEntry] RETURNS [value: REF, valid: BOOL] = {
    -- atomically retrieves the value in the entry
    RETURN [entry.ref, entry.valid];
    };

  GetStats: PUBLIC ENTRY PROC
      RETURNS [intProbes, intMisses, intFilled, refProbes, refMisses, refFilled: INT] = {
    ENABLE UNWIND => NULL;
    RETURN [intCache.probes, intCache.misses, intCache.filled,
                refCache.probes, refCache.misses, refCache.filled];
    };

  NewComponentMap: PUBLIC PROC [len: NAT] RETURNS [map: ComponentMap] = {
    map _ pz.NEW[ComponentMapRep[len]];
    FOR i: NAT IN [0..len) DO
       map[i] _ NullComponentEntry;
       ENDLOOP;
    };

  FillNameComponent: PUBLIC ENTRY PROC
      [map: ComponentMap, index: INT, name: ROPE] RETURNS [alreadyFull: BOOL] = {
    -- comment
    ENABLE UNWIND => NULL;
    x: NAT _ 0;
    IF index < 0 OR index >= map.len THEN RETURN WITH ERROR InvalidIndex;
    x _ index;
    IF map[x].validName THEN RETURN [TRUE];
    map[x].name _ name;
    map[x].validName _ TRUE;
    map.filledNames _ map.filledNames + 1;
    RETURN [FALSE];
    };  

  FillTypeComponent: PUBLIC ENTRY PROC
      [map: ComponentMap, index: INT, type: Type] RETURNS [alreadyFull: BOOL] = {
    -- comment
    ENABLE UNWIND => NULL;
    x: NAT _ 0;
    IF index < 0 OR index >= map.len THEN RETURN WITH ERROR InvalidIndex;
    x _ index;
    IF map[x].validType THEN RETURN [TRUE];
    map[x].type _ type;
    map[x].validType _ TRUE;
    map.filledTypes _ map.filledTypes + 1;
    RETURN [FALSE];
    };  

  GetComponentAtIndex: PUBLIC ENTRY PROC
    [map: ComponentMap, index: INT] RETURNS [comp: ComponentEntry] = {
    -- atomically returns the given component entry
    -- will ERROR InvalidIndex if index NOT IN [0..map.len)
    ENABLE UNWIND => NULL;
    IF index NOT IN [0..map.len) THEN RETURN WITH ERROR InvalidIndex;
    RETURN [map[index]];
    };

  GetComponentForName: PUBLIC ENTRY PROC
    [map: ComponentMap, name: ROPE, case: BOOL _ TRUE]
    RETURNS [index: INT, comp: ComponentEntry] = {
    -- atomically returns the given component entry for the given name
    -- IF case = TRUE, then name search is case-sensitive (Rope convention)
    -- will return [-1, NullComponentEntry] if no such name
    ENABLE UNWIND => NULL;
    FOR i: NAT IN [0..map.len) DO
      comp: ComponentEntry _ map[i];
      IF Rope.Equal[name, comp.name, case] THEN
         RETURN [i, comp];
      ENDLOOP;
    RETURN [-1, NullComponentEntry];
    };

  -- internal procs for flushing the cache

  DisableAndFlushIntCache: ENTRY PROC = {
    ENABLE UNWIND => NULL;
    intCache.enabled _ FALSE;
    intCache.probes _ intCache.misses _ intCache.filled _ 0;
    FOR i: HashRange IN HashRange DO
        FOR list: IntEntry _ intCache.hashVec[i], list.next UNTIL list = NIL DO
              list.valid _ FALSE;
              list.int _ -1;
              ENDLOOP;
        ENDLOOP;
    };

  DisableAndFlushRefCache: ENTRY PROC = {
    ENABLE UNWIND => NULL;
    refCache.enabled _ FALSE;
    refCache.probes _ refCache.misses _ refCache.filled _ 0;
    FOR i: HashRange IN HashRange DO
        FOR list: RefEntry _ refCache.hashVec[i], list.next UNTIL list = NIL DO
              list.valid _ FALSE;
              list.ref _ NIL;
              ENDLOOP;
        ENDLOOP;
    };

  DisableAndFlushAllCaches: PROC = {
    DisableAndFlushIntCache[];
    DisableAndFlushRefCache[];
    };

  pz: ZONE;
  intCache: IntCache;
  refCache: RefCache;

  TRUSTED {pz _ SafeStorage.NewZone[prefixed]};
  intCache _ pz.NEW[IntCacheRep];
  refCache _ pz.NEW[RefCacheRep];

  END.