DIRECTORY AbSets, Atom, BiRels, Convert, Core, CoreClasses, CoreOps, CoreProperties, IO, LichenDataOps, LichenDataStructure, LichenFromCore, LichenIntBasics, RefTab, Rope, RopeHash, SetBasics;

LichenFromCoreImpl: CEDAR PROGRAM
IMPORTS AbSets, Atom, BiRels, Convert, CoreClasses, CoreOps, CoreProperties, IO, LichenDataOps, LichenDataStructure, RefTab, Rope, RopeHash, SetBasics
EXPORTS LichenFromCore
=

BEGIN OPEN CC:CoreClasses, CO:CoreOps, CP:CoreProperties, LDO:LichenDataOps, LDS:LichenDataStructure, LichenFromCore, LIB:LichenIntBasics, Sets:AbSets;

ROPE: TYPE = Rope.ROPE;
VarSet: TYPE ~ Sets.VarSet;

ColorerKey: ATOM = $CoreLichenColorer;

Colorer: TYPE = REF ColorerPrivate;
ColorerPrivate: TYPE = RECORD [
CellTypeColor: PROC [ct: Core.CellType] RETURNS [LDS.Color],
ColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, LDS.Color]]
];

wireColorKey: ATOM = CP.RegisterProperty[
$LichenFromCoreImplWireColor,
CP.Props[]];

portKey: ATOM = CP.RegisterProperty[
$LichenPortFromCorePublicWire,
CP.Props[]];

lichenFromCore: ATOM = CP.RegisterProperty[
$LichenFromCore,
CP.Props[]];

implKey: PUBLIC ATOM ~ Atom.MakeAtom--the compiler is remarkably stupid about some things--["LichenFromCoreImplInstance"];
implVal: REF ROPE _ NEW [ROPE _ "New for this one"];

lichenToCore: LDS.Fn ~ BiRels.CreateHashTable[ALL[SetBasics.refs]];

GetDesign: PROC [rt: RefTab.Ref, name, suffix: ROPE, pacify: IO.STREAM _ NIL] RETURNS [d: LDS.Design] ~ {
root: Core.CellType ~ NARROW[rt.Fetch[name].val];
d _ LDO.CreateDesign[LDS.OneRope[name.Concat[suffix]]];
d.root _ GetLCT[d, root, pacify];
RETURN};

