
    <<CoreGeometryImpl.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Created by Bertrand Serlet, August 6, 1986 0:38:23 am PDT>>
        <<Bertrand Serlet December 7, 1986 3:58:58 pm PST>>
    <<>>
    DIRECTORY
        Basics, 
        CD, CDAtomicObjects, CDBasics, CDCells, CDDirectory, CDInstances, CDLayers, CDOrient, CDProperties, CDRects, CDSymbolicObjects, 
        CDTexts, 
        Convert, 
    CoreClasses, CoreFlat, CoreOps, CoreProperties,
        CoreGeometry,
        GList, HashTable,
        Rope;

    CoreGeometryImpl: CEDAR PROGRAM
        IMPORTS Basics, CD, CDAtomicObjects, CDBasics, CDCells, CDDirectory, CDInstances, CDLayers, CDOrient, CDProperties, CDRects, 
        CDSymbolicObjects, CDTexts, Convert, CoreClasses, CoreFlat, CoreOps, CoreProperties, GList, HashTable, Rope
        EXPORTS CoreGeometry
        SHARES CDRects ~ BEGIN OPEN CoreGeometry;
<<Creating Decoration>>
    CreateDecoration: PUBLIC PROC [name: ROPE] RETURNS [decoration: Decoration] ~ {
        irProp: ATOM = CoreProperties.RegisterProperty[
            Convert.AtomFromRope[Rope.Cat[name, "IR"]], 
            CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]
            ];
        pinsProp: ATOM = CoreProperties.RegisterProperty[
            Convert.AtomFromRope[Rope.Cat[name, "Pins"]], 
            CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]
            ];
        geometryProp: ATOM = CoreProperties.RegisterProperty[
            Convert.AtomFromRope[Rope.Cat[name, "Geometry"]], 
            CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]
            ];
        transfProp: ATOM = CoreProperties.RegisterProperty[
            Convert.AtomFromRope[Rope.Cat[name, "Transf"]], 
            CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]
            ];
        decoration _ NEW [DecorationRec _ [
            name: name, 
            irProp: irProp, pinsProp: pinsProp, geometryProp: geometryProp, transfProp: transfProp
            ]];
        };
