DIRECTORY Asserting, Basics, IO, OrderedSymbolTableRef, PrincOps, Rope, RoseCreate, RoseEvents, RoseTypes;

RoseCreateImplB: CEDAR PROGRAM
IMPORTS Asserting, IO, OSTR: OrderedSymbolTableRef, Rope, RoseCreate, RoseEvents, RoseTypes
EXPORTS RoseCreate =

BEGIN OPEN RoseCreate, RoseTypes;

cellTypes: SymbolTable _ OSTR.CreateTable[CompareCellTypes];

RegisterCellType: PUBLIC PROC
[
incrementally: BOOL _ FALSE,
name: ROPE,
expandProc: ExpandProc _ NIL,
ioCreator: IOCreator _ NIL,
driveCreator: DriveCreator _ NIL,
initializer: Initializer _ NIL,
evals: EvalProcs _ [],
tests: CellTestList _ NIL,
ports: Ports,
typeData: REF ANY _ NIL,
other: Assertions _ NIL
]
RETURNS [type: CellType] =
BEGIN
replace: BOOL = NOT incrementally;
conformingInterface, equalInterface: BOOL _ FALSE;
oldHadBehavior: BOOL _ FALSE;
newHasBehavior: BOOL _ evals.EvalSimple # NIL OR evals.PropUD # NIL;
simpleWordCount, switchWordCount: CARDINAL _ 0;
hasASwitchPort: BOOL _ FALSE;
FOR portIndex: PortIndex IN [0 .. ports.length) DO
port: Port _ ports[portIndex];
simpleWordCount _ MAX[simpleWordCount, MinSize[port.simple]];
switchWordCount _ MAX[switchWordCount, MinSize[port.switch]];
IF port.type = NIL THEN ERROR Error[IO.PutFR["No NodeType given for Port %g", IO.rope[port.name]]];
IF NOT port.type.simple THEN hasASwitchPort _ TRUE;
ENDLOOP;
type _ NARROW[cellTypes.Lookup[name]];
IF type = NIL THEN {
type _ NEW [CellTypeRep _ [name: name, testers: OSTR.CreateTable[CompareTests]]];
cellTypes.Insert[type];
}
ELSE {
[conformingInterface, equalInterface] _ EqualInterfaces[ports, type.ports];
oldHadBehavior _ type.evals.EvalSimple # NIL OR type.evals.PropUD # NIL;
};
IF type.firstInstance # NIL THEN {
firstLeaf: BOOL _ TRUE;
IF NOT incrementally THEN ERROR Error["Can't forget about instances", type];
IF NOT conformingInterface THEN ERROR Error["Can't change interface structure of existing instances", type];
FOR instance: Cell _ type.firstInstance, instance.nextInstance WHILE instance # NIL DO
IF instance.type # type THEN ERROR;
IF instance.expansion = Leaf THEN {
IF firstLeaf THEN {
firstLeaf _ FALSE;
IF NOT oldHadBehavior THEN ERROR;
IF NOT newHasBehavior THEN ERROR Error["Can't relieve existing instances of behavior", type];
IF NOT equalInterface THEN ERROR Error["Can't change interface of existing instances", type];
};
IF instance.realCellStuff.evals # type.evals THEN ERROR;
instance.realCellStuff.evals _ evals;
};
ENDLOOP;
};
type.ports _ ports;
IF NOT equalInterface THEN {
type.simpleWordCount _ simpleWordCount;
type.switchWordCount _ switchWordCount;
type.hasASwitchPort _ hasASwitchPort;
};
IF replace OR expandProc # NIL THEN type.expand _ expandProc;
IF replace OR ioCreator # NIL THEN type.ioCreator _ ioCreator;
IF replace OR driveCreator # NIL THEN type.driveCreator _ driveCreator;
IF replace OR initializer # NIL THEN type.initializer _ initializer;
IF replace OR evals # [] THEN type.evals _ evals;
IF replace OR typeData # NIL THEN type.typeData _ typeData;
IF incrementally
THEN type.other _ Asserting.Union[other, type.other]
ELSE type.other _ other;
IF NOT incrementally THEN type.testers.DeleteAllItems[];
FOR tests _ tests, tests.rest WHILE tests # NIL DO
[] _ SetTest[test: NEW [CellTestRep _ tests.first], of: type, mayOverwriteOld: incrementally];
ENDLOOP;
END;