GetLCT: PUBLIC PROC [d: LDS.Design, cct: Core.CellType, pacify: IO.STREAM _ NIL] RETURNS [lct: LDS.CellType] = {
raw: REF ANY;
lct _ NIL;
raw _ CP.GetCellTypeProp[cct, lichenFromCore];
IF raw # NIL THEN WITH raw SELECT FROM
x: LDS.CellType => IF x.other.HasAA[implKey, implVal] THEN lct _ x;
ENDCASE;
IF lct = NIL THEN {
cName: ROPE = CO.GetCellTypeName[cct];
colorer: Colorer = WITH CP.InheritCellTypeProp[cct, ColorerKey] SELECT FROM
x: Colorer => x,
ENDCASE => defaultColorer;
typeColor: LDS.Color = LDS.FilterColor[colorer.CellTypeColor[cct]];
flavor: LDO.CellFlavor ~ WITH cct.data SELECT FROM
x: CC.RecordCellType => unorganized,
x: CC.SequenceCellType => array,
x: ROPE => leaf,
x: LDS.Design => ERROR,
ENDCASE => ERROR;
CopyPort: PROC [wire: Core.Wire] RETURNS [subWires, quit: BOOL] --CoreOps.EachWireProc-- ~ {
[] _ ToNewPort[wire];
RETURN [FALSE, FALSE]};
ToNewPort: PROC [wire: Core.Wire] RETURNS [p: LDS.Port] ~ {
kids: LDS.Seq _ LDS.nilBiRel;
names: LDS.Set ~ Sets.CreateHashSet[LDS.steppyNameSpace];
FOR nl: LDS.LOR _ CO.GetFullWireNames[cct.public, wire], nl.rest WHILE nl # NIL DO [] _ names.AddElt[ConvertName[nl.first].SnV] ENDLOOP;
IF wire.size#0 THEN {
kids _ LDS.CreateSeq[len: wire.size, oneToOne: TRUE, dense: TRUE, rightSpace: d.eSpace];
FOR i: NATURAL IN [0 .. wire.size) DO
kids.AddNewIA[i, ToNewPort[wire[i]]];
ENDLOOP;
wire _ wire};
p _ LDO.CreatePort[ct: lct, fullNames: names, deduced: FALSE, addum: FALSE, nameDum: FALSE, fixExpConns: FALSE, fixInstConns: FALSE, fixWExpConns: FALSE, fixWInstConns: FALSE, children: kids];
CP.PutWireProp[wire, portKey, p];
lichenToCore.AddNewAA[p, wire];
RETURN};
IF pacify#NIL THEN pacify.PutF["Converting %g\n", [rope[cName]]];
SetWireColor[cct.public, typeColor];
colorer.ColorPorts[cct, SetWireColor];
lct _ LDO.CreateCellType[d, flavor, LIB.emptyRange2, LDS.OneRope[cName]];
lct.other.AddNewAA[implKey, implVal];
lct.color _ typeColor;
[] _ CO.VisitWireSeq[cct.public, CopyPort];
SELECT flavor FROM
unorganized => {rct: CC.RecordCellType ~ NARROW[cct.data];
CopyWire: PROC [wire: Core.Wire] RETURNS [subWires, quit: BOOL] --CoreOps.EachWireProc-- ~ {
[] _ ToNewWire[wire];
RETURN [FALSE, FALSE]};
ToNewWire: PROC [cw: Core.Wire] RETURNS [lw: LDS.Wire] ~ {
kids: LDS.Seq _ LDS.nilBiRel;
names: LDS.Set ~ Sets.CreateHashSet[LDS.steppyNameSpace];
FOR nl: LDS.LOR _ CO.GetFullWireNames[rct.internal, cw], nl.rest WHILE nl # NIL DO [] _ names.AddElt[ConvertName[nl.first].SnV] ENDLOOP;
IF CP.GetWireProp[cw, lichenFromCore] # NIL THEN ERROR --DAG, not Tree--;
IF cw.size#0 THEN {
kids _ LDS.CreateSeq[len: cw.size, oneToOne: TRUE, dense: TRUE, rightSpace: d.eSpace];
FOR i: NATURAL IN [0 .. cw.size) DO
kids.AddNewIA[i, ToNewWire[cw[i]]];
ENDLOOP;
cw _ cw};
lw _ LDO.CreateWire[ct: lct, fullNames: names, deduced: FALSE, fixExpConns: FALSE, fixInstConns: FALSE, children: kids];
CP.PutWireProp[cw, lichenFromCore, lw];
lichenToCore.AddNewAA[lw, cw];
RETURN};
ConnectPort: PROC [cw: Core.Wire] RETURNS [subWires, quit: BOOL] --CoreOps.EachWireProc-- ~ {
lp: LDS.Port ~ GetPort[cw];
lw: LDS.Wire ~ NARROW[CP.GetWireProp[cw, lichenFromCore]];
IF lp=NIL OR lw=NIL THEN ERROR;
LDO.Connect[d, lw, lp, lct];
RETURN [TRUE, FALSE]};
[] _ CO.VisitWireSeq[rct.internal, CopyWire];
[] _ CO.VisitWireSeq[cct.public, ConnectPort];
FOR ii: INT IN [0 .. rct.size) DO
cci: CC.CellInstance = rct.instances[ii];
type: LDS.CellType = GetLCT[d, cci.type, pacify];
lci: LDS.CellInstance = LDO.Instantiate[type, lct, FALSE, [], LIB.dullInt2, ConvertName[CC.GetCellInstanceName[cci]].OneSteppy];
Bind: PROC [actualWire, publicWire: Core.Wire] RETURNS [subWires, quit: BOOL] ~ {
lp: LDS.Port ~ GetPort[publicWire];
lw: LDS.Wire ~ NARROW[GetLElt[actualWire]];
LDO.Connect[d, lw, lp, lci];
RETURN [TRUE, FALSE]};
lichenToCore.AddNewAA[lci, cci];
CP.PutCellInstanceProp[cci, lichenFromCore, lci];
[] _ CO.VisitBindingSeq[cci.actual, cci.type.public, Bind];
ENDLOOP;
};
array => {sct: CC.SequenceCellType ~ NARROW[cct.data];
lect: LDS.CellType ~ GetLCT[d, sct.base, pacify];
seqs: LDS.Set--of INT-- ~ Setify[sct.sequence];
IF sct.flatSequence#NIL AND sct.flatSequence.length#0 THEN ERROR;
IF sct.stitch#NIL AND sct.stitch.length#0 THEN ERROR;
LDO.SetArrayPart[lct, lect, LDO.CreateArrayPart[lct, lect, [sct.count, 1], [1, 1], LDS.nilBiRel, NIL]];
IF cct.public.size # sct.base.public.size THEN ERROR;
FOR idx: INT IN [0 .. cct.public.size) DO
ep: LDS.Port ~ GetPort[sct.base.public[idx]];
ap: LDS.Port ~ GetPort[cct.public[idx]];
IF NOT seqs.HasMemI[idx] THEN {
IF cct.public[idx].size # 0 THEN ERROR;
LDO.MakeArrayNewConnection[d, lct.asArray, [[0, sct.count-1], [0, 1]], [1, 0], ep, ep];
LDO.MakeArrayExport[d, lct.asArray, ap, ep, [0, 0]]}
ELSE {
IF cct.public[idx].size # sct.count THEN ERROR;
FOR j: NAT IN [0 .. sct.count) DO
LDO.MakeArrayExport[d, lct.asArray, NARROW[d.Sub[ap, j]], ep, [j, 0]];
ENDLOOP};
ENDLOOP;
LDO.FinishedMakingArrayConnections[lct];
};
leaf => NULL;
ENDCASE => ERROR;
lichenToCore.AddNewAA[lct, cct];
CP.PutCellTypeProp[cct, lichenFromCore, lct];
};
RETURN};

