
<<RoseInstantiateImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reversed.>>
<<Barth, August 1, 1985 2:31:39 pm PDT>>
    <<Spreitzer, August 1, 1985 10:43:26 pm PDT>>

DIRECTORY Core, CoreFlatten, IO, Rope, RoseControl, RoseSimTypes;

RoseInstantiateImpl: CEDAR PROGRAM
IMPORTS CoreFlatten, IO, Rope
EXPORTS RoseControl
=

BEGIN OPEN RoseSimTypes;
    <<This program instantiates a Rosemary simulation.>>
    <<A Wire will be a leaf iff:>>
        <<All of its parts, if any, are used in parallel, and>>
        <<No ancestor could be a leaf.>>

    Simulation: TYPE = REF SimulationRec;
    SimulationRec: PUBLIC TYPE = RoseSimTypes.SimulationRec;

    wireGroupKey: ATOM = $RoseWireGroup;

    WireGroup: TYPE = {aboveLeaf, leaf, belowLeaf};

    Instantiate: PUBLIC PROC [cellType: CellType, expansionControlFileName: ROPE _ NIL] RETURNS [simulation: Simulation] = {
        simulation _ NEW [SimulationRec _ [
            root: CoreFlatten.Flatten[cellType, CoreFlatten.ControlByFile[expansionControlFileName]]
            ]];
        FindLeafWires[simulation];
        MakeRoseWires[simulation];
        MakeRoseCells[simulation];
        InitSimulator[simulation];
        };

    FindLeafWires: PROC [sim: Simulation] = {
        rootWire: Wire _ NARROW[CoreProperties.GetProp[sim.root.properties, CoreFlatten.internalWire]];
        MarkAsLeaf[rootWire];
        FLWWork[sim.root];
        };

    MarkAsLeaf: PROC [wire: Wire] = {
        wire.properties _ CoreProperties.PutProp[wire.properties, wireGroupKey, $Leaf];
        };

    MarkAboveLeaf: PROC [wire: Wire] = {
        wire.properties _ CoreProperties.PutProp[wire.properties, wireGroupKey, $AboveLeaf];
        };

    GetWireGroup: PROC [wire: Wire] RETURNS [wg: WireGroup] = {
        val: ATOM _ NARROW[CoreProperties.GetProp[wire.properties, wireGroupKey]];
        wg _ SELECT val FROM
            $Leaf => leaf,
            $AboveLeaf => aboveLeaf,
            NIL => belowLeaf,
            ENDCASE => ERROR;
        };

    FLWWork: PROC [ci: CellInstance] = {
        SELECT IsCellLeaf[ci] FROM
            FALSE => {
                children: CoreFlatten.InstanceList _ NARROW[CoreProperties.GetProp[ci.properties, CoreFlatten.children]];
                FOR children _ children, children.rest WHILE children # NIL DO
                    FLWWork[children.first];
                    ENDLOOP;
                children _ children;
                };
            TRUE => {
                FlwAwWork[ci.actualWire, [NIL, 0]];
                };
            ENDCASE => ERROR;
        };

    FlwAwWork: PROC [wire: Wire, parent: UpLinkRec] = {
        SELECT InCircuit[wire] FROM
            FALSE => {
                SELECT wire.structure FROM
                    atom => ERROR;
                    sequence, record => {
                        FOR i: NAT IN [0 .. wire.elements.size) DO
                            FlwAwWork[wire.elements[i], [wire, i]];
                            ENDLOOP;
                        wire _ wire;
                        };
                    ENDCASE => ERROR;
                };
            TRUE => {
                group: WireGroup _ GetWireGroup[wire];
                SELECT group FROM
                    aboveLeaf, leaf => NULL;
                    belowLeaf => BreakParent[wire];
                    ENDCASE => ERROR;
                };
            ENDCASE => ERROR;
        };

    BreakParent: PROC [from: Wire] = {
        wul: WireUpLink _ GetWireUpLink[from];
        parent: Wire _ wul.parent;
        pg: WireGroup _ GetWireGroup[parent];
        FOR i: NAT IN [0 .. parent.elements.size) DO
            child: Wire _ parent.elements[i];
            cg: WireGroup _ GetWireGroup[child];
            SELECT cg FROM
                belowLeaf => MarkAsLeaf[child];
                leaf, AboveLeaf => NULL;
                ENDCASE => ERROR;
            ENDLOOP;
        MarkAboveLeaf[parent];
        SELECT pg FROM
            belowLeaf => BreakParent[parent];
            leaf => NULL;
            aboveLeaf => ERROR;
            ENDCASE => ERROR;
        };

    Start: PROC = {
        CoreProperties.RegisterProperty[prop: wireGroupKey];
        };

    Start[];

    END.