
    <<SchematicExtractorImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Last Edited by: Jacobi, August 13, 1985 4:44:22 pm PDT>>
        <<Last Edited by: Jacobi, September 24, 1985 6:50:23 pm PDT>>
    <<Last Edited by: Jacobi, October 4, 1985 5:32:59 pm PDT>>

    DIRECTORY 
        AMBridge,
        AMTypes,
        Ascii,
        Atom,
        Core,
        CoreOps,
        CoreCreate,
        CD,
        CDBasics,
        CDCells,
        CDCommandOps,
        CDDirectory,
        CDExtras,
        CDImports,
        CDInstances,
        CDMenus,
        CDOps,
        CDOrient,
        CDPinObjects,
        CDProperties,
        CDSequencer,
        CDTexts,
        Interpreter,
        IO,
        RefTab,
        Rope,
        RuntimeError,
        SchematicExtractor,
        SymTab,
        TerminalIO,
        CDSil;

    SchematicExtractorImpl: CEDAR PROGRAM
        IMPORTS AMBridge, AMTypes, Ascii, Atom, Core, CoreOps, CoreCreate, CD, CDBasics, CDCells, CDCommandOps, CDDirectory, CDExtras, 
        CDImports, CDInstances, CDMenus, CDOps, CDOrient, CDPinObjects, CDProperties, CDSequencer, Interpreter, IO, RefTab, Rope, 
        RuntimeError, SymTab, TerminalIO, CDSil
        EXPORTS SchematicExtractor =
    BEGIN

    wireLayer: CD.Layer _ CDSil.xneutral;
    failCheck: ERROR = CODE;
    <<>>
    Failed: PROC [r: Rope.ROPE_NIL] =
        BEGIN
        TerminalIO.WriteRope[Rope.Cat["**failed: ", r, "\n"]];
        END;
    <<>>
    <<>>
    <<--electrical equipotential region, local to some hierarchical structure>>
    Node: TYPE = REF NodeRec;
    NodeRec: TYPE = RECORD [
        replaceMeBy: Node _ NIL,
        naming: Rope.ROPE _ NIL
        ];

    <<--point which causes connection to any wire touching the point>>
    Connect: TYPE = REF ConnectRec;
    ConnectRec: TYPE = RECORD [
        r: CD.Rect,
        node: Node
        ];

    SubCell: TYPE = REF SubCellRec;
    SubCellRec: TYPE = RECORD [
        inst: CD.Instance,
        bindings: LIST OF Binding_NIL
        ];

    <<--a binding must know implicitely which SubCell it binds>>
    Binding: TYPE = REF BindingRec;
    BindingRec: TYPE = RECORD [
        name: REF, --wire name
        node: Node
        ];


    State: TYPE = REF StateRec;
    StateRec: TYPE = RECORD [
        <<--permanent state>>
        design: CD.Design,
        lambda: CD.Number,
        coreDesign: Core.Design,
        cdToCore: RefTab.Ref, -- CD.Object => Core.CellType
        cdHandled: RefTab.Ref, --to prevent recursion
        numberForNaming: INT _ 0,
        <<--temporary state while analyzing ob>>
        ob: CD.Object _ NIL, 
        nodeByName: SymTab.Ref _ NIL,
        subCells: LIST OF SubCell _ NIL,
        connects: LIST OF Connect _ NIL,
        nodeTab: RefTab.Ref, --set up only after connects is finished
        numberOfInstances: INT _ 0
        ];


    MakeName: PROC [state: State, prefix: Rope.ROPE_NIL] RETURNS [name: Rope.ROPE] =
        BEGIN
        state.numberForNaming _ state.numberForNaming+1;
        IF prefix=NIL THEN prefix _ "NoName";
        name _ Name[IO.PutFR["%g%g", IO.rope[prefix], IO.int[state.numberForNaming]]];
        END;

    Ident: PROC  [proposed: Rope.ROPE_NIL] RETURNS [r: Rope.ROPE] =
        <<--given a rope, makes an identifier>>
        BEGIN
        Trans: Rope.TranslatorType =
            BEGIN
            IF Ascii.Letter[old] THEN new _ old
            ELSE IF Ascii.Digit[old] AND ~first THEN new _ old
            ELSE new _ 'x;
            first _ FALSE
            END;
        first: BOOL _ TRUE;
        r _ Rope.Translate[base: proposed, translator: Trans];
        IF Rope.IsEmpty[r] THEN r _ "x";
        END;

    Name: PROC [x: REF_NIL] RETURNS [name: Rope.ROPE] =
        BEGIN
        name _ Ident[CDExtras.ToRope[x]]
        END;

    IdentFromProp: PROC [what: REF, key: ATOM]  RETURNS [n: Rope.ROPE_NIL] =
        <<--or NIL>>
        BEGIN
        n _ CDExtras.ToRope[ CDProperties.GetProp[what, key] ];
        IF Rope.IsEmpty[n] THEN n _ NIL ELSE n _ Name[n]
        END;

    ResetState: PROC [state: State, ob: CD.Object _ NIL] =
        BEGIN
        state.connects _ NIL;
        state.subCells _ NIL;
        state.nodeTab _ RefTab.Create[];
        state.nodeByName _ SymTab.Create[];
        state.ob _ ob;
        state.numberOfInstances _ 0;
        END;

    NewState: PROC [design: CD.Design, coreDesign: Core.Design_NIL] RETURNS [state: State] =
        <<--and initializes the permanent variables>>
        BEGIN
        MyCoreCreateDesign: PROC [name: Rope.ROPE _ NIL] RETURNS [coreDesign: Core.Design] =
            BEGIN
            coreDesign _ CoreOps.CreateDesign[Name[name] ! Core.StructureError => RESUME];
            END;
        IF coreDesign=NIL THEN coreDesign _ MyCoreCreateDesign[];
        state _ NEW[StateRec _ [
            design: design,
            lambda: design.technology.lambda,
            coreDesign: coreDesign,
            cdToCore: RefTab.Create[],
            cdHandled: RefTab.Create[],
            numberForNaming: 0
            ]];
        ResetState[state];
        END;

    NewNode: PROC [] RETURNS [node: Node] =
        BEGIN
        node _ NEW[NodeRec];
        END;

    NewConnect: PROC [r: CD.Rect] RETURNS [connect: Connect] =
        BEGIN
        node: Node _ NewNode[];
        connect _ NEW[ConnectRec _ [r: r, node: node]];
        END;

    NewSubCell: PROC [state: State, inst: CD.Instance] RETURNS [subCell: SubCell] =
        BEGIN
        subCell _ NEW[SubCellRec_[inst: inst, bindings: NIL]];
        state.subCells _ CONS[subCell, state.subCells];
        END;

    RealNode: PROC [n: Node] RETURNS [use: Node] =
        BEGIN
        use _ n;
        IF use.replaceMeBy#NIL THEN {
            name: Rope.ROPE _ use.naming;
            WHILE use.replaceMeBy#NIL DO
                use _ use.replaceMeBy;
                IF use.naming#NIL THEN name _ use.naming; 
                ENDLOOP;
            use.naming _ name;
            WHILE n#use DO
                remember: Node _ n.replaceMeBy;
                n.replaceMeBy _ use;
                n _ remember;
                ENDLOOP;
            };
        END;


    Aequipotential: PROC [a, b: Connect] =
        BEGIN
        use: Node _ RealNode[b.node];
        other: Node _ RealNode[a.node];
        IF use#other THEN other.replaceMeBy _ use;
        a.node _ b.node _ use;
        END;

    IntroduceWire: PROC [state: State, inst: CD.Instance] =
        BEGIN
        r: CD.Rect _ CDInstances.InstRectI[inst];
        connect: Connect _ IncludeConnect[state, r];
        IF connect.node.naming=NIL THEN connect.node.naming _ IdentFromProp[inst, $SignalName];
        END;

    IncludeConnect: PROC[state: State, r: CD.Rect] RETURNS [connect: Connect] =
        BEGIN
        PseudoTouch: PROC [a, b: CD.Rect] RETURNS [BOOL] =
            <<--a, b must have common point>>
            INLINE BEGIN
            RETURN [
                a.x1=b.x1 OR a.x2=b.x2 OR --a.x1=b.x2 OR a.x2=b.x1 OR 
                a.y1=b.y1 OR a.y2=b.y2 --OR a.y1=b.y2 OR a.y2=b.y1 
                ]
            END;
        connect _ NewConnect[r];
        FOR cpl: LIST OF Connect _ state.connects, cpl.rest WHILE cpl#NIL DO
            IF CDBasics.Intersect[r, cpl.first.r] THEN {
                common: CD.Rect _ CDBasics.Intersection[r, cpl.first.r];
                sz: CD.Position _ CDBasics.SizeOfRect[common];
                IF sz.x<state.lambda OR sz.y<state.lambda OR PseudoTouch[r, cpl.first.r] OR CDBasics.Inside[r, cpl.first.r] OR 
                CDBasics.Inside[cpl.first.r, r] THEN Aequipotential[connect, cpl.first];
                <<--else this is a crossing whithout connection>>
                };
            ENDLOOP;
        state.connects _ CONS[connect, state.connects];
        END;

    RectDist: PROC [a, b: CD.Rect] RETURNS [n: CD.Number] =
        BEGIN
        w, h: CD.Number;
        IF a.x1>b.x1 THEN w _ a.x1-b.x2 ELSE w _ b.x1-a.x2;
        IF a.y1>b.y1 THEN h _ a.y1-b.y2 ELSE h _ b.y1-a.y2;
        n _ MAX[0, w, h];
        END;

    IntroduceName: PROC [state: State, inst: CD.Instance] =
        <<--should be called after all the connects are made...>>
        BEGIN
        tp: CDTexts.TextPtr _ NARROW[inst.ob.specificRef];
        name: Rope.ROPE _ Name[tp.text];
        minDist: CD.Number = 100;
        nameR: CD.Rect _ CDInstances.InstRectI[inst];
        use: Node _ NIL;
        min: INT _ minDist;
        IF ~Rope.Equal[name, tp.text] THEN
            Failed[Rope.Cat["name: ", tp.text, " replaced by ", name]];
        FOR cl: LIST OF Connect _ state.connects, cl.rest WHILE cl#NIL DO
            d: INT _ RectDist[nameR, cl.first.r];
            IF d<=min THEN {
                IF d<min THEN {
                    min _ d;
                    use _ cl.first.node _ RealNode[cl.first.node];
                    }
                ELSE --IF d=min THEN-- {
                    <<--don't know which node should get the name, if the nodes are really different>>
                    cl.first.node _ RealNode[cl.first.node];
                    IF use#cl.first.node THEN use _ NIL;
                    }
                }
            ENDLOOP;
        IF use#NIL THEN { 
            IF Rope.IsEmpty[use.naming] THEN use.naming _ name
            ELSE IF ~Rope.Equal[use.naming, name] THEN
                Failed[Rope.Cat["node has multiple names: ", name, " ", use.naming]]
            }
        ELSE Failed[Rope.Cat["did not find object to name ", name]]
        END;


    CheckPinsWithCore: PROC [state: State, ob: CD.Object, coreCell: Core.CellType] =
        <<--raises failCheck>>
        BEGIN
        ToBad: PROC [r: Rope.ROPE_NIL] =
            BEGIN
            Failed[Rope.Cat["in subcell ", CDDirectory.Name[ob], " ", r]]; 
            ERROR failCheck;
            END;
        EachPin: PROC [inst: CD.Instance] RETURNS [quit: BOOL_FALSE] =
            BEGIN
            name: Rope.ROPE _ Name[GetGates32ConnectName[inst]];
            <<--sorry right now only one pin per wire>>
            IF ~SymTab.Store[names, name, $occurs] THEN ToBad["multiple pins"];
            END;
        EachWire: CoreOps.EachWireProc =
            BEGIN
            IF wire#coreCell.publicWire THEN {
                wireCount _ wireCount+1;
                IF SymTab.Fetch[names, wire.name].val#$occurs THEN 
                    ToBad[Rope.Cat["wire ", wire.name, " has no corresponding pin"]];
                [] _ SymTab.Store[names, wire.name, $found];
                } 
            END;
        wireCount: INT _ 0;
        names: SymTab.Ref _ SymTab.Create[];
        IF coreCell.publicWire.structure#record THEN ToBad["wire not of record structure"];
        <<--build symtab with entry=pin name>>
        FOR rL: LIST OF Rope.ROPE _ GetRopeList[ob, $ConnectByName], rL.rest WHILE rL#NIL DO
            IF ~SymTab.Store[names, rL.first, $occurs] THEN ToBad["multiple pins"];
            ENDLOOP; 
        [] _ CDPinObjects.EnumeratePins[ob: ob, eachPin: EachPin];
        [] _ EnumerateGates32Connects[ob: ob, eachConnect: EachPin, lambda: state.lambda];
        <<--check if each wire is in symtab>>
        CoreOps.VisitWire[coreCell.publicWire, EachWire];
        IF wireCount#names.size THEN ToBad["wire number does not match"];
        END;

    CreateCoreCellType: PROC [coreDesign: Core.Design, name: Rope.ROPE] RETURNS [cellType: Core.CellType] =
        BEGIN
        use: Rope.ROPE _ Name[name];
        cellType _ CoreOps.FetchCellType[coreDesign, use];
        IF cellType#NIL THEN {
            WHILE cellType#NIL DO
                use _ Rope.Cat[use, "x"];
                cellType _ CoreOps.FetchCellType[coreDesign, use];
                ENDLOOP;
            Failed[Rope.Cat["CellType ", Name[name], " already exists; name modified to ", use]];
            };
        cellType _ CoreCreate.CreateRecordCell[design: coreDesign, name: use];
        END;

