
<<FunctionCacheImpl.mesa>>
    <<Michael Plass, July 15, 1985 12:53:54 pm PDT>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
    <<>>
DIRECTORY
Ascii USING [Lower],
Atom USING [GetPName],
FunctionCache USING [Cache, CacheEntry, CacheInfo, CacheRep, ClientID, CompareProc, Domain, FuncProc, Match, Range],
Rope USING [Equal, ROPE],
SafeStorage USING [ReclaimCollectibleObjects],
VMSideDoor USING [rmPages];

    FunctionCacheImpl: CEDAR MONITOR LOCKS x USING x: Cache
    IMPORTS Ascii, Atom, SafeStorage, Rope, VMSideDoor
    EXPORTS FunctionCache
    ~ BEGIN OPEN FunctionCache;

        <<N. B. The entryList in a CacheRep has a list head;>>

        Create: PUBLIC PROC [maxEntries: INT, maxTotalSize: INT] RETURNS [Cache] ~ {
            RETURN [NEW[CacheRep _ [nEntries: 0, maxEntries: maxEntries, totalSize: 0, maxTotalSize: maxTotalSize, entryList: LIST[[NIL, NIL, 
            NIL, 0]]]]];
            };

        ROPE: TYPE ~ Rope.ROPE;
        LORA: TYPE ~ LIST OF REF ANY;

        ListCompare: PROC [a, b: LORA, match: Match] RETURNS [BOOL] ~ {
            UNTIL a=NIL OR b=NIL DO
                IF a.first=b.first OR Equal[a.first, b.first, match] THEN {a _ a.rest; b _ b.rest}
                ELSE RETURN [FALSE];
                ENDLOOP;
            RETURN [a=b];
            };

        Equal: PUBLIC PROC [a, b: Domain, match: Match] RETURNS [equal: BOOL ] ~ {
            equal _ IF a = b THEN TRUE
                ELSE IF match = refs THEN FALSE
                ELSE WITH a SELECT FROM
                A: REF INT   => (WITH b SELECT FROM B: REF INT => (A^=B^), ENDCASE => FALSE),
                A: REF REAL => (WITH b SELECT FROM B: REF REAL => (A^=B^), ENDCASE => FALSE),
                A: REF CHAR => (WITH b SELECT FROM B: REF CHAR => IF match = case THEN (A^=B^) ELSE (Ascii.Lower[A^]=Ascii.Lower[B^]), ENDCASE => 
                FALSE),
                A: ATOM => (WITH b SELECT FROM B: ATOM => (Rope.Equal[Atom.GetPName[A], Atom.GetPName[B], match#text]), ENDCASE => FALSE),
                A: ROPE => (WITH b SELECT FROM B: ROPE => (Rope.Equal[A, B, match#text]), ENDCASE => FALSE),
                A: LORA => (WITH b SELECT FROM B: LORA => ListCompare[A, B, match], ENDCASE => FALSE),
                ENDCASE => FALSE;
            };

        Eval: PUBLIC PROC [x: Cache, F: FuncProc, arg: Domain, match: Match, clientID: ClientID _ NIL] RETURNS [value: Range] ~ {
            refCompare: CompareProc ~ {good _ arg = argument};
            fancyCompare: CompareProc ~ {good _ arg= argument OR Equal[arg, argument, match]};
            ok: BOOL;
            [value, ok] _ Lookup[x, IF match=refs THEN refCompare ELSE fancyCompare, clientID];
            IF NOT ok THEN {
                size: INT;
                [value, size] _ F[arg];
                Insert[x: x, argument: arg, value: value, size: size, clientID: clientID];
                };
            };

        Insert: PUBLIC ENTRY PROC [x: Cache, argument: Domain, value: Range, size: INT, clientID: ClientID] ~ {
            x.entryList.rest _ CONS[[clientID: clientID, argument: argument, value: value, size: size], x.entryList.rest];
            x.nEntries _ x.nEntries + 1;
            x.totalSize _ x.totalSize + size;
        Validate[x];
            };

        Lookup: PUBLIC ENTRY PROC [x: Cache, compare: CompareProc, clientID: ClientID _ NIL] RETURNS [value: Range, ok: BOOL] ~ {
            ENABLE UNWIND => NULL;
            prev: LIST OF CacheEntry _ x.entryList;
            p: LIST OF CacheEntry _ prev.rest;
            IF p # NIL THEN {
                IF p.first.clientID = clientID AND compare[p.first.argument] THEN RETURN [value: p.first.value, ok: TRUE];
                prev _ p;
                };
            UNTIL (p _ prev.rest) = NIL DO
                IF p.first.clientID = clientID AND compare[p.first.argument] THEN {
                    prev.rest _ p.rest;
                    p.rest _ x.entryList.rest;
                    x.entryList.rest _ p;
                    RETURN [value: p.first.value, ok: TRUE];
                    };
                prev _ p;
                ENDLOOP;
            RETURN [value: NIL, ok: FALSE];
            };

        Any: PUBLIC CompareProc ~ {RETURN [TRUE]};

        Obtain: PUBLIC ENTRY PROC [x: Cache, compare: CompareProc, limit: INT, clientID: ClientID] RETURNS [list: LIST OF CacheEntry] ~ {
            ENABLE UNWIND => NULL;
            end: LIST OF CacheEntry _ NIL;
            prev: LIST OF CacheEntry _ x.entryList;
            p: LIST OF CacheEntry _ prev.rest;
            UNTIL limit = 0 OR p = NIL DO
                IF p.first.clientID = clientID AND compare[p.first.argument] THEN {
                    x.nEntries _ x.nEntries - 1;
                    x.totalSize _ x.totalSize - p.first.size;
                    IF end = NIL THEN {list _ end _ p}
                    ELSE {end.rest _ p; end _ p};
                    p _ prev.rest _ p.rest;
                    <<end.rest _ NIL; -- will be set later>>
                    limit _ limit-1;
                    };
                prev _ p;
                p _ prev.rest;
                ENDLOOP;
            IF end#NIL THEN {
                end.rest _ NIL;
            Validate[x];
                };
            };

        Release: PUBLIC ENTRY PROC [x: Cache, list: LIST OF CacheEntry] ~ {
            IF list # NIL THEN {
                p: LIST OF CacheEntry _ list;
                DO
                    x.nEntries _ x.nEntries + 1;
                    x.totalSize _ x.totalSize + p.first.size;
                    IF p.rest = NIL THEN EXIT;
                    p _ p.rest;
                    ENDLOOP;
                p.rest _ x.entryList.rest;
                x.entryList.rest _ list;
                Validate[x];
                };
            };

        GetInfo: PUBLIC ENTRY PROC [x: Cache] RETURNS [CacheInfo] ~ {
            RETURN [[nEntries: x.nEntries, maxEntries: x.maxEntries, totalSize: x.totalSize, maxTotalSize: x.maxTotalSize]]
            };

        GetList: PUBLIC ENTRY PROC [x: Cache] RETURNS [list: LIST OF CacheEntry] ~ {
            end: LIST OF CacheEntry _ NIL;
            FOR p: LIST OF CacheEntry _ x.entryList, p.rest UNTIL p=NIL DO
                IF end = NIL THEN {list _ end _ LIST[p.first]}
                ELSE {end.rest _ LIST[p.first]; end _ end.rest};
                ENDLOOP;
            };

        SetLimits: PUBLIC ENTRY PROC [x: Cache, maxEntries: INT, maxTotalSize: INT] ~ {
            x.maxEntries _ maxEntries;
            x.maxTotalSize _ maxTotalSize;
        Validate[x];
            };

        SetValueSize: PUBLIC ENTRY PROC [x: Cache, value: Range, size: INT] ~ {
            FOR p: LIST OF CacheEntry _ x.entryList.rest, p.rest UNTIL p = NIL DO
                IF p.first.value = value THEN {
                    x.totalSize _ x.totalSize - p.first.size + size;
                    p.first.size _ size;
                    };
                ENDLOOP;
            Validate[x];
            };

        CheckInvariants: INTERNAL PROC [x: Cache] ~ {
            n: INT _ 0;
            s: INT _ 0;
            FOR p: LIST OF CacheEntry _ x.entryList.rest, p.rest UNTIL p = NIL DO
                n _ n + 1;
                s _ s + p.first.size;
                ENDLOOP;
            IF n # x.nEntries THEN ERROR;
            IF s # x.totalSize THEN ERROR;
            };

        debug: BOOL _ FALSE;
        Validate: INTERNAL PROC [x: Cache] ~ INLINE {
            IF debug THEN CheckInvariants[x];
        IF x.nEntries > x.maxEntries OR x.totalSize > x.maxTotalSize THEN EnforceLimits[x];
            IF debug THEN CheckInvariants[x];
            };

        triggerSize: INT _ 8000;
        trimmedSize: INT _ 0;
            <<trimmedSize is not correctly monitored, but it is only a hint.>>

        EnforceLimits: INTERNAL PROC [x: Cache] ~ {
            e: INT _ 0;
            s: INT _ 0;
            emax: INT ~ x.maxEntries;
            smax: INT ~ x.maxTotalSize;
            last: LIST OF CacheEntry _ x.entryList;
            p: LIST OF CacheEntry;
            UNTIL (p _ last.rest) = NIL OR e+1 > emax OR s+p.first.size > smax DO
                e _ e + 1;
                s _ s + p.first.size;
                last _ p;
                ENDLOOP;
            trimmedSize _ (x.totalSize-s) + trimmedSize;
            last.rest _ NIL;
            x.nEntries _ e;
            x.totalSize _ s;
            UNTIL p = NIL DO
                t: LIST OF CacheEntry _ p.rest;
                p.first.argument _ NIL;
                p.first.value _ NIL;
                p.rest _ NIL;
                p _ t;
                ENDLOOP;
            IF trimmedSize > triggerSize THEN {
                trimmedSize _ 0;
                SafeStorage.ReclaimCollectibleObjects[suspendMe: FALSE, traceAndSweep: FALSE];
                };
            };

        GlobalCache: PUBLIC PROC RETURNS [Cache] ~ {RETURN [globalCache]};

        globalCache: Cache ~ Create[maxEntries: 100, maxTotalSize: VMSideDoor.rmPages*(256/2)];

        Example: PROC [n: INT] RETURNS [result: LIST OF INT] ~ {
            <<-- silly example that returns a list of INTs from 1 to n.>>
            cache: Cache ~ GlobalCache[];
            compare: CompareProc ~ {
                good _ WITH argument SELECT FROM
                    i: REF INT => (i^ = n),
                    ENDCASE => FALSE;
                };
            val: REF; ok: BOOL;
            [val, ok] _ Lookup[cache, compare, $SillyExample];
            IF ok THEN result _ NARROW[val]
            ELSE {
                result _ LIST[];
                FOR i: INT DECREASING IN [1..n] DO
                    result _ CONS[i, result];
                    ENDLOOP;
                Insert[x: cache, argument: NEW[INT _ n], value: result, size: n*(SIZE[INT]+SIZE[REF]+2), clientID: $SillyExample];
                };
            };


    END.