CDLRUCacheImpl.mesa a Chipndale module
Copyright © 1984 by Xerox Corporation. All rights reserved.
by Christian Jacobi March 7, 1984 5:59:42 pm PST
last change Christian October 22, 1984 3:00:40 pm PDT
DIRECTORY
CDLRUCache,
CD;
CDLRUCacheImpl:
CEDAR
MONITOR
LOCKS lruCache USING lruCache: LRUCache
IMPORTS CD
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]
};
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�ultAequivalence;
lru.new ← newProc;
RETURN [lru]
END;
UnusedOrNew:
PUBLIC ENTRY
PROC [lruCache: LRUCache]
RETURNS [
CD.ObPtr] =
BEGIN
ob: CD.ObPtr;
IF lruCache.new=NIL THEN RETURN WITH ERROR CD.Error[ec: callingError, explanation: "no newproc defined"];
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.level]
};
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.level#ob2.level 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.