<> <> <> <> DIRECTORY CD USING [ObPtr, Rect, Position, Orientation, Properties, ApplicationPtr, ApplicationList, Number], CDInline USING [NonEmpty, Extend, Intersect, Intersection, ToRect], CDOrient USING [MapRect, DeMapRect, MapPosition, ComposeOrient, original, rotate90, rotate180, rotate270, RectAt], CDProperties USING [GetPropFromObject], TerminalIO USING [WriteRope], Atom USING [PropList], CornerStitching USING [Region, Tesselation, NewTesselation, FreeTesselation, EnumerateArea, ChangeRect, FuncChangeRect, PerTileChangeProc, AreaEmpty, PerTileProc, Area, Value, TilePtr, NorthEdge, SouthEdge, EastEdge, WestEdge, ENorthNeighbour, NEastNeighbour, WSouthNeighbour, SWestNeighbour, TileAt, Rect], SpinifexAtoms USING [ spinifex], SpinifexCircuit USING [AZ, LogicalCell, Circuit, SpinifexLayerIndex, QuadTree, AreaSplit, Rectangle, CircuitNode, CircuitConstraint, ConstraintResolution, NodeLinkage, AttachedNode, MergeRec, TechHandle, LookupNode, FindRootNode, Dimension, GeometricRule, spaceIndex, nodeIndex, NormalizeCircuit, PaintErrorRect, MergeNode, AdjustNode, EnumerateGeometry, PerRectProc], SpinifexLayers ; SpinifexLayersImpl: CEDAR PROGRAM IMPORTS CDInline, CDOrient, CDProperties, CornerStitching, TerminalIO, SpinifexAtoms, SpinifexCircuit EXPORTS SpinifexLayers ~ BEGIN <<-- TYPES>> AZ: ZONE ~ SpinifexCircuit.AZ; Circuit: TYPE ~ SpinifexCircuit.Circuit; QuadTree: TYPE ~ SpinifexCircuit.QuadTree; AreaSplit: TYPE ~ SpinifexCircuit.AreaSplit; Rectangle: TYPE ~ SpinifexCircuit.Rectangle; CircuitNode: TYPE ~ SpinifexCircuit.CircuitNode; CircuitConstraint: TYPE ~ SpinifexCircuit.CircuitConstraint; ConstraintResolution: TYPE ~ SpinifexCircuit.ConstraintResolution; NodeLinkage: TYPE ~ SpinifexCircuit.NodeLinkage; AttachedNode: TYPE ~ SpinifexCircuit.AttachedNode; MergeRec: TYPE ~ SpinifexCircuit.MergeRec; SpinifexLayerIndex: TYPE ~ SpinifexCircuit.SpinifexLayerIndex; AnalyzeGeometry: PUBLIC PROCEDURE [cell: REF SpinifexCircuit.LogicalCell] ~ { cir: REF SpinifexCircuit.Circuit ~ cell.circuit; <<-- Process each of the analysis layers.>> conflictWorlds: ARRAY SpinifexLayerIndex OF REF CornerStitching.Tesselation; geometryWorlds: ARRAY SpinifexLayerIndex OF REF CornerStitching.Tesselation; constraintQueue: ARRAY SpinifexLayerIndex OF LIST OF REF CornerStitching.Region _ ALL[NIL]; FOR layer: SpinifexLayerIndex IN [0..cir.technologyHandle.numSpinifexLayers) DO conflictWorld: REF CornerStitching.Tesselation _ conflictWorlds[layer] _ CornerStitching.NewTesselation[]; geometryWorld: REF CornerStitching.Tesselation _ geometryWorlds[layer] _ CornerStitching.NewTesselation[]; <<-- ComputeConflicts>> ComputeConflicts: PROCEDURE [qt: REF QuadTree] ~ { descentDepth: INT _ 1; <<3 things are put into the conflictWorld they are:>> <<=> REF Rectangle occupied by a node (possibly within a subcell as determined by val.nodeInformation's TYPE, either REF circuitNode or CD.ApplicationPtr)>> <<=> REF CircuitConstraint occupied by a constraint or some resolution of constraints such that the resolution at each step was one of the two contending constraints vying for occupancy of the region.>> <<=> LIST OF REF Rectangle Bid for occupancy by a subcell to some unspecified depth.>> <> <<=> ATOM ~ $Conflict being the result of an irresolvable conflict for occupancy and flagging a region as requiring instantiation and analysis.>> OccupyByNode: CornerStitching.PerTileChangeProc -- [plane: REF CornerStitching.Tesselation, rect: CD.Rect, oldValue: REF ANY, data: REF ANY] -- ~ { WITH oldValue SELECT FROM a: ATOM => IF a # $Conflict THEN ERROR; r: REF Rectangle => IF data # r THEN conflictWorld.ChangeRect[rect, $Conflict]; applRef: LIST OF REF Rectangle => IF data # applRef.first THEN { conflictWorld.ChangeRect[rect, data]; Flatten[rect, applRef] } ELSE ERROR; c: REF CircuitConstraint => IF ResolveConstraints[c, data] # data THEN conflictWorld.ChangeRect[rect, $Conflict]; ENDCASE => IF oldValue # NIL THEN ERROR ELSE conflictWorld.ChangeRect[rect, data]; }; OccupyByConstr: CornerStitching.PerTileChangeProc -- [plane: REF CornerStitching.Tesselation, rect: CD.Rect, oldValue: REF ANY, data: REF ANY] -- ~ { WITH oldValue SELECT FROM a: ATOM => IF a # $Conflict THEN ERROR; r: REF Rectangle => conflictWorld.ChangeRect[rect, $Conflict]; applRef: LIST OF REF Rectangle => { conflictWorld.ChangeRect[rect, data]; Flatten[rect, applRef] }; c: REF CircuitConstraint => { resolution: REF ANY ~ ResolveConstraints[c, data]; IF resolution # c AND resolution # data THEN conflictWorld.ChangeRect[rect, $Conflict] ELSE IF resolution # c THEN conflictWorld.ChangeRect[rect, resolution]; }; ENDCASE => IF oldValue # NIL THEN ERROR ELSE conflictWorld.ChangeRect[rect, data]; }; OccupyByAppl: CornerStitching.PerTileChangeProc -- [plane: REF CornerStitching.Tesselation, rect: CD.Rect, oldValue: REF ANY, data: REF ANY] -- ~ { WITH oldValue SELECT FROM a: ATOM => IF a # $Conflict THEN ERROR; r: REF Rectangle => { IF NARROW[data, LIST OF REF Rectangle].first = r THEN ERROR; Flatten[rect, NARROW[data]] }; applRef: LIST OF REF Rectangle => IF data # applRef THEN DescendOneLevel[rect, applRef, NARROW[data]]; c: REF CircuitConstraint => Flatten[rect, NARROW[data]]; ENDCASE => IF oldValue # NIL THEN ERROR ELSE conflictWorld.ChangeRect[rect, data]; }; Flatten: PROCEDURE [clipRect: CD.Rect, applRef: LIST OF REF Rectangle] ~ { appl: CD.ApplicationPtr ~ NARROW[applRef.first.nodeInformation]; FlattenCell: PROCEDURE [appl: CD.ApplicationPtr, pos: CD.Position, orient: CD.Orientation] ~ { MapRect: PROCEDURE [inCellRect: CD.Rect] RETURNS [inWorldRect: CD.Rect] ~ INLINE { inWorldRect _ CDInline.Intersection[CDOrient.MapRect[itemInCell~ inCellRect, cellSize~ appl.ob.size, cellInstOrient~ orient, cellInstPos~ pos], clipRect] }; FlattenTree: PROCEDURE [qt: REF QuadTree, bBox: CD.Rect] ~ { IF qt = NIL THEN RETURN; FOR boxes: LIST OF REF Rectangle _ qt.boxes, boxes.rest WHILE boxes # NIL DO WITH boxes.first.nodeInformation SELECT FROM node: REF CircuitNode => { r: CD.Rect ~ MapRect[boxes.first.interestBound]; IF CDInline.NonEmpty[r] THEN conflictWorld.FuncChangeRect[ r, OccupyByNode, boxes.first] }; constr: REF CircuitConstraint => { r: CD.Rect ~ MapRect[boxes.first.interestBound]; IF CDInline.NonEmpty[r] THEN conflictWorld.FuncChangeRect[ r, OccupyByConstr, constr] }; subAppl: CD.ApplicationPtr => FlattenCell[subAppl, CDOrient.MapPosition[ itemInCell~CDOrient.RectAt[ pos~subAppl.location, size~subAppl.ob.size, orient~subAppl.orientation], cellSize~appl.ob.size, cellInstOrient~orient, cellInstPos~pos], CDOrient.ComposeOrient[subAppl.orientation, orient]]; ENDCASE => ERROR; ENDLOOP; FOR quad: AreaSplit IN AreaSplit DO subBox: CD.Rect _ bBox; SELECT quad FROM north => IF mappedClip.y2 <= qt.midY THEN LOOP ELSE subBox.y1 _ qt.midY; south => IF mappedClip.y1 >= qt.midY THEN LOOP ELSE subBox.y2 _ qt.midY; east => IF mappedClip.x2 <= qt.midX THEN LOOP ELSE subBox.x1 _ qt.midX; west => IF mappedClip.x1 >= qt.midX THEN LOOP ELSE subBox.x2 _ qt.midX; ENDCASE; FlattenTree[qt.subTrees[quad], subBox] ENDLOOP; }; cellQt: REF QuadTree; cellBB: CD.Rect; mappedClip: CD.Rect ~ CDOrient.DeMapRect[ itemInWorld~clipRect, cellSize~appl.ob.size, cellInstOrient~orient, cellInstPos~pos]; [size~ cellBB, geometry~ cellQt] _ NARROW[CDProperties.GetPropFromObject[from~ appl.ob, prop~ SpinifexAtoms.spinifex], REF Circuit].spinifexLayers[layer]; FlattenTree[cellQt, cellBB]; }; FlattenCell[appl, appl.location, appl.orientation] }; DescendOneLevel: PROCEDURE [clipRect: CD.Rect, old, new: LIST OF REF Rectangle] ~ { levelCount: INT; BidByNode: CornerStitching.PerTileChangeProc -- [plane: REF CornerStitching.Tesselation, rect: CD.Rect, oldValue: REF ANY, data: REF ANY] -- ~ { WITH oldValue SELECT FROM a: ATOM => IF a # $Conflict THEN ERROR; r: REF Rectangle => IF data # r THEN ERROR; applRef: LIST OF REF Rectangle => conflictWorld.ChangeRect[rect, data]; c: REF CircuitConstraint => conflictWorld.ChangeRect[rect, data]; ENDCASE => ERROR; }; BidByConstr: CornerStitching.PerTileChangeProc -- [plane: REF CornerStitching.Tesselation, rect: CD.Rect, oldValue: REF ANY, data: REF ANY] -- ~ { WITH oldValue SELECT FROM a: ATOM => IF a # $Conflict THEN ERROR; r: REF Rectangle => IF new.first # r THEN ERROR; applRef: LIST OF REF Rectangle => IF applRef # new THEN conflictWorld.ChangeRect[rect, data]; c: REF CircuitConstraint => { resolution: REF ANY ~ ResolveConstraints[c, data]; IF resolution # c THEN conflictWorld.ChangeRect[rect, resolution]; }; ENDCASE => ERROR; }; BidByAppl: CornerStitching.PerTileChangeProc -- [plane: REF CornerStitching.Tesselation, rect: CD.Rect, oldValue: REF ANY, data: REF ANY] -- ~ { WITH oldValue SELECT FROM a: ATOM => IF a # $Conflict THEN ERROR; r: REF Rectangle => IF NARROW[data, LIST OF REF Rectangle].first # r THEN ERROR; applRef: LIST OF REF Rectangle => IF data # applRef THEN conflictWorld.ChangeRect[rect, data]; c: REF CircuitConstraint => conflictWorld.ChangeRect[rect, data]; ENDCASE => ERROR; }; DescendCell: PROCEDURE [appl: CD.ApplicationPtr, pos: CD.Position, orient: CD.Orientation] ~ { MapRect: PROCEDURE [inCellRect: CD.Rect] RETURNS [inWorldRect: CD.Rect] ~ INLINE { inWorldRect _ CDInline.Intersection[CDOrient.MapRect[itemInCell~ inCellRect, cellSize~ appl.ob.size, cellInstOrient~ orient, cellInstPos~ pos], clipRect] }; DescendTree: PROCEDURE [qt: REF QuadTree, bBox: CD.Rect] ~ { IF qt = NIL THEN RETURN; FOR boxes: LIST OF REF Rectangle _ qt.boxes, boxes.rest WHILE boxes # NIL DO WITH boxes.first.nodeInformation SELECT FROM node: REF CircuitNode => { r: CD.Rect ~ MapRect[boxes.first.interestBound]; IF CDInline.NonEmpty[r] THEN conflictWorld.FuncChangeRect[ r, BidByNode, new.first] }; constr: REF CircuitConstraint => { r: CD.Rect ~ MapRect[boxes.first.interestBound]; IF CDInline.NonEmpty[r] THEN conflictWorld.FuncChangeRect[ r, BidByConstr, constr] }; subAppl: CD.ApplicationPtr => IF levelCount > 0 THEN DescendCell[subAppl, CDOrient.MapPosition[ itemInCell~CDOrient.RectAt[ pos~subAppl.location, size~subAppl.ob.size, orient~subAppl.orientation], cellSize~appl.ob.size, cellInstOrient~orient, cellInstPos~pos], CDOrient.ComposeOrient[subAppl.orientation, orient]] ELSE { r: CD.Rect ~ MapRect[boxes.first.interestBound]; IF CDInline.NonEmpty[r] THEN conflictWorld.FuncChangeRect[ r, BidByAppl, new] }; ENDCASE => ERROR; ENDLOOP; FOR quad: AreaSplit IN AreaSplit DO subBox: CD.Rect _ bBox; SELECT quad FROM north => IF mappedClip.y2 <= qt.midY THEN LOOP ELSE subBox.y1 _ qt.midY; south => IF mappedClip.y1 >= qt.midY THEN LOOP ELSE subBox.y2 _ qt.midY; east => IF mappedClip.x2 <= qt.midX THEN LOOP ELSE subBox.x1 _ qt.midX; west => IF mappedClip.x1 >= qt.midX THEN LOOP ELSE subBox.x2 _ qt.midX; ENDCASE; DescendTree[qt.subTrees[quad], subBox] ENDLOOP; }; cellQt: REF QuadTree; cellBB: CD.Rect; mappedClip: CD.Rect ~ CDOrient.DeMapRect[ itemInWorld~clipRect, cellSize~appl.ob.size, cellInstOrient~orient, cellInstPos~pos]; [size~ cellBB, geometry~ cellQt] _ NARROW[CDProperties.GetPropFromObject[from~ appl.ob, prop~ SpinifexAtoms.spinifex], REF Circuit].spinifexLayers[layer]; levelCount _ levelCount.PRED; DescendTree[cellQt, cellBB]; levelCount _ levelCount.SUCC; }; appl: CD.ApplicationPtr ~ NARROW[new.first.nodeInformation]; descentDepth _ descentDepth.SUCC; levelCount _ descentDepth/2; -- Descend until levelCount = 0 DescendCell[appl, appl.location, appl.orientation]; conflictWorld.FuncChangeRect[ clipRect, OccupyByAppl, old]; descentDepth _ descentDepth.PRED }; <<-- Body of ComputeConflicts>> <<-- The big boxes are inserted first, then the smaller stuff. Having radix sorted the boxes into sub-trees increases locality of reference to the corner stitched data structure.>> IF qt = NIL THEN RETURN; FOR boxes: LIST OF REF Rectangle _ qt.boxes, boxes.rest WHILE boxes # NIL DO WITH boxes.first.nodeInformation SELECT FROM node: REF CircuitNode => conflictWorld.FuncChangeRect[ boxes.first.interestBound, OccupyByNode, boxes.first]; constr: REF CircuitConstraint => conflictWorld.FuncChangeRect[ boxes.first.interestBound, OccupyByConstr, constr]; appl: CD.ApplicationPtr => conflictWorld.FuncChangeRect[ boxes.first.interestBound, OccupyByAppl, boxes]; ENDCASE => ERROR; ENDLOOP; FOR quad: AreaSplit IN AreaSplit DO ComputeConflicts[qt.subTrees[quad]] ENDLOOP; IF descentDepth # 1 THEN ERROR }; <<-- BloatConflictsIntoAOIs>> BloatConflictsIntoAOIs: PROCEDURE ~ { CopyBloated: CornerStitching.PerTileProc -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ~ { IF tile.Value = $Conflict THEN { cleanedConflicts.ChangeRect[ rect~ CDInline.Extend[ tile.Area, cir.technologyHandle.layerInterestBloat[layer]], newValue~$AOI]; } }; cleanedConflicts: REF CornerStitching.Tesselation _ CornerStitching.NewTesselation[]; [] _ conflictWorld.EnumerateArea[ cir.spinifexLayers[layer].size, CopyBloated]; conflictWorld.FreeTesselation[FALSE]; conflictWorld _ conflictWorlds[layer] _ cleanedConflicts; }; <<-- InstantiateAOIs>> InstantiateAOIs: PROCEDURE [qt: REF QuadTree, bBox: CD.Rect, flatLoc: CD.Position _ [0,0], flatOrient: CD.Orientation _ CDOrient.original, appl: CD.ApplicationPtr _ NIL, nameQualifier: LIST OF CD.ApplicationPtr _ NIL] ~ { <<-- Depth first instantiation of those regions of the hierarchy that were found to be interesting.>> InstantiateTree: PROCEDURE [qt: REF QuadTree, bBox: CD.Rect] ~ { EnqueueConstraintRegion: PROCEDURE [cc: REF CircuitConstraint, r: CornerStitching.Rect] ~ { constraintQueue[layer] _ CONS[ AZ.NEW[ CornerStitching.Region _ [ rect~r, value~cc]], constraintQueue[layer]] }; <<-- Body of InstantiateTree>> FOR boxes: LIST OF REF Rectangle _ qt.boxes, boxes.rest WHILE boxes # NIL DO mappedDim: CD.Rect ~ CDOrient.MapRect[ itemInCell~ SpinifexCircuit.Dimension[boxes.first], cellSize~ (IF appl = NIL THEN [0,0] ELSE appl.ob.size), cellInstOrient~ flatOrient, cellInstPos~ flatLoc]; IF conflictWorld.AreaEmpty[mappedDim] THEN LOOP; WITH boxes.first.nodeInformation SELECT FROM subAppl: CD.ApplicationPtr => { cellQt: REF QuadTree; cellBBox: CD.Rect; [size~ cellBBox, geometry~ cellQt] _ NARROW[ CDProperties.GetPropFromObject[ from~subAppl.ob, prop~SpinifexAtoms.spinifex], REF Circuit].spinifexLayers[layer]; IF cellQt = NIL THEN LOOP; InstantiateAOIs[ qt~ cellQt, bBox~ cellBBox, flatLoc~ CDOrient.MapPosition[ itemInCell~ CDOrient.RectAt[ pos~ subAppl.location, size~ subAppl.ob.size, orient~ subAppl.orientation], cellSize~ (IF appl = NIL THEN [0,0] ELSE appl.ob.size), cellInstOrient~ flatOrient, cellInstPos~ flatLoc], flatOrient~CDOrient.ComposeOrient[ itemOrientInCell~ subAppl.orientation, cellOrientInWorld~ flatOrient], appl~ subAppl, nameQualifier~ CONS[subAppl, nameQualifier] ]; }; cNode: REF CircuitNode => { name: REF CircuitNode ~ IF nameQualifier = NIL THEN cNode ELSE cir.FindRootNode[subcircuitNode~ cNode, qualifier~ nameQualifier, insertIfNotInCircuit~ TRUE].node; occupants: LIST OF REF CornerStitching.Region _ NARROW[ geometryWorld.EnumerateArea[ mappedDim] ]; newList: LIST OF REF CircuitNode _ LIST[name]; geometryWorld.ChangeRect[ rect~ mappedDim, newValue~ newList]; WHILE occupants # NIL DO IF ~conflictWorld.AreaEmpty[ occupants.first.rect] THEN WITH occupants.first.value SELECT FROM oldList: LIST OF REF CircuitNode => -- oldList forms shared tail in all multiply occupied areas. Subsequent processing allows this. We must ensure that each node appears only once and that the list head is unique. IF ~(oldList.first = name AND oldList.rest = NIL) THEN { old: LIST OF REF CircuitNode _ oldList; replaceList: LIST OF REF CircuitNode; WHILE old # NIL DO <<-- check not already on list.>> IF old.first = name THEN EXIT; old _ old.rest; ENDLOOP; replaceList _ IF old # NIL THEN CONS[ oldList.first, oldList.rest] ELSE CONS[ name, oldList]; geometryWorld.ChangeRect[ rect~occupants.first.rect, newValue~replaceList] }; ENDCASE => ERROR; occupants _ occupants.rest; ENDLOOP; }; cc: REF CircuitConstraint => EnqueueConstraintRegion[ cc, mappedDim]; ENDCASE => ERROR; ENDLOOP; FOR quad: AreaSplit IN AreaSplit DO IF qt.subTrees[quad] # NIL THEN { subBox: CD.Rect _ bBox; SELECT quad FROM north => subBox.y1 _ qt.midY; south => subBox.y2 _ qt.midY; east => subBox.x1 _ qt.midX; west => subBox.x2 _ qt.midX; ENDCASE; InstantiateTree[qt.subTrees[quad], subBox] } ENDLOOP; }; <<--~~~~~~~~~~~~~~~~~~>> InstantiateTree[qt, bBox]; }; <<-- AnalyzeNodesInAOIs>> AnalyzeNodesInAOIs: PROCEDURE ~ { EnumerationDataRec: TYPE ~ RECORD [ geom: REF CornerStitching.Tesselation, tech: REF SpinifexCircuit.TechHandle ]; MergeNodeTiles: CornerStitching.PerTileProc -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ~ { <<-- This is quite an embarassment to me, but ...>> <<-- on the morning of October 12, with 9 days to go, I discovered a fairly deep flaw in my approach to area and perimeter calculation. I figured out to ways to fix it, neither of them particularly great. I chose to implement the one I understood best although it is perhaps the less efficient of the two. Each cornersitched tile is a list of CircuitNodes which had tiles in the area, think of them as the set of sources for any tile. I'm sure with a bit more time someone could come up with a better way to represent these sets than lists, however it should not be too bad as I expect the list will only ever contain a couple of members. Just be warned that pathological behaviour may arise. Note the length of source lists is precisely the degree of overlap of boxes with the proviso that subcells only contribute one box. Actually it hasn't turned out too badly.>> CountEdge: PROCEDURE [ nl1, nl2: LIST OF REF CircuitNode] RETURNS [INT] ~ { <<-- There is an edge for every CircuitNode not shared by the two lists.>> InAButNotB: PROCEDURE [ a,b: LIST OF REF CircuitNode] RETURNS [c: INT _ 0] ~ { FOR s1: LIST OF REF CircuitNode _ a, s1.rest WHILE s1 # NIL DO s2: LIST OF REF CircuitNode _ b; WHILE s2 # NIL DO IF s1.first = s2.first THEN EXIT; -- Shared sources. s2 _ s2.rest; ENDLOOP; IF s2 = NIL THEN c _ c + 1; -- node in s1 not in s2 ENDLOOP; }; RETURN [InAButNotB[a~nl1, b~nl2] + InAButNotB[a~nl2, b~nl1]] }; <<--~~~~~~~~~~~~~~~~>> WITH tile.Value SELECT FROM cnList: LIST OF REF CircuitNode => { <<-- Process merging and area changes in the interior of the tile.>> list: LIST OF REF CircuitNode _ cnList.rest; eastBound: INT ~ tile.EastEdge; northBound: INT ~ tile.NorthEdge; westBound: INT ~ tile.WestEdge; southBound: INT ~ tile.SouthEdge; r: CD.Rect~tile.Area; extraNodes: INT _ 0; n1: REF CircuitNode~SpinifexCircuit.LookupNode[cnList.first]; WHILE list # NIL DO n2: REF CircuitNode ~ SpinifexCircuit.LookupNode[list.first]; IF n1 # n2 THEN cir.MergeNode[to~n1,from~n2]; <<-- Area adjustment.>> SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ -((r.x2 - r.x1)*(r.y2 - r.y1)), perim~ 0]; extraNodes _ extraNodes+1; list _ list.rest; ENDLOOP; <<-- Process merging and perim changes at the tile southern and western boundary.>> <<-- To do this we must count the number of edges at each tile-pair boundary.>> FOR tileSouth: CornerStitching.TilePtr _ tile.WSouthNeighbour, tileSouth.NEastNeighbour WHILE tileSouth.WestEdge < eastBound DO IF tileSouth.Value # NIL THEN WITH tileSouth.Value SELECT FROM cnSouthList: LIST OF REF CircuitNode => { n2: REF CircuitNode; IF n1 # (n2_SpinifexCircuit.LookupNode[cnSouthList.first]) THEN cir.MergeNode[ to~n1, from~n2]; SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ 0, perim~ -(CountEdge[ cnList, cnSouthList] * (MIN[eastBound,tileSouth.EastEdge] - MAX[westBound,tileSouth.WestEdge]) )] }; constraint: REF CircuitConstraint => NULL; -- Ignore ENDCASE => ERROR ELSE IF extraNodes > 0 THEN SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ 0, perim~ -(extraNodes * (MIN[eastBound,tileSouth.EastEdge] - MAX[westBound,tileSouth.WestEdge]) )] ENDLOOP; FOR tileWest: CornerStitching.TilePtr _ tile.SWestNeighbour, tileWest.ENorthNeighbour WHILE tileWest.SouthEdge < northBound DO IF tileWest.Value # NIL THEN WITH tileWest.Value SELECT FROM cnWestList: LIST OF REF CircuitNode => { n2: REF CircuitNode; IF n1 # (n2_SpinifexCircuit.LookupNode[cnWestList.first]) THEN cir.MergeNode[ to~n1, from~n2]; SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ 0, perim~ -(CountEdge[ cnList, cnWestList] * (MIN[northBound,tileWest.NorthEdge] - MAX[southBound,tileWest.SouthEdge]) )] }; constraint: REF CircuitConstraint => NULL; -- Ignore ENDCASE => ERROR ELSE IF extraNodes > 0 THEN SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ 0, perim~ -(extraNodes * (MIN[northBound,tileWest.NorthEdge] - MAX[southBound,tileWest.SouthEdge]) )] ENDLOOP; FOR tileNorth: CornerStitching.TilePtr _ tile.ENorthNeighbour, tileNorth.SWestNeighbour WHILE tileNorth.EastEdge > westBound DO IF tileNorth.Value = NIL AND extraNodes > 0 THEN SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ 0, perim~ -(extraNodes * (MIN[eastBound,tileNorth.EastEdge] - MAX[westBound,tileNorth.WestEdge]) )] ENDLOOP; FOR tileEast: CornerStitching.TilePtr _ tile.NEastNeighbour, tileEast.WSouthNeighbour WHILE tileEast.NorthEdge > southBound DO IF tileEast.Value = NIL AND extraNodes > 0 THEN SpinifexCircuit.AdjustNode[ node~ n1, layer~ layer, area~ 0, perim~ -(extraNodes * (MIN[northBound,tileEast.NorthEdge] - MAX[southBound,tileEast.SouthEdge]) )] ENDLOOP; }; ENDCASE => ERROR }; <<-- Main Body of AnalyzeNodesInAOIs.>> [] _ geometryWorld.EnumerateArea[ rect~cir.spinifexLayers[layer].size, perTile~MergeNodeTiles]; }; <<-- Main Body of Per Layer LOOP.>> IF cir.spinifexLayers[layer].geometry = NIL THEN LOOP; ComputeConflicts[cir.spinifexLayers[layer].geometry]; TerminalIO.WriteRope["."]; BloatConflictsIntoAOIs[]; TerminalIO.WriteRope["."]; InstantiateAOIs[cir.spinifexLayers[layer].geometry, cir.spinifexLayers[layer].size]; TerminalIO.WriteRope["."]; AnalyzeNodesInAOIs[]; TerminalIO.WriteRope[". "]; ENDLOOP; FOR layer: SpinifexLayerIndex IN [0..cir.technologyHandle.numSpinifexLayers) DO geometryWorld: REF CornerStitching.Tesselation _ geometryWorlds[layer]; FOR tiles: LIST OF REF CornerStitching.Region _ NARROW[ geometryWorld.EnumerateArea[ rect~cir.spinifexLayers[layer].size]], tiles.rest WHILE tiles # NIL DO geometryWorld.ChangeRect[ rect~tiles.first.rect, newValue~SpinifexCircuit.LookupNode[ NARROW[ tiles.first.value, LIST OF REF CircuitNode].first ]] ENDLOOP; ENDLOOP; SpinifexCircuit.NormalizeCircuit[cir]; FOR layer: SpinifexLayerIndex IN [0..cir.technologyHandle.numSpinifexLayers) DO conflictWorld: REF CornerStitching.Tesselation _ conflictWorlds[layer]; geometryWorld: REF CornerStitching.Tesselation _ geometryWorlds[layer]; <> DesignRuleCheckAOIs: PROCEDURE ~ { Quadrants: TYPE ~ { ne, nw, sw, se }; FindNode: PROCEDURE [nodeLayer: SpinifexLayerIndex, r: CD.Rect] RETURNS [REF ANY] ~ { node: REF CircuitNode; FoundIt: SIGNAL [n: REF CircuitNode]; { ENABLE FoundIt => { node _ n; GOTO Done }; FindNodeInner: PROCEDURE [circuit: REF Circuit, rect: CD.Rect, aChain: LIST OF CD.ApplicationPtr] ~ { SearchForNode: SpinifexCircuit.PerRectProc -- [r: REF Rectangle, data: REF ANY] -- ~ { WITH r.nodeInformation SELECT FROM n: REF CircuitNode => IF CDInline.Intersect[r.Dimension, rect] THEN { parentNode: REF CircuitNode; newChain: LIST OF CD.ApplicationPtr; [parentNode, newChain] _ cir.FindRootNode[ n, aChain]; IF newChain = NIL THEN SIGNAL FoundIt[parentNode] }; a: CD.ApplicationPtr => { <> subcir: REF Circuit ~ NARROW[CDProperties.GetPropFromObject[from~ a.ob, prop~ SpinifexAtoms.spinifex]]; subR: CD.Rect ~ CDOrient.DeMapRect[ itemInWorld~ rect, cellSize~ a.ob.size, cellInstOrient~ a.orientation, cellInstPos~ a.location]; FindNodeInner[ subcir, subR, CONS[ a, aChain]]; }; ENDCASE; }; circuit.EnumerateGeometry[ nodeLayer, rect, SearchForNode, NIL] }; FindNodeInner[cir, r, NIL]; RETURN [NEW[INT]]; EXITS Done => RETURN [node]; } }; DesignRuleCheckCorner: PROCEDURE [ quadVals: ARRAY Quadrants OF REF ANY, pos: CD.Position] ~ { CheckArea: PROCEDURE [ rule: REF SpinifexCircuit.GeometricRule, orient: CD.Orientation, flavour: { convex, concave}] ~ { FindNodeAtCorner: PROCEDURE [n: REF ANY] RETURNS [REF ANY] ~ { WITH n SELECT FROM cn: REF CircuitNode => RETURN [cn]; cc: REF CircuitConstraint => { IF ~cc.hasCorrespondingNode THEN ERROR; RETURN [FindNode[cc.correspondingNodeLayer, CDInline.Extend[ CDInline.ToRect[pos, pos], 1]] ] }; ENDCASE => RETURN [NEW[INT]]; }; FindNodeInTile: PROCEDURE [n: REF ANY, tile: CornerStitching.TilePtr] RETURNS [REF ANY] ~ { WITH n SELECT FROM cn: REF CircuitNode => RETURN [cn]; cc: REF CircuitConstraint => { IF ~cc.hasCorrespondingNode THEN ERROR; RETURN [FindNode[cc.correspondingNodeLayer, tile.Area] ] }; ENDCASE => RETURN [NEW[INT]]; }; CheckValue: CornerStitching.PerTileProc -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ~ { WITH tile.Value SELECT FROM cn: REF CircuitNode => { IF ~rule.trigger2[SpinifexCircuit.nodeIndex] THEN RETURN; IF (rule.okIfConnected AND nodeAtCorner # NIL AND FindNodeAtCorner[nodeAtCorner] = SpinifexCircuit.LookupNode[cn]) THEN RETURN; }; cc: REF CircuitConstraint => { IF ~rule.trigger2[cc.index] THEN RETURN; IF (rule.okIfConnected AND nodeAtCorner # NIL AND cc.hasCorrespondingNode AND FindNodeAtCorner[nodeAtCorner] = FindNodeInTile[cc, tile]) THEN RETURN; }; ENDCASE => { IF tile.Value = NIL THEN { IF ~rule.trigger2[SpinifexCircuit.spaceIndex] THEN RETURN; } ELSE ERROR }; <<-- Check it is really an error. (Kind of funny sort of empty! What we mean is empty of non-$AOI tiles)>> IF notReportedYet AND conflictWorld.AreaEmpty[ rect~CDOrient.MapRect[ itemInCell~[ x1~-delta, y1~-delta, x2~len, y2~len], cellSize~[0,0], cellInstOrient~orient, cellInstPos~pos], backgroundValue~$AOI] THEN { <<-- FOUND AN ERROR>> cell.PaintErrorRect[ errorBox~ CDOrient.MapRect[ itemInCell~[x1~0, y1~0, x2~rule.extent, y2~rule.extent], cellSize~[0,0], cellInstOrient~orient, cellInstPos~pos], message~ rule.message]; notReportedYet _ FALSE } }; notReportedYet: BOOLEAN _ TRUE; len: INT~rule.extent; delta: INT~1; SELECT flavour FROM convex => { [] _ geometryWorld.EnumerateArea[ rect~CDOrient.MapRect[ itemInCell~[ x1~-delta, y1~0, x2~len, y2~len], cellSize~[0,0], cellInstOrient~orient, cellInstPos~pos], perTile~CheckValue, backgroundValue~$Nix]; [] _ geometryWorld.EnumerateArea[ rect~CDOrient.MapRect[ itemInCell~[ x1~0, y1~-delta, x2~len, y2~0], cellSize~[0,0], cellInstOrient~orient, cellInstPos~pos], perTile~CheckValue, backgroundValue~$Nix]; }; concave => { [] _ geometryWorld.EnumerateArea[ rect~CDOrient.MapRect[ itemInCell~[x1~0, y1~0, x2~len, y2~len], cellSize~[0,0], cellInstOrient~orient, cellInstPos~pos], perTile~CheckValue, backgroundValue~$Nix]; }; ENDCASE; }; or0: CD.Orientation ~ CDOrient.original; or90: CD.Orientation ~ CDOrient.rotate90; or180: CD.Orientation ~ CDOrient.rotate180; or270: CD.Orientation ~ CDOrient.rotate270; nodeAtCorner: REF ANY _ NIL; FOR ruleList: LIST OF REF SpinifexCircuit.GeometricRule _ cir.technologyHandle.rules[layer], ruleList.rest WHILE ruleList # NIL DO rule: REF SpinifexCircuit.GeometricRule ~ ruleList.first; bitIndex: ARRAY Quadrants OF INTEGER ~ [ 8, 4, 2, 1]; quadBits: INTEGER _ 0; nodeAtCorner _ NIL; <<-- Translate the quadrant contents into bit vector values.>> FOR q: Quadrants IN Quadrants DO WITH quadVals[q] SELECT FROM cn: REF CircuitNode => { IF rule.trigger1[SpinifexCircuit.nodeIndex] THEN { quadBits _ quadBits + bitIndex[q]; nodeAtCorner _ cn } }; cc: REF CircuitConstraint => { IF rule.trigger1[cc.index] THEN { quadBits _ quadBits + bitIndex[q]; IF cc.hasCorrespondingNode AND nodeAtCorner = NIL THEN nodeAtCorner _ cc } }; ENDCASE => { IF quadVals[q] = NIL THEN { IF rule.trigger1[SpinifexCircuit.spaceIndex] THEN quadBits _ quadBits + bitIndex[q] } ELSE ERROR }; ENDLOOP; <<-- Is this really a corner in the terms of this rule?>> <<-- Bits are ne=8, nw=4, sw=2, se=1. The check is applied to the quad opposite the generating corner. (IE rot. 180)>> <<-- Here are are some diagrams to make it explicit, X=TRUE, O=FALSE 0 - OO 1 - OO 2 - OO 3 - OO OO OX XO XX 4 - XO 5 - XO 6 - XO 7 - XO OO OX XO XX 8 - OX 9 - OX 10- OX 11- OX OO OX XO XX 12- XX 13- XX 14- XX 15- XX OO OX XO XX>> SELECT quadBits FROM 0 => NULL; 1 => CheckArea[ rule, or90, convex]; 2 => CheckArea[ rule, or0, convex]; 3 => NULL; 4 => CheckArea[ rule, or270, convex]; 5 => { CheckArea[ rule, or90, convex]; CheckArea[ rule, or270, convex] }; 6 => NULL; 7 => CheckArea[ rule, or0, concave]; 8 => CheckArea[ rule, or180, convex]; 9 => NULL; 10 => { CheckArea[ rule, or0, convex]; CheckArea[ rule, or180, convex] }; 11 => CheckArea[ rule, or90, concave]; 12 => NULL; 13 => CheckArea[ rule, or180, concave]; 14 => CheckArea[ rule, or270, concave]; 15 => NULL; ENDCASE => ERROR; ENDLOOP; }; CheckTile: CornerStitching.PerTileProc -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ~ { <<-- Since tile are stitched at their North-East and South-West corners these are favoured points from which to DRC. We exploit the fact that every corner has either 3 or (rarely) 4 edges meeting at it, and thus contains a NE or SW or (rarely) both tile corner at it.>> tileBound: CD.Rect ~ tile.Area; <<-- SW corner>> IF conflictWorld.TileAt[ [x~tileBound.x1, y~tileBound.y1]].Value = $AOI THEN { IF tile.SWestNeighbour.SouthEdge = tileBound.y1 THEN { IF tile.WSouthNeighbour.WestEdge = tileBound.x1 THEN NULL -- This is a (rare I suspect) 4 way corner it is handled at the NE corner. ELSE { IF tile.Value = tile.SWestNeighbour.Value THEN ERROR -- Max horz rule ELSE { <<-- Get the quadrants at the SW corner and call DesignRuleCheckCorner>> DesignRuleCheckCorner[ [ ne~tile.Value, nw~tile.SWestNeighbour.Value, sw~tile.WSouthNeighbour.Value, se~tile.WSouthNeighbour.Value], [ tileBound.x1, tileBound.y1]]; } } } ELSE { -- tile.WSouthNeighbour.WestEdge = tileBound.x1 IMPLICITLY IF tile.Value = tile.WSouthNeighbour.Value THEN NULL -- No corner really ELSE { <<-- Get the quadrants at the SW corner and call DesignRuleCheckCorner>> DesignRuleCheckCorner[ [ ne~tile.Value, nw~tile.SWestNeighbour.Value, sw~tile.SWestNeighbour.Value, se~tile.WSouthNeighbour.Value], [ tileBound.x1, tileBound.y1]]; } } }; <<-- NE corner>> IF conflictWorld.TileAt[ [x~tileBound.x2, y~tileBound.y2]].Value = $AOI THEN { IF tile.NEastNeighbour.NorthEdge = tileBound.y2 THEN { IF tile.ENorthNeighbour.EastEdge = tileBound.x2 THEN { <<-- 4 way corner, damn it>> neQTile: CornerStitching.TilePtr _ tile.ENorthNeighbour.NEastNeighbour; WHILE neQTile.SouthEdge > tileBound.y2 DO neQTile _ neQTile.WSouthNeighbour; ENDLOOP; DesignRuleCheckCorner[ [ ne~neQTile.Value, nw~tile.ENorthNeighbour.Value, sw~tile.Value, se~tile.NEastNeighbour.Value], [ tileBound.x2, tileBound.y2]]; } ELSE { IF tile.Value = tile.NEastNeighbour.Value THEN ERROR -- Max horz rule ELSE { <<-- Get the quadrants at the NE corner and call DesignRuleCheckCorner>> DesignRuleCheckCorner[ [ ne~tile.ENorthNeighbour.Value, nw~tile.ENorthNeighbour.Value, sw~tile.Value, se~tile.NEastNeighbour.Value], [ tileBound.x2, tileBound.y2]]; } } } ELSE { -- tile.ENorthNeighbour.EastEdge = tileBound.x2 IMPLICITLY IF tile.Value = tile.ENorthNeighbour.Value THEN NULL -- No corner really ELSE { <<-- Get the quadrants at the NE corner and call DesignRuleCheckCorner>> DesignRuleCheckCorner[ [ ne~tile.NEastNeighbour.Value, nw~tile.ENorthNeighbour.Value, sw~tile.Value, se~tile.NEastNeighbour.Value], [ tileBound.x2, tileBound.y2]]; } } } }; <<-- Main Body of DesignRuleCheckAOIs.>> <<-- First add the constraint regions to the geometry.>> FOR newCc: LIST OF REF CornerStitching.Region _ constraintQueue[layer], newCc.rest WHILE newCc # NIL DO tilesToPaint: LIST OF REF CornerStitching.Region _ NIL; newCcVal: REF CircuitConstraint ~ NARROW[ newCc.first.value]; MixConstraints: CornerStitching.PerTileProc -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ~ { newval: REF ANY _ newCcVal; IF tile.Value = NIL OR (newval _ ResolveConstraints[newCcVal, tile.Value]) # tile.Value THEN tilesToPaint _ AZ.CONS[ NEW[ CornerStitching.Region _ [rect~CDInline.Intersection[ newCc.first.rect, tile.Area], value~newval]], tilesToPaint] }; [] _ geometryWorld.EnumerateArea[ rect~newCc.first.rect, perTile~MixConstraints, backgroundValue~newCc.first.value]; WHILE tilesToPaint # NIL DO geometryWorld.ChangeRect[ rect~tilesToPaint.first.rect, newValue~tilesToPaint.first.value]; tilesToPaint _ tilesToPaint.rest; ENDLOOP; ENDLOOP; <<-- Now examine every tile in the world>> [] _ geometryWorld.EnumerateArea[ rect~cir.spinifexLayers[layer].size, perTile~CheckTile, backgroundValue~$Nothing]; }; DesignRuleCheckAOIs[]; TerminalIO.WriteRope["."]; ENDLOOP; TerminalIO.WriteRope[" "]; FOR layer: SpinifexLayerIndex IN [0..cir.technologyHandle.numSpinifexLayers) DO conflictWorlds[layer].FreeTesselation[FALSE]; geometryWorlds[layer].FreeTesselation[FALSE]; ENDLOOP; }; ResolveConstraints: PROCEDURE [newConstraint: REF CircuitConstraint, oldValue: REF ANY] RETURNS [REF ANY] ~ { <> IF newConstraint = oldValue THEN RETURN[newConstraint]; WITH oldValue SELECT FROM oldConstraint: REF CircuitConstraint => { <<-- What should be done here. Duplicate the entries on both list or search both list, and what if no resolution is found? For now we search both lists and raise an ERROR if nothing found.>> FOR cr: LIST OF ConstraintResolution _ newConstraint.withConstraint, cr.rest WHILE cr # NIL DO IF cr.first.opponent = oldConstraint THEN RETURN [cr.first.result]; ENDLOOP; FOR cr: LIST OF ConstraintResolution _ oldConstraint.withConstraint, cr.rest WHILE cr # NIL DO IF cr.first.opponent = newConstraint THEN RETURN [cr.first.result]; ENDLOOP; ERROR; }; node: REF CircuitNode => IF newConstraint.withNode = NIL THEN RETURN [node] ELSE RETURN [newConstraint.withNode]; rect: REF Rectangle => IF newConstraint.withNode = NIL THEN RETURN [rect] ELSE RETURN [newConstraint.withNode]; ENDCASE => ERROR; }; END.