<<InterestRect>>
    HasIR: PUBLIC PROC [decoration: Decoration, cellType: CellType] RETURNS [BOOL] = {
        RETURN [CoreProperties.GetCellTypeProp[cellType, decoration.irProp]#NIL]
        };

    GetIR: PUBLIC PROC [decoration: Decoration, cellType: CellType] RETURNS [ir: Rect] = {
        refRect: REF Rect _ NARROW [CoreProperties.GetCellTypeProp[cellType, decoration.irProp]];
        ir _ refRect^;
        };
        <<>>
    PutIR: PUBLIC PROC [decoration: Decoration, cellType: CellType, ir: Rect] = {
        CoreProperties.PutCellTypeProp[cellType, decoration.irProp, NEW [Rect _ ir]];
        };
<<Pins>>
    expandPinsCount: INT = 2;
    maxLazyPins: INT = 100;
    clippedRatio: INT = 100000;

    TransfWireIR: TYPE = REF TransfWireIRRec;
    TransfWireIRRec: TYPE = RECORD [transf: Instance, wire: Wire, ir: Rect];

    InstanceSeq: TYPE = REF InstanceSeqRec;
    InstanceSeqRec: TYPE = RECORD [instances: SEQUENCE size: NAT OF Instance];

    <<This internal PROC is used to replace lazy pins by the physical instances.>>
    ExpandPins: PRIVATE PROC [decoration: Decoration, public: Wire, count: NAT] = {
    index: NAT _ 0;
    pins: InstanceSeq _ NEW [InstanceSeqRec[count]];
    ConsEachPin: EachInstanceProc = {pins[index] _ instance; index _ index + 1};
        WITH CoreProperties.GetWireProp[public, decoration.pinsProp] SELECT FROM
        wire: Wire                => [] _ EnumeratePins[decoration, wire, ConsEachPin];
        wires: LIST OF Wire        => WHILE wires#NIL DO 
        [] _ EnumeratePins[decoration, wires.first, ConsEachPin]; wires _ wires.rest;
        ENDLOOP;
        transfWireIR: TransfWireIR    => {
        ConsTransfEachPin: EachInstanceProc = {
            IF TransfedNotAtEdge[transfWireIR.transf, transfWireIR.ir, instance] THEN RETURN;
        pins[index] _ Transform[transfWireIR.transf, instance]; index _ index + 1;
            };
        [] _ EnumeratePins[decoration, transfWireIR.wire, ConsTransfEachPin];
        };
        recordCell: CellType    => {
        recData: CoreClasses.RecordCellType = NARROW [recordCell.data];
        ir: Rect = GetIR[decoration, recordCell];
        FOR i: NAT IN [0 .. recData.size) DO
        cellInstance: CoreClasses.CellInstance = recData[i];
        transf: CD.Instance = GetTransf[decoration, cellInstance];
        ConsTransfClipEachPin: EachInstanceProc = {
            IF TransfedNotAtEdge[transf, ir, instance] THEN RETURN;
        pins[index] _ Transform[transf, instance]; index _ index + 1;
            };
        EachBind: CoreOps.EachWirePairProc = {
        IF actualWire#public THEN RETURN;
        [] _ EnumeratePins[decoration, publicWire, ConsTransfClipEachPin];
        };
        [] _ CoreOps.VisitBindingSeq[cellInstance.actual, cellInstance.type.public, EachBind];
        ENDLOOP;
        };
        refProc: REF LazyPinsEnumerateProc    => [] _ refProc^[decoration, public, ConsEachPin];
            ENDCASE    => ERROR; -- decoration unknown to this module.  Pins were probably created without using the procedural interface.
        IF index#count THEN ERROR;
        CoreProperties.PutWireProp[public, decoration.pinsProp, SELECT count FROM 0 => NIL, 1 => pins[0], ENDCASE => pins];
        };

    EnumeratePins: PUBLIC PROC [decoration: Decoration, public: Wire, eachInstance: EachInstanceProc] RETURNS [quit: BOOL] = {
        value: REF _ CoreProperties.GetWireProp[public, decoration.pinsProp];
        IF value=NIL THEN RETURN [FALSE];
        WITH value SELECT FROM
        instance: Instance    => RETURN [eachInstance[instance]];
        instances: InstanceSeq    => {
            FOR i: NAT IN [0 .. instances.size) DO 
                IF eachInstance[instances[i]] THEN RETURN [TRUE];
                ENDLOOP;
            RETURN [FALSE];
        };
        wire: Wire            => {
            count: NAT _ 0;
        EachWirePin: EachInstanceProc = {count _ count + 1; quit _ eachInstance[instance]};
        quit _ EnumeratePins[decoration, wire, EachWirePin];
            IF NOT quit AND count<=expandPinsCount THEN ExpandPins[decoration, public, count];
        };
        wires: LIST OF Wire    => {
            count: NAT _ 0;
        EachWiresPin: EachInstanceProc = {count _ count + 1; quit _ eachInstance[instance]};
        quit _ FALSE;
        WHILE wires#NIL DO
        quit _ EnumeratePins[decoration, wires.first, EachWiresPin];
        IF quit THEN RETURN [TRUE];
        wires _ wires.rest;
        ENDLOOP;
            IF count<=expandPinsCount THEN ExpandPins[decoration, public, count];
        };
        transfWireIR: TransfWireIR    => {
            count: NAT _ 0;
        TransfEachPin: EachInstanceProc = {
            IF TransfedNotAtEdge[transfWireIR.transf,transfWireIR.ir, instance] THEN RETURN;
            count _ count + 1;
            quit _ eachInstance[Transform[transfWireIR.transf, instance]];
            };
        quit _ EnumeratePins[decoration, transfWireIR.wire, TransfEachPin];
            IF NOT quit AND count<=expandPinsCount THEN ExpandPins[decoration, public, count];
        };
        recordCell: CellType    => {
            count: NAT _ 0;
        recData: CoreClasses.RecordCellType = NARROW [recordCell.data];
        ir: Rect = GetIR[decoration, recordCell];
        subTransf: Instance _ NIL;
        subPublic: Wire _ NIL;
        nbSubs, clipped: INT _ 0;
        quit _ FALSE;
        FOR i: NAT IN [0 .. recData.size) DO
        cellInstance: CoreClasses.CellInstance = recData[i];
        transf: CD.Instance = GetTransf[decoration, cellInstance];
        TransfClipEachPin: EachInstanceProc = {
            IF TransfedNotAtEdge[transf, ir, instance] THEN {clipped _ clipped + 1; RETURN};
            count _ count + 1;
            quit _ eachInstance[Transform[transf, instance]];
            };
        EachBind: CoreOps.EachWirePairProc = {
        IF actualWire#public THEN RETURN;
        nbSubs _ nbSubs + 1;
        subPublic _ publicWire; subTransf _ transf;
        quit _ EnumeratePins[decoration, publicWire, TransfClipEachPin];
        };
        IF NOT HasIR[decoration, cellInstance.type] THEN ERROR; -- this sub Cell has not been decorated
        IF CoreOps.VisitBindingSeq[cellInstance.actual, cellInstance.type.public, EachBind] THEN RETURN [TRUE];
        ENDLOOP;
        SELECT TRUE FROM
        quit                                => ERROR; -- quit can never be TRUE at this point!
        count<=expandPinsCount        => ExpandPins[decoration, public, count]; -- cheaper to just record them!
        nbSubs=1                            => PutTransfWireIRLazyPins[decoration, public, subPublic, subTransf, ir]; -- only found in one 
        actual (typical for long abuts)
        clipped>clippedRatio*count        => ExpandPins[decoration, public, count]; -- to avoid being lazy on Vdd or Gnd
        count>maxLazyPins                => ExpandPins[decoration, public, count]; -- to avoid being lazy on Vdd or Gnd
        ENDCASE                            => {};
        };
        refProc: REF LazyPinsEnumerateProc    => {
            count: NAT _ 0;
        ProcEachPin: EachInstanceProc = {count _ count + 1; quit _ eachInstance[instance]};
        quit _ refProc^[decoration, public, ProcEachPin];
            IF NOT quit AND count<=expandPinsCount THEN ExpandPins[decoration, public, count];
            };
            ENDCASE    => ERROR; -- decoration unknown to this module.  Pins were probably created without using the procedural interface.
        };
        <<>>
    HasPins: PUBLIC PROC [decoration: Decoration, public: Wire] RETURNS [BOOL] = {
        ReturnFirstPin: EachInstanceProc = {quit _ TRUE};
        RETURN [EnumeratePins[decoration, public, ReturnFirstPin]];
        };

    GetPins: PUBLIC PROC [decoration: Decoration, public: Wire] RETURNS [pins: Instances _ NIL] = {
        ConsEachPin: EachInstanceProc = {pins _ CONS [instance, pins]};
        value: REF _ CoreProperties.GetWireProp[public, decoration.pinsProp];
        IF value=NIL THEN RETURN [NIL];
        WITH value SELECT FROM
        instance: Instance        => RETURN [LIST [instance]];
        instances: InstanceSeq    => FOR i: NAT IN [0 .. instances.size) 
        DO pins _ CONS [instances[i], pins] ENDLOOP;
            ENDCASE        => [] _ EnumeratePins[decoration, public, ConsEachPin];
        };
        <<>>
    PutPin: PUBLIC PROC [decoration: Decoration, public: Wire, pin: Instance] = {
        CoreProperties.PutWireProp[public, decoration.pinsProp, pin];
        };

    PutPins: PUBLIC PROC [decoration: Decoration, public: Wire, pins: Instances] = {
        SELECT TRUE FROM
            pins=NIL    => CoreProperties.PutWireProp[public, decoration.pinsProp, NIL];
            pins.rest=NIL    => CoreProperties.PutWireProp[public, decoration.pinsProp, pins.first];
            ENDCASE    => {
                size: NAT = GList.Length[pins];
                instances: InstanceSeq = NEW [InstanceSeqRec[size]];
                FOR i: NAT IN [0 .. size) DO
                    instances[i] _ pins.first; pins _ pins.rest;
                    ENDLOOP;
                CoreProperties.PutWireProp[public, decoration.pinsProp, instances];
                };
        };
<<Geometry>>
    EnumerateFlatGeometry: PUBLIC PROC [decoration: Decoration, root: CellType, leafProc: LeafProc, eachFlatWire: EachFlatWireProc _ 
    NIL, eachFlatCell: EachFlatCellProc _ NIL, clipRect: Rect _ universe] = {
        <<We came from that one from a RecordCell [vertical move]>>
        TransfBoundFlat: CoreFlat.BoundFlatCellProc = {
        transf: Instance = GetTransf[decoration, instance];
        currentTransf: Instance = Transform[NARROW [data], transf];
        IF Intersect[clipRect, currentTransf] 
        THEN BoundFlat[cell, target, flatCell, instance, parent, flatParent, currentTransf, bindings];
            };
        BoundFlat: CoreFlat.BoundFlatCellProc = {
            IF leafProc[cell] THEN {
                IF eachFlatCell#NIL THEN eachFlatCell[bindings: bindings, cell: cell, flatCell: flatCell, transf: NARROW [data]];
                RETURN;
                };
            IF cell.class=CoreClasses.recordCellClass THEN {
            RecordGeometry: CoreOps.EachWireProc = {
            boundWire: FlatWireRec;
            geometry: Instances _ GetGeometry[decoration, wire];
            ringGeometry: Instances _ NIL;
            FOR geometry: Instances _ GetGeometry[decoration, wire], geometry.rest WHILE geometry#NIL DO
            geom: Instance = Transform[NARROW [data], geometry.first];
            IF Intersect[clipRect, geom] THEN ringGeometry _ CONS [geom, ringGeometry];
            ENDLOOP;
            IF ringGeometry=NIL THEN RETURN;
            IF bindings=NIL 
            THEN boundWire _ [flatCell: flatCell, wireRoot: public, wire: wire]
            ELSE {
            refBoundWire: FlatWire _ NARROW [HashTable.Fetch[bindings, wire].value];
            boundWire _ IF refBoundWire#NIL THEN refBoundWire^ ELSE [flatCell: flatCell, wire: wire];
            };
            eachFlatWire[wire, boundWire, ringGeometry];
            };
            rct: CoreClasses.RecordCellType = NARROW [cell.data];
            IF eachFlatWire#NIL THEN [] _ CoreOps.VisitWireSeq[rct.internal, RecordGeometry];
                CoreFlat.NextBoundCellType[cell, target, flatCell, instance, parent, flatParent, data, bindings, TransfBoundFlat];
                }
            ELSE CoreFlat.NextBoundCellType[cell, target, flatCell, instance, parent, flatParent, data, bindings, BoundFlat];
            };
        BoundFlat[cell: root, data: CDInstances.NewInst[CDCells.CreateEmptyCell[]]];
        };

    GetGeometry: PUBLIC PROC [decoration: Decoration, internal: Wire] RETURNS [geometry: Instances] = {
        geometry _ NARROW [CoreProperties.GetWireProp[internal, decoration.geometryProp]];
        };
        <<>>
    PutGeometry: PUBLIC PROC [decoration: Decoration, internal: Wire, geometry: Instances] = {
        CoreProperties.PutWireProp[internal, decoration.geometryProp, geometry];
        };
<<Instance Transformation>>
    GetTransf: PUBLIC PROC [decoration: Decoration, cellInstance: CellInstance] RETURNS [transf: Instance] = {
        transf _ NARROW [CoreProperties.GetCellInstanceProp[cellInstance, decoration.transfProp]];
        };

    PutTransf: PUBLIC PROC [decoration: Decoration, cellInstance: CellInstance, transf: Instance] = {
        CoreProperties.PutCellInstanceProp[cellInstance, decoration.transfProp, transf];
        };
<<Enumeration of Sides for Routers>>
GetSides: PUBLIC PROC [ir: Rect, pin: Instance] RETURNS [sides: Sides _ noSide] = {
sides _ PinIRSides[ir, CDBasics.MoveRect[CDInstances.InstRectI[pin], CDBasics.SubPoints[[0, 0], CDBasics.BaseOfRect[ir]]]]; 
};

<<pinIR is the rectangle expressing the InterestRect of the pin in the InterestRect coordinate system of the outer.>>
PinIRSides: PROC [ir, pinIR: Rect] RETURNS [sides: Sides _ noSide] = {
objSize: CD.Position = CDBasics.SizeOfRect[ir];
sides[top] _ CDBasics.Intersect[pinIR, [0, objSize.y-1, objSize.x, objSize.y]];
sides[bottom] _ CDBasics.Intersect[pinIR, [0, 0, objSize.x, 1]];
sides[left] _ CDBasics.Intersect[pinIR, [0, 0, 1, objSize.y]];
sides[right] _ CDBasics.Intersect[pinIR, [objSize.x-1, 0, objSize.x, objSize.y]];
};

EnumerateSides: PUBLIC PROC [decoration: Decoration, cellType: CellType, wire: Wire, eachPin: EachPinProc] RETURNS [quit: BOOL] = {
InternalEachPin: EachInstanceProc = {
    <<inst will disappear as soon as the IFU is out.>>
EnumerateSeg: PROC [bbox: Rect, layer: CD.Layer] = {
pinIR: Rect = CDBasics.MoveRect[bbox, CDBasics.SubPoints[[0, 0], CDBasics.BaseOfRect[ir]]]; -- bbox of the pin in the obj 
coordinate system of the outer  
sides: Sides = PinIRSides[ir, pinIR];
layer _ CDLayers.AbstractToPaint[layer];
IF CDProperties.GetLayerProp[layer, $RoutingLayer]=NIL THEN RETURN;
FOR side: Side IN Side DO 
min, max: INT _ 0;
IF ~sides[side] THEN LOOP;
IF side=top OR side=bottom THEN {min _ pinIR.x1; max _ pinIR.x2};
IF side=left OR side=right THEN {min _ pinIR.y1; max _ pinIR.y2};
IF (quit _ eachPin[min, max, side, layer]) THEN RETURN;
ENDLOOP;
};
SELECT TRUE FROM
instance.ob.class=CDRects.bareRectClass    
=> EnumerateSeg[CDInstances.InstRectI[instance], instance.ob.layer];
CDSymbolicObjects.IsSymbolicOb[instance.ob]    
=> EnumerateSeg[CDInstances.InstRectI[instance], CDSymbolicObjects.GetLayer[instance]];
ENDCASE
=> FOR rList: CDAtomicObjects.DrawList _ FlattenAtomic[instance.ob], rList.rest WHILE rList#NIL DO
EnumerateSeg[
CDOrient.MapRect[rList.first.r, instance.ob.size, instance.orientation, instance.location], 
rList.first.lev];
ENDLOOP;
};
ir: Rect _ GetIR[decoration, cellType];
    quit _ EnumeratePins[decoration, wire, InternalEachPin];
};
<<>>
    EnumerateWireSides: PUBLIC PROC [decoration: Decoration, cellType: CellType, eachWirePin: EachWirePinProc] RETURNS [quit: BOOL] = {
        EachWireSide: CoreOps.EachWireProc = {
            EachPin: EachPinProc = {quit _ eachWirePin[wire, min, max, side, layer]};
        quit _ EnumerateSides[decoration, cellType, wire, EachPin];
        };
        quit _ CoreOps.VisitWireSeq[cellType.public, EachWireSide];
        };

WMMSL: TYPE = RECORD [wire: Wire, min, max: INT, side: Side, layer: CD.Layer];

    EnumerateNonOverlappingSides: PUBLIC PROC [decoration: Decoration, cellType: CellType, eachWirePin: EachWirePinProc] RETURNS [quit: 
    BOOL] = {
    list: LIST OF REF WMMSL _ NIL;
        CompareWMMSL: GList.CompareProc = {
            wmmsl1: REF WMMSL = NARROW [ref1];
            wmmsl2: REF WMMSL = NARROW [ref2];
            RETURN [Basics.CompareINT[wmmsl1.min, wmmsl2.min]];
            };
        EachWirePin: EachWirePinProc = {
            list _ CONS [NEW [WMMSL _ [wire, min, max, side, layer]], list];
        };
        [] _ EnumerateWireSides[decoration, cellType, EachWirePin];
        list _ NARROW [GList.Sort[list, CompareWMMSL]]; -- modifies the list for good
        FOR wmmsls: LIST OF REF WMMSL _ list, wmmsls.rest WHILE wmmsls#NIL DO
            wmmsl1: REF WMMSL = wmmsls.first;
            merge: BOOL _ TRUE;
            WHILE merge DO
                FOR aux: LIST OF REF WMMSL _ wmmsls, aux.rest WHILE aux#NIL AND aux.rest#NIL DO
                    wmmsl2: REF WMMSL = aux.rest.first;
                IF wmmsl1.wire=wmmsl2.wire AND wmmsl1.side=wmmsl2.side AND wmmsl1.layer=wmmsl2.layer AND wmmsl2.min<=wmmsl1.max  
                THEN {wmmsl1.max _ MAX [wmmsl1.max, wmmsl2.max]; aux.rest _ aux.rest.rest; EXIT};
                REPEAT FINISHED    => merge _ FALSE;
                ENDLOOP;
            ENDLOOP;
            ENDLOOP;
        WHILE list#NIL DO
            quit _ eachWirePin[list.first.wire, list.first.min, list.first.max, list.first.side, list.first.layer];
            IF quit THEN EXIT;
            list _ list.rest;
            ENDLOOP;
        };

WMML: TYPE = RECORD [wire: Wire, min, max: INT, layer: CD.Layer];

    EnumerateSortedSides: PUBLIC PROC [decoration: Decoration, cellType: CellType, side: Side, eachSortedPin: EachSortedPinProc] 
    RETURNS [quit: BOOL] = {
    list: LIST OF REF WMML _ NIL;
    sideFilter: Side = side;
        CompareWMML: GList.CompareProc = {
            wmml1: REF WMML = NARROW [ref1];
            wmml2: REF WMML = NARROW [ref2];
            RETURN [Basics.CompareINT[wmml1.min, wmml2.min]];
            };
        EachWirePin: EachWirePinProc = {
        IF side=sideFilter THEN list _ CONS [NEW [WMML _ [wire, min, max, layer]], list];
        };
        [] _ EnumerateWireSides[decoration, cellType, EachWirePin];
        list _ NARROW [GList.Sort[list, CompareWMML]]; -- modifies the list for good
        WHILE list#NIL DO
            quit _ eachSortedPin[list.first.wire, list.first.min, list.first.max, list.first.layer];
            IF quit THEN EXIT;
            list _ list.rest;
            ENDLOOP;
        };
<<Fabrication of Shells for Routers or for IO>>
font: CDTexts.CDFont _ CDTexts.MakeFont["Xerox/TiogaFonts/Helvetica8", 4];
<<Font used for the text labels>>
<<>>
    CreateShell: PUBLIC PROC [decoration: Decoration, cellType: CellType, withCuteFonts: BOOL _ FALSE] RETURNS [shell: CD.Object] = {
    ConstructEachWire: CoreOps.EachWireProc = {
    ConstructPins: EachInstanceProc = {
        inst: CD.Instance _ CDCells.IncludeOb[
            design: NIL, cell: shell, ob: instance.ob, 
            position: instance.location, orientation: instance.orientation,
            cellCSystem: cdCoords, obCSystem: cdCoords, mode: dontPropagate
            ].newInst;
        CDProperties.CopyProps[instance.properties, inst]; -- for example for pins!
        CDProperties.PutInstanceProp[inst, $InstanceName, name];
    };
    name: ROPE _ CoreOps.GetFullWireName[cellType.public, wire];
    [] _ EnumeratePins[decoration, wire, ConstructPins];
    IF withCuteFonts THEN {
    ConstructFonts: EachPinProc = {
        [] _ CDCells.IncludeOb[
            design: NIL, cell: shell, ob: text, 
            position: SELECT side FROM 
                left => [-300, min], right => [iSize.x+10, min], top => [min, iSize.y+10], 
                bottom => [min, -300], ENDCASE => ERROR, 
            orientation: SELECT side FROM left, right => 0, top, bottom => 2, ENDCASE => ERROR,
            cellCSystem: interrestCoords, obCSystem: interrestCoords, mode: dontPropagate
            ];
    };
    text: CD.Object _ CDTexts.CreateText[name, font];
    [] _ EnumerateSides[decoration, cellType, wire, ConstructFonts];
    };
    };
        ir: CD.Rect _ GetIR[decoration, cellType];
        iSize: CD.Position _ CDBasics.SizeOfRect[ir];
    shell _ CDCells.CreateEmptyCell[];
    CDCells.SetInterestRect[shell, ir];
    [] _ CoreOps.VisitWireSeq[cellType.public, ConstructEachWire];
    [] _ CDCells.RepositionCell[shell, NIL];
        };
<<Checking of Decorations>>
    CheckInterface: PUBLIC PROC [decoration: Decoration, cellType: CellType] RETURNS [ok: BOOL] = {
        CheckPins: PROC [wire: Wire] = {IF NOT HasPins[decoration, wire] THEN ok _ FALSE};
        ok _ HasIR[decoration, cellType];
        CoreOps.VisitRootAtomics[cellType.public, CheckPins];
        };
        <<>>
    CheckInternal: PUBLIC PROC [decoration: Decoration, recordCell: CellType] RETURNS [ok: BOOL] = {
        data: CoreClasses.RecordCellType = NARROW [recordCell.data];
        ok _ CheckInterface[decoration, recordCell];
        FOR i: NAT IN [0 .. data.size)
            DO IF GetTransf[decoration, data[i]]=NIL THEN ok _ FALSE ENDLOOP;
        };
<<Lazy Setting of Pins >>
    PutLazyPins: PUBLIC PROC [decoration: Decoration, public: Wire, lazyPinsEnumerate: LazyPinsEnumerateProc] = {
        CoreProperties.PutWireProp[public, decoration.pinsProp, NEW [LazyPinsEnumerateProc _ lazyPinsEnumerate]];
        };
        <<>>
    PutIndirectLazyPins: PUBLIC PROC [decoration: Decoration, public: Wire, indirect: Wire] = {
        CoreProperties.PutWireProp[public, decoration.pinsProp, indirect];
        };
        <<>>
    PutIndirectsLazyPins: PUBLIC PROC [decoration: Decoration, public: Wire, indirects: LIST OF Wire] = {
        CoreProperties.PutWireProp[public, decoration.pinsProp, indirects];
        };
        <<>>
    AddIndirectLazyPins: PUBLIC PROC [decoration: Decoration, public: Wire, indirect: Wire] = {
        value: REF _ CoreProperties.GetWireProp[public, decoration.pinsProp];
        SELECT TRUE FROM
            CoreProperties.GetWireProp[indirect, decoration.pinsProp]=NIL    => {};
            value=NIL        => PutIndirectLazyPins[decoration, public, indirect];
            value=indirect    => {};
            ENDCASE    => WITH value SELECT FROM
                wire: Wire    => PutIndirectsLazyPins[decoration, public, LIST [wire, indirect]];
                wires: LIST OF Wire    => IF NOT CoreOps.Member[wires, indirect] THEN PutIndirectsLazyPins[decoration, public, CONS [indirect, 
                wires]];
                ENDCASE    => {
                    pins: Instances _ NIL;
                ConsEachPin: EachInstanceProc = {pins _ CONS [instance, pins]};
                [] _ EnumeratePins[decoration, public, ConsEachPin]; 
                [] _ EnumeratePins[decoration, indirect, ConsEachPin]; 
                    PutPins[decoration, public, pins];
                };
        };

    PutTransfWireIRLazyPins: PUBLIC PROC [decoration: Decoration, public: Wire, indirect: Wire, transf: Instance, ir: Rect] = {
        CoreProperties.PutWireProp[public, decoration.pinsProp, NEW [TransfWireIRRec _ [transf, indirect, ir]]];
        };
        <<>>
    PutRecordLazyPins: PUBLIC PROC [decoration: Decoration, public: Wire, recordCell: CellType] = {
        CoreProperties.PutWireProp[public, decoration.pinsProp, recordCell];
        };
<<Geometry Utilities>>
    AtEdge: PUBLIC PROC [ir: Rect, instance: Instance] RETURNS [BOOL] = {
        RETURN [NOT CDBasics.Inside[CDInstances.InstRectO[instance], CDBasics.Extend[ir, -1]]]
        };
        <<>>
    TransfedNotAtEdge: PUBLIC PROC [transf: Instance, ir: Rect, instance: Instance] RETURNS [BOOL] = {
        RETURN [CDBasics.Inside[
            IF transf.orientation=CDOrient.original 
                THEN CDOrient.RectAt[
                    CDBasics.AddPoints[transf.location, instance.location],
                    instance.ob.size, 
                    instance.orientation
                    ]
                ELSE CDOrient.RectAt[
                    CDBasics.BaseOfRect[CDOrient.MapRect[
                        itemInCell: CDOrient.RectAt[instance.location, instance.ob.size, instance.orientation],
                        cellSize: transf.ob.size, 
                        cellInstOrient: transf.orientation, 
                        cellInstPos: transf.location
                        ]], 
                    instance.ob.size, 
                    CDOrient.ComposeOrient[itemOrientInCell: instance.orientation, cellOrientInWorld: transf.orientation]
                    ], 
            CDBasics.Extend[ir, -1]
            ]]
        };
        <<>>
    Intersect: PUBLIC PROC [clipRect: Rect, instance: Instance] RETURNS [BOOL] = {
        RETURN [CDBasics.Intersect[CDInstances.InstRectO[instance], clipRect]]
        };

    Transform: PUBLIC PROC [transf, instance: Instance] RETURNS [Instance] = {
    <<looks very much like CDInstances.Composed[instance, transf.location, transf.ob.size, transf.orientation], but shares the property 
    list.>>
        RETURN [NEW [CD.InstanceRep _ [
            ob: instance.ob, 
            location: CDBasics.BaseOfRect[CDOrient.MapRect[
                itemInCell: CDOrient.RectAt[instance.location, instance.ob.size, instance.orientation],
                cellSize: transf.ob.size, 
                cellInstOrient: transf.orientation, 
                cellInstPos: transf.location
                ]], 
            orientation: CDOrient.ComposeOrient[itemOrientInCell: instance.orientation, cellOrientInWorld: transf.orientation], 
            properties: instance.properties
            ]]];
    };

    TransformList: PUBLIC PROC [transf: Instance, instances: Instances] RETURNS [Instances] = {
    RETURN [CDInstances.ComposedList[instances, transf.location, transf.ob.size, transf.orientation]];
    };

FlattenAtomic: PUBLIC PROC [obj: CD.Object] RETURNS [rList: CDAtomicObjects.DrawList _ NIL] = {
SELECT TRUE FROM
obj.class=CDRects.bareRectClass        => RETURN [LIST [[CD.InterestRect[obj], obj.layer]]];
CDSymbolicObjects.IsSymbolicOb[obj]    => RETURN [NIL];
CDAtomicObjects.IsAtomicOb[obj]        => RETURN [NARROW [obj.specificRef, CDAtomicObjects.AtomicObsPtr].rList];
CDProperties.GetObjectProp[obj, $FlattenAtomicCache]#NIL    => RETURN [NARROW [CDProperties.GetObjectProp[obj, 
$FlattenAtomicCache], REF CDAtomicObjects.DrawList]^];
ENDCASE                                    => {
FOR list: LIST OF CD.Instance _ NARROW [CDDirectory.ExpandByDraw[obj, TRUE, TRUE].specificRef, CD.CellPtr].contents, list.rest 
WHILE list#NIL DO
IF list.first.ob.class#CDRects.bareRectClass THEN ERROR;
rList _ CONS [[CDInstances.InstRectO[list.first], list.first.ob.layer], rList];
ENDLOOP;
CDProperties.PutObjectProp[obj, $FlattenAtomicCache, NEW [CDAtomicObjects.DrawList _ rList]];
};
};

