CDLRUCacheImpl.mesa a Chipndale module
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, March 7, 1984 5:59:42 pm PST
last change Christian Jacobi, April 11, 1985 9:27:31 am PST
DIRECTORY
CDLRUCache,
CD;
CDLRUCacheImpl: CEDAR MONITOR
LOCKS lruCache USING lruCache: LRUCache
EXPORTS CDLRUCache =
BEGIN
AequivalenceProc: TYPE = PROC[mySpecific, other: REF ANY] RETURNS [BOOL];
NewProc: TYPE = PROC [] RETURNS [CD.ObPtr];
LRUCache: TYPE = REF LRUCacheRep;
LRUCacheRep: PUBLIC TYPE = MONITORED RECORD [
freeObject: CD.ObPtr←NIL,
freeEntry: CARDINAL𡤀,
aequivalence: AequivalenceProc,
new: NewProc,
access: SEQUENCE size: CARDINAL OF LinkRecord -- access[0] is not used but a dummy
];
DefaultAequivalence: PROC [mySpecific, other: REF ANY] RETURNS [BOOL] = {
RETURN [mySpecific=other]
};
DefaultNew: PROC [] RETURNS [CD.ObPtr] = {
RETURN [ NEW[CD.ObjectDefinition ← [size: [1, 1], layer: CD.highLightError]] ];
};
Create: PUBLIC PROC [size: CARDINAL, aequivalenceProc: AequivalenceProc, newProc: NewProc] RETURNS [LRUCache] =
--creates new LRU cache of suggested size
BEGIN
lru: LRUCache;
size ← MAX[MIN[size, 256], 1]+1; --users don't know that access[0] is a dummy
lru ← NEW[LRUCacheRep[size]];
lru.aequivalence ← aequivalenceProc;
IF lru.aequivalence=NIL THEN lru.aequivalence ← DefaultAequivalence;
lru.new ← newProc;
IF lru.new=NIL THEN lru.new ← DefaultNew;
RETURN [lru]
END;
UnusedOrNew: PUBLIC ENTRY PROC [lruCache: LRUCache] RETURNS [CD.ObPtr] =
BEGIN
ob: CD.ObPtr;
IF lruCache.freeObject=NIL THEN ob ← lruCache.new[]
ELSE {
ob ← lruCache.freeObject;
lruCache.freeObject ← NIL
};
RETURN [ob]
END;
LinkRecord: TYPE = RECORD[
object: CD.ObPtr, hash: INT,
older, younger: INTEGER
];
hit: INT𡤀
missed: INT𡤀
Hit: PROC = INLINE {IF hit<LAST[INT] THEN hit←hit+1};
Missed: PROC = INLINE {IF missed<LAST[INT] THEN missed←missed+1};
ReplaceByAequivalent: PUBLIC ENTRY PROC [lruCache: LRUCache, ob: CD.ObPtr] RETURNS [CD.ObPtr] =
--returns either "ob" or an aequivalent object to "ob"
--side effect: introduces "ob" in aequivalence table to be accessed by others.
--consider "ob" immutable! respectively, on any further change, it may cause
--the same change made to all or some aequivalent objects in past and future
BEGIN
--no error should be raised
Hash: PROC[ob: CD.ObPtr] RETURNS [INT] = INLINE {
RETURN [
(ob.size.x MOD 1000B)*400000B+(ob.size.y MOD 1000B)*400B+ob.layer]
};
Aequivalent: PROC[ob, ob2: CD.ObPtr] RETURNS [BOOL] = INLINE
--do not test marked
--makes no comparison of properties
BEGIN
IF ob.size#ob2.size OR ob.p#ob2.p
OR ob.layer#ob2.layer THEN RETURN [FALSE];
RETURN [lruCache.aequivalence[ob.specificRef, ob2.specificRef! ANY => GOTO SomeError]]
EXITS
SomeError => RETURN [FALSE]
END;
RemoveEntry: INTERNAL PROC[entry: INTEGER] =
--assume entry properly in list
BEGIN
lruCache.access[lruCache.access[entry].older].younger ← lruCache.access[entry].younger;
lruCache.access[lruCache.access[entry].younger].older ← lruCache.access[entry].older;
END;
IncludeEntryAsYoungest: INTERNAL PROC[entry: INTEGER] =
--assume entry properly in list
BEGIN
lruCache.access[entry].older ← lruCache.access[0].older;
lruCache.access[entry].younger ← 0;
lruCache.access[lruCache.access[0].older].younger ← entry;
lruCache.access[0].older ← i;
END;
i: INTEGER;
hash: INT = Hash[ob];
FOR i ← lruCache.access[0].older, lruCache.access[i].older WHILE i#0 DO
IF hash=lruCache.access[i].hash
AND Aequivalent[lruCache.access[i].object, ob] THEN {
Hit[];
RemoveEntry[i];
IncludeEntryAsYoungest[i];
lruCache.freeObject ← ob;
RETURN [lruCache.access[i].object]
};
ENDLOOP;
--not found
--Determine where entry will go in table
Missed[];
IF lruCache.freeEntry<lruCache.size THEN {
i ← lruCache.freeEntry;
lruCache.freeEntry ← lruCache.freeEntry + 1;
}
ELSE {
i ← lruCache.access[0].younger;
RemoveEntry[i];
};
lruCache.access[i].object ← ob;
lruCache.access[i].hash ← hash;
IncludeEntryAsYoungest[i];
RETURN [lruCache.access[i].object]
END;
END.