<> <> <> <> <> 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_0, 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 ]; <> <> <> <> 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 { <> RemoveEntry[i]; IncludeEntryAsYoungest[i]; lruCache.freeObject _ ob; RETURN [lruCache.access[i].object] }; ENDLOOP; <<--not found>> <<--Determine where entry will go in table>> <> IF lruCache.freeEntry