<<>>
<<RefTabImpl.mesa>>
    <<Copyright Ó 1985, 1987, 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.>>
    <<RefTabImpl => HashTableImpl by Bertrand Serlet, July 24, 1985>>
    <<Last Edited by Bertrand Serlet, August 12, 1985 7:06:47 pm PDT>>
    <<Last Edited by Widom, July 25, 1985 4:46:10 pm PDT>>
    <<Spreitzer, January 10, 1992 9:51 am PST>>
    <<HashTableImpl => RefTabImpl by Doug Wyatt, January 7, 1987>>
    <<Russ Atkinson (RRA) July 10, 1990 9:11 am PDT>>
    <<Doug Wyatt, February 4, 1987 2:57:57 pm PST>>
    <<Carl Hauser, June 21, 1988 10:29:56 pm PDT>>
    <<Michael Plass, February 21, 1992 5:30 pm PST>>
    <<Willie-s, March 3, 1992 12:40 pm PST>>

        DIRECTORY
            RefTab,
            RefTabBackdoor,
            RefTabPrivate,
            Rope USING [Equal],
            RopeHash USING [FromRope];

RefTabImpl: CEDAR MONITOR LOCKS x USING x: Ref
    IMPORTS Rope, RopeHash
    EXPORTS RefTab, RefTabBackdoor = { OPEN RefTab, RefTabPrivate;

    Impl: TYPE ~ REF RefTabImplRep;
    RefTabImplRep: PUBLIC TYPE = RefTabPrivate.RefTabImplRep;
<<Hash/Equal functions>>
    EqualRope: PUBLIC EqualProc ~ {
        RETURN [Rope.Equal[s1: NARROW[key1], s2: NARROW[key2], case: TRUE]];
        };

    EqualRopeCaseless: PUBLIC EqualProc ~ {
        RETURN [Rope.Equal[s1: NARROW[key1], s2: NARROW[key2], case: FALSE]];
        };

    HashRope: PUBLIC HashProc ~ {
        RETURN [RopeHash.FromRope[rope: NARROW[key], case: TRUE]];
        };

    HashRopeCaseless: PUBLIC HashProc ~ {
        RETURN [RopeHash.FromRope[rope: NARROW[key], case: FALSE]];
        };

<<Public operations>>
    minMod: SeqIndex = 2;

    Create: PUBLIC PROC [mod: SeqIndex Ź 17, equal: EqualProc Ź NIL, hash: HashProc Ź NIL] RETURNS [Ref] =  {
        seqLen: SeqIndex ~ MAX[mod, minMod];
        impl: Impl ~ NEW [RefTabImplRep Ź [
            hash: hash, equal: equal,
            size: 0, sizeLimit: seqLen, inhibitCount: 0,
            data: NEW [Seq[seqLen]]
            ]];
        RETURN [NEW [RefTabRep Ź [impl: impl]]];
        };

    GetSize: PUBLIC ENTRY PROC [x: Ref] RETURNS [INT] = {
        impl: Impl ~ x.impl;
        RETURN [impl.size];
        };

    ComputeIndex: PROC [impl: Impl, key: Key] RETURNS [SeqIndex] = INLINE {
        IF impl.hash=NIL THEN RETURN [LOOPHOLE[key, CARD32] MOD impl.data.max];
        RETURN [impl.hash[key] MOD impl.data.max];
        };

    Fetch: PUBLIC ENTRY PROC [x: Ref, key: Key] RETURNS [found: BOOL, val: Val] = {
        impl: Impl ~ x.impl;
        index: SeqIndex Ź ComputeIndex[impl, key];
        node: Node Ź impl.data[index];
        WHILE node # NIL DO
            IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) 
                THEN RETURN [TRUE, node.val];
            node Ź node.next;
            ENDLOOP;
        RETURN [FALSE, NIL];
        };

    UnmonitoredFetch: PUBLIC PROC [x: Ref, key: Key] RETURNS [found: BOOL, val: Val] = {
        impl: Impl ~ x.impl;
        index: SeqIndex Ź ComputeIndex[impl, key];
        node: Node Ź impl.data[index];
        WHILE node # NIL DO
            IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) 
                THEN RETURN [TRUE, node.val];
            node Ź node.next;
            ENDLOOP;
        RETURN [FALSE, NIL];
        };

    Replace: PUBLIC ENTRY PROC [x: Ref, key: Key, val: Val] RETURNS [BOOL] = {
        impl: Impl ~ x.impl;
        index: SeqIndex Ź ComputeIndex[impl, key];
        node: Node Ź impl.data[index];
        WHILE node # NIL DO
            IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) 
                THEN {node.val Ź val; RETURN [TRUE]};
            node Ź node.next;
            ENDLOOP;
        RETURN [FALSE];
        };

    Store: PUBLIC ENTRY PROC [x: Ref, key: Key, val: Val] RETURNS [BOOL] = {
        impl: Impl ~ x.impl;
        index: SeqIndex Ź ComputeIndex[impl, key];
        node: Node Ź impl.data[index];
        WHILE node # NIL DO
            IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) 
                THEN {node.val Ź val; RETURN [FALSE]};
            node Ź node.next;
            ENDLOOP;
        impl.data[index] Ź NEW[NodeRep Ź [key: key, val: val, next: impl.data[index]]];
        IF (impl.size Ź impl.size + 1) > impl.sizeLimit AND impl.inhibitCount = 0 THEN ReHash[impl];
        RETURN [TRUE];
        };

    Insert: PUBLIC ENTRY PROC [x: Ref, key: Key, val: Val] RETURNS [BOOL] = {
        impl: Impl ~ x.impl;
        index: SeqIndex Ź ComputeIndex[impl, key];
        node: Node Ź impl.data[index];
        WHILE node # NIL DO
            IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) 
                THEN RETURN [FALSE];
            node Ź node.next;
            ENDLOOP;
        impl.data[index] Ź NEW[NodeRep Ź [key: key, val: val, next: impl.data[index]]];
        IF (impl.size Ź impl.size + 1) > impl.sizeLimit AND impl.inhibitCount = 0 THEN ReHash[impl];
        RETURN [TRUE];
        };

    Delete: PUBLIC ENTRY PROC [x: Ref, key: Key] RETURNS [BOOL] = {
        impl: Impl ~ x.impl;
        index: SeqIndex Ź ComputeIndex[impl, key];
        node: Node Ź impl.data[index];
        lag: Node Ź NIL;
        WHILE node # NIL DO
            IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) THEN {
                IF lag = NIL THEN impl.data[index] Ź node.next ELSE lag.next Ź node.next;
                impl.size Ź impl.size - 1;
                RETURN [TRUE];
                };
            lag Ź node;
            node Ź node.next;
            ENDLOOP;
        RETURN [FALSE];
        };

    Erase: PUBLIC ENTRY PROC [x: Ref] = {
        impl: Impl ~ x.impl;
        FOR i: SeqIndex IN [0..impl.data.max) DO impl.data[i] Ź NIL ENDLOOP;
        impl.size Ź 0;
        };

    UnmonitoredPairs: PUBLIC PROC [x: Ref, action: EachPairAction] RETURNS [quit: BOOL] = {
        data: REF Seq ~ x.impl.data;
        node: Node _ NIL;
        index: CARDINAL _ 0;
        DO
            [node, index] _ UnmonitoredGetNext[data, node, index];
            IF node = NIL THEN EXIT;
            IF action[node.key, node.val] THEN RETURN [TRUE];
            ENDLOOP;
        RETURN[FALSE]};

    UnmonitoredGetNext: PROC [data: REF Seq, node: Node, index: CARDINAL] RETURNS [Node, CARDINAL] = {
        IF node = NIL
            THEN index _ data.max
            ELSE {
                node _ node.next;
                IF node # NIL THEN RETURN [node, index];
                };
        WHILE index > 0 DO
            index _ index - 1;
            node _ data[index];
            IF node # NIL THEN RETURN [node, index];
            ENDLOOP;
        RETURN [NIL, 0];
        };

    Pairs: PUBLIC PROC [x: Ref, action: EachPairAction] RETURNS [quit: BOOL] = {
        Inhibit: ENTRY PROC [x: Ref] ~ {
            impl: Impl ~ x.impl;
            impl.inhibitCount Ź impl.inhibitCount + 1;
            };
        Release: ENTRY PROC [x: Ref] ~ {
            impl: Impl ~ x.impl;
            impl.inhibitCount Ź impl.inhibitCount - 1;
            IF impl.inhibitCount#0 THEN RETURN;
            WHILE impl.size > impl.sizeLimit DO ReHash[impl] ENDLOOP;
            };
        Enumerate: PROC [x: Ref, action: EachPairAction] RETURNS [quit: BOOL Ź FALSE] ~ {
            node: Node Ź NIL;
            index: CARDINAL Ź 0;
            DO
                [node, index] Ź GetNext[x, node, index];
                IF node = NIL THEN EXIT;
                IF action[node.key, node.val] THEN RETURN [TRUE];
                ENDLOOP;
            };
        Inhibit[x];
        quit Ź Enumerate[x, action ! UNWIND => Release[x]];
        Release[x];
        };

    GetNext: ENTRY PROC [x: Ref, node: Node, index: CARDINAL] RETURNS [Node, CARDINAL] = {
        impl: Impl ~ x.impl;
        IF node = NIL
            THEN index Ź impl.data.max
            ELSE {
                node Ź node.next;
                IF node # NIL THEN RETURN [node, index];
                };
        WHILE index > 0 DO
            index Ź index - 1;
            node Ź impl.data[index];
            IF node # NIL THEN RETURN [node, index];
            ENDLOOP;
        RETURN [NIL, 0];
        };

    <<UpdateOperation: TYPE = {none, store, delete};>>
        <<>>
    <<UpdateAction: TYPE = PROC [found: BOOL, val: Val] 
    RETURNS [op: UpdateOperation _ none, new: Val _ NIL];>>
        <<>>
    Update: PUBLIC ENTRY PROC [x: Ref, key: Key, action: UpdateAction] = {
        <<... atomically performs an update action; looks up key and calls action, which returns the desired operation.  If op=none, the 
        table is not changed; if op=store, the new value is stored; if op=delete, key is removed from the table.>>
        ENABLE UNWIND => NULL;
        IF action # NIL THEN {
            impl: Impl ~ x.impl;
            index: SeqIndex Ź ComputeIndex[impl, key];
            head: Node Ź impl.data[index];
            node: Node Ź head;
            lag: Node Ź NIL;
            op: UpdateOperation Ź none;
            val: Val Ź NIL;
            WHILE node # NIL DO
                next: Node Ź node.next;
                IF key=node.key OR (impl.equal#NIL AND impl.equal[key, node.key]) THEN {
                    [op, val] Ź action[TRUE, node.val];
                    SELECT op FROM
                        delete => {
                            IF lag = NIL THEN impl.data[index] Ź next ELSE lag.next Ź next;
                            impl.size Ź impl.size - 1;
                            };
                        store => node.val Ź val;
                        ENDCASE;
                    RETURN;
                    };
                lag Ź node;
                node Ź next;
                ENDLOOP;
            [op, val] Ź action[FALSE, NIL];
            SELECT op FROM
                store => {
                    impl.data[index] Ź NEW[NodeRep Ź [key: key, val: val, next: head]];
                    IF (impl.size Ź impl.size + 1) > impl.sizeLimit AND impl.inhibitCount = 0 THEN
                        ReHash[impl];
                    };
                ENDCASE;
            };
        };

    Copy: PUBLIC ENTRY PROC [x: Ref] RETURNS [Ref] = {
        <<... atomically copies the table.>>
        impl: Impl = x.impl;
        oldData: REF Seq = impl.data;
        max: CARDINAL = oldData.max;
        newImpl: Impl = NEW[RefTabImplRep Ź impl­];
        newData: REF Seq = NEW[Seq[max]];  -- note, all buckets initially NIL
        newImpl.data Ź newData;
        FOR i: NAT IN [0..max) DO
            oldChain: Node Ź oldData[i];
            IF oldChain # NIL THEN {
                newTail: Node Ź NIL;
                WHILE oldChain # NIL DO
                    new: Node Ź NEW[NodeRep Ź [key: oldChain.key, val: oldChain.val, next: NIL]];
                    IF newTail = NIL THEN newData[i] Ź new ELSE newTail.next Ź new;
                    newTail Ź new;
                    oldChain Ź oldChain.next;
                    ENDLOOP;
                };
            ENDLOOP;
        RETURN [NEW[RefTabRep Ź [impl: newImpl]]];
        };
        <<>>
    ReHash: INTERNAL PROC [impl: Impl] = {
        oldData: REF Seq = impl.data;
        newData: REF Seq;
        seek: CARDINAL = impl.data.max * 2;
        newPTI: CARDINAL Ź 0;
        newMod: CARDINAL Ź highPrime;
        IF seek >= highPrime
            THEN newPTI Ź PrimeTableSize-1
            ELSE DO
                newMod Ź primeTable[newPTI];
                IF newMod >= seek THEN EXIT;
                newPTI Ź newPTI+1;
                ENDLOOP;
        IF newMod = impl.data.max THEN {impl.sizeLimit Ź LAST[INT]; RETURN};
        impl.sizeLimit Ź newMod;
        impl.data Ź newData Ź NEW [Seq[newMod]];
        FOR i: SeqIndex IN [0 .. oldData.max) DO
            next: Node Ź NIL;
            FOR cur: Node Ź oldData[i], next WHILE cur # NIL DO
                index: SeqIndex Ź ComputeIndex[impl, cur.key];
                next Ź cur.next;
                cur.next Ź newData[index];
                newData[index] Ź cur;
                ENDLOOP;
            IF next # NIL THEN ERROR;
            ENDLOOP;
        };

    PrimeTableSize: NAT = 14;
        highPrime: CARDINAL[0..LAST[SeqIndex]] = 32749;
    primeTable: ARRAY [0 .. PrimeTableSize) OF CARDINAL = [
        00002,  00005,  00011,  00023,  00053,  00113,  00251,  00509,  01019,  02039,  04079,  08179,  16369,  highPrime];

    }.
    <<Carl Hauser, January 14, 1988 3:11:35 pm PST>>
        <<prepare for Portable Cedar>>
        <<changes to: DIRECTORY folded RefTabExtras, Munch made identity function for Portable Cedar (32 bit machines).>>
    <<>>