GetPort: PUBLIC PROC [pw: Core.Wire] RETURNS [port: LDS.Port] = {
port _ NARROW[CP.GetWireProp[pw, portKey]];
RETURN};

SetWireColor: PROC [wire: Core.Wire, color: LDS.Color] = {
CP.PutWireProp[wire, wireColorKey, NEW [LDS.Color _ color]];
RETURN};

GetWireColor: PROC [wire: Core.Wire] RETURNS [color: LDS.Color] = {
rc: REF LDS.Color = NARROW[CP.GetWireProp[wire, wireColorKey]];
color _ rc^;
RETURN};

GetCCT: PUBLIC PROC [lct: LDS.CellType] RETURNS [cct: Core.CellType] = {
cct _ NARROW[lichenToCore.ApplyA[lct].MDA];
RETURN};

GetLElt: PUBLIC PROC [ce: CircuitElement] RETURNS [v: LDS.Vertex] = {
WITH ce SELECT FROM
w: Core.Wire => v _ NARROW[CP.GetWireProp[w, lichenFromCore]];
ci: CC.CellInstance => v _ NARROW[CP.GetCellInstanceProp[ci, lichenFromCore]];
ENDCASE => ERROR;
RETURN};

GetCElt: PUBLIC PROC [v: LDS.Vertex] RETURNS [ce: CircuitElement] = {
ce _ NARROW[lichenToCore.ApplyA[v].MDA];
RETURN};

defaultColorer: Colorer _ NEW [ColorerPrivate _ [DefaultCellTypeColor, DefaultColorPorts]];

DefaultCellTypeColor: PROC [ct: Core.CellType] RETURNS [color: LDS.Color] = {
name: ROPE _ CO.GetCellTypeName[ct];
color _ RopeHash.FromRope[name];
RETURN};

DefaultColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, LDS.Color]] = {
ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
IF wire # ct.public THEN {
name: ROPE = UnionNames[CO.GetFullWireNames[ct.public, wire]];
SetColor[wire, RopeHash.FromRope[name]];
};
RETURN};
[] _ CO.VisitWire[ct.public, ColorPort];
RETURN};

transistorColorer: Colorer _ NEW [ColorerPrivate _ [TransistorCellTypeColor, ColorTransistorPorts]];

TransistorCellTypeColor: PROC [ct: Core.CellType] RETURNS [color: LDS.Color] = {
td: CC.Transistor = NARROW[ct.data];
color _ SELECT td.type FROM
nE => 36,
pE => 24,
nD => 33,
ENDCASE => ERROR;
RETURN};

ColorTransistorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, LDS.Color]] = {
ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
IF wire # ct.public THEN {
name: ROPE = CO.GetShortWireName[wire];
SetColor[wire, SELECT TRUE FROM
name.Substr[len: 2].Equal["ch", FALSE] => channelColor,
name.Equal["gate", FALSE] => gateColor,
ENDCASE => ERROR
];
};
RETURN};
[] _ CO.VisitWire[ct.public, ColorPort];
RETURN};
gateColor: LDS.Color _ 47;
channelColor: LDS.Color _ 834;

UnionNames: PROC [names: LIST OF ROPE] RETURNS [unioned: ROPE] = {
unioned _ NIL;
FOR names _ names, names.rest WHILE names # NIL DO
unioned _ IF unioned=NIL THEN names.first ELSE Rope.Cat[unioned, "|", names.first];
ENDLOOP;
unioned _ unioned;
RETURN};

Setify: PROC [ss: CC.SequenceSet] RETURNS [ints: LDS.Set] ~ {
ints _ Sets.CreateHashSet[SetBasics.ints];
FOR i: NAT IN [0 .. ss.length) DO [] _ ints.AddI[ss[i]] ENDLOOP;
RETURN};

ConvertName: PROC [coreName: ROPE] RETURNS [LDS.SteppyName] ~ {
lb: INT ~ coreName.Find["["];
IF lb=-1 THEN RETURN LDS.OSn[coreName];
{rb: INT ~ coreName.Find["]", lb];
IF rb=-1 THEN ERROR;
{idx: NAT ~ Convert.IntFromRope[coreName.Substr[start: lb+1, len: rb-lb-1]];
IF lb=0 THEN RETURN LDS.OSn[NEW [INT _ idx]];
RETURN LDS.LSn[LIST[coreName.Substr[len: lb], NEW [INT _ idx]]]}}};

Start: PROC = {
CP.PutCellClassProp[CC.transistorCellClass, ColorerKey, transistorColorer];
RETURN};

Start[];

END.
–LichenFromCoreImpl.Mesa
Last tweaked by Mike Spreitzer on August 3, 1988 3:28:19 pm PDT
Must set the color of each non-root of the public wire.
Κ
†–

"cedar" style˜
code™K™?—K˜KšΟk	œLœi˜ΐ
K˜šΠbxœœ
˜!KšœFœG˜–
Kšœ˜K˜
—K˜Kšœ
œ
œœ
œœœ&œΟnœ˜—
K˜Kšœœœ
˜Kšœœ˜K˜Kšœœ˜&K˜Kšœ	œœ˜#šœœœ˜KšŸ
œœœœ˜<š
Ÿ
œœŸœœ
œ˜KK™7—K˜—K˜šœœœ˜)Kš
œ˜Kšœ
˜—K˜šœ	œœ˜$Kš
œ˜Kšœ
˜—K˜šœœœ˜+Kš
œ˜Kšœ
˜—K˜Kšœ	œ
œΟc7œ˜zKš	œ	œ
œœœ˜4K˜Kšœœœ˜CK˜šŸ	œœ œ
œ
œœœœ˜iKšœœ˜1Kšœœœ˜7Kš
œ!˜!Kšœ˜—K˜šŸœœ
œœ%œ
œœœœ˜pKšœœ
œ
˜
Kšœœ
˜
Kšœœ&˜.šœœ
œ
œœ
˜&Kšœœ
œ!œ	˜CKšœ
˜—šœœ
œ˜Kšœœœ˜&šœœ
œ&œ
˜KK˜Kšœ˜—Kšœœ	œ)˜Cšœœœ
œ
˜2Kšœœ˜$Kšœœ˜ Kšœœ	˜Kšœœœ
˜Kšœœ
˜—š
Ÿœœœœ œ˜\K˜Kšœœœ˜—šŸ	œœœœ
˜;Kšœœœ
˜Kšœœœ˜9Kšœœ
œœ-œœ
œ.œ
˜ˆ
šœ
œ˜Kšœœ%œ	œ˜Xšœœ
œ˜%K˜%Kšœ
˜—Kš
œ
˜
—Kšœœ0œ	œœœœœœ˜ΐ
Kšœ˜!K˜Kšœ˜—Kšœœ
œ/˜AK˜$K˜&Kšœœœœ˜IK˜%Kš
œ˜Kšœœ$˜+Kšœ˜šœœœ˜:š
Ÿœœœœ œ˜\Kš
œ˜Kšœœœ˜—šŸ	œœœœ
˜:Kšœœœ
˜Kšœœœ˜9Kšœœ
œœ-œœ
œ.œ
˜ˆ
Kšœ
œ#œ
œ
œ
 œ
