LRUCacheImpl.mesa
Copyright Ó 1986, 1987, 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
LRUCache: Definitions for least recently used cache abstraction.
Created by Christian Jacobi, August 14, 1986 12:54:36 pm PDT
Christian Jacobi, August 30, 1990 12:07 pm PDT
Michael Plass, September 30, 1991 10:49 am PDT
DIRECTORY
LRUCache,
Rope,
RopeHash;
<<Process, SafeStorage>>
LRUCacheImpl:
CEDAR
MONITOR
LOCKS h
USING h: Handle
IMPORTS Rope, RopeHash
<<, Process, SafeStorage>>
EXPORTS LRUCache =
BEGIN
OPEN LRUCache;
ENABLE UNWIND's are removed, as hash AND equal are only set by the implementor of a handle and locking is on a per handle basis.
Handle: TYPE = REF LRUCacheRep;
FieldRec: TYPE = RECORD [value: REF¬NIL, el: REF Element¬NIL]; --note that value and el do NOT belong too each other but are stored together only to use both a SEQUENCE
LRUCacheRep:
PUBLIC
TYPE =
MONITORED
RECORD [
next, size: NAT ¬ 0,
hash: HashProc, equal: EqualProc,
dummy: REF Element,
s: SEQUENCE alloc: NAT OF FieldRec
];
dummy: dummy element in circular double linked list; rule:
new elements are included to the left of dummy
old elements are removed to the right of dummy
Element:
TYPE =
RECORD [
index, hashIndex: CARDINAL ¬ 0,
left, right, hashNext: REF Element ¬ NIL
];
Create:
PUBLIC
PROC [size:
NAT, hash: HashProc¬
NIL, equal: EqualProc¬
NIL]
RETURNS [h: Handle] = {
IF size<1 THEN ERROR;
h ¬ NEW[LRUCacheRep[size/2*2+3]];
h.size ¬ size; h.dummy ¬ NEW[Element¬[]];
h.hash ¬ hash; h.equal ¬ equal;
Reset[h];
<<SafeStorage.EnableFinalization[h];>>
};
Include:
PUBLIC ENTRY
PROC [h: Handle, value:
REF]
RETURNS [index:
NAT¬0, insert:
BOOL, used:
REF] = {
ENABLE UNWIND => NULL;
x: CARDINAL ¬ 0; --hash index
el: REF Element;
FindEl:
PROC []
RETURNS [p:
REF Element ¬ h.s[x].el] =
INLINE {
--quick check using pointer equality first [we assume this to succeed often]
WHILE p#
NIL
DO
IF h.s[p.index].value=value THEN RETURN;
p ¬ p.hashNext;
ENDLOOP;
--serious checking
p ¬ h.s[x].el;
WHILE p#
NIL
DO
IF h.equal#
NIL
THEN {
IF h.equal[h.s[p.index].value, value] THEN RETURN;
}
ELSE {
IF Rope.Equal[NARROW[h.s[p.index].value], NARROW[value]] THEN RETURN;
};
p ¬ p.hashNext;
ENDLOOP;
};
HashExcl:
PROC [] =
INLINE {
IF h.s[el.hashIndex].el=el THEN h.s[el.hashIndex].el ¬ el.hashNext
ELSE {
p: REF Element ¬ h.s[el.hashIndex].el;
WHILE p#
NIL
DO
IF p.hashNext=el THEN {p.hashNext ¬ el.hashNext; EXIT};
p ¬ p.hashNext
ENDLOOP;
};
};
HashIncl:
PROC [] =
INLINE {
el.hashIndex ¬ x;
el.hashNext ¬ h.s[x].el;
h.s[x].el ¬ el;
};
CircleExcl:
PROC [] =
INLINE {
--exclude el, where ever it is
el.left.right ¬ el.right;
el.right.left ¬ el.left;
};
CircleIncl:
PROC [] =
INLINE {
--include el to the left of h.dummy
el.right ¬ h.dummy;
el.left ¬ h.dummy.left;
h.dummy.left ¬ el.left.right ¬ el;
};
x ¬ (
IF h.hash#
NIL
THEN h.hash[value]
ELSE RopeHash.FromRope[
NARROW[value]])
MOD h.alloc;
el ¬ FindEl[];
IF (insert ¬ el=
NIL)
THEN {
IF h.next>=h.size
THEN {
el ¬ h.dummy.right;
CircleExcl[]; CircleIncl[];
IF x#el.hashIndex
THEN {
HashExcl[]; HashIncl[];
}
}
ELSE {
el ¬ NEW[Element¬[index: h.next]];
h.next ¬ h.next+1;
CircleIncl[]; HashIncl[];
};
h.s[el.index].value ¬ value;
}
ELSE {
--found value
CircleExcl[]; CircleIncl[];
};
index ¬ el.index;
used ¬ h.s[index].value;
};
Search:
PUBLIC ENTRY
PROC [h: Handle, value:
REF]
RETURNS [index:
NAT, found:
BOOL, val:
REF] = {
ENABLE UNWIND => NULL;
--maintaining hint: the code of Include is considered the truth
x: CARDINAL ¬ 0; --hash index
el: REF Element;
FindEl:
PROC []
RETURNS [p:
REF Element ¬ h.s[x].el] =
INLINE {
--quick check using pointer equality first [we assume this to succeed often]
WHILE p#
NIL
DO
IF h.s[p.index].value=value THEN RETURN;
p ¬ p.hashNext;
ENDLOOP;
--serious checking
p ¬ h.s[x].el;
WHILE p#
NIL
DO
IF h.equal#
NIL
THEN {
IF h.equal[h.s[p.index].value, value] THEN RETURN;
}
ELSE {
IF Rope.Equal[NARROW[h.s[p.index].value], NARROW[value]] THEN RETURN;
};
p ¬ p.hashNext;
ENDLOOP;
};
x ¬ (
IF h.hash#
NIL
THEN h.hash[value]
ELSE RopeHash.FromRope[
NARROW[value]])
MOD h.alloc;
el ¬ FindEl[];
IF el=NIL THEN RETURN [h.size, FALSE, NIL];
RETURN [el.index, TRUE, h.s[el.index].value];
};
Fetch:
PUBLIC
ENTRY
PROC [h: Handle, index:
NAT]
RETURNS [used:
REF] = {
ENABLE UNWIND => NULL;
--maintaining hint: the code of Include is considered the truth
x: CARDINAL; --hash index
el: REF Element;
CircleExcl:
PROC [] =
INLINE {
--identical code in Include
--exclude el, where ever it is
el.left.right ¬ el.right;
el.right.left ¬ el.left;
};
CircleIncl:
PROC [] =
INLINE {
--identical code in Include
--include el to the left of h.dummy
el.right ¬ h.dummy;
el.left ¬ h.dummy.left;
h.dummy.left ¬ el.left.right ¬ el;
};
used ¬ h.s[index].value;
x ¬ (IF h.hash#NIL THEN h.hash[used] ELSE RopeHash.FromRope[NARROW[used]]) MOD h.alloc;
el ¬ h.s[x].el;
CircleExcl[]; CircleIncl[];
};
BadIndex: ERROR = CODE;
Peek:
PUBLIC
ENTRY
PROC [h: Handle, index:
NAT]
RETURNS [val:
REF] = {
ENABLE UNWIND => NULL;
IF index>=h.alloc THEN RETURN WITH ERROR BadIndex;
RETURN [h.s[index].value];
};
Reset:
PUBLIC
ENTRY
PROC [h: Handle] = {
ENABLE UNWIND => NULL;
h.next ¬ 0;
h.dummy.left ¬ h.dummy.right ¬ h.dummy;
FOR i:
NAT
IN [0..h.size)
DO
h.s[i].value ¬ NIL; h.s[i].el ¬ NIL;
ENDLOOP
};
<<
Destroy: PROC [h: Handle] = {
IF h=NIL OR h.dummy=NIL THEN RETURN;
--necessary to break circularity on D machine
h.dummy.left ← h.dummy.right ← NIL;
--be friendly to the garbage collector in case of a leak
FOR i: NAT IN [0..h.size) DO
el: REF Element ← h.s[i].el;
IF el#NIL THEN el.left ← el.right ← el.hashNext ← NIL;
h.s[i].value ← NIL; h.s[i].el ← NIL;
ENDLOOP;
h.dummy ← NIL;
};
FinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = {
DO
Destroy[NARROW[SafeStorage.FQNext[fooFQ]]];
ENDLOOP
};
fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[];
SafeStorage.EstablishFinalization[CODE[LRUCacheRep], 0, fooFQ];
TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]};
>>
END.