Touch: PUBLIC TouchProc = {
IF NOT CDBasics.Intersect[CDInstances.InstRectO[instance1], CDInstances.InstRectO[instance2]] THEN RETURN;
SELECT TRUE FROM
instance1.ob.class=CDRects.bareRectClass                
=> RETURN [TouchRect[instance2, CDInstances.InstRectO[instance1], instance1.ob.layer]];
CDSymbolicObjects.IsSymbolicOb[instance1.ob]        
=> RETURN [TouchRect[instance2, CDInstances.InstRectO[instance1], CDSymbolicObjects.GetLayer[instance1]]];
ENDCASE                    
=> FOR rList: CDAtomicObjects.DrawList _ FlattenAtomic[instance1.ob], rList.rest WHILE rList#NIL DO
IF TouchRect[instance2, CDOrient.MapRect[rList.first.r, instance1.ob.size, instance1.orientation, instance1.location], 
rList.first.lev] THEN RETURN [TRUE];
    ENDLOOP;
};

TouchRect: PUBLIC PROC [instance: Instance, rect: Rect, layer: CD.Layer] RETURNS [BOOL _ FALSE] = {
IF ~Intersect[rect, instance] THEN RETURN;
IF CDProperties.GetLayerProp[layer, $Well]#NIL THEN RETURN;
IF instance.ob.class=CDRects.bareRectClass THEN 
RETURN [CDLayers.AbstractToPaint[instance.ob.layer]=CDLayers.AbstractToPaint[layer]];
RETURN [Touch[
instance, 
CDInstances.NewInst[
ob: CDRects.CreateRect[CDBasics.SizeOfRect[rect], layer], 
location: CDBasics.BaseOfRect[rect]
]
]];
};

TouchList: PUBLIC PROC [instances: LIST OF CD.Instance, instance: CD.Instance] RETURNS [BOOL _ FALSE] = {
FOR list: LIST OF CD.Instance _ instances, list.rest WHILE list#NIL DO
IF Touch[list.first, instance] THEN RETURN [TRUE];
ENDLOOP;
};

TouchListList: PUBLIC PROC [instances1, instances2: LIST OF CD.Instance] RETURNS [BOOL _ FALSE] = {
FOR list: LIST OF CD.Instance _ instances1, list.rest WHILE list#NIL DO
IF TouchList[instances2, list.first] THEN RETURN [TRUE];
ENDLOOP;
};
<<Initialization>>
CDProperties.PutLayerProp[CD.commentLayer, $RoutingLayer, $RoutingLayer];

    END.