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

    DIRECTORY BitTwiddling, Core, CoreFlatten, CoreOps, CoreProperties, CoreRecord, IO, Rope, RoseBind, RoseBindPrivate, RoseControl, 
    RoseEngine, RosePrivates, RoseSimTypes, RoseWireTwiddling, RoseWireTypes, RoseWiring;

    RoseInstantiateImpl: CEDAR PROGRAM
        IMPORTS BitTwiddling, CoreFlatten, CoreOps, CP: CoreProperties, RoseBind, RoseBindPrivate, RoseEngine, RoseWireTwiddling, RoseWiring
        EXPORTS RoseControl, RoseEngine, RoseSimTypes
        =

    BEGIN OPEN CR: CoreRecord, RoseWireTypes, RoseSimTypes, RoseEngine;
    <<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.>>

    BehaviorClass: TYPE = REF BehaviorClassRec;
    BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
    Simulation: TYPE = REF SimulationRec;
    SimulationRec: PUBLIC TYPE = RoseSimTypes.SimulationRec;

    notInWireList: PUBLIC RoseWire _ NEW [RoseWireRep];
    notInCellList: PUBLIC RoseCellInstance _ NEW [RoseCellInstanceRep];

    roseWireTypeKey: PUBLIC ATOM _ CP.RegisterProperty[$RoseWireTypeKey];
    roseWireKey: PUBLIC ATOM _ CP.RegisterProperty[$RoseWireKey];
    roseCellKey: PUBLIC ATOM _ CP.RegisterProperty[$RoseCellKey];
    wireGroupKey: ATOM = CP.RegisterProperty[$RoseWireGroup];
    wireBehaviorKindKey: ATOM = CP.RegisterProperty[$RoseWireBehaviorKind];
    coreCellTypeToRoseCellType: ATOM = CP.RegisterProperty[$RoseCellTypeFromCoreCellType];

    Instantiate: PUBLIC PROC [cellType: CellType, expansionControl: CoreFlatten.FlattenControl] RETURNS [simulation: Simulation] = {
        rootType: CellType _ GetTestRootType[cellType];
        flatRootType: CellType _ CoreFlatten.Flatten[
            rootType,
            CoreFlatten.ControlByRecognition[LIST[
                [CoreFlatten.RecognizeName["tester"], immediate[leaf]],
                [CoreFlatten.RecognizeName["testee"], nest[expansionControl]]
                ]]
            ];
        simulation _ NEW [SimulationRec _ [
            flatRootType: flatRootType,
            rootRecordType: NARROW[flatRootType.data],
            sch: NEW [SchedulingRep _ [sim: NIL]]
            ]];
        simulation.sch.sim _ simulation;
        MakeUpPointers[simulation.rootRecordType.internalWire, NIL];
        ComputeBehaviorKinds[simulation];
        FindLeafWires[simulation];
        MakeRoseWires[simulation];
        MakeRoseCells[simulation];
        FinishTestInstantiation[simulation, rootType];
        };

    upPointerKey: ATOM = CP.RegisterProperty[$RoseUpPointer];

    MakeUpPointers: PROC [wire: Wire, parent: Wire] = {
        CP.PutWireProp[wire, upPointerKey, parent];
        IF wire.elements # NIL THEN {
            wire _ wire;
            FOR i: INT IN [0 .. wire.elements.size) DO
                MakeUpPointers[wire.elements[i], wire];
                ENDLOOP;
            wire _ wire;
            };
        };

    GetInternalParent: PUBLIC PROC [wire: Wire] RETURNS [parent: Wire] =
        {parent _ NARROW[CP.GetWireProp[wire, upPointerKey]]};

    IsInternal: PROC [sim: Simulation, wire: Wire] RETURNS [is: BOOL] =
        {is _ wire=sim.rootRecordType.internalWire OR CP.GetWireProp[wire, upPointerKey]#NIL};

    ComputeBehaviorKinds: PROC [sim: Simulation] = {
        GetPWPWBK: PROC [publicWirePrototype: Wire, specIn: WireBehaviorKind] RETURNS [pwpWBK: WireBehaviorKind] = {
            pwpWBK _ GetWBK[publicWirePrototype];
            IF pwpWBK = unspecified THEN {
                thisSpec: WireBehaviorKind _ SELECT CP.GetWireProp[publicWirePrototype, RoseBind.switchWire] FROM =NIL => specIn, #NIL => switch, 
                ENDCASE => ERROR;
                SELECT publicWirePrototype.structure FROM
                    atom => pwpWBK _ IF thisSpec # unspecified THEN thisSpec ELSE simple;
                    sequence => {
                        IF publicWirePrototype.elements.size = 0 THEN ERROR;
                        FOR i: NAT IN [0 .. publicWirePrototype.elements.size) DO
                            this: WireBehaviorKind _ GetPWPWBK[publicWirePrototype.elements[i], thisSpec];
                            IF i = 0 THEN pwpWBK _ this ELSE IF pwpWBK # this THEN ERROR;
                            ENDLOOP;
                        pwpWBK _ pwpWBK
                        };
                    record => {
                        someSwitch, someSimple, some: BOOL _ FALSE;
                        sim _ sim;
                        FOR i: NAT IN [0 .. publicWirePrototype.elements.size) DO
                            sub: WireBehaviorKind _ GetPWPWBK[publicWirePrototype.elements[i], thisSpec];
                            some _ TRUE;
                            SELECT sub FROM
                                simple => someSimple _ TRUE;
                                switch => someSwitch _ TRUE;
                                mixed => someSimple _ someSwitch _ TRUE;
                                unspecified => ERROR;
                                ENDCASE => ERROR;
                            ENDLOOP;
                        IF NOT some THEN ERROR;
                        pwpWBK _ IF someSimple THEN IF someSwitch THEN mixed ELSE simple ELSE IF someSwitch THEN switch ELSE ERROR;
                        };
                    ENDCASE => ERROR;
                SetWBK[publicWirePrototype, pwpWBK];
                };
            IF specIn # unspecified AND specIn # pwpWBK THEN ERROR;
            };
        GetWBKCopy: PROC [from, to: Wire, proto: BOOL] RETURNS [wbk: WireBehaviorKind] = {
            wbk _ GetWBK[to];
            IF wbk # unspecified THEN RETURN;
            SELECT to.structure FROM
                atom => NULL;
                record, sequence => {
                    from _ from;
                    FOR i: NAT IN [0 .. to.elements.size) DO
                        fromI: NAT _ IF proto AND from.structure=sequence THEN 0 ELSE i;
                        [] _ GetWBKCopy[from.elements[fromI], to.elements[i], proto];
                        ENDLOOP;
                    to _ to;
                    };
                ENDCASE => ERROR;
            SetWBK[to, wbk _ GetWBK[from]];
            IF wbk = unspecified THEN ERROR;
            };
        sim _ sim;
        FOR il: CellInstanceList _ sim.rootRecordType.instances, il.rest WHILE il # NIL DO
            ci: CellInstance _ il.first;
            cic: BehaviorClass _ RoseBindPrivate.GetBehaviorClass[ci.type, FALSE, FALSE, FALSE].class;
            [] _ GetPWPWBK[cic.publicWirePrototype, unspecified];
            [] _ GetWBKCopy[cic.publicWirePrototype, ci.type.publicWire, TRUE];
            ENDLOOP;
        sim _ sim;
        };

    GetWBK: PUBLIC PROC [wire: Wire] RETURNS [wbk: WireBehaviorKind] = {
        val: REF ANY _ CP.GetWireProp[wire, wireBehaviorKindKey];
        wbk _ SELECT val FROM
            $simple => simple,
            $switch => switch,
            $mixed => mixed,
            NIL => unspecified,
            ENDCASE => ERROR;
        };

    SetWBK: PROC [wire: Wire, wbk: WireBehaviorKind] = {
        CP.PutWireProp[
            wire,
            wireBehaviorKindKey,
            SELECT wbk FROM
                simple => $simple,
                switch => $switch,
                mixed => $mixed,
                ENDCASE => ERROR
            ];
        };

    FindLeafWires: PROC [sim: Simulation] = {
        FlwAwWork: PROC [publicWire, actualWire: Wire, drive: RoseWireType] = {
            pwWBK: WireBehaviorKind _ GetWBK[publicWire];
            IF pwWBK=unspecified THEN ERROR;
            SELECT (IsInternal[sim, actualWire] AND drive.class.structure=atom AND pwWBK IN [simple..switch]) FROM
                FALSE => {
                    SELECT actualWire.structure FROM
                        atom => ERROR;
                        sequence, record => {
                            actualWire _ actualWire;
                            FOR i: NAT IN [0 .. actualWire.elements.size) DO
                                FlwAwWork[
                                    publicWire.elements[i],
                                    actualWire.elements[i],
                                    SELECT drive.class.structure FROM
                                        atom => drive,
                                        record => drive.class.super.SubType[drive, [field[i]]],
                                        sequence => drive.class.super.SubType[drive, [subscript[i]]],
                                        ENDCASE => ERROR
                                    ];
                                ENDLOOP;
                            IF CP.GetWireProp[actualWire, wireGroupKey] = NIL THEN MarkAboveLeaf[actualWire];
                            };
                        ENDCASE => ERROR;
                    };
                TRUE => {
                    group: WireGroup _ GetWireGroup[actualWire];
                    awWBK: WireBehaviorKind _ GetWBK[actualWire];
                    newAWwbk: WireBehaviorKind _ SELECT TRUE FROM
                        awWBK=unspecified => pwWBK,
                        awWBK=mixed => ERROR,
                        awWBK=pwWBK => awWBK,
                        ENDCASE => switch;
                    IF awWBK#pwWBK THEN SetWBK[actualWire, newAWwbk];
                    SELECT group FROM
                        aboveLeaf, leaf => NULL;
                        belowLeaf => BreakWire[GetInternalParent[actualWire]];
                        ENDCASE => ERROR;
                    };
                ENDCASE => ERROR;
            };
        rootWire: Wire _ sim.rootRecordType.internalWire;
        MarkAsLeaf[rootWire];
        FOR il: CellInstanceList _ sim.rootRecordType.instances, il.rest WHILE il # NIL DO
            ci: CellInstance _ il.first;
            cic: BehaviorClass _ RoseBindPrivate.GetBehaviorClass[ci.type, FALSE, FALSE, TRUE].class;
            driveType: RoseWireType _ cic.wiring[drive].super.GetType[cic.wiring[drive], ci.actualWire];
            FlwAwWork[ci.type.publicWire, ci.actualWire, driveType];
            ENDLOOP;
        sim _ sim;
        };

    MarkAsLeaf: PROC [wire: Wire] = {
        CP.PutWireProp[wire, wireGroupKey, $Leaf];
        };

    MarkAboveLeaf: PROC [wire: Wire] = {
        CP.PutWireProp[wire, wireGroupKey, $AboveLeaf];
        };

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

    BreakWire: PROC [wire: Wire] = {
        pg: WireGroup _ GetWireGroup[wire];
        FOR i: NAT IN [0 .. wire.elements.size) DO
            child: Wire _ wire.elements[i];
            cg: WireGroup _ GetWireGroup[child];
            SELECT cg FROM
                belowLeaf => MarkAsLeaf[child];
                leaf, aboveLeaf => NULL;
                ENDCASE => ERROR;
            ENDLOOP;
        MarkAboveLeaf[wire];
        SELECT pg FROM
            belowLeaf => BreakWire[GetInternalParent[wire]];
            leaf => NULL;
            aboveLeaf => ERROR;
            ENDCASE => ERROR;
        };

    MakeRoseWires: PROC [sim: Simulation] = {
        Work: PROC [wire: Wire] = {
            wg: WireGroup _ GetWireGroup[wire];
            SELECT wg FROM
                belowLeaf => ERROR;
                aboveLeaf => {
                    wire _ wire;
                    FOR i: INT IN [0 .. wire.elements.size) DO
                        Work[wire.elements[i]];
                        ENDLOOP;
                    wire _ wire;
                    };
                leaf => {
                    rw: RoseWire;
                    rwc: RoseWireClass;
                    rwt: RoseWireType;
                    wbk: WireBehaviorKind _ GetWBK[wire];
                    rwc _ RoseWiring.GetWiring[
                        wire,
                        SELECT wbk FROM
                            simple => simple,
                            switch => switch,
                            ENDCASE => ERROR
                        ];
                    rwt _ rwc.super.GetType[rwc, wire];
                    CP.PutWireProp[wire, roseWireTypeKey, rwt];
                    rw _ NEW [RoseWireRep _ [
                        schIn: sim.sch,
                        core: wire,
                        type: rwt,
                        valPtr: RoseWireTwiddling.CreateUntypedInstance[rwt],
                        bitCount: rwt.class.super.Bits[rwt],
                        nextPerturbed: notInWireList,
                        nextAffected: notInWireList,
                        nextDelayed: notInWireList,
                        prevDelayed: notInWireList
                        ]];
                    CP.PutWireProp[wire, roseWireKey, rw];
                    };
                ENDCASE => ERROR;
            };
        Work[sim.rootRecordType.internalWire];
        };

    MakeRoseCells: PROC [sim: Simulation] = {
        FOR il: CellInstanceList _ sim.rootRecordType.instances, il.rest WHILE il # NIL DO
            ci: CellInstance = NARROW[il.first];
            args: REF ANY = CP.GetCellTypeProp[ci.type, RoseBind.argsKey];
            rct: RoseCellType = GetRoseCellType[ci.type, TRUE, TRUE];
            bc: BehaviorClass = rct.behaviorClass;
            pw: Wire = ci.type.publicWire;
            rci: RoseCellInstance _ NEW [RoseCellInstanceRep _ [
                schIn: sim.sch,
                core: ci,
                args: args,
                type: rct,
                effectivePorts: NIL,
                connectedWires: NIL,
                schedNext: notInCellList,
                nextNeeded: notInCellList,
                nextNoted: notInCellList,
                switchIO: bc.private.createSwitch[pw],
                newIO: bc.private.createSimple[pw],
                oldIO: bc.private.createSimple[pw],
                newDrive: bc.private.createDrive[pw],
                oldDrive: bc.private.createDrive[pw]
                ]];
            IF rci.type.behaviorClass.details.CreateState # NIL THEN rci.state _ rci.type.behaviorClass.details.CreateState[args];
            [rci.effectivePorts, rci.connectedWires, rci.hasTransducedPort] _ ComputeEffectiveInterface[rci];
            CP.PutCellInstanceProp[ci, roseCellKey, rci];
            ENDLOOP;
        sim _ sim;
        };

    GetRoseCellType: PUBLIC PROC [ct: CellType, details, privates: BOOL] RETURNS [rct: RoseCellType] = {
        rct _ NARROW[CP.GetCellTypeProp[ct, coreCellTypeToRoseCellType]];
        IF rct = NIL THEN {
            bc: BehaviorClass;
            [bc] _ RoseBindPrivate.GetBehaviorClass[ct, FALSE, FALSE, TRUE];
            rct _ NEW [RoseCellTypeRep _ [
                behaviorClass: bc,
                wireTypes: [
                    switch: bc.wiring[switch].super.GetType[bc.wiring[switch], ct.publicWire],
                    simple: bc.wiring[simple].super.GetType[bc.wiring[simple], ct.publicWire],
                    drive: bc.wiring[drive].super.GetType[bc.wiring[drive], ct.publicWire]
                    ]
                ]];
            CP.PutCellTypeProp[ct, coreCellTypeToRoseCellType, rct];
            };
        IF details OR privates THEN {
            goodDetails, goodPrivate: BOOL;
            [goodDetails, goodPrivate] _ RoseBindPrivate.EnsureBCParts[rct.behaviorClass, details, privates];
            IF (details AND NOT goodDetails) OR (privates AND NOT goodPrivate) THEN ERROR;
            };
        };

    ComputeEffectiveInterface: PROC [rci: RoseCellInstance] RETURNS [effectivePorts: EffectivePortS, connectedWires: RoseWireS, 
    hasTransducedPort: BOOL] = {
        length, index: NAT _ 0;
        Count: PROC [wire: Wire] = {
            wg: WireGroup _ GetWireGroup[wire];
            SELECT wg FROM
                belowLeaf => ERROR;
                aboveLeaf => {
                    wire _ wire;
                    FOR i: INT IN [0 .. wire.elements.size) DO
                        Count[wire.elements[i]];
                        ENDLOOP;
                    wire _ wire;
                    };
                leaf => length _ length + 1;
                ENDCASE => ERROR;
            };
        Fillin: PROC [publicWire, actualWire: Wire, switchType, simpleType, driveType: RoseWireType, switch, newSimple, oldSimple, 
        newDrive, oldDrive: Ptr, path: PortPath] = {
            wg: WireGroup _ GetWireGroup[actualWire];
            SELECT wg FROM
                belowLeaf => ERROR;
                aboveLeaf => {
                    actualWire _ actualWire;
                    FOR i: INT IN [0 .. actualWire.elements.size) DO
                        sel: Selector _ SELECT actualWire.structure FROM
                            atom => ERROR,
                            sequence => [subscript[i]],
                            record => [field[i]],
                            ENDCASE => ERROR;
                        Fillin[
                            publicWire.elements[i],
                            actualWire.elements[i],
                            switchType.class.super.SubType[switchType, sel],
                            simpleType.class.super.SubType[simpleType, sel],
                            driveType.class.super.SubType[driveType, sel],
                            Subscript[switch, switchType, sel],
                            Subscript[newSimple, simpleType, sel],
                            Subscript[oldSimple, simpleType, sel],
                            Subscript[newDrive, driveType, sel],
                            Subscript[oldDrive, driveType, sel],
                            PathAppend[path, i]
                            ];
                        ENDLOOP;
                    actualWire _ actualWire;
                    };
                leaf => {
                    rw: RoseWire _ NARROW[CP.GetWireProp[actualWire, roseWireKey]];
                    wbkP: WireBehaviorKind _ GetWBK[publicWire];
                    wbkA: WireBehaviorKind _ GetWBK[actualWire];
                    pSimple: BOOL _ SELECT wbkP FROM
                        simple => TRUE,
                        switch => FALSE,
                        ENDCASE => ERROR;
                    aSimple: BOOL _ SELECT wbkA FROM
                        simple => TRUE,
                        switch => FALSE,
                        ENDCASE => ERROR;
                    transduced: BOOL = (aSimple # pSimple);
                    me: Slot = [rci, index];
                    modelType: RoseWireType =
                        IF pSimple THEN simpleType ELSE switchType;
                    IF transduced AND aSimple THEN ERROR;
                    IF transduced THEN hasTransducedPort _ TRUE;
                    effectivePorts[index] _ [
                        switch: switch,
                        newSimple: newSimple,
                        oldSimple: oldSimple,
                        newDrive: newDrive,
                        oldDrive: oldDrive,
                        type: modelType,
                        implType: IF transduced THEN switchType ELSE modelType,
                        path: path,
                        input: TRUE,
                        output: TRUE,
                        XPhobic: pSimple,
                        transduced: transduced
                        ];
                    SELECT aSimple FROM
                        TRUE => {
                            initialStrength: Strength = none;
                            prev: Slot = rw.byStrength[initialStrength].last;
                            effectivePorts[index].curStrength _ initialStrength;
                            effectivePorts[index].strengthNext _ nilSlot;
                            effectivePorts[index].strengthPrev _ prev;
                            IF prev = nilSlot
                                THEN rw.byStrength[initialStrength].first _ me
                                ELSE prev.cell.effectivePorts[prev.effectivePortIndex].strengthNext _ me;
                            rw.byStrength[initialStrength].last _ me;
                            };
                        FALSE => {
                            rw.switchConnections _ CONS[me, rw.switchConnections];
                            rw.XPhobic _ rw.XPhobic OR effectivePorts[index].XPhobic;
                            };
                        ENDCASE => ERROR;
                    connectedWires[index] _ rw;
                    index _ index + 1;
                    };
                ENDCASE => ERROR;
            };
        hasTransducedPort _ FALSE;
        Count[rci.core.actualWire];
        effectivePorts _ NEW [EffectivePortSeq[length]];
        connectedWires _ NEW [RoseWireSeq[length]];
        Fillin[
            rci.core.type.publicWire,
            rci.core.actualWire,
            rci.type.wireTypes[switch],
            rci.type.wireTypes[simple],
            rci.type.wireTypes[drive],
            RoseWireTwiddling.RefToPtr[rci.switchIO, rci.type.wireTypes[switch]],
            RoseWireTwiddling.RefToPtr[rci.newIO, rci.type.wireTypes[simple]],
            RoseWireTwiddling.RefToPtr[rci.oldIO, rci.type.wireTypes[simple]],
            RoseWireTwiddling.RefToPtr[rci.newDrive, rci.type.wireTypes[drive]],
            RoseWireTwiddling.RefToPtr[rci.oldDrive, rci.type.wireTypes[drive]],
            NIL
            ];
        IF index # length THEN ERROR;
        };

    Subscript: PROC [p: Ptr, rwt: RoseWireType, sel: Selector] RETURNS [q: Ptr] = {
        dereference: BOOL = rwt.class.dereference;
        dBits: NAT;
        dBits _ rwt.class.super.SelectorOffset[rwt, sel];
        IF dereference THEN p _ BitTwiddling.DeReferencePtr[p];
        q _ BitTwiddling.OffsetPtr[p, dBits];
        };

    PathAppend: PROC [path: PortPath, index: INT] RETURNS [longer: PortPath] = {
        RETURN [IF path = NIL THEN LIST[index] ELSE CONS[path.first, PathAppend[path.rest, index]]];
        };

    flattenToBehavior: PUBLIC CoreFlatten.FlattenControl _ NEW [CoreFlatten.FlattenControlRec _ [DecideByBehavior, NIL]];

    DecideByBehavior: PROC [data: REF ANY, who: CoreFlatten.InstantiationPath] RETURNS [ed: CoreFlatten.ExpandDecision] = {
        ci: CellInstance = who.first;
        ed _ IF RoseBindPrivate.GetBehaviorClass[ci.type, TRUE, FALSE, FALSE].goodDetails THEN leaf ELSE expand;
        };

    FlattenStructure: PUBLIC PROC [from: Core.CellType] RETURNS [fc: CoreFlatten.FlattenControl] = {
        fc _ NEW [CoreFlatten.FlattenControlRec _ [DecideByStructure, from]];
        };

    DecideByStructure: PROC [data: REF ANY, who: CoreFlatten.InstantiationPath] RETURNS [ed: CoreFlatten.ExpandDecision] = {
        ct: CellType _ IF who # NIL THEN who.first.type ELSE NARROW[data];
        WHILE ct.class.recast # NIL DO
            ct _ CoreOps.Recast[ct];
            ENDLOOP;
        WITH ct.data SELECT FROM
            rct: CR.RecordCellType => RETURN [expand];
            ENDCASE => RETURN [leaf];
        };

    END.