˜Išœœ˜Kšœœ#œ	œ˜Všœœ
œ˜#Kš
œ#˜#Kšœ
˜—Kš
œ	˜	—Kš	œœ0œœœ˜xKšœ%˜'Kš
œ˜Kšœ˜—š
Ÿœœœœ œ˜]Kšœœ˜Kšœœœ
œ"˜:Kšœœ
œœ
œ
œ
˜Kšœ˜Kšœœœ˜—Kšœœ&˜-Kšœœ'˜.šœœ
œ˜!Kšœœ"˜)Kšœœ(˜1Kšœœœœœœ&˜€
šŸœœ%œœ˜QKšœœ˜#Kšœœœ˜+Kšœ˜Kšœœœ˜—Kš
œ ˜ Kšœ/˜1Kšœœ4˜;Kšœ
˜—K˜—šœœœ˜6Kšœœ(˜1Kšœœ 
œ˜/Kš
œœ
œœ
œ
˜AKš
œœ
œœ
œ
˜5Kšœœ4œœ˜gKšœ(œ
œ
˜5šœœ
œ˜)Kšœœ&˜-Kšœœ!˜(šœ
œœ˜Kšœœ
œ
˜'KšœT˜WKšœ1˜4—šœ˜Kšœ"œ
œ
˜/šœœ
œ˜!Kšœ!œ˜FKšœ˜	——Kšœ
˜—Kšœ%˜(K˜—Kšœœ
˜
Kšœœ
˜Kš
œ ˜ Kšœ+˜-Kš
œ˜—Kšœ˜—K˜š
Ÿœœ
œœœ
˜AKšœœ
œ˜+Kšœ˜—K˜šŸœœœ˜:Kšœ!œœ˜<Kšœ˜—K˜šŸœœœ	œ˜CKš	œœ
œ	œ
œ"˜?K˜Kšœ˜—K˜š
Ÿœœ
œœœ˜HKšœœœ˜+Kšœ˜—K˜š
Ÿœœ
œœœ˜Ešœœ
˜Kšœœ
œ!˜>Kšœœœ
œ*˜NKšœœ
˜—Kšœ˜—K˜š
Ÿœœ
œœ	œ˜EKšœœœ˜(Kšœ˜—K˜Kšœœ>˜[K˜šŸœœœ	œ˜MKšœœœ˜$Kš
œ ˜ Kšœ˜—K˜š
ŸœœŸœœ
œ˜VšŸ	œœœœœœœ œ˜mšœœ˜Kšœœœ$˜>Kš
œ(˜(K˜—Kšœ˜—Kšœœ!˜(Kšœ˜—K˜KšœœD˜dK˜šŸœœœ	œ˜PJšœœœ
˜$šœœ	˜J˜	J˜	J˜	Jšœœ
˜—Kšœ˜—K˜š
ŸœœŸœœ
œ˜YšŸ	œœœœœœœ œ˜mšœœ˜Kšœœœ˜'šœœ
œ
˜Kšœ œ˜7Kšœœ˜'Kšœ˜K˜—K˜—Kšœ˜—Kšœœ!˜(Kšœ˜Kšœœ˜Kšœœ
˜—K˜šŸ
œœ	œ
œ
œœœ˜BKšœ
œ
˜šœœ	œ
˜2Kš	œ
œ	œ
œ
œ%˜SKšœ
˜—Kš
œ˜Kšœ˜—K˜š
Ÿœœœœœ	˜=Kš
œ*˜*Kš
œœ
œœœ
˜@Kšœ˜—K˜š
Ÿœœœœœ˜?Kšœœ˜Kšœœ
œ
œ˜'Kšœœ˜"Kšœœ
œ
˜KšœœC˜LKšœœ
œ
œœœ	˜-Kš
œ
œœœœ
˜C—K˜šŸœœ˜Kšœœ5˜KKšœ˜—K˜K˜K˜Kšœ
˜—…—&ξ5