GetCellType: PUBLIC PROC [name: ROPE] RETURNS [type: CellType] =
{type _ NARROW[cellTypes.Lookup[name]]};

GetTest: PUBLIC PROC [name: ROPE, from: CellType] RETURNS [t: CellTest] =
{t _ NARROW[from.testers.Lookup[name]]};

SetTest: PUBLIC PROC [test: CellTest, of: CellType, mayOverwriteOld: BOOL _ FALSE] RETURNS [old: CellTest] = {
old _ NARROW[of.testers.Lookup[test]];
IF old # NIL THEN {
IF mayOverwriteOld
THEN {IF of.testers.Delete[test] # old THEN ERROR}
ELSE ERROR Error[IO.PutFR["Duplicate Test (named %g) given for cell type %g", IO.rope[test.name], IO.rope[of.name]]];
};
of.testers.Insert[test];
};

EqualInterfaces: PUBLIC PROC [a, b: Ports] RETURNS [structurally, fully: BOOL] = {
structurally _ fully _ a.length = b.length;
FOR portIndex: PortIndex IN [0 .. a.length) WHILE structurally DO
IF NOT (
Conforming[a[portIndex].type, b[portIndex].type] AND
a[portIndex].input = b[portIndex].input AND
a[portIndex].output = b[portIndex].output AND
a[portIndex].name.Equal[b[portIndex].name]
)
THEN structurally _ fully _ FALSE;
IF NOT (
FieldEqual[a[portIndex].simple, b[portIndex].simple] AND
FieldEqual[a[portIndex].switch, b[portIndex].switch] AND
a[portIndex].type = b[portIndex].type AND
a[portIndex].XPhobic = b[portIndex].XPhobic
)
THEN fully _ FALSE;
ENDLOOP;
};

CreateSim: PUBLIC PROC [steady: BOOL] RETURNS [sim: Simulation] = {
sim _ NEW [SimulationRep _ [steady: steady]];
RoseEvents.Notify[event: $NewSim, handleAborted: TRUE, arg: sim];
};

Possible: PUBLIC PROC [cell: Cell, whatToDo: ExpandDecision] RETURNS [possible: BOOLEAN] =
BEGIN
evalable: BOOL _ cell.type.evals.EvalSimple # NIL OR cell.type.evals.PropUD # NIL;
iok: BOOL _ (cell.type.simpleWordCount = 0 AND cell.type.switchWordCount = 0) OR cell.type.ioCreator # NIL;
RETURN [SELECT whatToDo FROM
Leaf => evalable AND iok,
Expand => cell.type.expand # NIL,
ENDCASE => ERROR];
END;

XPhobicize: PUBLIC PROC [n: Node] RETURNS [m: Node-- = n --] =
{(m _ n).XPhobic _ TRUE};

EnumerateConnections: PUBLIC PROC [asRope: ROPE, to: PROC [key: Key, nodeName: ROPE]] = {
index: CARDINAL _ 0;
in: IO.STREAM _ IO.RIS[asRope];
[] _ in.GetIndex[];	--wake up generic GetIndex impl
FOR i: NAT _ in.SkipWhitespace[], in.SkipWhitespace[] WHILE NOT in.EndOf[] DO
nodeName: ROPE _ GetName[in];
[] _ in.SkipWhitespace[];
IF (NOT in.EndOf[]) AND (in.PeekChar[] = ':) THEN {
portName: ROPE _ nodeName;
IF in.GetChar[] # ': THEN ERROR;
[] _ in.SkipWhitespace[];
IF in.EndOf[] THEN ERROR Error[IO.PutFR["Interface spec syntax error, at %g", IO.int[in.GetIndex[]]]];
nodeName _ GetName[in];
to[[keyword[portName]], nodeName];
}
ELSE {
to[[position[index]], nodeName];
};
index _ index + 1;
[] _ in.SkipWhitespace[];
IF in.EndOf[] THEN EXIT;
IF in.GetChar[] # ', THEN ERROR Error[IO.PutFR["Interface spec syntax error (missing comma?), at %g", IO.int[in.GetIndex[]]]];
ENDLOOP;
in.Close[];
};

