DIRECTORY Asserting, Core, CoreClasses, CoreOps, CoreProperties, LichenCollections, LichenDataOps, LichenDataStructure, LichenFromCore, Rope, RopeHash;

LichenFromCoreImpl: CEDAR PROGRAM
IMPORTS Asserting, CoreClasses, CoreOps, CoreProperties, LichenCollections, LichenDataOps, LichenDataStructure, Rope, RopeHash
EXPORTS LichenFromCore
=

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

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

implKey: ATOM = $LichenFromCoreImplInstance;
implVal: REF ROPE _ NEW [ROPE _ "New for this one"];

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[]];

lichenToCore: ATOM = $LichenToCore;

GetLCT: PUBLIC PROC [cct: Core.CellType] RETURNS [lct: LDS.CellType] = {
original: Core.CellType = cct;
Work: PROC [cct: Core.CellType] 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 Asserting.FnVal[implKey, x.otherPublic] = implVal THEN lct _ x;
ENDCASE;
IF lct = NIL THEN {
cName: ROPE = CO.GetCellTypeName[original];
colorer: Colorer = WITH CP.InheritCellTypeProp[original, ColorerKey] SELECT FROM
x: Colorer => x,
ENDCASE => defaultColorer;
SELECT cct.class.recast FROM
=NIL => {
typeColor: LDS.Color = LDS.FilterColor[colorer.CellTypeColor[cct]];
SetWireColor[cct.public, typeColor];
colorer.ColorPorts[cct, SetWireColor];
lct _ NEW [LDS.CellTypePrivate _ [
class: coreLCC,
designs: Sets.CreateHashSet[],
publicKnown: TRUE,
privateKnown: FALSE,
otherPublic: Asserting.AssertFn1[implKey, implVal, NIL],
otherPrivate: Asserting.AssertFn1[understoodCore, cct, NIL],
color: typeColor
]];
lct.port _ PublicToPort[lct, cct.public, Sets.CreateHashSet[]];
};
#NIL => lct _ Work[CO.Recast[cct]];
ENDCASE => ERROR;
VisitPortAndCoreWire[lct.port, cct.public, AssocPortWithPublicWire];
lct.otherPublic _ Asserting.AssertFn1[lichenToCore, cct, lct.otherPublic];
lct.otherPublic _ Asserting.Assert[LDS.nameReln, LIST[cName], lct.otherPublic];
CP.PutCellTypeProp[cct, lichenFromCore, lct];
};
};
lct _ Work[cct];
};

understoodCore: ATOM = $LichenUnderstoodCoreCellType;

coreLCC: LDS.CellClass = NEW [LDS.CellClassPrivate _ [
DefinePrivates: DefinePrivates]];

DefinePrivates: PROC [lct: LDS.CellType] = {
cct: Core.CellType = NARROW[Asserting.FnVal[understoodCore, lct.otherPrivate]];
rct: CC.RecordCellType = WITH cct.data SELECT FROM
x: CC.RecordCellType => x,
ENDCASE => NIL;
IF lct.privateKnown THEN RETURN;
lct.privateKnown _ TRUE;
IF rct = NIL THEN RETURN;
lct.asUnorganized _ NEW [LDS.UnorganizedPrivate _ [
containedInstances: Sets.CreateHashSet[]
]];
{iw: LDS.Wire ~ LDO.CreateWire[lct];
IF iw#lct.asUnorganized.internalWire THEN ERROR;
};
{DefineInternal: PROC [cw: Core.Wire, containingWire: LDS.Wire, seen: VarSet] = {
lw: LDS.Wire = IF cw = rct.internal THEN lct.asUnorganized.internalWire ELSE LDO.CreateWire[lct, containingWire, LDS.CreateSteppyNames[LIST[LIST[CO.GetShortWireName[cw]]]]];
IF NOT seen.AddElt[cw] THEN ERROR--DAG, not Tree--;
lw.other _ Asserting.AssertFn1[lichenToCore, cw, lw.other];
CP.PutWireProp[cw, lichenFromCore, lw];
FOR i: INT IN [0 .. cw.size) DO
DefineInternal[
cw: cw[i],
containingWire: IF cw # rct.internal THEN lw ELSE NIL,
seen: seen];
ENDLOOP;
};
DefineInternal[rct.internal, NIL, Sets.CreateHashSet[]];
};
{SetPortWire: PROC [port: LDS.Port, pw: Core.Wire] = {
IF (port.wire _ NARROW[GetLElt[pw]]) = NIL AND pw.size = 0 THEN ERROR;
};
VisitPortAndCoreWire[lct.port, cct.public, SetPortWire]};
FOR ii: INT IN [0 .. rct.size) DO
cci: CC.CellInstance = rct.instances[ii];
type: LDS.CellType = GetLCT[cci.type];
lci: LDS.CellInstance = LDO.Instantiate[type, lct, LDS.CreateSteppyNames[LIST[LIST[CC.GetCellInstanceName[cci]]]]];
CreateBinding: PROC [lp: LDS.Port, caw, cpw: Core.Wire, cellward: LDS.Vertex] = {
subLP: LDS.Port _ lp.firstChild;
IF caw.size # cpw.size THEN ERROR;
FOR i: INT IN [0 .. caw.size) DO
scaw: Core.Wire = caw[i];
scpw: Core.Wire = cpw[i];
slaw: LDS.Wire = NARROW[GetLElt[scaw]];
IF subLP = NIL THEN ERROR;
IF slaw # NIL THEN {
LDO.AddEdge[[cellward: cellward, wireward: slaw], subLP];
}
ELSE {
sich: LDS.Vertex ~ LDO.CreateIntermediary[cellward, wireward, lct, subLP, subLP.PortNames.Copy.data];
IF scaw.size = 0 THEN ERROR--should've reached internal wire by now--;
CreateBinding[subLP, scaw, scpw, sich];
};
subLP _ subLP.next;
ENDLOOP;
IF subLP # NIL THEN ERROR;
};
lci.other _ Asserting.AssertFn1[lichenToCore, cci, lci.other];
CP.PutCellInstanceProp[cci, lichenFromCore, lci];
CreateBinding[type.port, cci.actual, cci.type.public, lci];
ENDLOOP;
LDO.AddMirror[lct];
lct _ lct;
};

