
    <<CDValueImpl.mesa   (part of ChipNDale)>>
        <<Copyright © 1983 by Xerox Corporation.  All rights reserved.>>
        <<by Christian Jacobi, August 16, 1983 4:09 pm >>
        <<last edited Christian Jacobi, October 25, 1985 1:05:23 pm PDT>>

    DIRECTORY
        CDValue,
        CD,
        CDEvents,
        RefTab;

    CDValueImpl: CEDAR MONITOR 
        IMPORTS CD, CDEvents, RefTab 
        EXPORTS CD, CDValue = 
    BEGIN

    Propagation: TYPE = CDValue.Propagation;

    DesignValuesRep: PUBLIC TYPE = RECORD [
        values: RefTab.Ref
        ];

    TechnologyValuesRep: PUBLIC TYPE = RECORD [
        registration: RefTab.Ref,
        values: RefTab.Ref
        ];

    globalTab: RefTab.Ref = RefTab.Create[];
    registerTab: RefTab.Ref = RefTab.Create[];

    DesignHasBeenCreated: CDEvents.EventProc = {
        design.designValues _ NEW[DesignValuesRep _ [values: RefTab.Create[]]]
        };

    TechnologyHasBeenRegistered: CDEvents.EventProc =
        BEGIN
        tech: CD.Technology = NARROW[x];
        tech.technologyValues _ NEW[TechnologyValuesRep _ 
            [registration: RefTab.Create[], values: RefTab.Create[]]]
        END;

    registeredWithTechnology: REF _ NEW[INT];

    EnregisterKey: PUBLIC ENTRY PROC [key: REF, boundTo: CD.Technology, registrationKey: REF] =
        BEGIN ENABLE UNWIND => NULL;
        Register: PROC [regTab: RefTab.Ref, key: REF, registrationKey: REF] RETURNS [ok: BOOL] =
            BEGIN
            oldRegistrationKey: REF _ RefTab.Fetch[regTab, key].val;
            IF oldRegistrationKey=NIL THEN ok _ RefTab.Insert[regTab, key, registrationKey]
            ELSE IF oldRegistrationKey=$nil OR oldRegistrationKey#registrationKey THEN ok _ FALSE
            ELSE ok _ TRUE
            END;
        done: BOOL _ FALSE;
        IF registrationKey=NIL THEN registrationKey _ $nil;
        IF boundTo=NIL THEN done _ Register[registerTab, key, registrationKey]
        ELSE {
            done _ Register[registerTab, key, registeredWithTechnology];
            IF done THEN {
                tem: REF TechnologyValuesRep = boundTo.technologyValues;
                IF tem=NIL THEN RETURN WITH 
                    ERROR CD.Error[ec: callingError, explanation: "technology had not been registered"];
                done _ Register[tem.registration, key, registrationKey]
                };
            };
        IF ~done THEN RETURN WITH ERROR CD.Error[doubleRegistration]
        END;

    Fetch: PUBLIC ENTRY PROC [boundTo: REF, key: REF, propagation: Propagation] RETURNS [REF] =
        BEGIN ENABLE UNWIND => NULL;
        val: RefTab.Val;
        found: BOOL;
        DO
            WITH boundTo SELECT FROM 
                d: CD.Design => {
                    tem: REF DesignValuesRep = d.designValues;
                    [found: found, val: val] _ RefTab.Fetch[tem.values, key];
                    IF found THEN RETURN [val];
                    IF propagation>design THEN boundTo_d.technology ELSE RETURN [NIL]
                    };
                t: CD.Technology => {
                    tem: REF TechnologyValuesRep = t.technologyValues;
                    [found: found, val: val] _ RefTab.Fetch[tem.values, key];
                    IF found THEN RETURN [val];
                    IF propagation>technology THEN boundTo_NIL ELSE RETURN [NIL]
                    };
                ENDCASE => {
                    IF boundTo#NIL THEN 
                        RETURN WITH ERROR CD.Error[callingError, "CDValue.Fetch: bad boundTo type"]
                    ELSE {
                        [found: found, val: val] _ RefTab.Fetch[globalTab, key];
                        IF found THEN RETURN [val];
                        RETURN [NIL]
                        };
                    };
            ENDLOOP
        END;

    GetTab: PROC [boundTo: REF] RETURNS [ref: RefTab.Ref] =
        INLINE BEGIN
        WITH boundTo SELECT FROM 
            t: CD.Technology => {
                tem: REF TechnologyValuesRep = t.technologyValues;
                ref _ tem.values;
                };
            d: CD.Design => {
                tem: REF DesignValuesRep = d.designValues;
                ref _ tem.values;
                };
            ENDCASE => {
                IF boundTo#NIL THEN
                    RETURN WITH ERROR CD.Error[callingError, "CDValue.Store: bad boundTo type"]
                ELSE ref _ globalTab 
                };
        END;

    Store: PUBLIC PROC [boundTo: REF, key: REF, value: REF] =
        BEGIN 
        ref: RefTab.Ref = GetTab[boundTo];
        IF value#NIL THEN [] _ RefTab.Store[ref, key, value]
        ELSE [] _ RefTab.Delete[ref, key];
        END;

    StoreConditional: PUBLIC PROC [boundTo: REF, key: REF, value: REF] RETURNS [done: BOOL] =
        BEGIN 
        ref: RefTab.Ref = GetTab[boundTo];
        IF value#NIL THEN done _ RefTab.Insert[ref, key, value]
        ELSE done _ RefTab.Delete[ref, key];
        END;

    FetchInt: PUBLIC PROC [boundTo: REF, key: REF, propagation: Propagation, ifNotFound: INT] RETURNS [INT] =
        BEGIN
        x: REF ANY _ Fetch[boundTo: boundTo, key: key, propagation: propagation];
        WITH x SELECT FROM
            r: REF INT => RETURN [r^]
            ENDCASE => RETURN [ifNotFound]
        END;

    StoreInt: PUBLIC PROC [boundTo: REF, key: REF, value: INT] =
        BEGIN
        x: REF INT _ NEW[INT _ value];
        Store[boundTo: boundTo, key: key, value: x]
        END;

    CDEvents.RegisterEventProc[$CreateNewDesign, DesignHasBeenCreated];
    CDEvents.RegisterEventProc[$RegisterTechnology, TechnologyHasBeenRegistered];
    END.