GetGates32ConnectName: PROC [connInst: CD.Instance] RETURNS [r: Rope.ROPE _ NIL] =
BEGIN
IF CDPinObjects.IsPinOb[connInst.ob] THEN r _ CDPinObjects.GetName[connInst]
ELSE IF IsGates32Connector[connInst.ob]#none THEN {
WITH CDProperties.GetPropFromInstance[connInst, gates32PinProp] SELECT FROM
n: Rope.ROPE => r _ n
ENDCASE => NULL
}
END;

    CreateCoreCellUsingPins: PROC [state: State, ob: CD.Object] RETURNS [coreCell: Core.CellType] = 
        <<--creates a Core CellType with the public wire corresponding to ob's pins>>
        BEGIN
        EachPin: PROC [inst: CD.Instance] RETURNS [quit: BOOL_FALSE] =
            BEGIN
            name: Rope.ROPE _ Name[GetGates32ConnectName[inst]];
            [] _ CoreCreate.CreatePublicWire[design: state.coreDesign, on: coreCell, name: name];
            END;
        name: Rope.ROPE _ Name[Rope.Cat[CDDirectory.Name[ob], "Substitute"]];
        coreCell _ CreateCoreCellType[coreDesign: state.coreDesign, name: name]; 
        [] _ CDPinObjects.EnumeratePins[ob: ob, eachPin: EachPin];
        [] _ EnumerateGates32Connects[ob, EachPin, state.lambda];
        END;

