<> <> <> <> <> DIRECTORY LRUCache, Rope, Process, RopeHash, SafeStorage; LRUCacheImpl: CEDAR MONITOR LOCKS h USING h: Handle IMPORTS Process, Rope, RopeHash, SafeStorage EXPORTS LRUCache = BEGIN OPEN LRUCache; Handle: TYPE = REF LRUCacheRep; FieldRec: TYPE = RECORD [value: REF_NIL, el: REF Element_NIL]; 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: NAT _ 0, hashIndex: NAT _ 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] = { ENABLE UNWIND => NULL; x: NAT; --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; }; Fetch: PUBLIC ENTRY PROC [h: Handle, index: NAT] RETURNS [used: REF] = { ENABLE UNWIND => NULL; 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, el] _ h.s[index]; CircleExcl[]; CircleIncl[]; }; 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; <<--absolutely necessary>> h.dummy.left _ h.dummy.right _ NIL; <<--pure friendlyness to the garbage collector>> 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; }; LRUFinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = { DO h: Handle = NARROW[SafeStorage.FQNext[fooFQ]]; Destroy[h]; ENDLOOP }; fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[]; TRUSTED {Process.Detach[FORK LRUFinalizerProcess[fooFQ]]}; END.