DIRECTORY LRUCache, Rope, RopeHash; LRUCacheImpl: CEDAR MONITOR LOCKS h USING h: Handle IMPORTS Rope, RopeHash EXPORTS LRUCache = BEGIN OPEN LRUCache; 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 ]; 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]; }; Include: PUBLIC ENTRY PROC [h: Handle, value: REF] RETURNS [index: NAT¬0, insert: BOOL, used: REF] = { x: CARDINAL ¬ 0; --hash index el: REF Element; FindEl: PROC [] RETURNS [p: REF Element ¬ h.s[x].el] = INLINE { WHILE p#NIL DO IF h.s[p.index].value=value THEN RETURN; p ¬ p.hashNext; ENDLOOP; 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 { el.left.right ¬ el.right; el.right.left ¬ el.left; }; CircleIncl: PROC [] = INLINE { 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] = { x: CARDINAL ¬ 0; --hash index el: REF Element; FindEl: PROC [] RETURNS [p: REF Element ¬ h.s[x].el] = INLINE { WHILE p#NIL DO IF h.s[p.index].value=value THEN RETURN; p ¬ p.hashNext; ENDLOOP; 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] = { x: CARDINAL; --hash index el: REF Element; CircleExcl: PROC [] = INLINE { el.left.right ¬ el.right; el.right.left ¬ el.left; }; CircleIncl: PROC [] = INLINE { 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] = { IF index>=h.alloc THEN RETURN WITH ERROR BadIndex; RETURN [h.s[index].value]; }; Reset: PUBLIC ENTRY PROC [h: Handle] = { 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 }; END. π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 <> <<, Process, SafeStorage>> 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. 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 <> ENABLE UNWIND => NULL; --quick check using pointer equality first [we assume this to succeed often] --serious checking --exclude el, where ever it is --include el to the left of h.dummy ENABLE UNWIND => NULL; --maintaining hint: the code of Include is considered the truth --quick check using pointer equality first [we assume this to succeed often] --serious checking ENABLE UNWIND => NULL; --maintaining hint: the code of Include is considered the truth --identical code in Include --exclude el, where ever it is --identical code in Include --include el to the left of h.dummy ENABLE UNWIND => NULL; ENABLE UNWIND => NULL; << 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]]}; >> Κ x•NewlineDelimiter –(cedarcode) style˜codešœ™Kšœ ΟeœH™TKšœΟbœžœžœ™@K™