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, March 11, 1986 2:56:43 pm PST
Last edited by: Christian Jacobi, October 14, 1986 4:46:49 pm PDT
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.Object];
LRUCache: TYPE = REF LRUCacheRep;
LRUCacheRep:
PUBLIC TYPE =
MONITORED
RECORD [
freeObject: CD.Object←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.Object] = {
RETURN [ NEW[CD.ObjectRep ← [class: NIL, bbox: [0, 0, 1, 1], layer: CD.errorLayer]] ];
};
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.Object] =
BEGIN
ob: CD.Object;
IF lruCache.freeObject=NIL THEN ob ← lruCache.new[]
ELSE {
ob ← lruCache.freeObject;
lruCache.freeObject ← NIL
};
RETURN [ob]
END;
LinkRecord:
TYPE =
RECORD[
object: CD.Object, 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.Object]
RETURNS [
CD.Object] =
--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.Object]
RETURNS [
INT] =
INLINE {
RETURN [
((ob.bbox.x2-ob.bbox.x1) MOD 1000B)*400000B+((ob.bbox.y2-ob.bbox.y1) MOD 1000B)*400B+ob.layer]
};
Aequivalent:
PROC[ob, ob2:
CD.Object]
RETURNS [
BOOL] =
INLINE
--do not test marked
--makes no comparison of properties
BEGIN
IF ob.bbox#ob2.bbox
OR ob.class#ob2.class
OR ob.layer#ob2.layer THEN RETURN [FALSE];
RETURN [lruCache.aequivalence[ob.specific, ob2.specific! 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.