
    <<CDOpsImpl.mesa       (part of ChipNDale)>>
        <<Copyright © 1983, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi,  July 12, 1983 10:56 am >>
        <<Last edited by: Christian Jacobi, December 4, 1986 11:52:58 am PST>>

    DIRECTORY
        Atom,
        CD,
        CDBasics,
        CDBasicsInline,
        CDCells,
        CDDrawQueue,
        CDEvents,
        CDInstances,
        CDIO,
        CDOps,
        CDPrivate,
        CDProperties,
        CDRects,
        CDSequencer,
        CDSimpleOps,
        CDValue,
        Convert,
        HashTable,
        IO,
        Process, 
        Rope,
        SafeStorage,
        TerminalIO,
        UserProfile;

    CDOpsImpl: CEDAR MONITOR 
        IMPORTS Atom, CD, CDBasics, CDBasicsInline, CDCells, CDDrawQueue, CDEvents, CDInstances, CDIO, CDOps, CDPrivate, CDProperties, 
        CDRects, CDSimpleOps, CDValue, Convert, IO, HashTable, Process, Rope, SafeStorage, TerminalIO, UserProfile
        EXPORTS CDOps
        SHARES CD = 
    BEGIN
    createEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$CreateNewDesign];
    resetDesignEvent: CDEvents.EventRegistration=CDEvents.RegisterEventType[$ResetDesign];

    DelRec: TYPE = RECORD [
        delayedList: LIST OF Remember_NIL,
        length: INT _ 0
        ];

    GetDelayedRef: PROC [design: CD.Design] RETURNS [REF DelRec] = {
        WITH design.delayedRedrawsPriv SELECT FROM
            dr: REF DelRec => RETURN [dr];
            ENDCASE => {
                dr: REF DelRec = NEW[DelRec_[NIL]];
                design.delayedRedrawsPriv _ dr;
                RETURN [dr]
                };
        };

    Remember: TYPE = RECORD [area: CD.Rect, clear: BOOL];

    InternalResetDesign: PROC [design: CD.Design] = {
        <<--is local since it does not cause a redraw>>
        dummy: CD.Object _ CDCells.CreateEmptyCell[];
        dummy.bbox _ CDBasics.universe;
        design.cdDirectoryPriv _ HashTable.Create[101, HashTable.RopeEqual, HashTable.HashRope];
        design.unDoBuffers _ CD.InitPropRef[];
        design^.actual _ LIST[CD.PushRec[
            dummyCell: CDInstances.NewInst[ob: dummy],
            mightReplace: NIL,
            specific: NARROW[dummy.specific]
            ]];
        };

    CreateDesign: PUBLIC PROC [technology: CD.Technology] RETURNS [design: CD.Design] = {
        IF technology=NIL THEN ERROR CD.Error[callingError, "NIL technology"];
        design _ NEW[CD.DesignRec_[
            properties: CD.InitPropRef[],
            technology: technology,
            unDoBuffers: CD.InitPropRef[], 
            cdDirectoryPriv2: NEW[LONG POINTER _ NIL] 
            ]];
        IF finalizing THEN SafeStorage.EnableFinalization[design];
        InternalResetDesign[design]; -- must not cause redraw since event not yet processed
        [] _ CDEvents.ProcessEvent[createEvent, design]; 
        };

    ResetDesign: PUBLIC PROC [design: CD.Design] = {
        InternalResetDesign[design];
        [] _ CDEvents.ProcessEvent[resetDesignEvent, design]; 
        design.delayedRedrawsPriv _ NIL;
        ImmediateRedraw[design];
        };

    RealTopCell: PUBLIC PROC [design: CD.Design] RETURNS [dummyCell: CD.Object] = {
        FOR l: LIST OF CD.PushRec _ design^.actual, l.rest DO
            IF l.rest=NIL THEN RETURN [l.first.dummyCell.ob]
            ENDLOOP
        };

    PushedTopCell: PUBLIC PROC [design: CD.Design] RETURNS [dummyCell: CD.Object] = {
        RETURN [design^.actual.first.dummyCell.ob];
        };

    RemoveInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance, draw: BOOL_TRUE] = {
        il: CD.InstanceList _ CDOps.InstList[design];
        IF il#NIL THEN 
            IF il.first=inst THEN CDOps.SetInstList[design, il.rest]
            ELSE
                FOR l: CD.InstanceList _ il, l.rest WHILE l.rest#NIL DO
                    IF l.rest.first=inst THEN {l.rest_l.rest.rest; EXIT}
                    ENDLOOP;
        IF draw THEN Redraw[design, CDInstances.InstRectO[inst]];
        };

    SelectNewMode: PROC [design: CD.Design] RETURNS [BOOL] = {
        mode: INT = CDValue.FetchInt[boundTo: design, key: $CDxSelectNewMode, propagation: technology, ifNotFound: 0];
        RETURN [mode=1]
        };

    IncludeObject: PUBLIC PROC [design: CD.Design, ob: CD.Object, trans: CD.Transformation] = {
        IF ob#NIL THEN {
            inst: CD.Instance _ NEW[CD.InstanceRep _ [ob: ob, trans: trans]];
            IF SelectNewMode[design] THEN {
                CDSimpleOps.DeselectAll[design];
                inst.selected _ TRUE;
                };
            IncludeInstance[design, inst];
            }
        };

    FitObjectI: PUBLIC PROC [ob: CD.Object, location: CD.Position _ [0, 0], orientation: CD.Orientation _ CD.Orientation[original]] 
    RETURNS [trans: CD.Transformation] = {
        trans.orient _ orientation;
        trans.off _ CDBasics.SubPoints[location, CDBasics.BaseOfRect[CDBasics.MapRect[CD.InterestRect[ob], [[0, 0], orientation]]]];
        };

    IncludeObjectI: PUBLIC PROC[design: CD.Design, ob: CD.Object, location: CD.Position, orientation: CD.Orientation] = {
        IncludeObject[design, ob, FitObjectI[ob, location, orientation]];
        };

    IncludeInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance, draw: BOOL_TRUE] = {
        IF inst=NIL THEN ERROR CD.Error[callingError, "Include of NIL application"];
        IF inst.ob=NIL THEN ERROR CD.Error[callingError, "Include application with NIL object"];
        CDOps.SetInstList[design, CONS[inst, CDOps.InstList[design]]];
        IF draw THEN Redraw[design, CDInstances.InstRectO[inst], TRUE];
        };

    IncludeInstanceList: PUBLIC PROC [design: CD.Design, il: CD.InstanceList, draw: BOOL_TRUE] = {
        FOR list: CD.InstanceList _ il, list.rest WHILE list#NIL DO
            IncludeInstance[design, list.first, draw];
            ENDLOOP;
        };

    ImmediateRedraw: PUBLIC PROC [design: CD.Design, r: CD.Rect_CDOps.all, eraseFirst: BOOL_TRUE] = {
        CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[IF eraseFirst THEN $redraw ELSE $draw, r]];
        };


    CheckForShorten: PROC [dl: REF DelRec] = INLINE {
        IF dl.length>20 THEN {
            clear: BOOL _ FALSE;
            r: CD.Rect _ CDBasics.empty;
            FOR lst: LIST OF Remember _ dl.delayedList, lst.rest WHILE lst#NIL DO
                clear _ clear OR lst.first.clear;
                r _ CDBasics.Surround[r, lst.first.area]
                ENDLOOP;
            dl.delayedList _ LIST[Remember[area: r, clear: clear]];
            dl.length _ 1
            };
        };

    Redraw: PUBLIC ENTRY PROC [design: CD.Design, r: CD.Rect, eraseFirst: BOOL_TRUE] = {
        ENABLE UNWIND => NULL;
        IF design#NIL THEN {
            dl: REF DelRec = GetDelayedRef[design];
            IF dl.delayedList=NIL THEN {
                dl.delayedList _  LIST[Remember[area: r, clear: eraseFirst]];
                dl.length _ 1
                }
            ELSE {
                list: LIST OF Remember _ dl.delayedList;
                DO
                    <<--ASSERTION1: {list#NIL}>>
                    <<--ASSERTION2: {no list rectangle is completely covered by an other one}>>
                    IF CDBasics.Intersect[list.first.area, r] THEN {
                        IF CDBasics.Inside[r, list.first.area] THEN { 
                            <<--r is contained somewhere; we dont include it>>
                            <<--it is unlikely that a small area is cleared and a big one not>>
                            list.first.clear _ list.first.clear OR eraseFirst;
                            <<--assertion2 => no other elements could be removed>>
                            RETURN
                            }
                        ELSE IF CDBasics.Inside[list.first.area, r] THEN {
                            <<--r contains an element; we remove this element and all others>>
                            <<--        which are contained in r>>
                            <<--it is unlikely that a small area is cleared and a big one not>>
                            remember: LIST OF Remember _ list;
                            eraseFirst _ list.first.clear OR eraseFirst;
                            list.first.area _ r;
                            <<--remove all other element contained in r; to maintain assertion2>>
                            WHILE list.rest#NIL DO
                                <<assert3: list#NIL>>
                                IF CDBasics.Inside[list.rest.first.area, r] THEN {
                                    eraseFirst _ list.rest.first.clear OR eraseFirst;
                                    list.rest _ list.rest.rest; --does not change list -> keeps assertion3
                                    dl.length _ dl.length-1;
                                    }
                                ELSE list _ list.rest --since list.rest#NIL -> keeps assertion3
                                ENDLOOP;
                            remember.first.clear _ eraseFirst;
                            RETURN
                            }
                        };
                    IF list.rest#NIL THEN list_list.rest
                    ELSE {
                        list.rest _ LIST[Remember[area: r, clear: eraseFirst]];
                        dl.length _ dl.length+1;
                        CheckForShorten[dl];
                        RETURN
                        }
                    ENDLOOP;
                } --of dl.delayedList#NIL
            } --of design#NIL
        };

    DoTheDelayedRedraws: PUBLIC ENTRY PROC [design: CD.Design] = {
        ENABLE UNWIND => NULL;
        sq: REF DelRec = GetDelayedRef[design];
        UNTIL sq.delayedList=NIL DO
            CDDrawQueue.InsertDrawCommand[design, CDDrawQueue.Request[(IF sq.delayedList.first.clear THEN $redraw ELSE $draw), 
            sq.delayedList.first.area]];
            sq.delayedList _ sq.delayedList.rest
            ENDLOOP;
        sq.length _ 0;
        };

    RedrawInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance_NIL, erase: BOOL_TRUE] = {
        IF inst#NIL THEN Redraw[design, CDInstances.InstRectO[inst], erase]
        ELSE Redraw[design, CDBasics.universe, erase]
        };

    DrawDesign: PUBLIC PROC[design: CD.Design, pr: CD.DrawRef] = {
        <<--the top level cell>>
        FOR il: CD.InstanceList _ CDOps.InstList[design], il.rest WHILE il#NIL DO
            IF CDBasicsInline.IntersectRI[pr.interestClip, il.first] THEN {
                IF pr.stopFlag^ THEN EXIT;
                pr.drawChild[il.first, il.first.trans, pr];
                }
            ENDLOOP;
        <<--the pushed in cells >>
        IF pr.environment THEN
            FOR w: LIST OF CD.PushRec _ design^.actual.rest, w.rest WHILE w#NIL DO
                IF pr.stopFlag^ THEN EXIT;
                pr.drawChild[w.first.dummyCell, [[0, 0], original], pr];
                ENDLOOP;
        <<--selections of the top level cell>>
        IF pr.selections THEN
            FOR il: CD.InstanceList _ CDOps.InstList[design], il.rest WHILE il#NIL DO
                IF il.first.selected AND CDBasicsInline.IntersectRI[pr.interestClip, il.first] THEN {
                    IF pr.stopFlag^ THEN EXIT;
                    pr.drawChildSel[il.first, il.first.trans, pr];
                    };
                ENDLOOP;
        }; 

    QuickDrawDesign: PUBLIC PROC [design: CD.Design, pr: CD.DrawRef] = {

        QuickDrawPushedCell: PROC [cp: CD.CellSpecific, pr: CD.DrawRef] = INLINE {
            IF pr.borders AND cp.drawBorder THEN pr.drawOutLine[cp.ir, CD.outlineLayer, pr];
            FOR w: CD.InstanceList _ cp.contents, w.rest WHILE w#NIL DO
                IF CDBasicsInline.IntersectRI[pr.interestClip, w.first] THEN {
                    IF pr.stopFlag^ THEN EXIT;
                    w.first.ob.class.quickDrawMe[w.first, w.first.trans, pr];
                    }
                ENDLOOP;
            }; 
        <<>>
        pr.setGround[pr: pr, pushedOut: FALSE];
        <<--the top level cell>>
        FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
            IF CDBasicsInline.IntersectRI[pr.interestClip, w.first] THEN {
                IF pr.stopFlag^ THEN EXIT;
                w.first.ob.class.quickDrawMe[w.first, w.first.trans, pr];
                IF pr.selections AND w.first.selected THEN
                    w.first.ob.class.showMeSelected[w.first, w.first.trans, pr];
                };
            ENDLOOP;
        <<--the pushed in cells >>
        IF design^.actual.rest#NIL THEN {
            pr.drawOutLine[design^.actual.first.specific.ir, CD.outlineLayer, pr];
            IF pr.environment THEN { 
                pr.setGround[pr: pr, pushedOut: TRUE];
                FOR w: LIST OF CD.PushRec _ design^.actual.rest, w.rest WHILE w#NIL DO
                    IF pr.stopFlag^ THEN EXIT;
                    QuickDrawPushedCell[w.first.specific, pr];
                    ENDLOOP;
                };
            };
        }; 

    SelectedInstance: PUBLIC PROC [design: CD.Design] RETURNS [first: CD.Instance_NIL, multiple: BOOL_FALSE] = {
        <<--first: returns ref to any selected application if there is one or more, otherwise nil.>>
            <<--multiple: more than one application is selected>>
        FOR w: CD.InstanceList _ CDOps.InstList[design], w.rest WHILE w#NIL DO
            IF w.first.selected THEN
                IF first=NIL THEN first_w.first
                ELSE {multiple_TRUE; RETURN}
            ENDLOOP;
        };

    TheInstance: PUBLIC PROC [design: CD.Design, text: Rope.ROPE_NIL] RETURNS [inst: CD.Instance_NIL] = {
        multiple: BOOL; 
        IF text#NIL THEN TerminalIO.PutRope[text];
        [inst, multiple] _ SelectedInstance[design];
        IF multiple THEN {TerminalIO.PutRope["   multiple selection; failed\n"]; RETURN [NIL]};
        IF inst=NIL THEN {TerminalIO.PutRope["   no selection; failed\n"]; RETURN [NIL]};
        IF inst.ob=NIL THEN {inst_NIL; TerminalIO.PutRope["   bad object; failed\n"]};
        };

    ObjectRope: PUBLIC PROC [ob: CD.Object] RETURNS [Rope.ROPE] = {
        IF ob=NIL THEN RETURN ["nil object"]
        ELSE IF ob.class.describe#NIL THEN RETURN [ob.class.describe[ob]] 
        ELSE RETURN [Atom.GetPName[ob.class.objectType]]
        };

    LayerRope: PUBLIC PROC [layer: CD.Layer] RETURNS [Rope.ROPE] = {
        uniqueKey: ATOM = CD.LayerKey[layer];
        IF uniqueKey=NIL THEN RETURN ["bad layer"]; 
        RETURN [Atom.GetPName[uniqueKey]]
        };

    InstRope: PUBLIC PROC [inst: CD.Instance, verbosity: INT_0] RETURNS [r: Rope.ROPE] = {
        IF inst=NIL THEN r _ "nil instance"
        ELSE {
        r _ 
            IF inst.ob=NIL THEN "nil object"
            ELSE IF inst.ob.class.describeInst#NIL THEN inst.ob.class.describeInst[inst] 
            ELSE ObjectRope[inst.ob];
            IF verbosity>0 THEN {
                WITH CDProperties.GetInstanceProp[inst, $SignalName] SELECT FROM
                    n: Rope.ROPE => r _ Rope.Cat[r, "  ", n];
                    a: ATOM => r _ Rope.Cat[r, "  ", Atom.GetPName[a]];
                    ENDCASE => NULL;
                };
            };
        RETURN [Rope.Cat["(", r, ")"]]
        };

    ToRope: PUBLIC PROC [x: REF, whenFailed: REF_NIL] RETURNS [rope: Rope.ROPE_NIL] = {
        WITH x SELECT FROM
            r: Rope.ROPE => rope _ r;
            rt: REF TEXT => rope _ Rope.FromRefText[rt];
            ri: REF INT => rope _ Convert.RopeFromInt[ri^];
            a: ATOM => rope _ Atom.GetPName[a];
            l: CDPrivate.LayerRef => rope _ CDOps.LayerRope[l.number]; 
            ob: CD.Object => rope _ CDOps.ObjectRope[ob];
            inst: CD.Instance => rope _ inst.ob.class.describeInst[inst];
            d: CD.Design  => rope _ d.name;
            t: CD.Technology  => rope _ t.name;
            rc: REF LONG CARDINAL => rope _ Convert.RopeFromCard[rc^];
            ri: REF INTEGER => rope _ Convert.RopeFromInt[ri^];
            ri: REF NAT => rope _ Convert.RopeFromInt[ri^];
            rc: REF CARDINAL => rope _ Convert.RopeFromCard[rc^];
            ENDCASE => 
                SELECT whenFailed FROM
                    NIL =>  rope _ NIL;
                    $Interactive => {
                        RopeNeeded: SIGNAL [ ref: REF REF ] = CODE;
                        refRef: REF REF = NEW[REF _ x];
                        TerminalIO.PutRope["please enter a ROPE using the debugger"];
                        SIGNAL RopeNeeded[refRef];
                        rope _ ToRope[refRef^ ! RopeNeeded => ERROR];
                        };
                    ENDCASE => rope _ ToRope[whenFailed];
        };

    LambdaRope: PUBLIC PROC [n: CD.Number, lambda: CD.Number_1] RETURNS [Rope.ROPE] = {
        IF n MOD lambda = 0 THEN RETURN IO.PutFR1[" %g", IO.int[n/lambda]]
        ELSE {
            r: Rope.ROPE _ " (";
            IF n<0 THEN {n _ ABS[n]; r _ " -("};
            IF n/lambda>0 THEN r _ IO.PutFR["%0g%0g+", IO.rope[r], IO.int[n/lambda]]; 
            RETURN [IO.PutFR["%0g%0g/%0g)", IO.rope[r], IO.int[n MOD lambda], IO.int[lambda]]];
            }
        };

    ReOrderInstance: PUBLIC PROC [design: CD.Design, inst: CD.Instance] = {
        <<--on return: design has exactly one occurrence of inst, and it is at the end. >>
        <<--(includes inst if necessary and removes double occurences)>>
        il: CD.InstanceList _ CDOps.InstList[design];
        found: BOOL _ FALSE;
        IF inst=NIL THEN ERROR CD.Error[callingError, "Reorder of NIL application"];
        WHILE il#NIL AND il.first=inst DO {found_TRUE; il _ il.rest} ENDLOOP;
        IF il=NIL THEN {
            IF found THEN il_LIST[inst] 
            ELSE ERROR CD.Error[callingError, "Reorder of application not in design"];
            }
        ELSE 
            FOR l: CD.InstanceList _ il, l.rest DO
                <<-- l#NIL AND l.first#inst holds at this point>>
                WHILE l.rest#NIL AND l.rest.first=inst DO {found_TRUE; l.rest _ l.rest.rest} ENDLOOP;
                IF l.rest=NIL THEN {
                    IF found THEN l.rest _ LIST[inst] 
                    ELSE ERROR CD.Error[callingError, "reorder finds bad instance"];
                    EXIT
                    }
                ENDLOOP;
        CDOps.SetInstList[design, il];
        };

    PlaceInst: PUBLIC PROC [design: CD.Design, ob: CD.Object, hint: REF_NIL] RETURNS [inst: CD.Instance] =  {
        lambda: CD.Number _ design.technology.lambda;
        space, w1, w2: CD.Number;
        grid: CD.Number _ MAX[1, CDPrivate.GetGrid[design, hint]];
        bb: CD.Rect _ CDOps.BoundingBox[design];
        IF ~CDBasics.NonEmpty[bb] THEN bb _ [0, 0, 0, 0]; 
        w1 _ MAX[lambda*5, bb.x2-bb.x1];
        w2 _ MAX[lambda*5, CD.InterestSize[ob].x];
        space _ MIN[w1, w2]/8+MAX[w1, w2]/80+lambda*4;
        inst _ CDInstances.NewInst[ob: ob, 
            trans: [[(bb.x2+space+grid-1)/grid*grid, (bb.y1+grid-1)/grid*grid]]
            ];
        CDOps.IncludeInstance[design, inst];
        };

    BoundingBox: PUBLIC PROC [design: CD.Design, onlySelected: BOOL] RETURNS [r: CD.Rect _ CDBasics.empty] = {
        IF onlySelected THEN r _ CDInstances.BoundingRectO[CDOps.InstList[design], TRUE]
        ELSE
            FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO
                r _ CDBasics.Surround[r, CDInstances.BoundingRectO[
                    NARROW[l.first.dummyCell.ob.specific, CD.CellSpecific].contents ]]
                ENDLOOP;
        };

    <<-- Finalization -->>
    <<-- designs are finalized to break circularities involving objects or instances>>

    DrawCollected: PROC [inst: CD.Instance, trans: CD.Transformation,pr: CD.DrawRef] = {
        pr.drawRect[CDBasics.MapRect[inst.ob.bbox, trans], CD.errorLayer, pr]
        }; 

    ReadCollected: CD.InternalReadProc --PROC [] RETURNS [Object]-- = {
        sz: CD.Position = CDIO.ReadPos[h];
        ob: CD.Object = CDRects.CreateRect[sz, CD.errorLayer];
        r: Rope.ROPE = "*design of this object has been destroyed; bug in creator program\n";
        CDProperties.PutObjectProp[ob, $SignalName, r];
        TerminalIO.PutRope[r];
        RETURN [ob]
        };

    WriteCollected: CD.InternalWriteProc = {
        CDIO.WritePos[h, CD.InterestSize[ob]];
        TerminalIO.PutRope["*write object which has been destroyed\n"];
        };

    gCollectedClass: CD.ObjectClass = CD.RegisterObjectClass[$GCollected, [
        drawMe: DrawCollected,
        quickDrawMe: DrawCollected,
        internalRead: ReadCollected,
        internalWrite: WriteCollected,
        description: "garbage object; design has been destroyed"
        ]];
    <<>>
    DestroyEachObject: HashTable.EachPairAction = {
        WITH value SELECT FROM
            ob: CD.Object => IF ob.class=NIL OR ob.class.inDirectory THEN {
                ob.class _ gCollectedClass; 
                ob.layer _ CD.errorLayer; 
                ob.specific _ NIL;
                ob.properties _ NIL;
                };
            ENDCASE => NULL;
        };

    FinalizeDesign: PROC [d: CD.Design] = {
        d.properties _ NIL;
        IF d.cdDirectoryPriv#NIL AND CDValue.Fetch[d, $KeepObjects]=NIL THEN
            [] _ NARROW[d.cdDirectoryPriv, HashTable.Table].Pairs[DestroyEachObject];
        WHILE d.actual#NIL DO
            d.actual.first.dummyCell.properties _ NIL;
            IF d.actual.first.mightReplace#NIL THEN d.actual.first.mightReplace.properties _ NIL;
            d.actual _ d.actual.rest;
            ENDLOOP;
        d.cdDirectoryPriv _ NIL;
        d.cdValuePriv _ NIL;
        d.cdSequencerPriv _ NIL;
        d.cdDrawQueuePriv _ NIL;
        d.delayedRedrawsPriv _ NIL;
        d.unDoBuffers _ NIL;
        };

    FinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = {
        DO
            d: CD.Design = NARROW[SafeStorage.FQNext[fooFQ]];
            FinalizeDesign[d];
            ENDLOOP
        };

    finalizing: BOOL = UserProfile.Boolean["ChipNDale.DoFinalization", TRUE];
    IF finalizing THEN {
        fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[];
        IF Atom.GetProp[$ChipNDalePrivate, $FinalizationEnabled]=$TRUE THEN
            SafeStorage.ReEstablishFinalization[CODE[CD.DesignRec], 0, fooFQ]
        ELSE {
            SafeStorage.EstablishFinalization[CODE[CD.DesignRec], 0, fooFQ];
            Atom.PutProp[$ChipNDalePrivate, $FinalizationEnabled, $TRUE];
            };
        TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]};
        };
    CDValue.RegisterKey[$KeepObjects];
    END.