PublicToPort: PROC [parent: REF ANY, public: Core.Wire, alreadySeen: VarSet--of Core.Wire--] RETURNS [port: LDS.Port] = {
cName: ROPE ~ CO.GetShortWireName[public];
IF NOT alreadySeen.AddElt[public] THEN ERROR--DAG, not Tree--;
port _ LDO.AddPort[[
parent: parent,
names: LDS.CreateSteppyNames[LIST[LIST[cName]]],
color: GetWireColor[public]
]];
FOR i: NAT IN [0 .. public.size) DO
child: LDS.Port = PublicToPort[port, public[i], alreadySeen];
ENDLOOP;
RETURN};

AssocPortWithPublicWire: PROC [port: LDS.Port, public: Core.Wire] = {
CP.PutWireProp[public, portKey, port];
port.other _ Asserting.AssertFn1[lichenToCore, public, port.other];
};

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

InsertCoreWire: PROC [cw: Core.Wire, in: VarSet] = {
Insert: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
subWires _ in.AddElt[wire];
};
[] _ CO.VisitWire[cw, Insert]};

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

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

GetCCT: PUBLIC PROC [lct: LDS.CellType] RETURNS [cct: Core.CellType] = {
cct _ NARROW[Asserting.FnVal[lichenToCore, lct.otherPublic]];
};

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;
};

GetCElt: PUBLIC PROC [v: LDS.Vertex] RETURNS [ce: CircuitElement] = {
ce _ Asserting.FnVal[lichenToCore, v.other];
};

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

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

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]];
};
};
[] _ CO.VisitWire[ct.public, ColorPort];
};

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;
};

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
];
};
};
[] _ CO.VisitWire[ct.public, ColorPort];
};
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;
};

VisitPortAndCoreWire: PROC [port: LDS.Port, cw: Core.Wire, Consume: PROC [LDS.Port, Core.Wire]] = {
subPort: LDS.Port _ port.firstChild;
Consume[port, cw];
FOR i: INT IN [0 .. cw.size) DO
IF subPort = NIL THEN ERROR;
VisitPortAndCoreWire[subPort, cw[i], Consume];
subPort _ subPort.next;
ENDLOOP;
IF subPort # NIL THEN ERROR;
};

VisitCoreWire: PROC [cw, containing: Core.Wire, Consume: PROC [coreWire, containingCoreWire: Core.Wire]] = {
Consume[cw, containing];
FOR i: INT IN [0 .. cw.size) DO VisitCoreWire[cw[i], cw, Consume] ENDLOOP;
};

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

Start[];

END.
–LichenFromCoreImpl.Mesa
Last tweaked by Mike Spreitzer on August 3, 1987 3:09:40 pm PDT
Must set the color of each non-root of the public wire.
ΚH–

