
    <<CoreCreateImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Bertrand Serlet, March 20, 1986 2:03:38 am PST>>
        <<Barth, May 7, 1986 10:21:40 am PDT>>
        <<Louis Monier May 1, 1986 4:50:13 pm PDT>>
    <<>>
    DIRECTORY
        Core, CoreClasses, CoreCreate, CoreOps, CoreProperties, CoreSequence, HashTable, IO, Rope;

    CoreCreateImpl: CEDAR PROGRAM
        IMPORTS CoreClasses, CoreOps, CoreProperties, CoreSequence, HashTable, IO, Rope
        EXPORTS CoreCreate = 
        BEGIN OPEN CoreCreate;
<<Wires>>
    WireList: PUBLIC PROC [wrs: LIST OF WR _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [newWire: Wire] = {
        count: NAT _ 0;
        FOR wrl: LIST OF WR _ wrs, wrl.rest UNTIL wrl=NIL DO
            IF wrl.first#NIL THEN count _ count + 1;
            ENDLOOP;
        newWire _ CoreOps.CreateWires[count, name, props];
        count _ 0;
        FOR wrl: LIST OF WR _ wrs, wrl.rest UNTIL wrl=NIL DO
            IF wrl.first#NIL THEN {
                new: Wire _ WITH wrl.first SELECT FROM
                    wire: Wire         => wire,
                    rope: ROPE        => CoreOps.CreateWire[name: rope],
                    text: REF TEXT     => CoreOps.CreateWire[name: Rope.FromRefText[text]],
                    ENDCASE         => ERROR;
                newWire[count] _ new;
                count _ count + 1;
                };
            ENDLOOP;
        };
        <<>>
    Wires: PUBLIC PROC [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13: WR _ NIL, name: ROPE _ NIL, props: 
    Properties _ NIL] RETURNS [Wire] = {
        RETURN [WireList[LIST [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13], name, props]];
        };
        <<>>
    Seq: PUBLIC PROC [name: ROPE _ NIL, size: NAT, protoChild: Wire _ NIL] RETURNS [wire: Wire] = {
        wire _ CoreOps.SetShortWireName[CoreOps.CreateWires[size], name];
        IF protoChild=NIL THEN FOR i: NAT IN [0..size) DO
            wire[i] _ CoreOps.CreateWire[];
            ENDLOOP
        ELSE FOR i: NAT IN [0..size) DO
            wire[i] _ CoreOps.CopyWire[protoChild];
            ENDLOOP;
        };
        <<>>
    Index: PUBLIC PROC [wr: WR, index: NAT] RETURNS [WR] = {
        WITH wr SELECT FROM
            wire: Wire         => RETURN [wire[index]];
            rope: ROPE         => RETURN [IO.PutFR["%g[%g]", IO.rope[rope], IO.int[index]]];
            text: REF TEXT     => RETURN [IO.PutFR["%g[%g]", IO.text[text], IO.int[index]]];
            ENDCASE         => ERROR
        };

    Range: PUBLIC PROC [wire: Wire, start, size: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [Wire] = {
        RETURN [CoreOps.SubrangeWire[wire, start, size, name, props]];
        };

    Union: PUBLIC PROC [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13: Wire _ NIL, name: ROPE _ NIL, props: 
    Properties _ NIL] RETURNS [wire: Wire] = {
        wires: LIST OF Wire _ LIST [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13];
        count: NAT _ 0;
        FOR wl: LIST OF Wire _ wires, wl.rest UNTIL wl=NIL DO
            IF wl.first#NIL THEN count _ count + (IF wl.first.size=0 THEN 1 ELSE wl.first.size);
            ENDLOOP;
        wire _ CoreOps.CreateWires[count, name, props];
        count _ 0;
        FOR wl: LIST OF Wire _ wires, wl.rest UNTIL wl=NIL DO
            IF wl.first#NIL THEN {
                IF wl.first.size=0 THEN {
                    wire[count] _ wl.first;
                    count _ count+1;
                    }
                ELSE {
                    FOR w: NAT IN [0..wl.first.size) DO
                        wire[count+w] _ wl.first[w];
                        ENDLOOP;
                    count _ count + wl.first.size;
                    };
                };
            ENDLOOP;
        };
        <<>>
