LichenFromCoreImpl.Mesa
Last tweaked by Mike Spreitzer on August 3, 1987 3:09:40 pm PDT
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 ROPENEW [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]]
Must set the color of each non-root of the public wire.
];
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: BOOLTRUE, quit: BOOLFALSE] --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: ROPECO.GetCellTypeName[ct];
color ← RopeHash.FromRope[name];
};
DefaultColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, LDS.Color]] = {
ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOLTRUE, quit: BOOLFALSE] --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: BOOLTRUE, quit: BOOLFALSE] --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.