"cedar" style˜
code™K™?—K˜KšΟk	œŽ
˜—
K˜šΠbxœœ
˜!Kšœw˜~Kšœ˜K˜
—K˜Kšœ
œ
œœ
œœœ&Οnœ˜
K˜Kšœœœ
˜Kšœœ˜K˜Kšœ	œ˜,Kš	œ	œ
œœœ˜4K˜Kšœœ˜&K˜Kšœ	œœ˜#šœœœ˜KšŸ
œœœœ˜<š
Ÿ
œœŸœœ
œ˜KK™7—K˜—K˜šœœœ˜)Kš
œ˜Kšœ
˜—K˜šœ	œœ˜$Kš
œ˜Kšœ
˜—K˜šœœœ˜+Kš
œ˜Kšœ
˜—K˜Kšœœ˜#K˜š
Ÿœœ
œœœ˜HKš
œ˜šŸœœœœ˜?Kšœœ
œ
˜
Kšœœ
˜
Kšœœ&˜.šœœ
œ
œœ
˜&Kšœœ
œ3œ	˜UKšœ
˜—šœœ
œ˜Kšœœœ˜+šœœ
œ+œ
˜PK˜Kšœ˜—šœ˜šœ
œ˜	Kšœœ	œ)˜CK˜$K˜&šœœœ˜"K˜K˜Kšœ
œ
˜Kšœœ
˜Kšœ3œ˜8Kšœ7œ˜<Kš
œ˜K˜—Kš
œ?˜?K˜—Kšœ
œœ˜#Kšœœ
˜—K˜DKš
œJ˜JKšœ#œœ˜OKšœ+˜-Kš
œ˜—K˜—Kš
œ˜K˜—K˜Kšœœ!˜5K˜šœ	œ
œœ˜6Kš
œ!˜!—K˜šŸœœœ˜,Kšœœ4˜Ošœœœ
œ
˜2Kšœœ˜Kšœœ
˜—Kšœœ
œ
˜ Kšœœ
˜Kšœœ
œ
œ
˜šœœœ˜3Kš
œ(˜(K˜—Kšœœœ˜$Kšœ#œ
œ
˜0Kš
œ˜šœ
Ÿœœ!œ˜QKšœœœœ œ
œ!œœ
œ
œ˜­
Kš	œ
œœ
Οcœ
˜3Kš
œ;˜;Kšœ%˜'šœœ
œ˜˜K˜
Kš	œœœœ
œ
˜6K˜—Kšœ
˜—K˜—Kšœœ˜8K˜šœ
Ÿœœœ˜6Kšœœœ
œ
œ
œ
˜FK˜—Kš
œ9˜9šœœ
œ˜!Kšœœ"˜)Kšœœ˜&Kš
œœœœœ
œ
œ˜sšŸ
œœœ&œ˜QKšœœ˜ Kšœœ
œ
˜"šœœ
œ˜ Kš
œ˜Kš
œ˜Kšœœœ˜'Kšœ	œ
œ
œ
˜šœœ
œ˜Kšœ6˜9K˜
—šœ˜Kšœœ
œO˜eKšœœ
 *œ
˜FKš
œ'˜'K˜—K˜Kšœ
˜—Kšœ	œ
œ
œ
˜K˜—Kš
œ>˜>Kšœ/˜1Kš
œ;˜;Kšœ
˜—Kšœ˜Kš
œ
˜
K˜—K˜šŸœœ
œ
œ( œœœ
˜yKšœœœ˜*Kš	œ
œœ
 œ
˜>šœœ
˜K˜Kšœœœ
œ
˜0Kš
œ˜Kš
œ˜—šœœ
œ˜#Kšœœ3˜=Kšœ
˜—Kšœ˜—K˜šŸœœœ˜EKšœ$˜&Kš
œC˜CK˜—K˜š
Ÿœœ
œœœ
˜AKšœœ
œ˜+K˜—K˜šŸœœ ˜4šŸœœœœœœœ œ˜jKš
œ˜K˜—Kšœœ˜—K˜šŸœœœ˜:Kšœ!œœ˜<K˜—K˜šŸœœœ	œ˜CKš	œœ
œ	œ
œ"˜?K˜K˜—K˜š
Ÿœœ
œœœ˜HKšœœ1˜=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˜šŸœœœŸœœœ˜cKšœ	œ˜$K˜šœœ
œ˜Kšœœ
œ
œ
˜Kš
œ.˜.K˜Kšœ
˜—Kšœœ
œ
œ
˜K˜—K˜šŸ
œœŸœœ/˜lKš
œ˜Kš
œœ
œœ#œ
˜JK˜—K˜šŸœœ˜Kšœœ5˜KK˜—K˜K˜K˜Kšœ
˜—…—$"1