LichenFromExt:
CEDAR
MONITOR
LOCKS dr USING dr: DesignReading
IMPORTS Asserting, Atom, BasicTime, Buttons, Containers, FS, HashTable, Icons, IO, LichenDataStructure, LichenDataOps, LichenSetTheory, List, PieViewers, Process, ProcessProps, RedBlackTree, RefText, Rope, RopeHash, ViewerOps, ViewerTools
= BEGIN OPEN Asserting, LichenDataStructure, LichenDataOps, LichenSetTheory;
REFTEXT: TYPE = REF TEXT;
Viewer: TYPE = ViewerClasses.Viewer;
SourceList: TYPE = LIST OF Source;
Source: TYPE = RECORD [stream: IO.STREAM ← NIL, name: ROPE ← NIL];
Reader: TYPE = REF ReaderRep;
ReaderRep:
TYPE =
RECORD [
keyword: ROPE,
read:
PROC [s: Source, reader: Reader, cr: CellReading],
Consumes newline at end of line.
data: REF ANY];
readers: Mapper ← CreateHashDictionary[TRUE];
DesignReading: TYPE = REF DesignReadingRep;
DesignReadingRep:
TYPE =
MONITORED
RECORD [
design: Design,
wDir: ROPE,
cellTypesByName: Mapper,
fetTypes: HashTable.Table,
unkosherArrays: Set,
toMerge: RedBlackTree.Table,
mostRecentPathToMerge: Path ← NIL,
impossibleMerges: ImpossibleMergeList ← NIL,
buffer: REFTEXT,
pacifier, pie, label, pause: Viewer,
lastPacify: BasicTime.Pulses,
stop: BOOL ← FALSE,
stack: SourceList ← NIL,
change: CONDITION];
undefinedINT: INT = FIRST[INT];
ImpossibleMergeList: TYPE = LIST OF ImpossibleMerge;
ImpossibleMerge:
TYPE =
RECORD [
arrayInstance: CellInstance, path1, path2: Path];
CellReading: TYPE = REF CellReadingRep;
CellReadingRep:
TYPE =
RECORD [
dr: DesignReading,
ct: CellType,
name: ROPE,
resistClasses: INT ← undefinedINT,
rScale: REAL--ohms-- ← 1.0E-3,
cScale: REAL--farads-- ← 1.0E-18,
lUnits: REAL--meters-- ← 1.0E-8,
scalingDefined: BOOL ← FALSE,
fetCount: INT ← 0,
waitingMerges: PathPairList ← NIL
];
PathPairList: TYPE = LIST OF PathPair;
Path: TYPE = LIST OF REF ANY--UNION [ROPE, REF Range2]--;
VertexArray: TYPE = REF VertexArrayRep;
VertexArrayRep:
TYPE =
RECORD [
shape: Size2,
vertices: SEQUENCE length: NAT OF Vertex];
Use: TYPE = RECORD [childName: ROPE, as: ArraySpec];
ArraySpec:
TYPE =
RECORD [
variant:
SELECT kind: *
FROM
scalar => [],
array => [
range: Range2,
sep: Size2
]
ENDCASE];
FetTerminal:
TYPE =
RECORD [
name: ROPE,
length: INT,
attrs: Assertions];
IntBox: TYPE = RECORD [xmin, ymin, xmax, ymax: INT];
Int2: TYPE = ARRAY Dim OF INT;
TransformAsTerms: TYPE = Terms;
PathPair: TYPE = REF PathPairPrivate;
PathPairPrivate: TYPE = RECORD [p1, p2: Path];
pacifierIcon: Icons.IconFlavor ← Icons.NewIconFromFile["Lichen.icons", 0];
labelHeight: INTEGER ← 17;
pauseWidth: INTEGER ← 60;
pieDiameter: INTEGER ← 50;
ReadDesign:
PROC [rootCellFileName:
ROPE, oldDR: DesignReading ←
NIL]
RETURNS [dr: DesignReading] =
BEGIN
Doit:
PROC = {
dr.stack ← NIL;
[] ← ReadCellType[dr.design, rootCellFileName, dr]};
IF oldDR =
NIL
THEN {
cp: FS.ComponentPositions;
fullFName, designName: ROPE;
[fullFName, cp, ] ← FS.ExpandName[rootCellFileName];
designName ← fullFName.Substr[start: cp.base.start, len: cp.base.length];
dr ←
NEW [DesignReadingRep ← [
design:
NEW [DesignPrivate ← [
cellTypes: CreateHashSet[],
other: Assert[nameReln, LIST[designName], NIL]
]],
wDir: fullFName.Substr[len: cp.base.start],
cellTypesByName: CreateHashDictionary[TRUE],
fetTypes: HashTable.Create[hash: HashFetType, equal: CompareFetTypes],
unkosherArrays: CreateHashSet[],
toMerge: RedBlackTree.Create[Id, ComparePaths],
buffer: RefText.New[200],
pacifier: Containers.Create[info: [name: designName.Cat[" pacifier"], icon: pacifierIcon]],
pie: NIL,
label: NIL,
pause: NIL,
lastPacify: BasicTime.GetClockPulses[] - pacifyPulses
]];
TRUSTED {
Process.InitializeCondition[@dr.change, Process.SecondsToTicks[60]];
Process.EnableAborts[@dr.change]};
dr.pause ← Buttons.Create[info: [name: "Pause", parent: dr.pacifier, wx: 0, wy: 0, ww: pauseWidth, wh: labelHeight], proc: TogglePause, clientData: dr];
dr.label ← ViewerTools.MakeNewTextViewer[info: [parent: dr.pacifier, wx: dr.pause.wx+dr.pause.ww, wy: 0, ww: 100, wh: labelHeight]];
Containers.ChildXBound[container: dr.pacifier, child: dr.label];
dr.pie ← PieViewers.Create[parent: dr.pacifier, x: 0, y: dr.label.wy+dr.label.wh, diameter: pieDiameter, total: 1.0, divisions: 100];
Containers.ChildXBound[container: dr.pacifier, child: dr.pie];
Containers.ChildYBound[container: dr.pacifier, child: dr.pie];
ViewerOps.SetOpenHeight[dr.pacifier, dr.pie.wy+dr.pie.wh];
}
ProcessProps.PushPropList[List.PutAssoc[$WorkingDirectory, dr.wDir, NIL], Doit];
ViewerTools.SetContents[dr.label, "Idle"];
PieViewers.Set[dr.pie, 0];
END;
TogglePause: Buttons.ButtonProc = {
dr: DesignReading = NARROW[clientData];
Flip:
ENTRY
PROC [dr: DesignReading] = {
dr.stop ← NOT dr.stop;
BROADCAST dr.change};
Flip[dr];
Buttons.ReLabel[dr.pause, IF dr.stop THEN "Continue" ELSE "Pause"];
};
PrintImpossibles:
PROC [to:
IO.
STREAM, dr: DesignReading] = {
FOR ims: ImpossibleMergeList ← dr.impossibleMerges, ims.rest
WHILE ims #
NIL
DO
im: ImpossibleMerge = ims.first;
to.PutF["%g: %g & %g\n", [rope[Describe[im.arrayInstance, dr.design]]], [rope[FmtPath[im.path1]]], [rope[FmtPath[im.path2]]]];
ENDLOOP;
};
fromExtClass: CellClass ← NEW [CellClassPrivate ← []];
pacifyPulses: BasicTime.Pulses ← BasicTime.MicrosecondsToPulses[2500000];
ReadCellType:
PROC [design: Design, cellFileName:
ROPE, dr: DesignReading]
RETURNS [ct: CellType] = {
cp: FS.ComponentPositions;
fullFName, cellTypeName: ROPE;
from: IO.STREAM;
s: Source;
cr: CellReading;
length: REAL;
cooler: SourceList = dr.stack;
suffix: ROPE = FmtStack[cooler];
myStack: SourceList;
[fullFName, cp] ← ExpandName[cellFileName, "ext"];
cellTypeName ← fullFName.Substr[start: cp.base.start, len: cp.base.length];
ct ← CreateCellType[design, dr, cellTypeName, TRUE, NIL, NIL];
cr ← NEW[CellReadingRep ← [dr: dr, ct: ct, name: cellTypeName]];
s ← [from ← FS.StreamOpen[fullFName], fullFName];
myStack ← CONS[s, cooler];
length ← INT[MAX[from.GetLength[], 1]];
DO
keyword: ROPE;
reader: Reader;
now: BasicTime.Pulses = BasicTime.GetClockPulses[];
Process.CheckForAbort[];
[] ← from.SkipWhitespace[];
IF from.EndOf[] THEN EXIT;
dr.stack ← myStack;
IF now-dr.lastPacify >= pacifyPulses
THEN {
index: INT = from.GetIndex[];
dr.lastPacify ← now;
ViewerTools.SetContents[dr.label, IO.PutFR["%g[%g]%g", [rope[cellTypeName]], [integer[index]], [rope[suffix]]]];
PieViewers.Set[dr.pie, index/length];
};
IF dr.stop THEN Wait[dr];
keyword ← from.GetTokenRope[TokenBreak].token;
reader ← NARROW[readers.Map[keyword]];
IF reader #
NIL
THEN reader.read[s, reader, cr]
ELSE {
terms: Terms ← GetLineTerms[from];
reln: ATOM ← Atom.MakeAtom[keyword];
ct.otherPublic ← Assert[reln, terms, ct.otherPublic];
};
ENDLOOP;
IF dr.toMerge.Size[] # 0 THEN DoMerges[s, cr];
DO
progress: BOOL ← FALSE;
wml: PathPairList ← cr.waitingMerges;
cr.waitingMerges ← NIL;
FOR wml ← wml, wml.rest
WHILE wml #
NIL
DO
progress ← MergeWork[cr, ct, wml.first.p1, wml.first.p2] OR progress;
ENDLOOP;
IF NOT progress THEN EXIT;
ENDLOOP;
IF cr.waitingMerges # NIL THEN ERROR;
ct.publicKnown ← TRUE;
ct.privateKnown ← TRUE;
from.Close[];
};
Wait:
ENTRY
PROC [dr: DesignReading] = {
WHILE dr.stop DO WAIT dr.change ENDLOOP};
FmtStack:
PROC [stack: SourceList]
RETURNS [suffix:
ROPE] = {
suffix ← NIL;
FOR stack ← stack, stack.rest
WHILE stack #
NIL
DO
full: ROPE;
cp: FS.ComponentPositions;
[full, cp, ] ← FS.ExpandName[stack.first.name];
suffix ← IO.PutFR["%g, %g[%g]", [rope[suffix]], [rope[full.Substr[cp.base.start, cp.base.length]]], [integer[IO.GetIndex[stack.first.stream]]]];
ENDLOOP;
suffix ← suffix;
};
GetLineTerms:
PROC [from:
IO.
STREAM]
RETURNS [terms: Terms] = {
tail: Terms ← terms ← NIL;
WHILE
NOT from.EndOf[]
DO
peek: CHAR ← from.PeekChar[];
SELECT peek
FROM
'\n => {IF from.GetChar[] # peek THEN ERROR; RETURN};
IN [0C .. ' ] => IF from.GetChar[] # peek THEN ERROR;
ENDCASE => {
this: LORA ← LIST[from.GetRefAny[]];
IF tail = NIL THEN terms ← this ELSE tail.rest ← this;
tail ← this};
ENDLOOP;
};
ExpandName:
PROC [fileName, defaultExtension:
ROPE]
RETURNS [fullFName:
ROPE, cp:
FS.ComponentPositions] = {
[fullFName, cp, ] ← FS.ExpandName[fileName];
IF defaultExtension.Length[] > 0
AND cp.ext.length = 0
THEN {
fileName ←
FS.ConstructFName[[
server: fullFName.Substr[cp.server.start, cp.server.length],
dir: fullFName.Substr[cp.dir.start, cp.dir.length],
subDirs: fullFName.Substr[cp.subDirs.start, cp.subDirs.length],
base: fullFName.Substr[cp.base.start, cp.base.length],
ext: defaultExtension,
ver: fullFName.Substr[cp.ver.start, cp.ver.length]
]];
[fullFName, cp, ] ← FS.ExpandName[fileName];
};
};
GetName:
PROC [s: Source]
RETURNS [name:
ROPE] = {
from: IO.STREAM = s.stream;
[] ← from.SkipWhitespace[];
SELECT from.PeekChar[]
FROM
'" => name ← from.GetRopeLiteral[];
ENDCASE => name ← from.GetTokenRope[TokenBreak].token;
};
TokenBreak:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass] =
{cc ←
SELECT char
FROM
'\n => break,
IN [0C .. ' ] => sepr,
ENDCASE => other};
EndLine:
PROC [from:
IO.
STREAM, buffer:
REFTEXT] = {
IF NOT from.EndOf[] THEN [] ← from.GetLine[buffer];
};
ReadTech:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
techname: ROPE ← GetName[s];
ct.otherPublic ← Assert[$tech, LIST[techname], ct.otherPublic];
EndLine[from, cr.dr.buffer];
};
ReadTimestamp:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
unixTime: INT ← from.GetInt[];
time: BasicTime.GMT ← BasicTime.Update[unixOrigin, unixTime];
ct.otherPublic ← Assert[$Source, LIST[cr.name.Cat[".mag"], IO.PutFR["%g", IO.time[time]]], ct.otherPublic];
EndLine[from, cr.dr.buffer];
};
unixOrigin: BasicTime.
GMT ← BasicTime.Pack[[
year: 1970,
month: January,
day: 1,
hour: 0,
minute: 0,
second: 0,
zone: 0--GMT, I hope--,
dst: no]];
ReadVersion:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
version: ROPE ← GetName[s];
deriver: ROPE = "UCB's Magic .extractor";
ct.otherPublic ← Assert[$DerivingProgram, LIST[deriver, version], ct.otherPublic];
EndLine[from, cr.dr.buffer];
};
ReadScale:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
rscale: INT ← from.GetInt[];
cscale: INT ← from.GetInt[];
lscale: INT ← from.GetInt[];
meters: ROPE = "meters";
IF cr.scalingDefined THEN Warn[s, "More than one scale statment"];
cr.scalingDefined ← TRUE;
cr.rScale ← rscale * cr.rScale;
cr.cScale ← cscale * cr.cScale;
cr.lUnits ← lscale * cr.lUnits;
ct.otherPublic ← AssertFn[$scale, LIST[NEW[REAL𡤌r.lUnits], meters], ct.otherPublic];
EndLine[from, cr.dr.buffer];
};
ReadResistClasses:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
n: INT ← 0;
IF cr.resistClasses # undefinedINT THEN Warn[s, "More than one resistclasses statment"];
DO
token: ROPE = from.GetTokenRope[TokenBreak].token;
IF token.Equal["\n"] THEN EXIT;
n ← n + 1;
ENDLOOP;
cr.resistClasses ← n;
};
keepCruft: BOOL ← FALSE;
ReadNode:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
nodeName: ROPE = GetName[s];
R: INT = from.GetInt[];
C: INT = from.GetInt[];
x: INT = from.GetInt[];
y: INT = from.GetInt[];
ok: BOOL = SkipNTokens[from, cr.resistClasses*2, cr.dr.buffer];
attrs: Assertions = ReadAttrs[s];
nv: Wire ← NARROW[LookupPart[ct, nodeName]];
IF nv =
NIL
THEN {
nv ← CreateWire[
containingCT: ct,
other: Assert[nameReln, LIST[nodeName], NIL]
];
}
IF keepCruft
THEN nv.other ← Asserting.Union[nv.other,
Assert[$R, LIST[NEW[REAL ← R*cr.rScale]],
Assert[$C, LIST[NEW[REAL ← C*cr.cScale]],
Assert[$locHint, LIST[NEW[INT←x], NEW[INT←y], $UnspecifiedLayer],
attrs]]]
];
EndLine[from, cr.dr.buffer];
};
ReadAttrs:
PROC [s: Source, zeroNIL:
BOOL ←
FALSE]
RETURNS [allTogetherNow: Assertions] = {
from: IO.STREAM = s.stream;
toke: ROPE ← NIL;
allTogetherNow ← NIL;
IF zeroNIL
THEN {
[] ← from.SkipWhitespace[];
IF from.PeekChar[] = '0
THEN {
IF from.GetChar[] # '0 THEN ERROR;
RETURN};
};
{
DO
attr: ROPE ← NIL;
toke ← from.GetTokenRope[AttrBreak !IO.EndOfStream => EXIT].token;
IF toke.Equal[","] THEN {Warn[s, "Extra comma"]; LOOP};
IF NOT toke.Equal["\""] THEN GOTO Return;
from.Backup['"];
attr ← from.GetRopeLiteral[ !IO.Error, IO.EndOfStream => {Warn[s, "not a rope literal"]; CONTINUE}];
IF attr # NIL THEN allTogetherNow ← Assert[$attr, LIST[attr], allTogetherNow];
toke ← from.GetTokenRope[AttrBreak !IO.EndOfStream => EXIT].token;
IF NOT toke.Equal[","] THEN GOTO Return;
ENDLOOP;
EXITS
Return => {
FOR i:
INT
DECREASING
IN [0 .. toke.Length[])
DO
s.stream.Backup[toke.Fetch[i]];
ENDLOOP;
};
}};
AttrBreak:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass] =
{cc ← SELECT char FROM ',, '\n, '" => break, ENDCASE => sepr};
ReadEquiv:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
name1: ROPE = GetName[s];
name2: ROPE = GetName[s];
v: Vertex ← LookupPart[ct, name1];
otherName: ROPE ← name2;
IF v = NIL THEN {v ← LookupPart[ct, name2]; otherName ← name1};
IF v = NIL THEN ERROR;
KnowVertexName[v, otherName];
EndLine[from, cr.dr.buffer];
};
ReadFet:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
type: ROPE ← GetName[s];
xl: INT ← from.GetInt[];
yl: INT ← from.GetInt[];
xh: INT ← from.GetInt[];
yh: INT ← from.GetInt[];
area: INT ← from.GetInt[];
perim: INT ← from.GetInt[];
sub: ROPE ← GetName[s];
GATE: FetTerminal ← GetFetTerminal[s];
T1: FetTerminal ← GetFetTerminal[s];
T2: FetTerminal ← GetFetTerminal[s];
sct: CellType;
tv: CellInstance;
DoTerm:
PROC [portIndex:
INT, ft: FetTerminal] = {
nv: Wire = GetNet[s, ct, ft.name];
Connect[tv, nv, portIndex];
};
sct ← GetFetType[cr.dr, type, [xl, yl, xh, yh], area, perim, T1.length+T2.length];
tv ← Instantiate[sct, ct, Assert[nameReln, LIST[IO.PutFR["Q%g", IO.int[cr.fetCount ← cr.fetCount + 1]]], NIL]];
DoTerm[0, GATE];
DoTerm[1, T1];
DoTerm[2, T2];
EndLine[from, cr.dr.buffer];
};
Connect:
PROC [ci: CellInstance, wire: Wire, portIndex:
INT] = {
[] ← AddEdge[vs: [cellward: ci, wireward: wire], port: ci.type.port.SubPort[portIndex]];
};
GetFetTerminal:
PROC [s: Source]
RETURNS [ft: FetTerminal] = {
from: IO.STREAM = s.stream;
ft.name ← GetName[s];
ft.length ← from.GetInt[];
ft.attrs ← ReadAttrs[s, TRUE];
};
GetFetType:
PROC [dr: DesignReading, className:
ROPE, innerGate: IntBox, area, perim, sumChannelLengths:
INT]
RETURNS [ct: CellType] = {
design: Design = dr.design;
ft: FetType = NEW [FetTypeRep ← [className, area, perim, sumChannelLengths]];
rft: FetType;
rft ← NARROW[dr.fetTypes.Fetch[ft].value];
IF rft =
NIL
THEN {
cellTypeName: ROPE = IO.PutFR["%g[%g,%g,%g]", IO.rope[ft.className], IO.int[ft.area], IO.int[ft.perim], IO.int[ft.twiceLength]];
Set:
PROC [type, mode:
ATOM] = {
ft.ct.otherPublic ← AssertFn1[$MOSFETFlavor, LIST[type, mode], ft.ct.otherPublic];
ft.ct.otherPublic ← AssertFn1[$EquivClass, Rope.Cat["MOSFET", Atom.GetPName[type], Atom.GetPName[mode]], ft.ct.otherPublic];
};
rft ← ft;
ft.ct ← CreateCellType[design, dr, cellTypeName, FALSE, AssertFn1[$MOSFETShape, LIST[NEW[REAL ← ft.twiceLength/2.0], NEW[REAL ← area*2.0/ft.twiceLength]], NIL], NIL];
FetPort[ft.ct.port];
SELECT
TRUE
FROM
className.Equal["nfet"] => Set[$n, $E];
className.Equal["pfet"] => Set[$p, $E];
ENDCASE => ERROR;
IF NOT dr.fetTypes.Insert[ft, ft] THEN ERROR;
};
ct ← rft.ct;
};
FetPort:
PROC [fp: Port] = {
[] ← AddPort[[parent: fp, other: Assert[nameReln, LIST[R["gate"]], NIL]]];
[] ← AddPort[[parent: fp, other: Assert[nameReln, LIST[R["ch1"]], NIL]]];
[] ← AddPort[[parent: fp, other: Assert[nameReln, LIST[R["ch2"]], NIL]]];
};
R: PROC [r: ROPE] RETURNS [r2: ROPE] = INLINE {r2 ← r}--stupid goddam anachronism--;
FetType: TYPE = REF FetTypeRep;
FetTypeRep:
TYPE =
RECORD [
className: ROPE,
area, perim, twiceLength: INT,
ct: CellType ← NIL];
HashFetType:
PROC [ra:
REF
ANY]
RETURNS [hash:
CARDINAL]
--HashTable.HashProc-- = {
ft: FetType = NARROW[ra];
hash ← RopeHash.FromRope[ft.className];
hash ← (hash + 3*ft.area + 11*ft.perim + 101*ft.twiceLength) MOD 65536;
};
CompareFetTypes:
PROC [r1, r2:
REF
ANY]
RETURNS [equal:
BOOL]
--HashTable.EqualProc-- = {
k1: FetType = NARROW[r1];
k2: FetType = NARROW[r2];
equal ← k1.className.Equal[k2.className] AND k1.area = k2.area AND k1.perim = k2.perim AND k1.twiceLength = k2.twiceLength;
};
ReadUse:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
typeName: ROPE = GetName[s];
useId: ROPE = GetName[s];
ok: BOOL = SkipNTokens[from, 6, cr.dr.buffer];
u: Use = ParseUseDef[useId];
type: CellType = EnsureType[cr.dr, typeName, u.as, ct, u.childName];
ci: CellInstance = FullyInstantiate[type, ct, Assert[nameReln, LIST[u.childName], NIL]];
EndLine[from, cr.dr.buffer];
};
ParseUseDef:
PROC [useId:
ROPE]
RETURNS [u: Use] = {
in: IO.STREAM = IO.RIS[useId];
u.childName ← in.GetTokenRope[UseNameBreak].token;
IF in.EndOf[]
THEN {
in.Close[];
RETURN [[u.childName, [scalar[]]]]
}
ELSE {
as: ArraySpec.array ← [array[range: ALL[[0, 0]], sep: [0, 0]]];
Get:
PROC [d: Dim] = {
IF in.GetChar[] # '[ THEN ERROR;
as.range[d].min ← in.GetInt[];
IF in.GetChar[] # ': THEN ERROR;
as.range[d].maxPlusOne ← in.GetInt[]+1;
IF in.GetChar[] # ': THEN ERROR;
as.sep[d] ← in.GetInt[];
IF in.GetChar[] # '] THEN ERROR;
};
Get[Foo];
Get[Bar];
IF NOT in.EndOf[] THEN ERROR;
in.Close[];
RETURN [[u.childName, as]];
};
};
UseNameBreak:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass]
--IO.BreakProc-- = {
cc ←
SELECT char
FROM
'[, '], ': => break,
ENDCASE => other;
};
EnsureType:
PROC [dr: DesignReading, typeName:
ROPE, as: ArraySpec, parent: CellType, childName:
ROPE]
RETURNS [ct: CellType] = {
design: Design = dr.design;
WITH as
SELECT
FROM
x: ArraySpec.scalar => {
ct ← NARROW[dr.cellTypesByName.Map[typeName]];
IF ct = NIL THEN ct ← ReadCellType[design, typeName, dr];
};
x: ArraySpec.array => {
ec: ROPE = typeName.Cat[FmtAS[as]];
cellTypeName: ROPE = IO.PutFR["%g(%g.%g)", IO.rope[ec], IO.rope[CTName[parent]], IO.rope[childName]];
eltType: CellType ← EnsureType[dr, typeName, [scalar[]], NIL, NIL];
size: Size2 = RangeSize[x.range];
ct ← CreateArray[design, dr, cellTypeName, eltType, size, [1, 1], AssertFn1[$EquivClass, ec, NIL], AssertFn1[$ArraySpec, NEW [ArraySpec.array ← x], NIL]];
};
ENDCASE => ERROR;
};
RangeSize:
PROC [r: Range2]
RETURNS [s: Size2] = {
s ← [
Foo: r[Foo].maxPlusOne-r[Foo].min,
Bar: r[Bar].maxPlusOne-r[Bar].min]
};
EmptyRange2:
PROC [r: Range2]
RETURNS [empty:
BOOL] = {
empty ← r[Foo].maxPlusOne<=r[Foo].min OR r[Bar].maxPlusOne<=r[Bar].min;
};
NameElt:
PROC [i:
INT]
RETURNS [eltName:
ROPE] =
{eltName ← IO.PutFR["[%g]", IO.int[i]]};
NameElt2:
PROC [f, b:
INT]
RETURNS [eltName:
ROPE] =
{eltName ← IO.PutFR["[%g, %g]", IO.int[f], [integer[b]]]};
FmtAS:
PROC [as: ArraySpec]
RETURNS [r:
ROPE] = {
r ←
WITH as
SELECT
FROM
scalar => "scalar",
array =>
IO.PutFLR["[%g:%g:%g][%g:%g:%g]",
LIST[
IO.int[range[Foo].min],
IO.int[range[Foo].maxPlusOne-1],
IO.int[sep[Foo]],
IO.int[range[Bar].min],
IO.int[range[Bar].maxPlusOne-1],
IO.int[sep[Bar]]]],
ENDCASE => ERROR;
};
FmtShape:
PROC [shape: Size2]
RETURNS [r:
ROPE] = {
r ← IO.PutFR["[Foo: %g, Bar: %g]", IO.int[shape[Foo]], IO.int[shape[Bar]]];
};
FmtPath:
PROC [path: Path]
RETURNS [r:
ROPE] = {
r ← NIL;
FOR path ← path, path.rest
WHILE path #
NIL
DO
step:
ROPE ←
WITH path.first
SELECT
FROM
x: ROPE => x,
x: REF Range2 => IO.PutFR["[%g:%g,%g:%g]", [integer[x[Foo].min]], [integer[x[Foo].maxPlusOne-1]], [integer[x[Bar].min]], [integer[x[Bar].maxPlusOne-1]]],
ENDCASE => ERROR;
r ← (IF r # NIL THEN r.Concat["/"] ELSE r).Concat[step];
ENDLOOP;
};
ReadMerge:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
name1: ROPE = GetName[s];
name2: ROPE = GetName[s];
path1: Path ← ParsePath[s, ct, name1];
path2: Path ← ParsePath[s, ct, name2];
IF PathCompare[path1, cr.dr.mostRecentPathToMerge]#equal
THEN {
DoMerges[s, cr];
cr.dr.toMerge.Insert[path1, path1];
};
cr.dr.toMerge.Insert[path2, path2];
cr.dr.mostRecentPathToMerge ← path2;
EndLine[from, cr.dr.buffer];
};
DoMerges:
PROC [s: Source, cr: CellReading] = {
from: CellType = cr.ct;
dr: DesignReading = cr.dr;
lastPath: Path ← NIL;
DoAMerge:
PROC [data:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
path: Path = NARROW[data];
IF lastPath # NIL THEN [] ← MergeWork[cr, from, lastPath, path];
lastPath ← path;
};
dr.toMerge.EnumerateIncreasing[DoAMerge];
dr.toMerge.DestroyTable[];
dr.mostRecentPathToMerge ← NIL;
};
ParsePath:
PROC [s: Source, from: CellType, asRope:
ROPE]
RETURNS [p: Path] = {
in: IO.STREAM = IO.RIS[asRope];
t: Path ← p ← NIL;
Append:
PROC [ra:
REF
ANY] = {
this: Path ← LIST[ra];
IF t = NIL THEN p ← this ELSE t.rest ← this;
t ← this};
GetRange:
PROC
RETURNS [x: Range] = {
x.maxPlusOne ← (x.min ← in.GetInt[]) + 1;
SELECT in.PeekChar[]
FROM
': => {
IF in.GetChar[] # ': THEN ERROR;
x.maxPlusOne ← in.GetInt[] + 1;
};
',, '] => NULL;
ENDCASE => ERROR;
};
WHILE
NOT in.EndOf[]
DO
toke: ROPE ← in.GetTokenRope[PathNameBreak].token;
ras: REF ArraySpec.array = NARROW[FnVal[$ArraySpec, from.otherPrivate]];
SELECT
TRUE
FROM
toke.Equal["/"] => LOOP;
toke.Equal["["] => {
food: BOOL = ras.range[Foo].min # ras.range[Foo].maxPlusOne-1;
bard: BOOL = ras.range[Bar].min # ras.range[Bar].maxPlusOne-1;
r2: Range2 ← ras.range;
twoD: BOOL ← FALSE;
IF NOT (food OR bard) THEN ERROR;
IF bard THEN r2[Bar] ← GetRange[] ELSE r2[Foo] ← GetRange[];
toke ← in.GetTokenRope[PathNameBreak].token;
SELECT
TRUE
FROM
toke.Equal["]"] => NULL;
toke.Equal[","] => {
twoD ← TRUE;
r2[Foo] ← GetRange[];
toke ← in.GetTokenRope[PathNameBreak].token;
IF NOT toke.Equal["]"] THEN ERROR;
};
ENDCASE => ERROR;
IF twoD # (food AND bard) THEN ERROR;
Append[NEW [Range2 ← r2]];
from ← from.asArray.eltType;
};
toke.Equal["]"] => ERROR;
toke.Equal[":"] => ERROR;
toke.Equal[","] => ERROR;
ENDCASE => {
Append[toke];
WITH LookupPart[from, toke]
SELECT
FROM
ci: CellInstance => from ← ci.type;
w: Wire => {IF NOT in.EndOf[] THEN ERROR; from ← NIL};
ENDCASE => ERROR;
};
ENDLOOP;
in.Close[];
};
PathNameBreak:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass]
--IO.BreakProc-- = {
cc ←
SELECT char
FROM
'[, '], ':, '/, ', => break,
ENDCASE => other;
};
SubType:
PROC [ct: CellType, subscript:
INT]
RETURNS [sct: CellType] = {
ci: CellInstance = NARROW[LookupPart[ct, NameElt[subscript]]];
sct ← ci.type};
lowerConnections: BOOL ← FALSE;
MergeWork:
PROC [cr: CellReading, ct: CellType, path1, path2: Path]
RETURNS [success:
BOOL] = {
IF ct.asArray # NIL THEN ERROR;
IF path1.rest #
NIL
AND path2.rest #
NIL
THEN
WITH path1.first
SELECT
FROM
x:
ROPE =>
WITH path2.first
SELECT
FROM
y:
ROPE =>
IF x.Equal[y]
THEN {
ci: CellInstance = NARROW[LookupPart[ct, x]];
IF ci.type.asArray #
NIL
THEN {
IF ci.type.useCount # 1 THEN ERROR;
IF NOT (success ← ArrayMerge[cr, ci, x, path1.rest, path2.rest]) THEN cr.waitingMerges ← CONS[NEW [PathPairPrivate ← [path1, path2]], cr.waitingMerges];
RETURN;
};
};
y: REF Range2 => ERROR;
ENDCASE => ERROR;
x: REF Range2 => ERROR;
ENDCASE => ERROR;
MergeFinal[ct, path1, path2];
success ← TRUE;
};
flg1: BOOL ← TRUE; --do we avoid making some self-connections because of edge conditions?
flg2: BOOL ← FALSE; --do we look only at the critical edge?
ArrayMerge:
PROC [cr: CellReading, arrayInstance: CellInstance, instanceName:
ROPE, path1, path2: Path]
RETURNS [success:
BOOL] = {
act: CellType = arrayInstance.type;
a: Array = act.asArray;
ras: REF ArraySpec.array = NARROW[FnVal[$ArraySpec, act.otherPrivate]];
et: CellType = a.eltType;
rr1: REF Range2 = NARROW[path1.first];
rr2: REF Range2 = NARROW[path2.first];
r1: Range2 = rr1^;
r2: Range2 = rr2^;
size: Size2 = RangeSize[r2];
xlate: Int2 = [-ras.range[Foo].min, -ras.range[Bar].min];
s1: Range2 = Range2Off[r1, xlate];
s2: Range2 = Range2Off[r2, xlate];
D: Int2 = Int2Sub[Range2Min[r2], Range2Min[r1]];
p1: Port = PortGet[et, path1.rest, TRUE];
p2: Port = PortGet[et, path2.rest, TRUE];
IF RangeSize[r1] # size THEN ERROR;
success ← TRUE;
SELECT
TRUE
FROM
D = [0, 0] =>
IF
NOT PathEquiv[et, path1.rest, path2.rest]
THEN {
IF a.size[Foo] < 2 AND a.size[Bar] < 2 THEN ERROR nyet--the following won't work because there are no joints--;
FOR d: Dim
IN Dim
DO
FOR side: End
IN End
DO
lowRange: Range2 ← s1;
tooMuch: BOOL;
SELECT side
FROM
low => lowRange[d].maxPlusOne ← MIN[lowRange[d].maxPlusOne, a.size[d]-1];
high => {lowRange[d] ← RangeOff[lowRange[d], -1];
lowRange[d].min ← MAX[lowRange[d].min, 0]};
ENDCASE => ERROR;
tooMuch ← flg1
AND
(SELECT side
FROM
low => lowRange[d].min = 1 AND (flg2 OR lowRange[d].maxPlusOne = a.size[d]-1),
high => lowRange[d].maxPlusOne = a.size[d]-2 AND (flg2 OR lowRange[d].min = 0),
ENDCASE => ERROR);
IF
NOT (tooMuch
OR EmptyRange2[lowRange])
THEN {
MakeArrayConnection[act, d, lowRange, [side, p1], [side, p2]];
success ← TRUE};
ENDLOOP;
ENDLOOP;
};
ABS[
D[Foo]]=1
AND
ABS[
D[Bar]]=1 => {
success ← FALSE;
FOR d: Dim
IN Dim
DO
o: Dim = OtherDim[d];
lowRange: Range2 ← s1;
highRange: Range2 ← s2;
lowPort, midPort, highPort, pf, pt: Port;
Do: INT ← D[o];
SELECT
D[d]
FROM
1 => {lowPort ← p1; highPort ← p2};
-1 => {lowPort ← p2; highPort ← p1; lowRange ← s2; highRange ← s1; Do ← -Do};
ENDCASE => ERROR;
midPort ← CrossATie[act, d, lowPort, low];
IF midPort #
NIL
THEN {
lowRange[d] ← RangeOff[lowRange[d], 1];
SELECT
D
o
FROM
1 => {pf ← midPort; pt ← highPort};
-1 => {pf ← highPort; pt ← midPort; lowRange[o] ← RangeOff[lowRange[o], -1]};
ENDCASE => ERROR;
MakeArrayConnection[act, o, lowRange, [low, pf], [high, pt]];
success ← TRUE;
EXIT;
};
midPort ← CrossATie[act, d, highPort, high];
IF midPort #
NIL
THEN {
lowRange ← highRange;
lowRange[d] ← RangeOff[lowRange[d], -1];
SELECT
D
o
FROM
1 => {pf ← lowPort; pt ← midPort; lowRange[o] ← RangeOff[lowRange[o], -1]};
-1 => {pf ← midPort; pt ← lowPort};
ENDCASE => ERROR;
MakeArrayConnection[act, o, lowRange, [low, pf], [high, pt]];
success ← TRUE;
EXIT;
};
ENDLOOP;
};
ABS[
D[Foo]] +
ABS[
D[Bar]] = 1 => {
SELECT
TRUE
FROM
D=[-1, 0] => MakeArrayConnection[act, Foo, s2, [low, p2], [high, p1]];
D=[ 1, 0] => MakeArrayConnection[act, Foo, s1, [low, p1], [high, p2]];
D=[0, -1] => MakeArrayConnection[act, Bar, s2, [low, p2], [high, p1]];
D=[0, 1] => MakeArrayConnection[act, Bar, s1, [low, p1], [high, p2]];
ENDCASE => ERROR;
};
ENDCASE => {
cr.dr.impossibleMerges ← CONS[[arrayInstance, path1, path2], cr.dr.impossibleMerges];
};
IF chaseBug
THEN {
IF bugTie.completion # NIL AND GetRoot[bugJ, bugRP1, bugCJI] # GetRoot[bugJ, bugRP2, bugCJI] THEN ERROR;
};
success ← success;
};
chaseBug: BOOL ← FALSE;
bugJ: Joint ← NIL;
bugTie: Tie ← NIL;
bugRP1, bugRP2: RoledPortData ← NIL;
bugCJI: INT ← 0;
RangeOff:
PROC [r: Range,
D:
INT]
RETURNS [s: Range] = {
s ← [min: r.min + D, maxPlusOne: r.maxPlusOne + D];
};
Range2Off:
PROC [r: Range2,
D: Int2]
RETURNS [s: Range2] = {
s ← [Foo: RangeOff[r[Foo], D[Foo]], Bar: RangeOff[r[Bar], D[Bar]]];
};
MergeFinal:
PROC [ct: CellType, path1, path2: Path] = {
w1, w2, nw: Wire;
w1 ← PathGet[ct, path1, TRUE];
w2 ← PathGet[ct, path2, TRUE];
nw ← MergeNets[w1, w2].merged;
};
VAFetch:
PROC [va: VertexArray, f, b:
NAT]
RETURNS [v: Vertex] = {
v ← va[f*va.shape[Bar]+b];
};
VAStore:
PROC [va: VertexArray, f, b:
NAT, v: Vertex] = {
va[f*va.shape[Bar]+b] ← v;
};
PathGet:
PROC [from: CellType, path: Path, mayAdd:
BOOL]
RETURNS [w: Wire] = {
WITH path.first
SELECT
FROM
r:
ROPE => {
child: Vertex = LookupPart[from, r];
WITH child
SELECT
FROM
x: Wire => w ← x;
ci: CellInstance => {
childPort: Port = PortGet[ci.type, path.rest, mayAdd];
IF childPort #
NIL
THEN {
w ← FindTransitiveConnection[ci, childPort];
IF w = NIL THEN ERROR;
};
};
ENDCASE => ERROR;
};
x: REF Range2 => ERROR;
ENDCASE => ERROR;
};
PortGet:
PROC [from: CellType, path: Path, mayAdd:
BOOL]
RETURNS [port: Port] = {
WITH path.first
SELECT
FROM
x:
REF Range2 => {
ras: REF ArraySpec.array = NARROW[FnVal[$ArraySpec, from.otherPrivate]];
a: Array = from.asArray;
eltPort: Port = PortGet[a.eltType, path.rest, mayAdd];
IF eltPort=
NIL
THEN port ←
NIL
ELSE {
index: ArrayIndex = Int2Sub[Range2Min[x^], Range2Min[ras.range]];
FOR d: Dim IN Dim DO IF x[d].min+1 # x[d].maxPlusOne THEN ERROR ENDLOOP;
port ← GetArrayPort[a, index, eltPort];
IF port =
NIL
AND mayAdd
THEN {
port ← FullyAddPort[[parent: from.port]].port;
SetArrayPort[a, index, eltPort, port];
};
};
};
x:
ROPE => {
child: Vertex = LookupPart[from, x];
WITH child
SELECT
FROM
w: Wire =>
IF path.rest #
NIL
THEN
ERROR
ELSE {
port ← PGet[from, w, NIL, mayAdd].port;
};
ci: CellInstance =>
IF path.rest =
NIL
THEN
ERROR
ELSE {
childPort: Port = PortGet[ci.type, path.rest, mayAdd];
IF childPort =
NIL
THEN port ←
NIL
ELSE {
w: Wire = FindTransitiveConnection[ci, childPort];
port ← PGet[from, w, NIL, mayAdd].port;
};
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
port ← port;
};
Range2Min:
PROC [r2: Range2]
RETURNS [min: Int2] = {
min ← [Foo: r2[Foo].min, Bar: r2[Bar].min]};
Int2Sub:
PROC [a, b: Int2]
RETURNS [c: Int2] = {
c ← [Foo: a[Foo]-b[Foo], Bar: a[Bar]-b[Bar]]};
WithTestRA:
PROC [x:
REF
ANY]
RETURNS [kind:
ROPE] = {
WITH x
SELECT
FROM
ci: CellInstance => RETURN ["CellInstance"];
v: Vertex => RETURN ["Vertex"];
ENDCASE => RETURN ["ENDCASE"];
};
WithTestV:
PROC [x: Vertex]
RETURNS [kind:
ROPE] = {
WITH x
SELECT
FROM
ci: CellInstance => RETURN ["CellInstance"];
v: Vertex => RETURN ["Vertex"];
ENDCASE => RETURN ["ENDCASE"];
};
PGet:
PROC [ct: CellType, internal: Wire, ci: CellInstance, mayAdd:
BOOL]
RETURNS [port: Port, external: Wire] = {
See:
PROC [p: Port, v: Vertex] = {
IF IsMirror[NARROW[v]] THEN port ← p;
};
IF internal.containingCT # ct THEN ERROR;
internal.EnumerateTransitiveConnections[See];
IF port =
NIL
THEN {
IF mayAdd
THEN {
[port, external] ← FullyAddPort[
[parent: ct.port, wire: internal, other: Assert[nameReln, LIST[Describe[internal, ct.asUnorganized.internalWire]], NIL]],
ci
];
};
}
ELSE IF ci # NIL THEN external ← FindTransitiveConnection[ci, port];
};
GetNet:
PROC [s: Source, from: CellType, name:
ROPE]
RETURNS [w: Wire] = {
path: Path ← ParsePath[s, from, name];
w ← PathGet[from, path, TRUE];
};
ReadCap:
PROC [s: Source, reader: Reader, cr: CellReading] = {
ct: CellType = cr.ct;
from: IO.STREAM = s.stream;
name1: ROPE ← GetName[s];
name2: ROPE ← GetName[s];
C: INT ← from.GetInt[];
EndLine[from, cr.dr.buffer];
};
SkipNTokens:
PROC [from:
IO.
STREAM, n:
INT, buffer:
REFTEXT]
RETURNS [ok:
BOOL] = {
WHILE n > 0
DO
token: REFTEXT = from.GetToken[TokenBreak, buffer].token;
IF RefText.Equal[token, "\n"] THEN RETURN [FALSE];
n ← n - 1;
ENDLOOP;
ok ← TRUE;
};
Warn:
PROC [s: Source, msg:
ROPE, v1, v2, v3, v4, v5:
IO.Value ← [null[]]] = {
IF s.name # NIL THEN msg ← IO.PutFR["At %g[%g]: %g", [rope[s.name]], [integer[s.stream.GetIndex[]]], [rope[msg]]];
msg ← IO.PutFR[msg, v1, v2, v3, v4, v5];
Log["%g", msg];
};
CreateArray:
PROC [design: Design, dr: DesignReading, cellTypeName:
ROPE, eltType: CellType, size, jointsPeriod: Size2, otherPublic, otherPrivate: Assertions ←
NIL]
RETURNS [ct: CellType] = {
nj: INT = jointsPeriod[Foo] * jointsPeriod[Bar];
a: Array =
NEW [ArrayPrivate ← [
eltType: eltType,
prevArray: eltType.lastArray,
nextArray: NIL,
size: size,
joints: [CreateRefSeq[nj], CreateRefSeq[nj]],
jointsPeriod: jointsPeriod,
portConnections: CreateRefTable[],
porting: CreateRefTable[]
]];
InitializePorting:
PROC [ep: Port] = {
[] ← a.porting.Store[ep, notPorted];
};
tf: INT = a.jointsPeriod[Foo];
tb: INT = a.jointsPeriod[Bar];
ct ← CreateCellType[design, dr, cellTypeName, FALSE, otherPublic, otherPrivate];
ct.asArray ← a;
IF a.prevArray # NIL THEN a.prevArray.asArray.nextArray ← ct ELSE eltType.firstArray ← ct;
eltType.lastArray ← ct;
eltType.useCount ← eltType.useCount + 1;
FOR d: Dim
IN Dim
DO FOR
f
f:
INT
IN [0 ..
t
f)
DO
FOR
f
b:
INT
IN [0 ..
t
b)
DO
phase2: ArrayIndex = [ff, fb];
size2: Size2 = [
Foo: FloorDiv[a.size[Foo]-(IF d=Foo THEN 2 ELSE 1) - ff, tf]+1,
Bar: FloorDiv[a.size[Bar]-(IF d=Bar THEN 2 ELSE 1) - fb, tb]+1];
i: INT = ArrayJointIndex[a, phase2];
a.joints[d][i] ←
NEW [JointPrivate ← [
size2: size2,
size: size2[Foo]*size2[Bar],
nrp: 0,
ties: CreateHashSet[],
toTie: [CreateRefTable[], CreateRefTable[]],
toRole: [CreateRefTable[], CreateRefTable[]],
roles: CreateVarRefSeq[]
]];
ENDLOOP ENDLOOP ENDLOOP;
EnumeratePorts[eltType, InitializePorting];
};
CreateCellType:
PROC [design: Design, dr: DesignReading, cellTypeName:
ROPE, internals:
BOOL, otherPublic, otherPrivate: Assertions ←
NIL]
RETURNS [ct: CellType] = {
pbn: Mapper = CreateHashDictionary[TRUE];
ct ←
NEW [CellTypePrivate ← [
class: fromExtClass,
designs: CreateHashSet[],
publicKnown: TRUE,
privateKnown: TRUE,
otherPublic: Assert[nameReln, LIST[cellTypeName], otherPublic],
otherPrivate: otherPrivate
]];
[] ← AddPort[[parent: ct]];
IF internals
THEN {
iw: Wire;
ct.otherPrivate ← AssertFn1[partsByNameKey, pbn, ct.otherPrivate];
ct.asUnorganized ←
NEW [UnorganizedPrivate ← [
containedInstances: CreateHashSet[]
]];
iw ← CreateWire[ct];
IF ct.asUnorganized.internalWire # iw THEN ERROR;
AddMirror[ct];
};
[] ← design.cellTypes.UnionSingleton[ct];
[] ← ct.designs.UnionSingleton[design];
IF dr.cellTypesByName.SetMapping[cellTypeName, ct] THEN ERROR;
};
LookupPart:
PROC [ct: CellType, name:
ROPE]
RETURNS [v: Vertex] = {
pbn: Mapper = NARROW[FnVal[partsByNameKey, ct.otherPrivate]];
v ← NARROW[pbn.Map[name]];
};
CTName:
PROC [cellType: CellType]
RETURNS [name:
ROPE] = {
name ← NARROW[FnVal[nameReln, cellType.otherPublic]];
};
PathEquiv:
PROC [from: CellType, path1, path2: Path]
RETURNS [equiv:
BOOL] = {
Work:
PROC [from: CellType, path1, path2: Path]
RETURNS [equiv:
BOOL, p1, p2: Port] = {
WITH path1.first
SELECT
FROM
r1:
ROPE =>
WITH path2.first
SELECT
FROM
r2:
ROPE => {
v1: Vertex = LookupPart[from, r1];
v2: Vertex = LookupPart[from, r2];
IF ISTYPE[v1, Wire] # (path1.rest=NIL) OR ISTYPE[v2, Wire] # (path2.rest=NIL) THEN ERROR;
IF path1.rest=
NIL
OR path2.rest=
NIL
THEN {
w1: Wire =
WITH v1
SELECT
FROM
w: Wire => w,
ci: CellInstance => PathGet[from, path1, FALSE],
ENDCASE => ERROR;
w2: Wire =
WITH v2
SELECT
FROM
w: Wire => w,
ci: CellInstance => PathGet[from, path2, FALSE],
ENDCASE => ERROR;
p1 ← PGet[from, w1, NIL, FALSE].port;
p2 ← PGet[from, w2, NIL, FALSE].port;
equiv ← w1=w2;
}
ELSE {
ci1: CellInstance = NARROW[v1];
ci2: CellInstance = NARROW[v2];
w1, w2: Wire;
IF ci1=ci2
THEN {
[equiv, p1, p2] ← Work[ci1.type, path1.rest, path2.rest];
IF equiv OR p1=NIL OR p2=NIL THEN RETURN;
w1 ← NARROW[FindTransitiveConnection[ci1, p1]];
w2 ← NARROW[FindTransitiveConnection[ci2, p2]];
}
ELSE {
w1 ← PathGet[from, path1, FALSE];
w2 ← PathGet[from, path2, FALSE];
};
p1 ← PGet[from, w1, NIL, FALSE].port;
p2 ← PGet[from, w2, NIL, FALSE].port;
equiv ← w1=w2;
};
};
x2: REF Range2 => RETURN [FALSE, NIL, NIL];
ENDCASE => ERROR;
s1:
REF Range2 =>
WITH path2.first
SELECT
FROM
r2: ROPE => RETURN [FALSE, NIL, NIL];
s2:
REF Range2 => {
a: Array = from.asArray;
IF RangeSize[s1^] # [1, 1] OR RangeSize[s2^] # [1, 1] THEN RETURN [s1^ = s2^, NIL, NIL];
{ep1: Port = PortGet[a.eltType, path1.rest, FALSE];
ep2: Port = PortGet[a.eltType, path1.rest, FALSE];
D: Int2 = Int2Sub[Range2Min[s2^], Range2Min[s1^]];
Try:
PROC [d: Dim, lowIndex: ArrayIndex, rp1, rp2: RoledPort]
RETURNS [connected:
BOOL] = {
phase: Int2 = [
Foo: lowIndex[Foo] MOD a.jointsPeriod[Foo],
Bar: lowIndex[Bar] MOD a.jointsPeriod[Bar]];
j: Joint = GetArrayJoint[a, d, phase];
tie1: Tie = NARROW[j.toTie[rp1.side].Fetch[rp1.port].value];
tie2: Tie = NARROW[j.toTie[rp2.side].Fetch[rp2.port].value];
IF tie1 # tie2 OR tie1 = NIL THEN connected ← FALSE
ELSE IF tie1.completion = NIL THEN connected ← TRUE
ELSE {
ji: Int2 = [
Foo: lowIndex[Foo] / a.jointsPeriod[Foo],
Bar: lowIndex[Bar] / a.jointsPeriod[Bar]];
cji: INT = ji[Foo] * j.size2[Bar] + ji[Bar];
rpd1: RoledPortData = NARROW[j.toRole[rp1.side].Fetch[rp1.port].value];
rpd2: RoledPortData = NARROW[j.toRole[rp2.side].Fetch[rp2.port].value];
connected ← GetRoot[j, rpd1, cji] = GetRoot[j, rpd2, cji];
};
equiv ← connected;
};
p1 ← GetArrayPort[a, Range2Min[s1^], ep1];
p2 ← GetArrayPort[a, Range2Min[s2^], ep2];
SELECT
TRUE
FROM
D = [0, 0] => {
FOR d: Dim
IN Dim
DO
FOR side: End
IN End
DO
lowIndex: ArrayIndex ← Range2Min[s1^];
IF side = high THEN lowIndex[d] ← lowIndex[d] - 1;
IF Try[d, lowIndex, [side, ep1], [side, ep2]] THEN RETURN;
ENDLOOP;
ENDLOOP;
};
ABS[
D[Foo]] +
ABS[
D[Bar]] = 1 => {
d: Dim = IF ABS[D[Foo]] = 1 THEN Foo ELSE Bar;
lowPort, highPort: Port;
lowS: REF Range2;
SELECT
D[d]
FROM
1 => {lowS ← s1; lowPort ← ep1; highPort ← ep2};
-1 => {lowS ← s2; lowPort ← ep2; highPort ← ep1};
ENDCASE => ERROR;
[] ← Try[d, Range2Min[lowS^], [low, lowPort], [high, highPort]];
};
ENDCASE => ERROR nyet;
}};
ENDCASE => ERROR;
ENDCASE => ERROR;
};
IF path1 = NIL OR path2 = NIL THEN ERROR;
RETURN [Work[from, path1, path2].equiv];
};
Id:
PROC [data:
REF
ANY]
RETURNS [ans:
REF
ANY] = {
ans ← data};
ComparePaths:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
k1: Path = NARROW[k];
k2: Path = NARROW[data];
c ← PathCompare[k1, k2]};
PathCompare:
PROC [path1, path2: Path]
RETURNS [c: Basics.Comparison] = {
DO
IF path1 = path2 THEN RETURN [equal];
IF path1 = NIL THEN RETURN [less];
IF path2 = NIL THEN RETURN [greater];
WITH path1.first
SELECT
FROM
r1:
ROPE =>
WITH path2.first
SELECT
FROM
r2: ROPE => c ← r1.Compare[r2];
x2: REF Range2 => c ← less;
ENDCASE => ERROR;
s1:
REF Range2 =>
WITH path2.first
SELECT
FROM
r2: ROPE => c ← greater;
s2:
REF Range2 =>
IF (c ← IntCompare[s1[Foo].min, s2[Foo].min]) = equal THEN
IF (c ← IntCompare[s1[Foo].maxPlusOne, s2[Foo].maxPlusOne]) = equal THEN
IF (c ← IntCompare[s1[Bar].min, s2[Bar].min]) = equal THEN
c ← IntCompare[s1[Bar].maxPlusOne, s2[Bar].maxPlusOne];
ENDCASE => ERROR;
ENDCASE => ERROR;
IF c # equal THEN RETURN;
path1 ← path1.rest;
path2 ← path2.rest;
ENDLOOP;
};
PathPairEqual:
PROC [k1, k2:
REF
ANY]
RETURNS [equal:
BOOL] = {
pp1: PathPair = NARROW[k1];
pp2: PathPair = NARROW[k2];
equal ← (PathCompare[pp1.p1, pp2.p1] = equal AND PathCompare[pp1.p2, pp2.p2] = equal) OR (PathCompare[pp1.p1, pp2.p2] = equal AND PathCompare[pp1.p2, pp2.p1] = equal);
};
HashPathPair:
PROC [key:
REF
ANY]
RETURNS [hash:
CARDINAL] = {
pp: PathPair = NARROW[key];
hash ← HashPath[pp.p1] + HashPath[pp.p2];
};
HashPath:
PROC [path: Path]
RETURNS [hash:
CARDINAL] = {
hash ← 0;
FOR path ← path, path.rest
WHILE path #
NIL
DO
WITH path.first
SELECT
FROM
r: ROPE => hash ← hash + RopeHash.FromRope[r];
x: REF Range2 => hash ← hash + HashInt[x[Foo].min] + HashInt[x[Foo].maxPlusOne] + HashInt[x[Bar].min] + HashInt[x[Bar].maxPlusOne];
ENDCASE => ERROR;
ENDLOOP;
};
HashInt:
PROC [i:
INT]
RETURNS [hash:
CARDINAL] = {
ln: Basics.LongNumber = [li[i]];
hash ← ln.lowbits + ln.highbits;
};
IntCompare:
PROC [i1, i2:
INT]
RETURNS [c: Basics.Comparison] = {
c ←
SELECT i1 - i2
FROM
>0 => greater,
=0 => equal,
<0 => less,
ENDCASE => ERROR;
};
Lg:
PROC [i:
INT]
RETURNS [lg:
CARDINAL] = {
IF i < 0 THEN ERROR;
IF i = 0 THEN RETURN [0];
lg ← 1 + (
SELECT i
FROM
<=00000001H => 00,
<=00000002H => 01,
<=00000004H => 02,
<=00000008H => 03,
<=00000010H => 04,
<=00000020H => 05,
<=00000040H => 06,
<=00000080H => 07,
<=00000100H => 08,
<=00000200H => 09,
<=00000400H => 10,
<=00000800H => 11,
<=00001000H => 12,
<=00002000H => 13,
<=00004000H => 14,
<=00008000H => 15,
<=00010000H => 16,
<=00020000H => 17,
<=00040000H => 18,
<=00080000H => 19,
<=00100000H => 20,
<=00200000H => 21,
<=00400000H => 22,
<=00800000H => 23,
<=01000000H => 24,
<=02000000H => 25,
<=04000000H => 26,
<=08000000H => 27,
<=10000000H => 28,
<=20000000H => 29,
<=40000000H => 30,
ENDCASE => 31);
};
Register:
PROC [keyword:
ROPE, read:
PROC [s: Source, reader: Reader, cr: CellReading], data:
REF
ANY ←
NIL] = {
r: Reader ← NEW [ReaderRep ← [keyword, read, data]];
IF readers.SetMapping[keyword, r] THEN ERROR;
};
Start:
PROC = {
Register["tech", ReadTech];
Register["timestamp", ReadTimestamp];
Register["version", ReadVersion];
Register["scale", ReadScale];
Register["resistclasses", ReadResistClasses];
Register["node", ReadNode];
Register["equiv", ReadEquiv];
Register["fet", ReadFet];
Register["use", ReadUse];
Register["merge", ReadMerge];
Register["adjust", ReadAdjust];
Register["cap", ReadCap];
};
Start[];
END.