DIRECTORY
Atom USING [GetPName],
BasicTime USING [Now],
CD USING [backgroundLayer, commentLayer, Design, errorLayer, FetchObjectClass, Instance, InstanceList, Layer, LayerKey, LayerTechnology, Number, Object, Orientation, original, outlineLayer, Position, Rect, selectionLayer, shadeLayer, Technology, undefLayer],
CDBasics USING [AddPoints, empty, Extend, Intersect, Intersection, SizeOfRect],
CDDirectory USING [Fetch],
CDErrors USING [IncludeMessage, RemoveMessages],
CDOrient USING [ComposeOrient, DecomposeOrient, MapRect, original],
CDProperties USING [GetProp, PutProp, PutObjectProp, RegisterProperty],
CDSimpleRules USING [MaxWidth, MinDist, MinWidth, NotKnown],
Core USING [CellType, Properties, Wire],
CoreClasses USING [recordCellClass, RecordCellType, transistorCellClass, unspecifiedCellClass],
CoreGeometry,
CoreOps USING [CreateWires, CopyWire, GetCellTypeName, GetShortWireName, SetShortWireName],
CoreProperties USING [CopyProps, GetProp, propCompare, propCopy, PropDoCopy, PropIntCompare, propPrint, PropPrintProc, Props, PutProp, RegisterProperty, StoreProperties],
FinchSmarts USING [CurrentFinchState, FinchState, GetProcs, Procs, RecordReason],
FS USING [StreamOpen],
IO USING [card, char, Close, Error, ErrorCode, int, noWhereStream, Put1, PutF, PutF1, PutFR, PutFR1, PutRope, refAny, rope, STREAM, time],
RefTab USING [Create, EachPairAction, Fetch, Insert, Pairs, Ref, SeqIndex],
Rope USING [Cat, ROPE],
Mayday USING [CellHullProc, CellToCellProc, CheckCell, DRV, DesignRuleViolation, ErrorRect, FindGeometry, MaterialToCellProc, State, StateRec],
SoSTNT USING [BlowTNT, InitTNT, InTNT, RememberTNT, SweepTNT, TNT],
ViewerIO USING [CreateViewerStreams],
ViewerTools USING [FindExistingViewer, Viewer];
EXPORTS Mayday ~
BEGIN
OPEN SoSTNT;
debug: BOOL ← FALSE; -- to start debugging enter: ← MaydayImpl.Debug[]
occDebug: BOOL = FALSE; -- for occasional debugging
useTNT: BOOL = TRUE; -- for timing analysis only
persist: BOOL ← TRUE; -- depends on Sinix (try hard to flag CD design)
fast: BOOL ← TRUE; -- if FALSE then Mayday is purely "object oriented"
break: SIGNAL = CODE; -- for debugging; related to property $MaydayBreak
panic: SIGNAL = CODE; -- cannot communicate violations
coreMess: SIGNAL [reason: Rope.ROPE, torch: REF ANY] = CODE; -- clean up before issuing coreInconsistent
coreInconsistent: PUBLIC ERROR [reason: Rope.ROPE, torch: REF ANY] = CODE;
mLog: IO.STREAM; -- messages
eLog: IO.STREAM; -- error log
dLog:
IO.
STREAM ←
IO.noWhereStream;
-- debugging
Note: Output to noWhereStream passes all I/O code, and hence is very slow !
State: TYPE = Mayday.State; -- REF StateRec;
StateRec: TYPE = Mayday.StateRec;
DRV: TYPE = Mayday.DRV; -- REF DesignRuleViolation
DesignRuleViolation:
TYPE = Mayday.DesignRuleViolation;
RECORD [count: INT ← 0, places: LIST OF ErrorRect]
ErrorRect:
TYPE = Mayday.ErrorRect;
RECORD [r: CD.Rect, msg: Rope.ROPE]
Mayday keys. For simplicity they are registered both with ChipNDale and Core and have the same name
checked:
ATOM = CoreProperties.RegisterProperty [$MaydayWasHere];
Attached to CellTypes.
DRVkey:
PUBLIC
ATOM ← CoreProperties.RegisterProperty [$MaydayError];
Error report may be processed by clients.
bbKey:
ATOM ← CoreProperties.RegisterProperty [$Maydaybb];
Cache for the bounding box.
trace:
ATOM = CoreProperties.RegisterProperty [$MaydaySeparationChecked];
Debugging only. Attached to ChipNDale objects processed.
Mayday analysis procedures (one for each ChpiNDale object class and one for each Core cell class)
analysis: ATOM = CoreProperties.RegisterProperty [$MaydayAnalysis];
cellHull: ATOM = CoreProperties.RegisterProperty [$MaydayHull];
matToCell: ATOM = CoreProperties.RegisterProperty [$Maydaymc];
cellToCell: ATOM = CoreProperties.RegisterProperty [$Maydaycc];
ChipNDale keys used by the Son of Spinifex
rectClass: ATOM = $Rect;
pinClass: ATOM = $PinOb0;
Core keys used by the Son of Spinifex
doNotAnalyse: ATOM = $DoNotDRC;
previousTechnology: CD.Technology ← NIL;
previousMaxSeparation: CD.Number ← 75 * 8;
specialLayers:
CD.Layer =
MAX [
CD.shadeLayer,
CD.errorLayer,
CD.backgroundLayer,
CD.outlineLayer,
CD.selectionLayer,
CD.commentLayer] + 1;
undefLayer, highLightShade, highLightError, pinRepresentation, outlineLayer, selectionLayer, commentLayer
Warning: CD.undefLayer could not be included in the list because of a minor bug in the compiler, but it should so once the bug is fixed.
errorFeedbackCutOff: CARDINAL = 50; -- after this number of errors, a | is no longer displayed in the ChipNDale Terminal viewer (if it may be displayed at all).
WireSet: TYPE = REF WireSetRec; -- the wires of a set of cells
WireSetRec: TYPE = RECORD [elt: SEQUENCE size: NAT OF Core.Wire];
PropSet: TYPE = REF PropSetRec; -- the properties of a set of cells
PropSetRec: TYPE = RECORD [p: SEQUENCE size: NAT OF Core.Properties];
Activation Procedure
CheckDesignRules:
PUBLIC
PROC [cell: Core.CellType, decoration: CoreGeometry.Decoration, design:
CD.Design ←
NIL, abortFlag:
REF
BOOL ←
NIL, verbose, shy, placebo:
BOOL ←
FALSE, cdObjKey:
ATOM]
RETURNS [quantity:
CARDINAL ← 1] ~
BEGIN
The external interface.
ENABLE
BEGIN
IO.Error =>
IF ec = StreamClosed
THEN
BEGIN
s: IO.STREAM;
m: BOOL = (stream = mLog);
IF m THEN StartLog [] ELSE Debug [];
s ← IF m THEN mLog ELSE dLog;
CONTINUE
END;
panic => GOTO paranoia
END;
state: State ← NEW [StateRec];
messy, okToType: BOOL ← FALSE;
abortionCause: Rope.ROPE;
debugTorch: REF ANY;
shadowCell: Core.CellType; -- to be implemented
fakeActual: Core.Wire;
cellName: Rope.ROPE = CoreOps.GetCellTypeName [cell];
designName: Rope.ROPE = IF design#NIL THEN design.name ELSE "in the sky";
state.shy ← shy; -- must be first statement
eLog ← FS.StreamOpen [fileName: "[]<>Temp>DRC>Mayday.log", accessOptions: create, keep: 5, extendFileProc: NIL, remoteCheck: FALSE, wDir: NIL]; -- keep is 5 because of incremental use
eLog.PutF1 ["Error log by Mayday. Design: %g\n\n", IO.rope [designName]];
IF placebo
THEN
BEGIN
FOR wait:
NAT
IN [0 .. 1984]
DO
IO.PutF1 [IO.noWhereStream, "Yes, you are really a very bright, smart and intelligent guy. Your Core structure is so great, it really gives me the frills. I feel so great looking at it. I'll propose you for the next Turing Award. [%g]", IO.card[wait]]
ENDLOOP;
Wow, did that CPU look busy !
RETURN
END;
[] ← Msg ["Welcome to S o S, the son of Spinifex. I will try to find all design rule violations in your design. Have a nice time."];
We now create a shadow cell on which we work. If we do not abort, we replace the original cell by the shadow cell, if we abort then the original cell is left untouched.
shadowCell ← CopyCell [cell]; -- to be implemented
returnedCell ← cell; -- to be implemented
okToType ← IF state.shy THEN NOT (Msg [cellName]) ELSE TRUE;
IF okToType THEN IO.PutF [stream: mLog,
format: "\nChecking wire geometry in cell %l%g%l of design %g\n",
v1: IO.rope ["b"], v2: IO.rope [cellName], v3: IO.rope ["B"], v4: IO.rope [designName]];
IF debug THEN IO.PutF [stream: dLog,
format: "\n%g. design: %g, cell: %g\n",
v1: IO.time [],
v2: IO.rope [designName],
v3: IF cellName = NIL THEN IO.refAny [shadowCell] ELSE IO.rope [cellName]];
state.design ← design;
state.abort ← IF abortFlag # NIL THEN abortFlag ELSE NEW [BOOL ← FALSE];
IF useTNT THEN state.nt ← InitTNT [];
IF (design =
NIL)
OR (design.technology =
NIL)
THEN
BEGIN
state.maxSeparation ← previousMaxSeparation ← 75 * 8;
I hope this figure is large enough. I did not make it too large for speed reasons.
previousTechnology ← NIL
END
ELSE
IF design.technology # previousTechnology
THEN
BEGIN
previousMaxSeparation ← ComputeMaxSeparation [design.technology];
previousTechnology ← design.technology
END;
state.maxSeparation ← previousMaxSeparation;
state.globalErrorCount ← 0;
state.verbose ← verbose;
state.cdObjKey ← cdObjKey;
state.decoration ← decoration;
DRC.
fakeActual ← CoreOps.CopyWire [shadowCell.public];
CheckCoreCell [self: shadowCell,
state: state,
actual: fakeActual,
loc: [0, 0],
orient: CDOrient.original
! coreMess => {messy ← TRUE; abortionCause ← reason; debugTorch ← torch; CONTINUE}];
IF useTNT THEN BlowTNT [state.nt];
IF messy
THEN
BEGIN
Clean up.
IF debug THEN break;
cell.properties ← CoreProperties.PutProp [shadowCell.properties, checked, NIL];
[] ← Msg ["Your Core data structure is busted! You lose, you lose,"];
Remember that we assigned returnedCell ← cell.
eLog.PutRope ["\nDRC failed. Your Core data structure is busted! You lose, you lose."];
eLog.Close [];
coreInconsistent [abortionCause, debugTorch]
END;
If the Core data struckture is busted, we have returned with (quantity = 1), because 1 > 0 and we do not know whether what we found in it is meaningful.
quantity ← state.globalErrorCount;
The above statement is obviously wrong, in that state.globalErrorCount tallies only newly found errors. The right thing to do is to traverse the Core data structure and count the errors. However this has to be done by the client, since there are people that do not want the data structures to be modified but just want a boolean answer. Those clients who want a detailed error report have to do it by themselves, as they have always done.
[] ← Msg ["This is S o S speaking."];
SELECT quantity
FROM
0 => [] ← Msg ["Congratulations, I could not find any new design rule violations in your design. Please check for old violations. Have a nice time."];
1 => [] ← Msg ["Sorry, there is a new design rule violation in your design. Please fix it."];
ENDCASE => [] ← Msg [IO.PutFR1 ["You have %g new bugs in your design. You lose, you lose,", IO.card [quantity]]];
IF NOT state.shy THEN IO.PutF [stream: mLog,
format: "\nNumber of new design violations found: %l%g%l\n",
v1: IO.rope ["b"], v2: IO.card [state.globalErrorCount], v3: IO.rope ["B"]];
returnedCell ← shadowCell; -- to be implemented
eLog.PutRope ["\nDRC terminated normally."]; eLog.Close [];
EXITS
Remember that we assigned returnedCell ← cell.
paranoia =>
-- cannot communicate with anybody
{eLog.PutRope ["\nThis is paranoia."]; eLog.Close []}
END; -- CheckDesignRules
Actions on Core Objects
CopyCell:
PROC [original: Core.CellType]
RETURNS [copy: Core.CellType] ~
BEGIN
Used to create a shadow cell on which Mayday operates. This allows to preserve the virginity of the cell we are handed over in the case of an abortion.
copy ← original -- << Yuck. Terrible hack. >> To be implemented
END; -- CopyCell
CheckCell:
TYPE = Mayday.CheckCell;
PROC [self: Core.CellType, state: State, actual: Core.Wire, loc: CD.Position, orient: CD.Orientation];
CheckCoreCell: CheckCell ~
BEGIN
Send:
PROC ~
INLINE
BEGIN
check: REF CheckCell ← NARROW [CoreProperties.GetProp [self.properties, analysis]];
IF check = NIL THEN check ← NARROW [CoreProperties.GetProp [self.class.properties, analysis]];
IF check =
NIL
THEN
BEGIN
obj: CD.Object = GetObject [self, state];
IF obj = NIL THEN RETURN; -- Cell contains no rectangles
check ← NEW [CheckCell ← DoNotCheck];
MarkError [self, state, [obj.class.interestRect[obj], "Cell has no provisions to be checked"]]
END;
check^ [self, state, actual, loc, orient]
END; -- Send
IF fast
THEN
SELECT self.class
FROM
CoreClasses.recordCellClass => CheckRecord [self, state, actual, loc, orient];
CoreClasses.transistorCellClass => CheckTransistor [self, state, actual, loc, orient];
CoreClasses.unspecifiedCellClass => NULL;
ENDCASE => Send []
ELSE Send []
END; -- CheckCoreCell
CheckRecord: CheckCell ~
BEGIN
[self: Core.CellType, state: State, actual: Core.Wire, loc: CD.Position, orient: CD.Orientation]
origin: CD.Position = [0, 0];
cellData: CoreClasses.RecordCellType;
bindingTable: RefTab.Ref;
boundInternal: Core.Wire;
propagatedActuals: WireSet; -- one wire per subcell
savedProps: PropSet; -- holds properties during recursion
ownName: Rope.ROPE = CoreOps.GetCellTypeName [self];
IF (CoreProperties.GetProp [self.properties, doNotAnalyse]#NIL) OR (CoreProperties.GetProp[self.properties, checked]#NIL) THEN RETURN;
IF state.shy THEN [] ← Msg [ownName] ELSE IO.Put1 [mLog, IO.char ['.]];
IF debug THEN IO.PutF [stream: dLog,
format: "\nChecking cell %l%g%l .\n",
v1: IO.rope ["e"],
v2: IF ownName = NIL THEN IO.refAny [self] ELSE IO.rope [ownName],
v3: IO.rope ["E"]];
IF state.abort^ THEN ERROR ABORTED;
ClearErrors [self, state];
cellData ← NARROW [self.data, CoreClasses.RecordCellType];
To be able to compare wires by comparing refs, the bound internal is the actual wire with the properties of the internal wire. Note that in this way the properties of the internal wire are propagated up to the actual wire; hence the actual wire has to be restored when popping up.
savedProps ← NEW [PropSetRec[actual.size]];
FOR p:
NAT
IN [0 .. actual.size)
DO
savedProps[p] ← CoreProperties.CopyProps [actual[p].properties];
ENDLOOP;
bindingTable ← CreateBindingTable [actual: actual, public: self.public];
boundInternal ← BindInternal [bindingTable, cellData.internal, state];
IF occDebug
THEN
BEGIN
dLog.PutF1 ["Binding and propagating: %g. Binding table:\n", IO.rope [ownName]];
PrintBinding [bindingTable];
dLog.PutF1 ["Bound internal of %g:\n", IO.rope [ownName]];
PrintWire [boundInternal]
END;
The propagated actuals must be determined here once for all, because new actual wires will differ from call to call.
propagatedActuals ← NEW [WireSetRec[cellData.size]];
FOR sub:
NAT
IN [0 .. cellData.size)
DO
propagatedActuals[sub] ← PropagateBinding [state, bindingTable, cellData.instances[sub].actual]
ENDLOOP;
FlushBindingTable [bindingTable];
The catechism states, that the recursion on the subcells has to take place at the end of the check among the internal of self and its subcells, in the procedure MaterialToCellSeparation. Nomen est omen, so I put the recursion step in here where it makes more sense to me. Furthermore the catechism states that the world is top-down, and that hence the recursion step is done at the end. Beside yielding a better program structure, this allows for more agressive (i.e. geometric) pruning.
FOR sub:
NAT
IN [0 .. cellData.size)
DO
cdInst: CD.Instance = CoreGeometry.GetTransf[state.decoration, cellData.instances[sub]];
IF (cdInst = NIL) THEN coreMess ["Core record cell has no geometry (1)", cellData];
CheckCoreCell [self: cellData.instances[sub].type,
state: state,
actual: propagatedActuals[sub],
loc: CDBasics.AddPoints [loc, cdInst.location],
orient: CDOrient.ComposeOrient [orient, cdInst.orientation]]
ENDLOOP;
Check the internal.
IF occDebug
THEN
BEGIN
dLog.PutF1 ["Verifying: %g\nbound internal:\n", IO.rope [ownName]];
PrintWire [boundInternal]
END;
Since in this case the error will go into the cell itself, we produce cell relative coordinates by appropriately setting loc1, loc2, orient1, and orient2.
FOR i:
NAT
IN [0 .. cellData.internal.size)
DO
FOR j:
NAT
IN [i .. cellData.internal.size)
DO
Although the separation rules do not have to hold for aequipotential pieces of material, we have to artificially check the geometry of each wire against itself in order to be able to verify the separation of cuts.
MaterialSeparation [state: state,
cell: self,
w1: boundInternal[i],
w2: boundInternal[j],
loc1: origin, loc2: origin,
orient1: CD.original, orient2: CD.original]
ENDLOOP;
WidthCheck [self, state, boundInternal[i]]
ENDLOOP;
Check the separation between the internal of self and its subcells.
FOR sub:
NAT
IN [0 .. cellData.size)
DO
cdInst: CD.Instance = CoreGeometry.GetTransf[state.decoration, cellData.instances[sub]];
IF (cdInst = NIL) THEN coreMess ["Core record cell has no geometry (2)", cellData];
FOR i:
NAT
IN [0 .. cellData.internal.size)
DO
MaterialToCellSeparation [state: state,
self: cellData.instances[sub].type,
actual: propagatedActuals[sub],
wire: cellData.internal[i],
father: self, -- for error marking
materialLoc: loc,
cellLoc: cdInst.location,
materialOrient: orient,
cellOrient: cdInst.orientation]
ENDLOOP
ENDLOOP;
Check the separation between the subcells of self.
IF useTNT THEN SweepTNT [state.nt];
FOR sub1:
NAT
IN [0 .. cellData.size)
DO
cdInst1: CD.Instance = CoreGeometry.GetTransf[state.decoration, cellData.instances[sub1]];
IF (cdInst1 = NIL) THEN coreMess ["Core record cell has no geometry (3)", cellData];
FOR sub2:
NAT
IN (sub1 .. cellData.size)
DO
cdInst2: CD.Instance = CoreGeometry.GetTransf[state.decoration, cellData.instances[sub2]];
IF (cdInst2 = NIL) THEN coreMess ["Core record cell has no geometry (4)", cellData];
IF useTNT AND (InTNT [state.nt, cdInst1, cdInst2, propagatedActuals[sub1], propagatedActuals[sub2]]) THEN LOOP;
CellToCellSeparation [state: state,
self: cellData.instances[sub1].type,
otherCell: cellData.instances[sub2].type,
selfActual: propagatedActuals[sub1],
otherActual: propagatedActuals[sub2],
father: self, -- for error marking
selfLoc: CDBasics.AddPoints [loc, cdInst1.location],
otherLoc: CDBasics.AddPoints [loc, cdInst2.location],
selfOrient: CDOrient.ComposeOrient [orient, cdInst1.orientation],
otherOrient: CDOrient.ComposeOrient [orient, cdInst2.orientation]];
IF useTNT THEN RememberTNT [state.nt, cdInst1, cdInst2, propagatedActuals[sub1], propagatedActuals[sub2]]
ENDLOOP
ENDLOOP;
Wires that were propagated down under recursion now contain all the geometry of the leaf cells. Here we restore the status quo ante.
FOR p:
NAT
IN [0 .. self.public.size)
DO
actual[p].properties ← CoreProperties.CopyProps [savedProps[p]];
ENDLOOP;
self.properties ← CoreProperties.PutProp [self.properties, checked, checked]
END; -- CheckRecord
CheckTransistor: CheckCell ~
BEGIN
[self: Core.CellType, state: State, actual: Core.Wire, loc: CD.Position, orient: CD.Orientation]
Transistors are atomic ChipNDale objects and are supposed to be correct by construction.
DoNotCheck [self, state, actual, loc, orient]
END; -- CheckTransistor
DoNotCheck: CheckCell ~
BEGIN
[self: Core.CellType, state: State, actual: Core.Wire, loc: CD.Position, orient: CD.Orientation]
(self.class = CoreClasses.unspecifiedCellClass) OR (CoreProperties.GetProp [self.properties, doNotAnalyse]#NIL);
self.properties ← CoreProperties.PutProp [self.properties, checked, checked]
END; -- DoNotCheck
RegisterAnalysisProcs:
PROC ~
BEGIN
Called in the module initialisation part.
CoreClasses.recordCellClass.properties ← CoreProperties.PutProp [
on: CoreClasses.recordCellClass.properties,
prop: analysis,
value: NEW [CheckCell ← CheckRecord]];
CoreClasses.transistorCellClass.properties ← CoreProperties.PutProp [CoreClasses.transistorCellClass.properties, analysis, NEW [CheckCell ← CheckTransistor]];
CoreClasses.unspecifiedCellClass.properties ← CoreProperties.PutProp [CoreClasses.unspecifiedCellClass.properties, analysis, NEW [CheckCell ← DoNotCheck]];
END; -- RegisterAnalysisProcs
Separation and Width Check Procedures
MaterialToCellProc:
TYPE = Mayday.MaterialToCellProc;
PROC [self: Core.CellType, state: State, actual, wire: Core.Wire, father: Core.CellType, materialLoc, cellLoc: CD.Position, materialOrient, cellOrient: CD.Orientation];
CellToCellProc:
TYPE = Mayday.CellToCellProc;
PROC [self: Core.CellType, state: State, otherCell: Core.CellType, selfActual, otherActual: Core.Wire, father: Core.CellType, selfLoc, otherLoc: CD.Position, selfOrient, otherOrient: CD.Orientation];
WidthCheck:
PROC [c: Core.CellType, s: State, w: Core.Wire] ~
BEGIN
The location and orientation are needed place the error rectangle.
At the moment our simplicistic approach does not have any knowledge of the topology. Therefore we cannot really test this rule.
min, max, a, b: CD.Number; -- a and b are such that a > b
r: CD.Rect; l: CD.Layer; key: ATOM;
il: CD.InstanceList = CoreGeometry.GetGeometry[s.decoration, w];
FOR i:
CD.InstanceList ← il, i.rest
WHILE i #
NIL
DO
[r, l] ← FindCDRect [i.first];
key ← CD.LayerKey [l];
IF (l < specialLayers) OR (key = NIL) THEN LOOP;
min ← CDSimpleRules.MinWidth [l]; max ← CDSimpleRules.MaxWidth [l];
a ← MAX [(r.x2 - r.x1), (r.y2 - r.y1)]; b ← MIN [(r.x2 - r.x1), (r.y2 - r.y1)];
IF (a < min)
OR (b < min)
OR (a > max)
OR (b > max)
THEN
BEGIN
<< Total Hack. Yuk. >>
The following is a cochonnerie to avoid flagging large split contacts that may occur in CMOS-B designs. The heuristics is there because of two reasons: a) I cannot know from which contact class the cut is coming, b) I do not want to put in here an even worse cochonnerie by introducing a dependency of Mayday on technologies by importing a specific technology.
splitA: CD.Number = 3 * min; splitB: CD.Number = min; -- yuk, spit
Note that I am using an atom because many users hide the technology from Mayday. If the splits are flagged then the atom in ChipNDale may have changed.
IF (CD.LayerKey[l] = $cut) AND (a = splitA) AND (b = splitB) THEN NULL -- mumble
ELSE MarkError [c, s, [r, Rope.Cat ["Width violation on layer ", Atom.GetPName [CD.LayerKey [l]], " (wire ", CoreOps.GetShortWireName[w], ")"]]]
END
ENDLOOP
END; -- WidthCheck
MaterialSeparation:
PROC [cell: Core.CellType, state: State, w1, w2: Core.Wire, loc1, loc2:
CD.Position, orient1, orient2:
CD.Orientation] ~
BEGIN
If two unrelated rectangles of material intersect, an error is flagged.
The parameter cell selects the cell receiving possible error messages. It must be the father of the cell containing w1 and the cell containing w2.
aequipotential: BOOL;
cd1, cd2: CD.InstanceList; obj1, obj2: CD.Object;
r1, r2, r, s: CD.Rect;
l1, l2: CD.Layer; key1, key2: ATOM;
sep: CD.Number;
Intersect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [CDBasics.Intersect [CDBasics.Extend[AtomicWireHull[w1,state],state.maxSeparation], AtomicWireHull[w2,state]]]
END; -- Intersect
NotCuts:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
Note that I am using atoms because many users hide the technology from Mayday. If violations from cuts arenot flagged then the atom in ChipNDale may have changed.
RETURN [NOT (((key1 = $cut) OR (key1 = $cut2)) AND ((key2 = $cut) OR (key2 = $cut2)))]
END; -- NotCuts
SameRect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [(l1 = l2) AND (r1.x1 = r2.x1) AND (r1.y1 = r2.y1) AND (r1.x2 = r2.x2) AND (r1.y2 = r2.y2)]
END; -- SameRect
IF state.abort^ THEN ERROR ABORTED;
We cannot skip the verification in the w1 = w2. In fact, in Core and Sinix, cuts are represented as material rectangles in wires. So to Mayday two cuts violating the separation rule will alway look as two aequipotential rectangles.
cd1 ← CoreGeometry.GetGeometry[state.decoration, w1];
cd2 ← CoreGeometry.GetGeometry[state.decoration, w2];
IF (cd1 = NIL) OR (cd2 = NIL) THEN RETURN; -- Skip wires without geometry
IF (NOT Intersect[]) THEN RETURN; -- or whose geometry is too far apart.
FOR outer:
CD.InstanceList ← cd1, outer.rest
WHILE outer #
NIL
DO
obj1 ← outer.first.ob;
[r1, l1] ← FindCDRect [outer.first];
key1 ← CD.LayerKey [l1];
Filter out the special layers. Also the extractor creates material at illegal levels. We try heuristically to filter it out here.
IF (l1 < specialLayers) OR (key1 = NIL) THEN LOOP;
r1 ← CDOrient.MapRect [itemInCell: r1,
cellSize: outer.first.ob.size,
cellInstOrient: orient1,
cellInstPos: loc1];
FOR inner:
CD.InstanceList ← cd2, inner.rest
WHILE inner #
NIL
DO
IF state.abort^ THEN ERROR ABORTED;
obj2 ← inner.first.ob;
Probe 1: Call the debugger. Give property $MaydayBreak to two pieces of material that violate a rule but are not flagged.
IF debug AND (obj1#NIL) AND (obj2#NIL) AND (CDProperties.GetProp[obj1,$MaydayBreak]#NIL) AND (CDProperties.GetProp[obj1,$MaydayBreak]#NIL) THEN SIGNAL break;
[r2, l2] ← FindCDRect [inner.first];
The order of the next two statements is very important.
aequipotential ← CDBasics.Intersect [r1, r2];
key2 ← CD.LayerKey [l2];
IF aequipotential AND NotCuts[] THEN LOOP;
IF (l2 < specialLayers) OR (key2 = NIL) THEN LOOP;
sep ← CDSimpleRules.MinDist [l1, l2 ! CDSimpleRules.NotKnown => sep ← 0];
IF sep = 0 THEN LOOP;
r2 ← CDOrient.MapRect [r2, inner.first.ob.size, orient2, loc2];
IF aequipotential AND SameRect[] THEN LOOP;
r ← CDBasics.Extend [r1, sep / 2]; s ← CDBasics.Extend [r2, sep / 2];
IF ((r.x1<s.x2)
AND (s.x1<r.x2)
AND (r.y1<s.y2)
AND (s.y1<r.y2))
THEN
BEGIN
rect1: Rope.ROPE = Rope.Cat [Atom.GetPName [key1], " (wire ", CoreOps.GetShortWireName[w1], ")"];
rect2: Rope.ROPE = Rope.Cat [Atom.GetPName [key2], " (wire ", CoreOps.GetShortWireName[w2], ")"];
Probe 2: Set a break point after this line to see why a wrong violation is flagged.
MarkError [cell, state, [CDBasics.Intersection[r,s], Rope.Cat["Separation violation between ", rect1, " and ", rect2]]];
END
ENDLOOP -- inner
ENDLOOP -- outer
END; -- MaterialSeparation
MaterialToCellSeparation: MaterialToCellProc ~
BEGIN
[self: Core.CellType, state: State, actual, wire: Core.Wire, father: Core.CellType, materialLoc, cellLoc: CD.Position, materialOrient, cellOrient: CD.Orientation]
For convenience.
Send:
PROC ~
INLINE
BEGIN
check: REF MaterialToCellProc ← NARROW [CoreProperties.GetProp [self.properties, matToCell]];
IF check = NIL THEN check ← NARROW [CoreProperties.GetProp [self.class.properties, matToCell]];
IF check =
NIL
THEN
BEGIN
obj: CD.Object = GetObject [self, state];
IF obj = NIL THEN RETURN; -- Cell contains no rectangles
check ← NEW [MaterialToCellProc ← MaterialToUnspecifiedSeparation];
MarkError [self, state, [obj.class.interestRect[obj], "Cell has no provisions to be checked"]]
END;
check^ [self, state, actual, wire, father, materialLoc, cellLoc, materialOrient, cellOrient]
END; -- Send
IF fast
THEN
SELECT self.class
FROM
CoreClasses.recordCellClass => MaterialToRecordCellSeparation [self, state, actual, wire, father, materialLoc, cellLoc, materialOrient, cellOrient];
CoreClasses.transistorCellClass => MaterialToTransistorSeparation [self, state, actual, wire, father, materialLoc, cellLoc, materialOrient, cellOrient];
CoreClasses.unspecifiedCellClass => MaterialToUnspecifiedSeparation [self, state, actual, wire, father, materialLoc, cellLoc, materialOrient, cellOrient];
ENDCASE => Send []
ELSE Send []
END; -- MaterialToCellSeparation
MaterialToTransistorSeparation: MaterialToCellProc ~
BEGIN
[self: Core.CellType, state: State, actual, wire: Core.Wire, father: Core.CellType, materialLoc, cellLoc: CD.Position, materialOrient, cellOrient: CD.Orientation]
wbb, tbb: CD.Rect; -- bounding boxes
tw: Core.Wire;
Intersect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [CDBasics.Intersect [CDBasics.Extend[tbb,state.maxSeparation], wbb]]
END; -- Intersect
IF state.abort^ THEN ERROR ABORTED;
IF (CoreProperties.GetProp [self.properties, doNotAnalyse] # NIL) THEN RETURN;
Find the bounding box of wire and check whether it has a non-empty intersection with the internal wire of the cell.
wbb ← AtomicWireHull [wire, state];
wbb ← CDOrient.MapRect [itemInCell: wbb,
cellSize: CDBasics.SizeOfRect [wbb],
cellInstOrient: materialOrient,
cellInstPos: materialLoc];
tbb ← TransistorHull [self, state];
tbb ← CDOrient.MapRect [itemInCell: tbb,
cellSize: CDBasics.SizeOfRect [tbb],
cellInstOrient: cellOrient,
cellInstPos: cellLoc];
IF (NOT Intersect[]) THEN RETURN;
tw ← BindTransistor [self.public, actual, state];
Check each element of the transistor wire of the cell against each element of wire.
FOR i:
NAT
IN [0 .. tw.size)
DO
MaterialSeparation [state: state,
cell: father,
w1: tw[i],
w2: wire,
loc1: cellLoc,
loc2: materialLoc,
orient1: cellOrient,
orient2: materialOrient]
ENDLOOP
END; -- MaterialToTransistorSeparation
MaterialToUnspecifiedSeparation: MaterialToCellProc ~
BEGIN
[self: Core.CellType, state: State, actual, wire: Core.Wire, father: Core.CellType, materialLoc, cellLoc: CD.Position, materialOrient, cellOrient: CD.Orientation]
NULL
END; -- MaterialToUnspecifiedSeparation
MaterialToRecordCellSeparation: MaterialToCellProc ~
BEGIN
[self: Core.CellType, state: State, actual, wire: Core.Wire, father: Core.CellType, materialLoc, cellLoc: CD.Position, materialOrient, cellOrient: CD.Orientation]
wbb, cbb: CD.Rect; -- bounding boxes
boundInternal: Core.Wire;
propagatedActuals: WireSet; -- one wire per subcell
bindingTable: RefTab.Ref;
cellData: CoreClasses.RecordCellType ← NARROW [self.data];
Intersect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [CDBasics.Intersect [CDBasics.Extend[cbb,state.maxSeparation], wbb]]
END; -- Intersect
IF state.abort^ THEN ERROR ABORTED;
IF (CoreProperties.GetProp [self.properties, doNotAnalyse] # NIL) OR (cellData.internal.size = 0) THEN RETURN;
Find the bounding box of wire and check whether it has a non-empty intersection with the internal wire of the cell.
wbb ← AtomicWireHull [wire, state];
wbb ← CDOrient.MapRect [itemInCell: wbb,
cellSize: CDBasics.SizeOfRect [wbb],
cellInstOrient: materialOrient,
cellInstPos: materialLoc];
cbb ← RecordCellHull [self, state];
cbb ← CDOrient.MapRect [itemInCell: cbb,
cellSize: CDBasics.SizeOfRect [cbb],
cellInstOrient: cellOrient,
cellInstPos: cellLoc];
IF (NOT Intersect[]) THEN RETURN;
Check each element of the internal wire of the cell against each element of wire.
bindingTable ← CreateBindingTable [actual: actual, public: self.public];
boundInternal ← BindInternal [bindingTable, cellData.internal, state];
FOR i:
NAT
IN [0 .. boundInternal.size)
DO
MaterialSeparation [state: state,
cell: father,
w1: boundInternal[i],
w2: wire,
loc1: cellLoc,
loc2: materialLoc,
orient1: cellOrient,
orient2: materialOrient]
ENDLOOP;
The propagated actuals must be determined here once for all, because new actual wires will differ from call to call.
propagatedActuals ← NEW [WireSetRec[cellData.size]];
FOR sub:
NAT
IN [0 .. cellData.size)
DO
propagatedActuals[sub] ← PropagateBinding [state, bindingTable, cellData.instances[sub].actual]
ENDLOOP;
FlushBindingTable [bindingTable];
Check intersections between subcells of cell and wire.
FOR sub:
NAT
IN [0 .. cellData.size)
DO
cdInst: CD.Instance = CoreGeometry.GetTransf[state.decoration, cellData.instances[sub]];
IF (cdInst = NIL) THEN coreMess ["Core record subcell has no geometry (6)", cellData];
MaterialToCellSeparation [self: cellData.instances[sub].type,
state: state,
actual: propagatedActuals[sub],
wire: wire,
father: self,
materialLoc: materialLoc,
cellLoc: CDBasics.AddPoints [cellLoc, cdInst.location],
materialOrient: materialOrient,
cellOrient: CDOrient.ComposeOrient [cellOrient, cdInst.orientation]]
ENDLOOP
END; -- MaterialToRecordCellSeparation
CellToCellSeparation: CellToCellProc ~
BEGIN
[self: Core.CellType, state: State, otherCell: Core.CellType, selfActual, otherActual: Core.Wire, father: Core.CellType, selfLoc, otherLoc: CD.Position, selfOrient, otherOrient: CD.Orientation]
For convenience.
Send:
PROC ~
INLINE
BEGIN
check: REF CellToCellProc ← NARROW [CoreProperties.GetProp [self.properties, cellToCell]];
IF check = NIL THEN check ← NARROW [CoreProperties.GetProp [self.class.properties, cellToCell]];
IF check =
NIL
THEN
BEGIN
obj: CD.Object = GetObject [self, state];
IF obj = NIL THEN RETURN; -- Cell contains no rectangles
check ← NEW [CellToCellProc ← UnspecifiedToAnyClassSeparation];
MarkError [self, state, [obj.class.interestRect[obj], "Cell has no provisions to be checked"]]
END;
check^ [self, state, otherCell, selfActual, otherActual, father, selfLoc, otherLoc, selfOrient, otherOrient]
END; -- Send
SELECT otherCell.class
FROM
CoreClasses.unspecifiedCellClass => RETURN;
CoreClasses.recordCellClass => NULL; -- default case
CoreClasses.transistorCellClass =>
-- nasty case
IF self.class = CoreClasses.transistorCellClass
THEN
BEGIN
IF fast
THEN
TransistorToTransistorSeparation [self, state, otherCell, selfActual, otherActual, father, selfLoc, otherLoc, selfOrient, otherOrient]
ELSE Send [];
RETURN
END
ELSE
BEGIN
-- swap
selfZ: Core.CellType = self;
selfActualZ: Core.Wire = selfActual;
selfLocZ: CD.Position = selfLoc;
selfOrientZ: CD.Orientation = selfOrient;
self ← otherCell; otherCell ← selfZ;
selfActual ← otherActual; otherActual ← selfActualZ;
selfLoc ← otherLoc; otherLoc ← selfLocZ;
selfOrient ← otherOrient; otherOrient ← selfOrientZ
END;
ENDCASE => ERROR;
IF fast
THEN
SELECT self.class
FROM
CoreClasses.recordCellClass => RecordCellToRecordCellSeparation [self, state, otherCell, selfActual, otherActual, father, selfLoc, otherLoc, selfOrient, otherOrient];
CoreClasses.transistorCellClass => TransistorToRecordCellSeparation [self, state, otherCell, selfActual, otherActual, father, selfLoc, otherLoc, selfOrient, otherOrient];
CoreClasses.unspecifiedCellClass => UnspecifiedToAnyClassSeparation [self, state, otherCell, selfActual, otherActual, father, selfLoc, otherLoc, selfOrient, otherOrient];
ENDCASE => Send []
ELSE Send []
END; -- CellToCellSeparation
TransistorToRecordCellSeparation: CellToCellProc ~
BEGIN
[self: Core.CellType, state: State, otherCell: Core.CellType, selfActual, otherActual: Core.Wire, father: Core.CellType, selfLoc, otherLoc: CD.Position, selfOrient, otherOrient: CD.Orientation]
cbb1, cbb2: CD.Rect; -- bounding boxes
othersCellData: CoreClasses.RecordCellType ← NARROW [otherCell.data];
othersBindingTable: RefTab.Ref;
tw: Core.Wire;
othersBoundInternal: Core.Wire;
ownName: Rope.ROPE = CoreOps.GetCellTypeName [self];
otherName: Rope.ROPE = CoreOps.GetCellTypeName [otherCell];
Intersect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [CDBasics.Intersect [CDBasics.Extend[cbb1,state.maxSeparation], cbb2]]
END; -- Intersect
Preamble.
IF state.abort^ THEN ERROR ABORTED;
IF (CoreProperties.GetProp [self.properties, doNotAnalyse]#NIL) OR (CoreProperties.GetProp [otherCell.properties, doNotAnalyse]#NIL) THEN RETURN;
IF debug
THEN
BEGIN
IO.PutF [stream: dLog,
format: "Checking transistor %l%g%l vs. %g. ",
v1: IO.rope ["e"],
v2: IF ownName = NIL THEN IO.refAny [self] ELSE IO.rope [ownName],
v3: IO.rope ["E"],
v4: IF otherName = NIL THEN IO.refAny [otherCell] ELSE IO.rope [otherName]];
IO.PutF [stream: dLog,
format: "Rel. orient: %g, dist: (%g, %g).\n",
v1: IO.int [CDOrient.DecomposeOrient [otherOrient, selfOrient]],
v2: IO.int [(otherLoc.x - selfLoc.x) / previousTechnology.lambda],
v3: IO.int [(otherLoc.y - selfLoc.y) / previousTechnology.lambda]]
END;
cbb1 ← RecordCellHull [self, state];
cbb1 ← CDOrient.MapRect [itemInCell: cbb1,
cellSize: CDBasics.SizeOfRect [cbb1],
cellInstOrient: selfOrient,
cellInstPos: selfLoc];
cbb2 ← RecordCellHull [otherCell, state];
cbb2 ← CDOrient.MapRect [itemInCell: cbb2,
cellSize: CDBasics.SizeOfRect [cbb2],
cellInstOrient: otherOrient,
cellInstPos: otherLoc];
IF (NOT Intersect[]) THEN RETURN;
Check the separation between the internal of transistor and cell2.
IF state.abort^ THEN ERROR ABORTED;
othersBindingTable ← CreateBindingTable [actual: otherActual, public: otherCell.public];
othersBoundInternal ← BindInternal [othersBindingTable, othersCellData.internal, state];
tw ← BindTransistor [self.public, selfActual, state];
FlushBindingTable [othersBindingTable];
FOR i:
NAT
IN [0 .. tw.size)
DO
FOR j:
NAT
IN [0 .. othersCellData.internal.size)
DO
MaterialSeparation [state: state,
cell: father, -- the cell getting the error flag --
w1: tw[i],
w2: othersBoundInternal[j],
loc1: selfLoc,
loc2: otherLoc,
orient1: selfOrient,
orient2: otherOrient]
ENDLOOP
ENDLOOP
END; -- TransistorToRecordCellSeparation
TransistorToTransistorSeparation: CellToCellProc ~
BEGIN
[self: Core.CellType, state: State, otherCell: Core.CellType, selfActual, otherActual: Core.Wire, father: Core.CellType, selfLoc, otherLoc: CD.Position, selfOrient, otherOrient: CD.Orientation]
cbb1, cbb2: CD.Rect; -- bounding boxes
tw1, tw2: Core.Wire;
ownName: Rope.ROPE = CoreOps.GetCellTypeName [self];
otherName: Rope.ROPE = CoreOps.GetCellTypeName [otherCell];
Intersect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [CDBasics.Intersect [CDBasics.Extend[cbb1,state.maxSeparation], cbb2]]
END; -- Intersect
Preamble.
IF state.abort^ THEN ERROR ABORTED;
IF (CoreProperties.GetProp [self.properties, doNotAnalyse]#NIL) OR (CoreProperties.GetProp [otherCell.properties, doNotAnalyse]#NIL) THEN RETURN;
cbb1 ← RecordCellHull [self, state];
cbb1 ← CDOrient.MapRect [itemInCell: cbb1,
cellSize: CDBasics.SizeOfRect [cbb1],
cellInstOrient: selfOrient,
cellInstPos: selfLoc];
cbb2 ← RecordCellHull [otherCell, state];
cbb2 ← CDOrient.MapRect [itemInCell: cbb2,
cellSize: CDBasics.SizeOfRect [cbb2],
cellInstOrient: otherOrient,
cellInstPos: otherLoc];
IF (NOT Intersect[]) THEN RETURN;
Check the separation between the internal of cell1 and cell2.
IF state.abort^ THEN ERROR ABORTED;
tw1 ← BindTransistor [self.public, selfActual, state];
tw2 ← BindTransistor [otherCell.public, otherActual, state];
FOR i:
NAT
IN [0 .. tw1.size)
DO
FOR j:
NAT
IN [0 .. tw2.size)
DO
MaterialSeparation [state: state,
cell: father, -- the cell getting the error flag --
w1: tw1[i],
w2: tw2[j],
loc1: selfLoc,
loc2: otherLoc,
orient1: selfOrient,
orient2: otherOrient]
ENDLOOP
ENDLOOP
END; -- TransistorToTransistorSeparation
UnspecifiedToAnyClassSeparation: CellToCellProc ~
BEGIN
[self: Core.CellType, state: State, otherCell: Core.CellType, selfActual, otherActual: Core.Wire, father: Core.CellType, selfLoc, otherLoc: CD.Position, selfOrient, otherOrient: CD.Orientation]
NULL
END; -- UnspecifiedToAnyClassSeparation
RecordCellToRecordCellSeparation: CellToCellProc ~
BEGIN
[self: Core.CellType, state: State, otherCell: Core.CellType, selfActual, otherActual: Core.Wire, father: Core.CellType, selfLoc, otherLoc: CD.Position, selfOrient, otherOrient: CD.Orientation]
cbb1, cbb2: CD.Rect; -- bounding boxes
ownCellData: CoreClasses.RecordCellType ← NARROW [self.data];
othersCellData: CoreClasses.RecordCellType ← NARROW [otherCell.data];
ownBindingTable, othersBindingTable: RefTab.Ref;
ownBoundInternal, othersBoundInternal: Core.Wire;
ownName: Rope.ROPE = CoreOps.GetCellTypeName [self];
otherName: Rope.ROPE = CoreOps.GetCellTypeName [otherCell];
Intersect:
PROC
RETURNS [
BOOL] ~
INLINE
BEGIN
RETURN [CDBasics.Intersect [CDBasics.Extend[cbb1,state.maxSeparation], cbb2]]
END; -- Intersect
Preamble.
IF state.abort^ THEN ERROR ABORTED;
IF (CoreProperties.GetProp [self.properties, doNotAnalyse]#NIL) OR (CoreProperties.GetProp [otherCell.properties, doNotAnalyse]#NIL) THEN RETURN;
IF debug
THEN
BEGIN
IO.PutF [stream: dLog,
format: "Checking cell %l%g%l vs. %g. ",
v1: IO.rope ["e"],
v2: IF ownName = NIL THEN IO.refAny [self] ELSE IO.rope [ownName],
v3: IO.rope ["E"],
v4: IF otherName = NIL THEN IO.refAny [otherCell] ELSE IO.rope [otherName]];
IO.PutF [stream: dLog,
format: "Rel. orient: %g, dist: (%g, %g).\n",
v1: IO.int [CDOrient.DecomposeOrient [otherOrient, selfOrient]],
v2: IO.int [(otherLoc.x - selfLoc.x) / previousTechnology.lambda],
v3: IO.int [(otherLoc.y - selfLoc.y) / previousTechnology.lambda]]
END;
cbb1 ← RecordCellHull [self, state];
cbb1 ← CDOrient.MapRect [itemInCell: cbb1,
cellSize: CDBasics.SizeOfRect [cbb1],
cellInstOrient: selfOrient,
cellInstPos: selfLoc];
cbb2 ← RecordCellHull [otherCell, state];
cbb2 ← CDOrient.MapRect [itemInCell: cbb2,
cellSize: CDBasics.SizeOfRect [cbb2],
cellInstOrient: otherOrient,
cellInstPos: otherLoc];
IF (NOT Intersect[]) THEN RETURN;
Check the separation between the internal of cell1 and cell2.
IF state.abort^ THEN ERROR ABORTED;
ownBindingTable ← CreateBindingTable [actual: selfActual, public: self.public];
othersBindingTable ← CreateBindingTable [actual: otherActual, public: otherCell.public];
ownBoundInternal ← BindInternal [ownBindingTable, ownCellData.internal, state];
othersBoundInternal ← BindInternal [othersBindingTable, othersCellData.internal, state];
FlushBindingTable [ownBindingTable]; FlushBindingTable [othersBindingTable];
FOR i:
NAT
IN [0 .. ownCellData.internal.size)
DO
FOR j:
NAT
IN [0 .. othersCellData.internal.size)
DO
MaterialSeparation [state: state,
cell: father, -- the cell getting the error flag --
w1: ownBoundInternal[i],
w2: othersBoundInternal[j],
loc1: selfLoc,
loc2: otherLoc,
orient1: selfOrient,
orient2: otherOrient]
ENDLOOP
ENDLOOP
END; -- RecordCellToRecordCellSeparation
ComputeMaxSeparation:
PROC [technology:
CD.Technology]
RETURNS [maxSeparation:
CD.Number] ~
BEGIN
Initialises the separation table. This is where the technology comes in !
maxSeparation ← 0;
FOR s1:
CD.Layer
IN
CD.Layer
DO
IF
CD.LayerTechnology[s1] = technology
THEN
FOR s2:
CD.Layer
IN
CD.Layer
DO
IF
CD.LayerTechnology[s2] = technology
THEN
BEGIN
sep: CD.Number = CDSimpleRules.MinDist [s1, s2 ! CDSimpleRules.NotKnown => LOOP]; -- try to filter out inappropriate layers
maxSeparation ← MAX [maxSeparation, sep]
END
ENDLOOP
ENDLOOP
END; -- ComputeMaxSeparation
RegisterSeparationProcs:
PROC ~
BEGIN
Called in the module initialisation part.
CoreClasses.recordCellClass.properties ← CoreProperties.PutProp [
on: CoreClasses.recordCellClass.properties,
prop: matToCell,
value: NEW [MaterialToCellProc ← MaterialToRecordCellSeparation]];
CoreClasses.transistorCellClass.properties ← CoreProperties.PutProp [CoreClasses.transistorCellClass.properties, matToCell, NEW [MaterialToCellProc ← MaterialToTransistorSeparation]];
CoreClasses.unspecifiedCellClass.properties ← CoreProperties.PutProp [CoreClasses.unspecifiedCellClass.properties, matToCell, NEW [MaterialToCellProc ← MaterialToUnspecifiedSeparation]];
CoreClasses.recordCellClass.properties ← CoreProperties.PutProp [
on: CoreClasses.recordCellClass.properties,
prop: cellToCell,
value: NEW [CellToCellProc ← RecordCellToRecordCellSeparation]];
CoreClasses.transistorCellClass.properties ← CoreProperties.PutProp [CoreClasses.transistorCellClass.properties, cellToCell, NEW [CellToCellProc ← TransistorToRecordCellSeparation]];
CoreClasses.unspecifiedCellClass.properties ← CoreProperties.PutProp [CoreClasses.unspecifiedCellClass.properties, cellToCell, NEW [CellToCellProc ← UnspecifiedToAnyClassSeparation]];
END; -- RegisterSeparationProcs