<<Cells>>
    Instance: PUBLIC PROC [type: CellType, pa1, pa2, pa3, pa4, pa5, pa6, pa7, pa8, pa9, pa10, pa11, pa12, pa13: PA _ [], name: ROPE _ 
    NIL, props: Properties _ NIL] RETURNS [CellInstance] = {
        revpas: LIST OF PA _ NIL;
        FOR pas: LIST OF PA _ LIST [pa1, pa2, pa3, pa4, pa5, pa6, pa7, pa8, pa9, pa10, pa11, pa12, pa13], pas.rest UNTIL pas=NIL DO
            IF pas.first#[] THEN revpas _ CONS [pas.first, revpas];
            ENDLOOP;
        RETURN [InstanceList[type: type, pas: revpas, name: name, props: props]];
        };
        <<>>
    instanceBindProp: ATOM _ CoreProperties.RegisterProperty[$CoreInstanceBind, CoreProperties.Props[[CoreProperties.propCopy, 
    CoreProperties.PropDoCopy], [CoreProperties.propPrint, CoreProperties.PropDontPrint]]];

    InstanceList: PUBLIC PROC [type: CellType, pas: LIST OF PA _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [instance: 
    CellInstance] = {
        instance _ CoreClasses.CreateInstance[actual: NIL, type: type, name: name, props: props];
        <<We check pas is of the right type, to detect errors as soon as possible>>
        FOR checkPas: LIST OF PA _ pas, checkPas.rest WHILE checkPas#NIL DO
            WITH checkPas.first.public SELECT FROM
                wire: Wire         => {};
                rope: ROPE         => {};
                text: REF TEXT    => {};
                ENDCASE            => ERROR;
            WITH checkPas.first.actual SELECT FROM
                wire: Wire         => {};
                rope: ROPE         => {};
                text: REF TEXT    => {};
                ENDCASE            => ERROR;
            ENDLOOP;
        CoreProperties.PutCellInstanceProp[on: instance, prop: instanceBindProp, value: pas];
        };

    CreateError: ERROR [msg: ROPE] = CODE;

    Cell: PUBLIC PROC [public: Wire, onlyInternal, internal: Wire _ NIL, instances: CellInstances, name: ROPE _ NIL, props: Properties 
    _ NIL] RETURNS [cellType: CellType] = {

        MakeError: PROC [msg: ROPE, cellName: ROPE] = {
            ERROR CreateError[Rope.Cat[msg, " in cell type '", cellName, "'"]];
            };

        CheckWellFormed: PROC [root: ROPE, wire: Wire] = {
            IF wire=NIL THEN MakeError[root, name];
            FOR sub: NAT IN [0..wire.size) DO
                CheckWellFormed[root, wire[sub]];
                ENDLOOP;
            };

        IF internal=NIL THEN internal _ CoreOps.UnionWire[public, onlyInternal] ELSE IF onlyInternal#NIL THEN MakeError["Both internal and 
        onlyInternal are specified", name];
        CheckWellFormed["Public is malformed", public];
        CheckWellFormed["Internal is malformed", internal];
        FOR instList: CellInstances _ instances, instList.rest UNTIL instList=NIL DO

            CreateActual: PROC [public: Wire] RETURNS [actual: Wire] = {

                ActualError: PROC = {
                    MakeError[Rope.Cat["Public '", CoreOps.GetFullWireNames[instance.type.public, public].first, "' has bad actual"], name];
                    };

                IF (actual _ NARROW [HashTable.Fetch[table: visitTab, key: public].value])=NIL THEN {
                    FOR paList: LIST OF PA _ pas, paList.rest UNTIL paList=NIL DO
                        IF paList.first.public=public THEN {
                            actual _ FindWire[internal, paList.first.actual];
                            IF actual#NIL THEN EXIT;
                            WITH paList.first.actual SELECT FROM
                                wire: Wire => {

                                    FindByName: PROC [wire: Wire] RETURNS [actual: Wire _ NIL] = {
                                        actualName: ROPE _ CoreOps.GetShortWireName[wire];
                                        IF actualName#NIL THEN actual _ FindWire[internal, actualName];
                                        IF actual=NIL THEN {
                                            IF wire.size=0 THEN ActualError[];
                                        actual _ wire;
                                        FOR i: NAT IN [0 .. wire.size) DO
                                        actual[i] _ FindByName[actual[i]];
                                        ENDLOOP;
                                            };
                                        };

                                    actual _ FindByName[wire];
                                    EXIT;
                                    };
                                rope: ROPE => MakeError[Rope.Cat["Actual with name '", rope, "' not found in internal"], name];
                                refText: REF TEXT => MakeError[Rope.Cat["Actual with name '", Rope.FromRefText[refText], "' not found in internal"], name];
                                ENDCASE => ERROR;
                            };
                        REPEAT FINISHED => {
                            FOR pNames: LIST OF ROPE _ CoreOps.GetFullWireNames[instance.type.public, public], pNames.rest UNTIL pNames=NIL DO
                                actual _ FindWire[internal, pNames.first];
                                IF actual#NIL THEN EXIT;
                                REPEAT FINISHED => {
                                    IF public.size=0 THEN ActualError[];
                                actual _ CoreOps.CreateWires[public.size];
                                FOR i: NAT IN [0 .. public.size) DO
                                actual[i] _ CreateActual[public[i]];
                                ENDLOOP;
                                    };
                                ENDLOOP;
                            };
                        ENDLOOP;
                    IF NOT HashTable.Insert[table: visitTab, key: public, value: actual] THEN ERROR;
                    };
                };

            instance: CellInstance _ instList.first;
            visitTab: HashTable.Table _ HashTable.Create[];  -- Wire to Wire
            pas: LIST OF PA _ NARROW[CoreProperties.GetCellInstanceProp[from: instance, prop: instanceBindProp]];
            FOR paList: LIST OF PA _ pas, paList.rest UNTIL paList=NIL DO
                pub: Wire _ FindWire[instance.type.public, paList.first.public];
                IF pub=NIL THEN {
                    names: LIST OF ROPE _ CoreOps.GetFullWireNames[instance.type.public, NARROW[paList.first.public]];
                    MakeError[Rope.Cat["Could not find public '", IF ISTYPE[paList.first.public, Wire] THEN IF names=NIL THEN "unknown" ELSE 
                    names.first ELSE CoreOps.FixStupidRef[paList.first.public], "'"], CoreOps.GetCellTypeName[instance.type]];
                    };
                paList.first.public _ pub;
                ENDLOOP;
            instance.actual _ CreateActual[instance.type.public];
            FOR i: NAT IN [0..instance.actual.size) DO
                IF NOT CoreOps.RecursiveMember[candidate: instance.actual[i], wire: internal] THEN
                    internal _ CoreOps.UnionWire[internal, CoreOps.CreateWire[LIST[instance.actual[i]]]];
                ENDLOOP;
            CoreProperties.PutCellInstanceProp[on: instance, prop: instanceBindProp, value: NIL];
            ENDLOOP;
        cellType _ CoreClasses.CreateRecordCell[public: public, internal: internal, instances: instances, name: name, props: props];
        };

    Transistor: PUBLIC PROC [type: TransistorType _ nE, length: NAT _ 2, width: NAT _ 4, name: ROPE _ NIL, props: Properties _ NIL] 
    RETURNS [cellType: CellType] = {
        cellType _ CoreClasses.CreateTransistor[
            args: [type: type, length: length, width: width],
            name: name, props: props
            ];
        };
        <<>>
    SequenceCell: PUBLIC PROC [baseCell: CellType, count: NAT, sequencePorts: Wire _ NIL, flatSequencePorts: Wire _ NIL, name: ROPE _ 
    NIL, props: Properties _ NIL] RETURNS [cellType: CellType] = {

        FindPorts: PROC [ports: Wire] RETURNS [set: CoreSequence.SequenceSet] = {
            IF ports#NIL THEN {
                set _ NEW[CoreSequence.SequenceSetRec[ports.size]];
                FOR i: INT IN [0..ports.size) DO
                    FOR w: NAT IN [0..baseCell.public.size) DO
                        sequenceName: ROPE _ CoreOps.GetShortWireName[ports[i]]; 
                        IF ports[i]=baseCell.public[w] OR (sequenceName#NIL AND Rope.Equal[sequenceName, CoreOps.GetShortWireName[ baseCell.public[w]]]) 
                        THEN {
                            set[i] _ w;
                            EXIT;
                            };
                        REPEAT FINISHED => ERROR;
                        ENDLOOP; 
                    ENDLOOP;
                };
            };

        seqCell: CoreSequence.SequenceCellType _ NEW [CoreSequence.SequenceCellTypeRec _ [
            base: baseCell,
            count: count,
            sequence: FindPorts[sequencePorts],
            flatSequence: FindPorts[flatSequencePorts]]];
        cellType _ CoreSequence.Create[args: seqCell, name: name, props: props];
        };

    FindWire: PUBLIC PROC [root: Wire, wr: WR] RETURNS [found: Wire _ NIL] = {

        WITH wr SELECT FROM
            wrwire: Wire     => IF CoreOps.RecursiveMember[candidate: wrwire, wire: root] THEN found _ wrwire;
            wrrope: ROPE     => found _ CoreOps.FindWire[root, wrrope];
            text: REF TEXT     => found _ CoreOps.FindWire[root, Rope.FromRefText[text]];
            ENDCASE => ERROR;
        };

    END.