Side: TYPE = {bottom, right, top, left, none};
gates32PinProp: ATOM _ $SignalName;

IsGates32Connector: PROC [ob: CD.Object] RETURNS [side: Side _ none] =
BEGIN
WITH ob.specificRef SELECT FROM
tp: CDTexts.TextPtr => 
IF Rope.Equal[tp.cdFont.supposedName, "Xerox/TiogaFonts/Gates32", FALSE] THEN {
SELECT TRUE FROM
Rope.Equal[tp.text, "Q"] => side _ top;
Rope.Equal[tp.text, "R"] => side _ left;
Rope.Equal[tp.text, "S"] => side _ bottom;
Rope.Equal[tp.text, "T"] => side _ right;
ENDCASE => NULL; 
}
ENDCASE => NULL; 
END;

Gates32ConnectorRect: PROC [side: Side, lambda: CD.Number] RETURNS [CD.Rect] =
BEGIN
RETURN [SELECT side FROM
bottom => [x1: lambda, y1: 28*lambda, x2: 2*lambda, y2: 30*lambda],
left => [x1: 0, y1: 27*lambda, x2: 2*lambda, y2: 28*lambda],
top => [x1: lambda, y1: 30*lambda, x2: 2*lambda, y2: 32*lambda],
right => [x1: 2*lambda, y1: 27*lambda, x2: 4*lambda, y2: 28*lambda],
ENDCASE => CDBasics.empty]
END;

    EnumerateGates32Connects: PROC [ob: CD.Object_NIL, eachConnect: CDPinObjects.InstanceEnumerator, lambda: CD.Number] RETURNS [quit: 
    BOOL_FALSE] =
    BEGIN
    makeNames: BOOL _ FALSE;
    cp: CD.CellPtr;

    Text: PROC [ob: CD.Object] RETURNS [r: Rope.ROPE_NIL] = 
    BEGIN
    WITH ob.specificRef SELECT FROM
    tp: CDTexts.TextPtr => r _ tp.text
    ENDCASE => NULL; 
    END;

    IsHelvetica7: PROC [ob: CD.Object] RETURNS [yes: BOOL_FALSE] = 
    BEGIN
    WITH ob.specificRef SELECT FROM
    tp: CDTexts.TextPtr => 
    yes _ Rope.Equal[tp.cdFont.supposedName, "Xerox/TiogaFonts/Helvetica7", FALSE]
    ENDCASE => NULL; 
    END;

    FindnameFor: PROC [inst: CD.Instance, lambda: CD.Number] = 
    <<--inst must be connector>>
    <<--uses global variables cp for context of inst>>
    BEGIN
    name: Rope.ROPE _ NIL;
    dist: CD.Number _ LAST[INTEGER];
    cRect: CD.Rect;
    WITH CDProperties.GetPropFromInstance[inst, gates32PinProp] SELECT FROM
    r: Rope.ROPE => IF ~Rope.IsEmpty[r] THEN RETURN;
    ENDCASE => NULL; 
    cRect _ CDOrient.MapRect[ --connector Rect
    itemInCell: Gates32ConnectorRect[IsGates32Connector[inst.ob], lambda],
    cellSize: inst.ob.size,
    cellInstOrient: inst.orientation,
    cellInstPos: inst.location];
    FOR list: CD.InstanceList _ cp.contents, list.rest WHILE list#NIL DO
    IF IsHelvetica7[list.first.ob] THEN {
    d: CD.Number;
    tRect: CD.Rect _ CD.InterestRect[list.first.ob]; --text Rect
    tRect.y2 _ (tRect.y1+tRect.y2)/2; --shrink it to have less texts
    tRect.y1 _ tRect.y2-1;
    tRect _ CDOrient.MapRect[
    itemInCell: tRect,
    cellSize: list.first.ob.size, 
    cellInstOrient: list.first.orientation,
    cellInstPos: list.first.location
    ];
    d _ RectDist[cRect, tRect];
    IF d<dist THEN {
    name _ Text[list.first.ob];
    dist _ d;
    }
    };
    ENDLOOP;
    IF name#NIL THEN CDProperties.PutPropOnInstance[inst, gates32PinProp, name];
    END;

    WITH ob.specificRef SELECT FROM
    c: CD.CellPtr => cp _ c;
    ip: CDImports.ImportPtr => { -- HACKK until imports handle pins reasonably
    IF ip.boundInstance=NIL THEN RETURN [TRUE];
    quit _ EnumerateGates32Connects[ip.boundInstance.ob, eachConnect, lambda];
    RETURN
    };
    ENDCASE => RETURN [TRUE];
    makeNames _ CDProperties.GetPropFromObject[ob, gates32PinProp]#$ok; 
    FOR list: CD.InstanceList _ cp.contents, list.rest WHILE (list#NIL AND ~quit) DO
    IF IsGates32Connector[list.first.ob]#none THEN {
    IF makeNames THEN FindnameFor[list.first, lambda];
    quit _ eachConnect[list.first]; -- do NOT catch errors
    };
    ENDLOOP;
    IF ~quit AND makeNames THEN
    CDProperties.PutPropOnObject[ob, gates32PinProp, $ok];
    END;

    RopePair: TYPE = RECORD [r1, r2: Rope.ROPE];
    ScanRopePair: PROC [r: Rope.ROPE] RETURNS [p: RopePair _ [NIL, NIL]] =
        <<--given a rope, splits it into the first identifier r1 and the remainder r2>>
        BEGIN
        s: IO.STREAM _ IO.RIS[r];
        p.r1 _ IO.GetID[s ! IO.EndOfStream, IO.Error => GOTO ioErr];
        p.r2 _ IO.GetLineRope[s ! IO.EndOfStream, IO.Error => GOTO ioErr];
        EXITS ioErr => NULL;
        END;

    GetRopeList: PROC [ob: CD.Object, key: ATOM] RETURNS [rList: LIST OF Rope.ROPE_NIL] =
        <<--gets a list of identifiers hanging on ob's key property >>
        BEGIN
        r: Rope.ROPE _ IdentFromProp[ob, key];
        WHILE ~Rope.IsEmpty[r] DO
            p: RopePair _ ScanRopePair[r];
            IF Rope.IsEmpty[p.r1] THEN Failed["bad rope list"]
            ELSE {
                rList _ CONS[p.r1, rList];
                r _ p.r2;
                }
            ENDLOOP
        END;

    FindOrCreateCoreCell: PROC [state: State, ob: CD.Object] RETURNS [coreCell: Core.CellType_NIL] = 
        --XXX should use instance instead of object, Core and ChipNDale are not parallel here
        BEGIN

        Problem: PROC [r: Rope.ROPE] =
            BEGIN
            TerminalIO.WriteRope[Rope.Cat["Core description for ", obName, ": ", r, "\n"]];
            END;

        EvalToCore: PROC [state: State, ob: CD.Object, r: Rope.ROPE] RETURNS [coreCell: Core.CellType_NIL] =
            BEGIN
            errorRope: Rope.ROPE;
            noResult: BOOL;
            tv: AMTypes.TV _ NIL;
            symTab: SymTab.Ref _ SymTab.Create[];
            SetTV: PROC [name: Rope.ROPE, ref: REF] = TRUSTED {
                refRef: REF REF _ NEW[REF _ ref];
                [] _ SymTab.Store[symTab, name, AMBridge.TVForReferent[refRef]];
                };
            TerminalIO.WriteRope[Rope.Cat["Feeds """, r, """ to the interpreter\n"]];
            SetTV["&design", state.design];
            SetTV["&coreDesign", state.coreDesign];
            SetTV["&ob", ob];
            BEGIN
                ENABLE {
                    UNWIND => GOTO iUnwind;
                    RuntimeError.UNCAUGHT => {
                        TerminalIO.WriteRope["** some while error interpreting; abort to free lock on design\n"];
                        REJECT
                        };
                    };
                [tv, errorRope, noResult] _ Interpreter.Evaluate[rope: r, symTab: symTab];
                END;
            IF noResult OR tv=NIL OR ~Rope.IsEmpty[errorRope] THEN {
                Problem[Rope.Cat[" has bad interpretation: ", errorRope]];
                RETURN
                };
            IF AMTypes.UnderClass[AMTypes.TVType[tv]]=ref THEN TRUSTED { 
                WITH AMBridge.SomeRefFromTV[tv] SELECT FROM
                    c: REF REF Core.CellType => {coreCell _ c^^};
                    c: REF Core.CellType => {coreCell _ c^};
                    c: Core.CellType => {coreCell _ c};
                    ENDCASE => Problem[" interpreter returns wrong type"]; 
                }
            ELSE Problem[" interpreter returns wrong type class"];
            EXITS iUnwind => TerminalIO.WriteRope["** UNWIND\n"];
            END;

        IncludeEvalToCore: PROC [state: State, ob: CD.Object, r: Rope.ROPE] RETURNS [coreCell: Core.CellType_NIL] =
            BEGIN
            coreCell _ EvalToCore[state, ob, r];
            IF coreCell#NIL THEN { 
                ct: Core.CellType _ CoreOps.FetchCellType[state.coreDesign, coreCell.name];
                IF ct#coreCell THEN
                    CoreOps.InsertCellType[state.coreDesign, coreCell ! Core.StructureError=> {
                        Problem[Rope.Cat[" cell with duplicate name """, coreCell.name, """ included"]];
                        RESUME
                        }];
                };
            END;

        obName: Rope.ROPE _ Name[CDDirectory.Name[ob]];
        WITH RefTab.Fetch[state.cdToCore, ob].val SELECT FROM
            coreCt: Core.CellType => RETURN [coreCt];
            ENDCASE => {
                x: REF _ CDProperties.GetPropFromObject[ob, $Represents];
                IF x=NIL THEN { 
                    IF CDImports.IsImport[ob] THEN {
                        rp: CDImports.ImportPtr _ NARROW[ob.specificRef];
                        IF rp.boundInstance#NIL THEN {
                            coreCell _ FindOrCreateCoreCell[state, rp.boundInstance.ob];
                            [] _ RefTab.Store[state.cdToCore, ob, coreCell];
                            RETURN
                            }
                        };
                    Problem[" object has no $Represents property"];
                    coreCell _ CoreOps.FetchCellType[state.coreDesign, obName];
                    }
                ELSE WITH x SELECT FROM
                    r: Rope.ROPE => {
                        rp: RopePair _ ScanRopePair[r];
                        SELECT TRUE FROM
                            Rope.Equal[rp.r1, "interpret", FALSE] => {
                                IF Rope.IsEmpty[rp.r2] THEN Problem[" empty call"]
                                ELSE coreCell _ IncludeEvalToCore[state, ob, rp.r2];
                                };
                            Rope.Equal[rp.r1, "fetch", FALSE] => {
                                IF Rope.IsEmpty[rp.r2] THEN Problem[" empty call"]
                                ELSE coreCell _ CoreOps.FetchCellType[state.coreDesign, Name[rp.r2]];
                                };
                            Rope.Equal[rp.r1, "extract", FALSE] => {
                                IF Rope.IsEmpty[rp.r2] THEN coreCell _ FindRecursive[state, ob]
                                ELSE coreCell _ RecursiveCall[state, rp.r2];
                                };
                            ENDCASE => {
                                Problem[" key is unknown"];
                                };
                        };
                    ENDCASE => Problem[" key has bad type"];
                IF coreCell=NIL THEN Problem[" not found"] 
                ELSE {
                    CheckPinsWithCore[state, ob, coreCell ! failCheck => {coreCell_NIL; CONTINUE}];
                    IF coreCell=NIL THEN Problem[" not valid"];
                    };
                IF coreCell=NIL THEN coreCell _ CreateCoreCellUsingPins[state, ob];
                [] _ RefTab.Store[state.cdToCore, ob, coreCell];
                };
        END;

    FindRecursive: PROC [state: State, ob: CD.Object] RETURNS [coreCell: Core.CellType_NIL] =
        BEGIN
        EachEntry: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL_FALSE] = {
            IF ob.class.inDirectory THEN {
                IF Rope.Equal[IdentFromProp[ob, $Implements], iconName] THEN {
                    IF state.cdHandled.Insert[ob, $x] THEN {
                        DoExtraction[state, ob];
                        WITH RefTab.Fetch[state.cdToCore, ob].val SELECT FROM
                            coreCt: Core.CellType => coreCell _ coreCt;
                            ENDCASE => Failed[Rope.Cat["extraction of ", iconName, " failed"]];
                        }
                    ELSE Failed[Rope.Cat[CDDirectory.Name[ob], " introduces recursion"]];
                    quit _ TRUE;
                    }
                }
            };
        iconName: Rope.ROPE _ Name[CDDirectory.Name[ob]];
        IF ~CDDirectory.Enumerate[design: state.design, action: EachEntry].quit THEN 
            Failed[Rope.Cat["no object claims to implement ", iconName]];
        END;

    RecursiveCall: PROC [state: State, name: Rope.ROPE] RETURNS [coreCell: Core.CellType_NIL] =
        BEGIN
        ob: CD.Object _ CDDirectory.Fetch[state.design, name].object;
        IF ob=NIL THEN Failed[Rope.Cat[name, " not found"]]
        ELSE IF state.cdHandled.Insert[ob, $x] THEN {
            DoExtraction[state, ob];
            WITH RefTab.Fetch[state.cdToCore, ob].val SELECT FROM
                coreCt: Core.CellType => RETURN [coreCt];
                ENDCASE => Failed[Rope.Cat["extraction of ", name, " failed"]];
            }
        ELSE Failed[Rope.Cat[name, " introduces recursion"]];
        END;

    IncludeBinding: PROC [subCell: SubCell, nameInSubCell: REF, node: Node] =
        <<--nameInSubCell: formal wire/pin name in subCell>>
        <<--node: actual node>>
        BEGIN
        binding: Binding;
        name: Rope.ROPE _ Name[nameInSubCell];
        FOR bl: LIST OF Binding _ subCell.bindings, bl.rest WHILE bl#NIL DO
            IF Rope.Equal[Name[bl.first.name], name] THEN {
                IF RealNode[node]=RealNode[bl.first.node] THEN RETURN;
                Failed[Rope.Cat["pin ", name, " in subcell ", CDDirectory.Name[subCell.inst.ob], 
                "connected to different nodes"]];
                };
            ENDLOOP;
        binding _ NEW[BindingRec _ [name: nameInSubCell, node: node]];
        subCell.bindings _ CONS[binding, subCell.bindings];
        END;

    IntroduceSubcircuit: PROC [state: State, subInst: CD.Instance] =
        BEGIN
        EachPin: PROC [inst: CD.Instance] RETURNS [quit: BOOL_FALSE] =
            BEGIN
            pinName: Rope.ROPE _ Name[GetGates32ConnectName[inst]];
            connect: Connect;
            r: CD.Rect;         -- connecting rect in coords of inst 
            globalR: CD.Rect;    -- connecting rect in coords containing cell
        IF CDPinObjects.IsPinOb[inst.ob] THEN r _ CDInstances.InstRectI[inst]
        ELSE r _ CDOrient.MapRect[ --connector Rect
        itemInCell: Gates32ConnectorRect[IsGates32Connector[inst.ob], state.lambda],
        cellSize: inst.ob.size,
        cellInstOrient: inst.orientation,
        cellInstPos: inst.location];
            globalR _ CDOrient.MapRect[
                itemInCell: r,
                cellSize: subInst.ob.size,
                cellInstOrient: subInst.orientation,
                cellInstPos: subInst.location
                ];
            connect _ IncludeConnect[state, globalR];
            IncludeBinding[subCell, pinName, connect.node];
            END;
        coreCell: Core.CellType _ FindOrCreateCoreCell[state, subInst.ob];
        subCell: SubCell _ NewSubCell[state, subInst];
        [] _ CDPinObjects.EnumeratePins[ob: subInst.ob, eachPin: EachPin];
        [] _ EnumerateGates32Connects[ob: subInst.ob, eachConnect: EachPin, lambda: state.lambda];
        END;

    BuildNodeTable: PROC [state: State] =
        <<--[builds state.nodeTab] assume the state.connects already built up completely>>
        BEGIN
        CleanupSubCell: PROC [subCell: SubCell] = {
            FOR b: LIST OF Binding _ subCell.bindings, b.rest WHILE b#NIL DO
                b.first.node _ RealNode[b.first.node];
                ENDLOOP;
            };
        CleanupBindings: PROC [state: State] = {
            FOR s: LIST OF SubCell _ state.subCells, s.rest WHILE s#NIL DO
                CleanupSubCell[s.first];
                ENDLOOP;
            };
        CleanupBindings[state];
        state.nodeTab _ RefTab.Create[state.numberOfInstances];
        FOR c: LIST OF Connect _ state.connects, c.rest WHILE c#NIL DO
            c.first.node _ RealNode[c.first.node];
            [] _ RefTab.Insert[state.nodeTab, c.first.node, $Internal];
            ENDLOOP;
        END;

    MakeNodePublic: PROC [state: State, inst: CD.Instance] =
        BEGIN
        name: Rope.ROPE _ Name[CDPinObjects.GetName[inst]];
        r: CD.Rect _ CDInstances.InstRectI[inst];
        FOR c: LIST OF Connect _ state.connects, c.rest WHILE c#NIL DO
            IF CDBasics.Intersect[r, c.first.r] THEN {
                [] _ RefTab.Store[state.nodeTab, c.first.node, $Public];
                IF c.first.node.naming=NIL THEN c.first.node.naming _ name;
                };
            ENDLOOP;
        END;

    FinishCore: PROC [state: State] =
        <<--finish the Core representation by using the internal data structures from state>>
        BEGIN

        EachNode: RefTab.EachPairAction =
            BEGIN
            node: Node _ NARROW[key];
            name: Rope.ROPE _ node.naming;
            IF Rope.IsEmpty[name] THEN name _ node.naming _ MakeName[state, "node"];
            [] _ SymTab.Store[state.nodeByName, name, node];
            IF val=$Public THEN
                [] _ CoreCreate.CreatePublicWire[design: state.coreDesign, on: coreCell, name: name]
            ELSE 
                [] _ CoreCreate.CreateWire[design: state.coreDesign, in: coreCell, name: name];
            quit _ FALSE;
            END;

        EachConnectByNameNode: SymTab.EachPairAction =
            BEGIN
            IF val=$noWireFoundYet THEN
                [] _ CoreCreate.CreateWire[design: state.coreDesign, in: coreCell, name: key];
            quit _ FALSE;
            END;

        coreCell: Core.CellType;
        name: Rope.ROPE;
        <<--create Core cellType>>
        name _ IdentFromProp[state.ob, $Implements];
        IF name=NIL THEN name _ Name[CDDirectory.Name[state.ob]];
        coreCell _ CreateCoreCellType[coreDesign: state.coreDesign, name: name]; 
        <<--introduce nodes>>
        [] _ RefTab.Pairs[state.nodeTab, EachNode];
        [] _ SymTab.Pairs[state.nodeByName, EachConnectByNameNode];
        <<--introduce instances>>
        FOR s: LIST OF SubCell _ state.subCells, s.rest WHILE s#NIL DO
            coreBind: Rope.ROPE _ NIL;
            coreInstCellType: Core.CellType _ FindOrCreateCoreCell[state, s.first.inst.ob];
            AddBinding: PROC [formal, actual: Rope.ROPE] = {
                <<--adds a binding to the rope coreBind>>
                IF coreBind#NIL THEN coreBind _ Rope.Concat[coreBind, ", "];
                coreBind _ Rope.Cat[coreBind, formal, ": ", actual];
                };
            <<--bindings with nodes found in drawing>>
            FOR b: LIST OF Binding _ s.first.bindings, b.rest WHILE b#NIL DO
                AddBinding[Name[b.first.name], b.first.node.naming];
                ENDLOOP;
            <<--bindings found through properties>>
            FOR rL: LIST OF Rope.ROPE _ GetRopeList[s.first.inst.ob, $ConnectByName], rL.rest WHILE rL#NIL DO
                name: Rope.ROPE;
                IF SymTab.Fetch[state.nodeByName, rL.first].found THEN name _ rL.first
                ELSE {
                    name _ MakeName[state, "IllegalNode"];
                    Failed[Rope.Cat["don't know where to connect ", rL.first, " from ", CDDirectory.Name[s.first.inst.ob]]];
                    [] _ CoreCreate.CreateWire[design: state.coreDesign, in: coreCell, name: name];
                    };
                AddBinding[rL.first, name];
                ENDLOOP;
            [] _ CoreCreate.CreateCellInstance[design: state.coreDesign, 
                type: coreInstCellType, 
                in: coreCell, 
                bind: coreBind, 
                name: IdentFromProp[s.first.inst, $InstanceName]
                ! CoreCreate.CreateError => {
                    Failed[Rope.Cat["while creating instance: ", message]];
                    CONTINUE
                    }
                ];
            ENDLOOP;
        [] _ RefTab.Store[state.cdToCore, state.ob, coreCell];
        END;

    GuaranteeChildren: PROC [state: State, ob: CD.Object] =
        <<--Makes sure all children are extracted.>>
        <<--We extract the children first, before we build the data structure to extract ob:>>
        <<--therefor, only the data structure for one extraction requires memory anytime>>
        BEGIN
        GuaranteeOneChild: PROC [me: CD.Object, x: REF] = {
            IF me.class.inDirectory THEN {
                IF CDImports.IsImport[me] THEN {
                    rp: CDImports.ImportPtr _ NARROW[me.specificRef];
                    IF rp.boundInstance=NIL THEN {
                        Failed[Rope.Cat[CDOps.Info[me], " not bound"]];
                        RETURN
                        }
                    ELSE me _ rp.boundInstance.ob 
                    };
                IF IdentFromProp[me, $Implements]#NIL THEN {
                    Failed[Rope.Cat[CDDirectory.Name[me], " is implementing ", IdentFromProp[me, $Implements], " but is used as icon"]];
                    }
                ELSE
                    WITH RefTab.Fetch[state.cdToCore, me].val SELECT FROM
                        coreCt: Core.CellType => RETURN;
                        ENDCASE => [] _ FindOrCreateCoreCell[state, me];
                }
            };
        CDDirectory.EnumerateChildObjects[me: ob, p: GuaranteeOneChild, x: state]
        END;

    DoExtraction: PROC [state: State, ob: CD.Object] =
        <<--main procedure to do the extraction>>
        <<--assumes state set up>>
        BEGIN
        ob1: CD.Object _ ob;
        cellPtr: CD.CellPtr;
        IF IdentFromProp[ob, $Implements]=NIL THEN TerminalIO.WriteRope[Rope.Cat["Warning: ", CDDirectory.Name[ob], " has no $Implements 
        property\n"]];
        <<--extract children before data structure gets big>>
        GuaranteeChildren[state, ob];
        <<--start extraction; knows only jow to deal with cells>>
        ResetState[state, ob];
        WHILE ~CDCells.IsCell[ob1] DO
            ob2: CD.Object _ CDDirectory.ExpandHard[ob1, IF ob=ob1 THEN state.design ELSE NIL, NIL];
            IF ob2#NIL AND ob2#ob1 THEN ob1 _ ob2
            ELSE {
                Failed[Rope.Cat["Can not extract ", CDOps.Info[ob], "; has wrong object class"]]; 
            RETURN
                }
            ENDLOOP;
        cellPtr _ NARROW[ob1.specificRef];
        <<--find nodes to be connected by name>>
        FOR rL: LIST OF Rope.ROPE _ GetRopeList[ob, $ConnectByName], rL.rest WHILE rL#NIL DO
            [] _ SymTab.Store[state.nodeByName, rL.first, $noWireFoundYet];
            ENDLOOP; 
        <<--introduce wires and subcircuits; test for unknown object classes>>
        FOR list: CD.InstanceList _ cellPtr.contents, list.rest WHILE list#NIL DO
            state.numberOfInstances _ state.numberOfInstances+1;
            SELECT TRUE FROM
                list.first.ob.class.wireTyped AND list.first.ob.layer=wireLayer => 
                    IntroduceWire[state, list.first];
                list.first.ob.class.inDirectory => IntroduceSubcircuit[state, list.first];
                ISTYPE[list.first.ob.specificRef, CDTexts.TextPtr] => NULL;
                CDPinObjects.IsPinApp[list.first] => NULL;
                ENDCASE => Failed[Rope.Cat["dont know what to do with ", CDOps.Info[list.first.ob]]];
            ENDLOOP;
        <<--recognize nodes and then find out which are public>>
        BuildNodeTable[state];
        FOR list: CD.InstanceList _ cellPtr.contents, list.rest WHILE list#NIL DO
            IF CDPinObjects.IsPinApp[list.first] THEN {
                MakeNodePublic[state, list.first]
                }
            ENDLOOP;
        <<--handle names>>
        FOR list: CD.InstanceList _ cellPtr.contents, list.rest WHILE list#NIL DO
            IF ISTYPE[list.first.ob.specificRef, CDTexts.TextPtr] THEN {
                IntroduceName[state, list.first]
                }
            ENDLOOP;
        <<--finish the Core structure>>
        FinishCore[state];
        END;


    CoreOutput: PROC [state: State] =
        <<--prints the Core design onto Terminal>>
        BEGIN
        out: IO.STREAM _ IO.ROS[];
        text: Rope.ROPE;
        CoreOps.PrintDesign[state.coreDesign, out];
        text _ IO.RopeFromROS[out];
        TerminalIO.WriteRope["--start Core output\n"];
        TerminalIO.WriteRope[text];
        TerminalIO.WriteLn[]; 
        TerminalIO.WriteRope["--end Core output\n"];
        END;

    Extract: PUBLIC PROC [design: CD.Design, what: REF_NIL, into: Core.Design, mode: REF_NIL] =
        BEGIN
        state: State;
        ob: CD.Object;
        WITH what SELECT FROM
            o: CD.Object => ob_o;
            i: CD.Instance => ob_i.ob;
            ENDCASE => ERROR;
        IF ~CDCells.IsCell[ob] THEN ERROR;
        state _ NewState[design, into];
        DoExtraction[state, ob];
        <<--output and test output>>
            Atom.PutProp[atom: $CoreFromCD, prop: $CoreFromCD, val: state.coreDesign];
            IF mode=$output THEN CoreOutput[state];
        ResetState[state]; --help the garbage collector
        END;

    ChipNSilExtractCommand: PROC [comm: CDSequencer.Command] =
        BEGIN
        inst: CD.Instance _ CDCommandOps.TheInstance[comm, "ChipNSil Circuit Extractor"];
        IF inst#NIL THEN {
            IF CDCells.IsCell[inst.ob] THEN {
                coreDesign: Core.Design _ NIL;
                IF comm.a=$TChipNSilExtract THEN 
                    coreDesign _ NARROW[Atom.GetProp[$CoreFromCD, $CoreFromCD]];
                Extract[design: comm.design, what: inst.ob, mode: $output, into: coreDesign];
                TerminalIO.WriteRope["end CSE\n"]; 
                }
            ELSE TerminalIO.WriteRope["ChipNSil Circuit Extractor can extract only cells\n"]; 
            }
        END;

    CDSequencer.ImplementCommand[a: $ChipNSilExtract, p: ChipNSilExtractCommand, queue: doQueue];
    CDSequencer.ImplementCommand[a: $TChipNSilExtract, p: ChipNSilExtractCommand, queue: doQueue];
    CDMenus.CreateEntry[menu: $ProgramMenu, entry: "ChipNSil Extraction", key: $ChipNSilExtract];
    CDMenus.CreateEntry[menu: $ProgramMenu, entry: "TEST X", key: $TChipNSilExtract];
    END.