FillInInterfaceNodes: PUBLIC PROC [cell: Cell, interfaceNodes: ROPE] =
BEGIN
PerConnection: PROC [key: Key, nodeName: ROPE] = {
portName: ROPE;
portIndex: PortIndex;
WITH key SELECT FROM
x: Key.position => {
IF x.index >= cell.interfaceNodes.length THEN ERROR Error[IO.PutFR["No %g'th element in %g's Interface", IO.int[x.index], IO.rope[cell.type.name]]];
portName _ cell.type.ports[portIndex _ x.index].name;
};
x: Key.keyword => {
IF (portIndex _ GetIndex[cell.type.ports, portName _ x.name]) = notFound THEN ERROR Error[IO.PutFR["No such port (%g) for CellType %g", IO.rope[portName], IO.rope[cell.type.name]]];
};
ENDCASE => ERROR;
IF cell.interfaceNodes[portIndex] # NIL THEN ERROR Error[IO.PutFR["Port %g specified twice in \"%g\"", IO.rope[portName], IO.rope[interfaceNodes]]];
cell.interfaceNodes[portIndex] _ LookupCellNode[cell.parent, nodeName];
IF cell.interfaceNodes[portIndex] = NIL THEN ERROR Error[IO.PutFR["Node %g not found", IO.rope[nodeName]]];
IF NOT Conforming[cell.interfaceNodes[portIndex].type, cell.type.ports[portIndex].type] THEN ERROR InterfaceMismatch[
cell: cell,
index: portIndex,
expected: cell.type.ports[portIndex].type,
got: cell.interfaceNodes[portIndex].type];
};
EnumerateConnections[interfaceNodes, PerConnection];
FOR portIndex: PortIndex IN [0 .. cell.interfaceNodes.length) DO
IF cell.interfaceNodes[portIndex] = NIL THEN
BEGIN
nodeName: ROPE _ cell.type.ports[portIndex].name;
cell.interfaceNodes[portIndex] _ LookupCellNode[cell.parent, nodeName];
IF cell.interfaceNodes[portIndex] = NIL THEN ERROR Error[IO.PutFR["Port %g not specified in \"%g\"", IO.rope[nodeName], IO.rope[interfaceNodes]]];
END;
ENDLOOP;
END;

GetName: PROC [from: IO.STREAM] RETURNS [name: ROPE] = {
first: CHAR _ from.PeekChar[];
SELECT first FROM
'" => name _ from.GetRopeLiteral[];
ENDCASE => name _ from.GetTokenRope[IDBreak].token;
};

IDBreak: IO.BreakProc =
{RETURN [SELECT char FROM
IO.SP, IO.CR, IO.LF, IO.TAB => sepr,
',, ': => break,
ENDCASE => other]};

MinSize: PROC [f: Field] RETURNS [words: CARDINAL] = {
words _ f.wordOffset + (INTEGER[f.bitOffset] + f.bitCount + Basics.bitsPerWord - 1)/Basics.bitsPerWord;
};

FieldEqual: PROC [f1, f2: Field] RETURNS [eq: BOOL] =
{eq _ f1 = f2};

