
<<[Indigo]<Rosemary>2.8>Rosemary.df=>RoseCaptureImpl.Mesa>>
<<Last Edited by: Spreitzer, May 2, 1985 0:03:59 am PDT>>

    DIRECTORY Asserting, AssertingIO, Convert, FS, GetMe, IO, OrderedSymbolTableRef, PupDefs, Rope, RoseCapture, RoseCreate, RoseTypes, 
    UserCredentials;

    RoseCaptureImpl: CEDAR PROGRAM
        IMPORTS Asserting, AssertingIO, Convert, FS, GetMe, IO, OrderedSymbolTableRef, PupDefs, Rope, RoseCreate, RoseTypes, UserCredentials
        EXPORTS RoseCapture =

    BEGIN OPEN RoseTypes;

    LORA: TYPE = LIST OF REF ANY;

    DesignCapture: TYPE = REF DesignCaptureRep;
    DesignCaptureRep: TYPE = RECORD [
        fileNameRoot: ROPE,
        dfOut: STREAM,
        genCount: INT _ 0
        ];

    CTCapture: TYPE = REF CTCaptureRep;
    CTCaptureRep: TYPE = RECORD [
        dc: DesignCapture,
        cellOut: STREAM,
        cell: Cell
        ];

    Wire: TYPE = REF WireRep;
    WireRep: TYPE = RECORD [name: ROPE, better: Wire _ NIL, worse: WireList _ NIL];
    WireList: TYPE = LIST OF Wire;

    machineName: ROPE _ "??";
    userName: ROPE _ "??";

    capKey: ATOM _ $Capture;
    wireKey: ATOM _ $Wire;

    captureExpansion: ERClass _ NEW [ERClassRep _ [
        CellInstance: CellInstance,
        NodeInstance: NodeInstance,
        SplitJoin: SplitJoin,
        ChangeReps: ChangeReps]];

    Log: PROC [format: ROPE, v1, v2, v3, v4, v5: IO.Value _ [null[]]] =
        BEGIN
        msg: ROPE _ IO.PutFR[format, v1, v2, v3, v4, v5];
        SIGNAL Warning[msg];
        END;

    CaptureDesign: PUBLIC PROC [directory, designName, topCellTypeName: ROPE] =
        BEGIN
        fileNameRoot: ROPE _ designName;
        dfName: ROPE _ fileNameRoot.Cat["-Str.DF"];
        dc: DesignCapture _ NEW [DesignCaptureRep _ [fileNameRoot, FS.StreamOpen[dfName, create]]];
        topCellType: CellType _ RoseCreate.GetCellType[topCellTypeName];
        IF topCellType = NIL THEN {Log["No such cell type as %g", IO.refAny[topCellTypeName]]; RETURN};
        machineName _ PupDefs.GetMyName[];
        userName _ UserCredentials.Get[].name;
        dc.dfOut.PutF["-- (DesignName %g)\n", IO.refAny[designName]];
        dc.dfOut.PutF["-- (CreatingUser %g)\n", IO.refAny[userName]];
        dc.dfOut.PutF["-- (CreationTime \"%g\")\n", IO.time[]];
        dc.dfOut.PutF["-- (CreationSite \"MilkyWay Sol III USA Xerox PARC ComputerResearch %q\")\n", IO.rope[machineName]];
        dc.dfOut.PutF["-- (DerivingProgram \"Rosemary Structure Capturer\" %g)\n", 
        IO.refAny[GetMe.StandardScrewyEncoding[GetMe.GetVersion[]]]];
        dc.dfOut.PutF["\n\nDirectory %g\n  %g\n", IO.rope[directory], IO.rope[dfName]];
        CaptureCellType[
            dc,
            NEW [CellRep _ [
                name: "Root",
                type: topCellType,
                parent: NIL,
                internalNodes: OrderedSymbolTableRef.CreateTable[ RoseCreate.CompareNodes],
                components: OrderedSymbolTableRef.CreateTable[ RoseCreate.CompareComponents],
                interfaceNodes: NEW [NodeSR[0]],
                substantiality: Real,
                expansion: Nested
                ]]
            ];
        dc.dfOut.Close[];
        END;

    CaptureCellType: PROC [dc: DesignCapture, cell: Cell] =
        BEGIN
        WriteNode: PROC [ra: REF ANY] RETURNS [stop: BOOL] = {
            WriteAliases: PROC [worse: WireList] = {
                FOR worse _ worse, worse.rest WHILE worse # NIL DO
                    ctc.cellOut.PutF[" (%g (G P))", IO.refAny[worse.first.name]];
                    WriteAliases[worse.first.worse];
                    ENDLOOP};
            WriteWires: PROC [type: NodeType, ra: REF ANY, other: Assertions] = {
                WITH type SELECT FROM
                    ant: ArrayNodeType => {list: LORA _ NARROW[ra];
                        FOR i: INT IN [ant.first .. ant.last] DO
                            WriteWires[ant.element, list.first, other]; list _ list.rest;
                            ENDLOOP};
                    ant: AtomNodeType => {w: Wire _ NARROW[ra];
                        IF w.better = NIL THEN {
                            ctc.cellOut.PutF["(N %g (G D)", IO.refAny[w.name]];
                            IF w.worse # NIL THEN {
                                ctc.cellOut.PutRope[" (A"];
                                WriteAliases[w.worse];
                                ctc.cellOut.PutRope[")"]};
                            FOR ol: Assertions _ other, ol.rest WHILE ol # NIL DO
                                ctc.cellOut.PutRope[" "];
                                AssertingIO.WriteAssn[ctc.cellOut, ol.first];
                                ENDLOOP;
                            ctc.cellOut.PutRope[")\n"];
                            };
                        };
                    ENDCASE => ERROR};
            n: Node _ NARROW[ra];
            w: REF ANY _ Asserting.FnVal[fn: wireKey, from: n.other];
            stop _ FALSE;
            WriteWires[n.type, w, Asserting.Filter[reln: wireKey, from: n.other].notAbout];
            };
        DestroyNode: PROC [ra: REF ANY] RETURNS [stop: BOOL] = {
            n: Node _ NARROW[ra];
            stop _ FALSE;
            IF cell.internalNodes.Delete[n] # n THEN ERROR;
            n.type _ NIL;
            n.data _ NIL;
            n.initialValue _ NIL;
            n.initialValueFormat _ NIL;
            n.cellIn _ NIL;
            n.visible _ [NIL, LAST[CARDINAL]];
            n.connections _ NIL;
            n.nextPerturbed _ notInNodeList;
            IF n.nextAffected # notInNodeList OR n.nextX # notInNodeList OR n.prevX # notInNodeList THEN ERROR;
            n.watchers _ ALL[NIL];
            n.next _ NIL;
            n.other _ NIL;
            };
        WriteComponent: PROC [ra: REF ANY] RETURNS [stop: BOOL] = {
            WriteConnection: PROC [type: NodeType, portName: ROPE, ra: REF ANY] =
                {WITH type SELECT FROM
                    ant: ArrayNodeType => {list: LORA _ NARROW[ra];
                        FOR i: INTEGER IN [ant.first .. ant.last] DO
                            WriteConnection[ant.element, Sub[portName, i], list.first];
                            list _ list.rest;
                            ENDLOOP};
                    ant: AtomNodeType => {w: Wire _ Best[ra];
                        ctc.cellOut.PutF["\n\t\t(%g %g)", IO.refAny[portName], IO.refAny[w.name]];
                        };
                    ENDCASE => ERROR};
            c: Cell _ NARROW[ra];
            prev: Cell _ NIL;
            stop _ FALSE;
            ctc.cellOut.PutF["(CI %g %g (G D)\n\t(CIC", IO.refAny[c.name], IO.refAny[c.type.name]];
            FOR index: CARDINAL IN [0 .. c.type.ports.length) DO
                w: REF ANY_ Asserting.FnVal[fn: wireKey, from: c.interfaceNodes[index].other];
                WriteConnection[c.type.ports[index].type, c.type.ports[index].name, w];
                ENDLOOP;
            ctc.cellOut.PutRope[")"];
            FOR ol: Assertions _ c.other, ol.rest WHILE ol # NIL DO
                ctc.cellOut.PutRope["\n\t"];
                AssertingIO.WriteAssn[ctc.cellOut, ol.first];
                ENDLOOP;
            ctc.cellOut.PutRope[")\n"];
            SELECT Asserting.FnVal[fn: capKey, from: c.type.other] FROM
                ctc.dc => NULL;
                ENDCASE => CaptureCellType[ctc.dc, c];
            IF cell.components.Delete[c] # c THEN ERROR;
            IF c.realCellStuff # NIL THEN ERROR;
            c.other _ NIL;
            c.interfaceNodes _ NIL;
            c.internalNodes.DestroyTable[];
            c.components.DestroyTable[];
            c.internalNodes _ c.components _ NIL;
            IF c.firstInternalNode # NIL THEN ERROR;
            IF c.leftChild # NIL THEN ERROR;
            c.parent _ c.rightSibling _ NIL;
            c.sim _ NIL;
            c.nextInstance _ NIL;
            c.type _ NIL;
            };
        cellFileName: ROPE _ CellFileName[dc, cell];
        ctc: CTCapture _ NEW [CTCaptureRep _ [
            dc: dc,
            cellOut: FS.StreamOpen[cellFileName, create],
            cell: cell
            ]];
        insides: Structure;
        cell.type.other _ Asserting.AssertFn1[fn: capKey, val: dc, inAdditionTo: cell.type.other];
        dc.dfOut.PutF["\n-- (CellType %g)\n  %g\n", IO.refAny[cell.type.name], IO.rope[cellFileName]];
        ctc.cellOut.PutF["(CellTypeName %g)\n", IO.refAny[cell.type.name]];
        ctc.cellOut.PutF["(CreationTime \"%g\")\n", IO.time[]];
        ctc.cellOut.PutF["(CreatingUser %g)\n", IO.refAny[userName]];
        ctc.cellOut.PutF["(CreationSite \"MilkyWay Sol III USA Xerox PARC ComputerResearch %q\")\n", IO.rope[machineName]];
        ctc.cellOut.PutF["(DerivingProgram \"Rosemary Structure Capturer\" %g)\n", 
        IO.refAny[GetMe.StandardScrewyEncoding[GetMe.GetVersion[]]]];
        WritePorts[cell.type, ctc.cellOut];
        WriteAssertions[cell.type.other, ctc.cellOut];
        ctc.cellOut.PutRope["(PrivateFollows)\n"];
        IF cell.type.expand # NIL
            THEN {
                cell.realCellStuff _ NEW [RealCellStuffRep _ [
                    schedNext: notInCellList,
                    nextNeeded: notInCellList,
                    nextNoted: notInCellList,
                    newIOAsWP: NIL,
                    oldIOAsWP: NIL,
                    switchIOAsWP: NIL,
                    state: insides _ NEW [StructureRep _ [
                        container: cell,
                        mirror: NEW [CellRep _ [
                            name: " world ",
                            type: cell.type,
                            parent: cell,
                            internalNodes: NIL,
                            components: NIL,
                            interfaceNodes: NEW [NodeSR[cell.type.ports.length]],
                            substantiality: Real,
                            expansion: Nested,
                            realCellStuff: NIL]],
                        insideNodes: NIL,
                        nextPerturbed: notInStrList,
                        nextWasPerturbed: notInStrList
                        ]]
                    ]];
                insides.insideNodes _ insides.mirror.interfaceNodes;
                FOR pi: NAT IN [0 .. cell.type.ports.length) DO
                    insideNode: Node _ NodeInstance[erInstance: ctc, name: cell.type.ports[pi].name, type: cell.type.ports[pi].type];
                    insides.insideNodes[pi] _ insideNode;
                    ENDLOOP;
                cell.type.expand[ctc.cell, [ctc, captureExpansion]];
                cell.internalNodes.EnumerateIncreasing[WriteNode];
                WritePortNets[cell.type, ctc.cellOut, insides.insideNodes];
                cell.components.EnumerateIncreasing[WriteComponent];
                cell.realCellStuff.state _ NIL;
                cell.realCellStuff _ NIL;
                insides.mirror.parent _ NIL;
                insides.mirror.type _ NIL;
                insides.mirror.interfaceNodes _ NIL;
                insides.mirror _ NIL;
                cell.internalNodes.EnumerateIncreasing[DestroyNode];
                }
            ELSE ctc.cellOut.PutRope["(InsidesUnspecified)\n"];
        ctc.cellOut.Close[];
        END;

    CellFileName: PROC [dc: DesignCapture, cell: Cell] RETURNS [cellFileName: ROPE] = {
        fullCellFileName: ROPE;
        cp: FS.ComponentPositions;
        cellFileName _ NIL;
        [fullCellFileName, cp, ] _ FS.ExpandName[cell.type.name !FS.Error => CONTINUE];
        IF fullCellFileName # NIL AND fullCellFileName.Substr[start: cp.base.start, len: cp.base.length].Equal[cell.type.name] THEN RETURN 
        [cell.type.name.Cat[".sch"]];
        cellFileName _ IO.PutFR["%g-%g.sch", IO.rope[dc.fileNameRoot], IO.card[dc.genCount _ dc.genCount + 1]];
        };

    WriteAssertions: PROC [assertions: Assertions, to: IO.STREAM] =
        BEGIN
        FOR assertions _ assertions, assertions.rest WHILE assertions # NIL DO
            AssertingIO.WriteAssn[to: to, assertion: assertions.first];
            to.PutRope["\n"];
            <<WITH assertions.first.first SELECT FROM>>
                <<a: ATOM => SELECT a FROM>>
                    <<$Capture => LOOP;>>
                    <<ENDCASE;>>
                <<ENDCASE => ERROR;>>
            <<to.PutF["%g\n", IO.refAny[assertions.first]];>>
            ENDLOOP;
        END;

    WritePorts: PROC [ct: CellType, to: IO.STREAM] =
        BEGIN
        dir: ROPE;
        other: Assertions;
        WritePort: PROC [type: NodeType, portName, ecName: ROPE] = {
            WITH type SELECT FROM
                ant: ArrayNodeType => {
                    IF ecName # NIL THEN Log["undoable equivalence class (%g) for port %g of cell type %g", IO.refAny[ecName], IO.refAny[portName], 
                    IO.refAny[ct.name]];
                    FOR i: INTEGER IN [ant.first .. ant.last] DO
                        WritePort[ant.element, Sub[portName, i], NIL];
                        ENDLOOP};
                ant: AtomNodeType => {
                    to.PutF["\n\t(%g (G D) (%g)", IO.refAny[portName], IO.rope[dir]];
                    IF (ecName # NIL) AND (NOT ecName.Equal[portName]) THEN to.PutF[" (EC \"Structure\" %g)", IO.refAny[ecName]];
                    FOR al: Assertions _ other, al.rest WHILE al # NIL DO
                        to.PutChar[' ];
                        AssertingIO.WriteAssn[to, al.first];
                        ENDLOOP;
                    to.PutRope[")"];
                    };
                ENDCASE => ERROR};
        to.PutRope["(Ports"];
        FOR pi: CARDINAL IN [0 .. ct.ports.length) DO
            ec: ROPE _ NARROW[Asserting.FnVal[$EC, ct.ports[pi].other, LIST[NARROW["Structure", ROPE]]]];
            dir _ IF ct.ports[pi].input THEN (IF ct.ports[pi].output THEN "BIDIR" ELSE "IN") ELSE IF ct.ports[pi].output THEN "OUT" ELSE ERROR;
            other _ Asserting.Filter[$EC, ct.ports[pi].other].notAbout;
            WritePort[ct.ports[pi].type, ct.ports[pi].name, ec];
            ENDLOOP;
        to.PutRope[")\n"];
        END;

    WritePortNets: PROC [ct: CellType, to: IO.STREAM, insideNodes: NodeS] =
        BEGIN
        WritePortNet: PROC [type: NodeType, portName: ROPE, node: REF ANY] = {
            WITH type SELECT FROM
                ant: ArrayNodeType => {l: LORA _ NARROW[node];
                    FOR i: INTEGER IN [ant.first .. ant.last] DO
                        WritePortNet[ant.element, Sub[portName, i], l.first];
                        l _ l.rest;
                        ENDLOOP;
                    IF l # NIL THEN ERROR};
                ant: AtomNodeType => to.PutF["(PN %g %g)\n", IO.refAny[portName], IO.refAny[Best[node].name]];
                ENDCASE => ERROR};
        FOR pi: CARDINAL IN [0 .. ct.ports.length) DO
            WritePortNet[ct.ports[pi].type,
                ct.ports[pi].name,
                Asserting.FnVal[fn: wireKey, from: insideNodes[pi].other]];
            ENDLOOP;
        END;

    NodeInstance: PROC [erInstance: REF ANY, name: ROPE, type: NodeType, initialValue, initialValueFormat: ROPE _ NIL, initData: REF 
    ANY _ NIL, other: Assertions _ NIL] RETURNS [node: Node] =
        BEGIN
        ctc: CTCapture _ NARROW[erInstance];
        node _ NEW [NodeRep _ [
            name: name,
            type: type,
            initialValue: initialValue,
            initialValueFormat: type.procs.GetFormat[type, initialValueFormat],
            cellIn: ctc.cell,
            nextPerturbed: notInNodeList,
            nextAffected: notInNodeList,
            nextX: notInNodeList,
            prevX: notInNodeList,
            other: other]];
        ctc.cell.internalNodes.Insert[node !OrderedSymbolTableRef.DuplicateKey => {Log["Duplicated Node name: %g", IO.rope[name]]; 
        CONTINUE}];
        node.other _ Asserting.AssertFn1[fn: wireKey, val: CreateWires[type, name], inAdditionTo: node.other];
        END;

    CreateWires: PROC [type: NodeType, name: ROPE] RETURNS [ra: REF ANY] =
        BEGIN
        WITH type SELECT FROM
            ant: ArrayNodeType => {
                list: LORA _ NIL;
                FOR i: INTEGER DECREASING IN [ant.first .. ant.last] DO
                    list _ CONS[CreateWires[ant.element, Sub[name, i]], list];
                    ENDLOOP;
                ra _ list};
            ant: AtomNodeType =>
                ra _ NEW [WireRep _ [name: name]];
            ENDCASE => ERROR
        END;

    CellInstance: PROC [erInstance: REF ANY, instanceName, typeName, interfaceNodes: ROPE, other: Assertions _ NIL] RETURNS [cell: 
    Cell] =
        BEGIN
        ctc: CTCapture _ NARROW[erInstance];
        type: CellType _ RoseCreate.GetCellType[typeName];
        IF type = NIL
            THEN Log["No such cell type as %g", IO.refAny[typeName]]
            ELSE {
                cell _ NEW [CellRep _ [
                    name: instanceName,
                    type: type,
                    parent: ctc.cell,
                    internalNodes: OrderedSymbolTableRef.CreateTable[ RoseCreate.CompareNodes],
                    components: OrderedSymbolTableRef.CreateTable[ RoseCreate.CompareComponents],
                    interfaceNodes: NEW [NodeSR[type.ports.length]],
                    substantiality: Real,
                    expansion: Nested,
                    other: other
                    ]];
                RoseCreate.FillInInterfaceNodes[cell, interfaceNodes];
                ctc.cell.components.Insert[cell !OrderedSymbolTableRef.DuplicateKey => {Log["Duplicated Cell name: %g", IO.rope[instanceName]]; 
                CONTINUE}];
                };
        END;

    SplitJoin: PROC [erInstance: REF ANY, a, b: StretchList, writeA, writeB: BOOLEAN] =
        BEGIN
        aWires: LIST OF TypedWire _ Squash[a];
        bWires: LIST OF TypedWire _ Squash[b];
        IF (a = NIL) # (b = NIL) THEN ERROR;
        IF a = NIL THEN RETURN;
        DO
            IF (aWires = NIL) # (bWires = NIL) THEN ERROR;
            IF aWires = NIL THEN EXIT;
            ChangeWires[aWires.first, bWires.first];
            aWires _ aWires.rest;
            bWires _ bWires.rest;
            ENDLOOP;
        END;

    TypedWire: TYPE = RECORD [type: NodeType, ra: REF ANY];

    Squash: PROC [sl: StretchList] RETURNS [wl: LIST OF TypedWire] =
        BEGIN
        SquashWork: PROC [nt: NodeType, ra: REF ANY] = {
            WITH nt SELECT FROM
                ant: AtomNodeType => {
                    w: Wire _ NARROW[ra];
                    wl _ CONS[[ant, w], wl]};
                ant: ArrayNodeType => {
                    l: LORA _ NARROW[ra];
                    FOR i: INTEGER IN [ant.first .. ant.last] DO
                        SquashWork[ant.element, l.first];
                        l _ l.rest;
                        ENDLOOP;
                    IF l # NIL THEN ERROR};
                ENDCASE => ERROR;
            wl _ wl};
        wl _ NIL;
        FOR sl _ sl, sl.rest WHILE sl # NIL DO
            ra: REF ANY _ Asserting.FnVal[fn: wireKey, from: sl.first.node.other];
            WITH sl.first SELECT FROM
                ss: SingleStretch => SquashWork[ss.node.type, ra];
                ss: SubStretch => {
                    l: LORA _ NARROW[ra];
                    ant: ArrayNodeType _ NARROW[ss.node.type];
                    FOR i: INTEGER IN [ant.first .. ant.last] DO
                        IF i IN [ss.first .. ss.last] THEN SquashWork[ant.element, l.first];
                        l _ l.rest;
                        ENDLOOP;
                    IF l # NIL THEN ERROR;
                    };
                ENDCASE => ERROR;
            ENDLOOP;
        END;

    ChangeReps: PROC [erInstance: REF ANY, a, b: Node, writeA, writeB: BOOLEAN] =
        BEGIN
        wa: REF ANY _ Asserting.FnVal[fn: wireKey, from: a.other];
        wb: REF ANY _ Asserting.FnVal[fn: wireKey, from: b.other];
        ChangeWires[[a.type, wa], [b.type, wb]];
        END;

    ChangeWires: PROC [a, b: TypedWire] =
        {WITH a.type SELECT FROM
            ant: ArrayNodeType => {bnt: ArrayNodeType _ NARROW[b.type];
                aList: LORA _ NARROW[a.ra];
                bList: LORA _ NARROW[b.ra];
                IF ant.first # bnt.first OR ant.last # bnt.last THEN ERROR;
                FOR i: INTEGER IN [ant.first .. ant.last] DO
                    ChangeWires[[ant.element, aList.first], [bnt.element, bList.first]];
                    aList _ aList.rest; bList _ bList.rest;
                    ENDLOOP};
            ant: AtomNodeType => {bnt: AtomNodeType _ NARROW[b.type];
                wa: Wire _ Best[a.ra];
                wb: Wire _ Best[b.ra];
                IF wa # wb
                    THEN {wb.better _ wa; wa.worse _ CONS[wb, wa.worse]}
                    ELSE ERROR;
                };
            ENDCASE => ERROR};

    Best: PROC [ra: REF ANY] RETURNS [w: Wire] = {w _ NARROW[ra];
        WHILE w.better # NIL DO w _ w.better ENDLOOP};

    Sub: PROC [name: ROPE, i: INTEGER] RETURNS [s: ROPE] = {
        s _ name.Cat["[", Convert.RopeFromInt[i], "]"]};

    Setup: PROC = {
        AssertingIO.SetWriter[$Capture, AssertingIO.DontWrite];
        };

    Setup[];

    END.