CompareRopes: PUBLIC PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
BEGIN
ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
{RETURN [WITH ref SELECT FROM r: ROPE => r, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;

CompareComponents: PUBLIC PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
BEGIN
ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
{RETURN [WITH ref SELECT FROM
r: ROPE => r, c: Cell => c.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;

CompareNodes: PUBLIC PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
BEGIN
k1, k2: ROPE;
WITH r1 SELECT FROM
r: ROPE => k1 _ r;
n: Node => k1 _ n.name;
ENDCASE => ERROR;
k2 _ WITH r2 SELECT FROM
r: ROPE => r,
n: Node => n.name,
ENDCASE => ERROR;
RETURN [k1.Compare[k2]];
END;

CompareCellTypes: PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
BEGIN
ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
{RETURN [WITH ref SELECT FROM
r: ROPE => r, ct: CellType => ct.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;

CompareTests: PROC [r1, r2: REF ANY] RETURNS [Basics.Comparison] --OSTR.CompareProc-- =
BEGIN
ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
{RETURN [WITH ref SELECT FROM
r: ROPE => r, a: CellTest => a.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;

END.
 [Indigo]<Rosemary>r>Rosemary.DF=>RoseCreateImplB.Mesa
Last Edited by: Spreitzer, May 2, 1985 12:51:29 pm PDT
Identification:
Structure:
Behavior:
Other:
Κ
Ž–

"cedar" style˜JšœΟm
œ"™5J™6J˜IcodešΟk	œžœK˜jK˜šΠbxœžœ
ž˜Kšžœžœžœ@˜[Kšžœ
˜—K˜Kšžœ
žœ˜!K˜Kšœžœ˜<K˜šΟnœžœ
ž˜š
œ
˜
Kšœžœžœ
˜™Kšœžœ
˜—™
Kšœžœ
˜—™	Kšœžœ
˜Kšœžœ
˜!Kšœžœ
˜Kš
œ˜Kšœžœ
˜—™Kš
œ
˜
Kšœ
žœ
žœžœ
˜Kšœž˜—Kš
œ
˜
—Kšžœ˜Kš
ž˜Kšœ	žœžœ˜"Kšœ%žœžœ
˜2Kšœžœžœ
˜Kš	œžœžœ
žœžœ
˜DKšœ"žœ˜/Kšœžœžœ
˜šžœžœž˜2K˜Kšœžœ(˜=Kšœžœ(˜=Kšžœ
žœ
žœ
žœžœ(žœ˜cKšžœ
žœžœžœ
˜3Kšžœ
˜—Kšœžœ˜&šžœžœ
žœ˜Kšœžœ&žœ˜QKš
œ˜K˜
—šžœ˜Kš
œK˜KKšœ)žœ
žœžœ
˜HKš
œ˜—šžœžœ
žœ˜"Kšœžœžœ
˜Kšžœ
žœžœ
žœ-˜LKšžœ
žœžœ
žœG˜lšžœ<žœžœ
ž˜VKšžœžœ
žœ
˜#šžœžœ˜#šžœžœ˜Kšœžœ
˜Kšžœ
žœžœ
žœ
˜!Kšžœ
žœžœ
žœ=˜]Kšžœ
žœžœ
žœ=˜]K˜—Kšžœ+žœ
žœ
˜8Kš
œ%˜%Kš
œ˜—Kšžœ
˜—K˜—Kš
œ˜šžœ
žœžœ˜Kš
œ'˜'Kš
œ'˜'Kš
œ%˜%K˜—Kšžœ	žœžœ
žœ˜=Kšžœ	žœ
žœ
žœ˜>Kšžœ	žœžœ
žœ"˜GKšžœ	žœžœ
žœ ˜DKšžœ	žœžœ˜1Kšžœ	žœžœ
žœ˜;šžœ˜Kšžœ0˜4Kšžœ˜—Kšžœ
žœžœ˜8šžœžœ	žœ
ž˜2KšœžœH˜^Kšžœ
˜—Kšžœ
˜—K˜š
 œžœ
žœžœžœ˜@Kšœžœ˜(—K˜š
 œžœ
žœžœžœ˜IKšœžœ˜(—K˜š œžœ
žœ1žœžœžœ˜nKšœžœ˜&šžœžœ
žœ˜šžœ˜Kšžœžœžœ
žœ
˜2Kš
žœ
žœžœ;žœžœ˜u—K˜—Kš
œ˜K˜—K˜š
 œžœ
žœžœžœ˜RKš
œ+˜+šžœžœžœž˜Ašžœ
žœ˜Kšœ1ž˜4Kšœ(ž˜+Kšœ*ž˜-Kš
œ*˜*K˜
—Kšžœžœ
˜"šžœ
žœ˜Kšœ5ž˜8Kšœ5ž˜8Kšœ&ž˜)Kš
œ+˜+Kš
œ
˜
—Kšžœ	žœ
˜Kšžœ
˜—K˜—K˜š
 	œžœ
žœ
žœžœ˜CKšœžœ$˜-Kšœ1žœ˜AKš
œ˜—K˜š
 œžœ
žœ(žœžœ˜ZKš
ž˜Kš	œ
žœ žœ
žœžœ
˜RKš	œžœ"žœ žœžœ
˜kšžœžœ
ž˜Kšœžœ˜Kšœžœ
˜!Kšžœžœ˜—Kšžœ
˜—K˜š
 
œžœ
žœžœ	Οc	œ˜>Kšœžœ˜—K˜š œžœ
žœ
žœžœžœ˜YKšœžœ˜Kš	œžœ
žœžœ
žœ	˜Kšœ‘˜3š	žœžœ,žœ
žœž˜MKšœ
žœ˜Kš
œ˜šžœžœ
žœžœ˜3Kšœ
žœ˜Kšžœžœ
žœ
˜ Kš
œ˜Kš
žœžœ
žœžœ-žœ˜fKš
œ˜K˜"Kš
œ
˜
—šžœ˜K˜ Kš
œ˜—K˜Kš
œ˜Kšžœžœ
žœ
˜Kš
žœžœ
žœžœ>žœ˜~Kšžœ
˜—K˜K˜—K˜š œžœ
žœžœ˜FKš
ž˜š 
œžœžœ˜2Kšœ
žœ
˜Kš
œ˜šžœžœ
ž˜š
œ˜Kšžœ'žœ
žœžœ-žœžœ˜”
Kš
œ5˜5K˜—˜KšžœGžœ
žœžœ,žœžœ˜΅
K˜—Kšžœžœ
˜—Kšžœ"žœ
žœ
žœžœ,žœžœ˜”
K˜GKšžœ"žœ
žœ
žœžœžœ˜kšžœ
žœRžœ
žœ˜uK˜K˜Kš
œ*˜*Kš
œ*˜*—K˜—Kš
œ4˜4šžœžœ#ž˜@šžœ"žœ
ž˜,Kš
ž˜Kšœ
žœ#˜1K˜GKšžœ"žœ
žœ
žœžœ*žœžœ˜’
Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—K˜š œžœžœ
žœžœžœ˜8Kšœžœ˜šžœž˜K˜#Kšžœ,˜3—K˜—K˜šœ	žœ˜šœ
žœžœž˜Kšžœ
žœžœ
žœžœ
žœžœ
žœ	˜$Kš
œ˜Kšžœ˜——K˜š œžœžœ	žœ˜6KšœžœH˜gK˜—K˜š 
œžœžœžœ˜5Kš
œ˜—K˜š œžœ
žœ
žœ
žœžœ‘œ˜^Kš
ž˜š œžœ
žœžœ
žœžœžœ˜0Kšœ
žœžœžœ
žœžœžœžœ˜?—Kšžœ ˜&Kšžœ
˜—K˜š œžœ
žœ
žœ
žœžœ‘œ˜cKš
ž˜š œžœ
žœžœ
žœžœžœ˜0šœ
žœžœžœ
ž˜Kšœžœžœžœ˜4——Kšžœ ˜&Kšžœ
˜—K˜š œžœ
žœ
žœ
žœžœ‘œ˜^Kš
ž˜Kšœžœ
˜
šžœžœ
ž˜Kšœžœ˜Kš
œ˜Kšžœžœ
˜—šœžœžœ
ž˜Kšœžœ˜
K˜Kšžœžœ
˜—Kšžœ˜Kšžœ
˜—K˜š œžœ
žœ
žœžœ‘œ˜[Kš
ž˜š œžœ
žœžœ
žœžœžœ˜0šœ
žœžœžœ
ž˜Kšœžœ žœžœ˜:——Kšžœ ˜&Kšžœ
˜—K˜š œžœ
žœ
žœžœ‘œ˜WKš
ž˜š œžœ
žœžœ
žœžœžœ˜0šœ
žœžœžœ
ž˜Kšœžœžœžœ˜8——Kšžœ ˜&Kšžœ
˜—K˜Kšžœ
˜—…—&*4X