DIRECTORY
Core, CoreClasses, CoreCreate, CoreOps, CoreProperties, CoreSequence, HashTable, IO, Rope;

CoreCreateImpl: CEDAR PROGRAM
IMPORTS CoreClasses, CoreOps, CoreProperties, CoreSequence, HashTable, IO, Rope
EXPORTS CoreCreate = 
BEGIN OPEN CoreCreate;
WireList: PUBLIC PROC [wrs: LIST OF WR _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [newWire: Wire] = {
count: NAT _ 0;
FOR wrl: LIST OF WR _ wrs, wrl.rest UNTIL wrl=NIL DO
IF wrl.first#NIL THEN count _ count + 1;
ENDLOOP;
newWire _ CoreOps.CreateWires[count, name, props];
count _ 0;
FOR wrl: LIST OF WR _ wrs, wrl.rest UNTIL wrl=NIL DO
IF wrl.first#NIL THEN {
new: Wire _ WITH wrl.first SELECT FROM
wire: Wire 		=> wire,
rope: ROPE		=> CoreOps.CreateWire[name: rope],
text: REF TEXT 	=> CoreOps.CreateWire[name: Rope.FromRefText[text]],
ENDCASE 		=> ERROR;
newWire[count] _ new;
count _ count + 1;
};
ENDLOOP;
};
Wires: PUBLIC PROC [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13: WR _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [Wire] = {
RETURN [WireList[LIST [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13], name, props]];
};
Seq: PUBLIC PROC [name: ROPE _ NIL, size: NAT, protoChild: Wire _ NIL] RETURNS [wire: Wire] = {
wire _ CoreOps.SetShortWireName[CoreOps.CreateWires[size], name];
IF protoChild=NIL THEN FOR i: NAT IN [0..size) DO
wire[i] _ CoreOps.CreateWire[];
ENDLOOP
ELSE FOR i: NAT IN [0..size) DO
wire[i] _ CoreOps.CopyWire[protoChild];
ENDLOOP;
};
Index: PUBLIC PROC [wr: WR, index: NAT] RETURNS [WR] = {
WITH wr SELECT FROM
wire: Wire 		=> RETURN [wire[index]];
rope: ROPE 		=> RETURN [IO.PutFR["%g[%g]", IO.rope[rope], IO.int[index]]];
text: REF TEXT 	=> RETURN [IO.PutFR["%g[%g]", IO.text[text], IO.int[index]]];
ENDCASE 		=> ERROR
};

Range: PUBLIC PROC [wire: Wire, start, size: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [Wire] = {
RETURN [CoreOps.SubrangeWire[wire, start, size, name, props]];
};

Union: PUBLIC PROC [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13: Wire _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
wires: LIST OF Wire _ LIST [wr1, wr2, wr3, wr4, wr5, wr6, wr7, wr8, wr9, wr10, wr11, wr12, wr13];
count: NAT _ 0;
FOR wl: LIST OF Wire _ wires, wl.rest UNTIL wl=NIL DO
IF wl.first#NIL THEN count _ count + (IF wl.first.size=0 THEN 1 ELSE wl.first.size);
ENDLOOP;
wire _ CoreOps.CreateWires[count, name, props];
count _ 0;
FOR wl: LIST OF Wire _ wires, wl.rest UNTIL wl=NIL DO
IF wl.first#NIL THEN {
IF wl.first.size=0 THEN {
wire[count] _ wl.first;
count _ count+1;
}
ELSE {
FOR w: NAT IN [0..wl.first.size) DO
wire[count+w] _ wl.first[w];
ENDLOOP;
count _ count + wl.first.size;
};
};
ENDLOOP;
};
Instance: PUBLIC PROC [type: CellType, pa1, pa2, pa3, pa4, pa5, pa6, pa7, pa8, pa9, pa10, pa11, pa12, pa13: PA _ [], name: ROPE _ NIL, props: Properties _ NIL] RETURNS [CellInstance] = {
revpas: LIST OF PA _ NIL;
FOR pas: LIST OF PA _ LIST [pa1, pa2, pa3, pa4, pa5, pa6, pa7, pa8, pa9, pa10, pa11, pa12, pa13], pas.rest UNTIL pas=NIL DO
IF pas.first#[] THEN revpas _ CONS [pas.first, revpas];
ENDLOOP;
RETURN [InstanceList[type: type, pas: revpas, name: name, props: props]];
};
instanceBindProp: ATOM _ CoreProperties.RegisterProperty[$CoreInstanceBind, CoreProperties.Props[[CoreProperties.propCopy, CoreProperties.PropDoCopy], [CoreProperties.propPrint, CoreProperties.PropDontPrint]]];

InstanceList: PUBLIC PROC [type: CellType, pas: LIST OF PA _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [instance: CellInstance] = {
instance _ CoreClasses.CreateInstance[actual: NIL, type: type, name: name, props: props];
FOR checkPas: LIST OF PA _ pas, checkPas.rest WHILE checkPas#NIL DO
WITH checkPas.first.public SELECT FROM
wire: Wire 		=> {};
rope: ROPE 		=> {};
text: REF TEXT	=> {};
ENDCASE			=> ERROR;
WITH checkPas.first.actual SELECT FROM
wire: Wire 		=> {};
rope: ROPE 		=> {};
text: REF TEXT	=> {};
ENDCASE			=> ERROR;
ENDLOOP;
CoreProperties.PutCellInstanceProp[on: instance, prop: instanceBindProp, value: pas];
};

CreateError: ERROR [msg: ROPE] = CODE;

Cell: PUBLIC PROC [public: Wire, onlyInternal, internal: Wire _ NIL, instances: CellInstances, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [cellType: CellType] = {

MakeError: PROC [msg: ROPE, cellName: ROPE] = {
ERROR CreateError[Rope.Cat[msg, " in cell type '", cellName, "'"]];
};

CheckWellFormed: PROC [root: ROPE, wire: Wire] = {
IF wire=NIL THEN MakeError[root, name];
FOR sub: NAT IN [0..wire.size) DO
CheckWellFormed[root, wire[sub]];
ENDLOOP;
};

IF internal=NIL THEN internal _ CoreOps.UnionWire[public, onlyInternal] ELSE IF onlyInternal#NIL THEN MakeError["Both internal and onlyInternal are specified", name];
CheckWellFormed["Public is malformed", public];
CheckWellFormed["Internal is malformed", internal];
FOR instList: CellInstances _ instances, instList.rest UNTIL instList=NIL DO

CreateActual: PROC [public: Wire] RETURNS [actual: Wire] = {

ActualError: PROC = {
MakeError[Rope.Cat["Public '", CoreOps.GetFullWireNames[instance.type.public, public].first, "' has bad actual"], name];
};

IF (actual _ NARROW [HashTable.Fetch[table: visitTab, key: public].value])=NIL THEN {
FOR paList: LIST OF PA _ pas, paList.rest UNTIL paList=NIL DO
IF paList.first.public=public THEN {
actual _ FindWire[internal, paList.first.actual];
IF actual#NIL THEN EXIT;
WITH paList.first.actual SELECT FROM
wire: Wire => {

FindByName: PROC [wire: Wire] RETURNS [actual: Wire _ NIL] = {
actualName: ROPE _ CoreOps.GetShortWireName[wire];
IF actualName#NIL THEN actual _ FindWire[internal, actualName];
IF actual=NIL THEN {
IF wire.size=0 THEN ActualError[];
actual _ wire;
FOR i: NAT IN [0 .. wire.size) DO
actual[i] _ FindByName[actual[i]];
ENDLOOP;
};
};

actual _ FindByName[wire];
EXIT;
};
rope: ROPE => MakeError[Rope.Cat["Actual with name '", rope, "' not found in internal"], name];
refText: REF TEXT => MakeError[Rope.Cat["Actual with name '", Rope.FromRefText[refText], "' not found in internal"], name];
ENDCASE => ERROR;
};
REPEAT FINISHED => {
FOR pNames: LIST OF ROPE _ CoreOps.GetFullWireNames[instance.type.public, public], pNames.rest UNTIL pNames=NIL DO
actual _ FindWire[internal, pNames.first];
IF actual#NIL THEN EXIT;
REPEAT FINISHED => {
IF public.size=0 THEN ActualError[];
actual _ CoreOps.CreateWires[public.size];
FOR i: NAT IN [0 .. public.size) DO
actual[i] _ CreateActual[public[i]];
ENDLOOP;
};
ENDLOOP;
};
ENDLOOP;
IF NOT HashTable.Insert[table: visitTab, key: public, value: actual] THEN ERROR;
};
};

instance: CellInstance _ instList.first;
visitTab: HashTable.Table _ HashTable.Create[];  -- Wire to Wire
pas: LIST OF PA _ NARROW[CoreProperties.GetCellInstanceProp[from: instance, prop: instanceBindProp]];
FOR paList: LIST OF PA _ pas, paList.rest UNTIL paList=NIL DO
pub: Wire _ FindWire[instance.type.public, paList.first.public];
IF pub=NIL THEN {
names: LIST OF ROPE _ CoreOps.GetFullWireNames[instance.type.public, NARROW[paList.first.public]];
MakeError[Rope.Cat["Could not find public '", IF ISTYPE[paList.first.public, Wire] THEN IF names=NIL THEN "unknown" ELSE names.first ELSE CoreOps.FixStupidRef[paList.first.public], "'"], CoreOps.GetCellTypeName[instance.type]];
};
paList.first.public _ pub;
ENDLOOP;
instance.actual _ CreateActual[instance.type.public];
FOR i: NAT IN [0..instance.actual.size) DO
IF NOT CoreOps.RecursiveMember[candidate: instance.actual[i], wire: internal] THEN
internal _ CoreOps.UnionWire[internal, CoreOps.CreateWire[LIST[instance.actual[i]]]];
ENDLOOP;
CoreProperties.PutCellInstanceProp[on: instance, prop: instanceBindProp, value: NIL];
ENDLOOP;
cellType _ CoreClasses.CreateRecordCell[public: public, internal: internal, instances: instances, name: name, props: props];
};

Transistor: PUBLIC PROC [type: TransistorType _ nE, length: NAT _ 2, width: NAT _ 4, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [cellType: CellType] = {
cellType _ CoreClasses.CreateTransistor[
args: [type: type, length: length, width: width],
name: name, props: props
];
};
SequenceCell: PUBLIC PROC [baseCell: CellType, count: NAT, sequencePorts: Wire _ NIL, flatSequencePorts: Wire _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [cellType: CellType] = {

FindPorts: PROC [ports: Wire] RETURNS [set: CoreSequence.SequenceSet] = {
IF ports#NIL THEN {
set _ NEW[CoreSequence.SequenceSetRec[ports.size]];
FOR i: INT IN [0..ports.size) DO
FOR w: NAT IN [0..baseCell.public.size) DO
sequenceName: ROPE _ CoreOps.GetShortWireName[ports[i]]; 
IF ports[i]=baseCell.public[w] OR (sequenceName#NIL AND Rope.Equal[sequenceName, CoreOps.GetShortWireName[ baseCell.public[w]]]) THEN {
set[i] _ w;
EXIT;
};
REPEAT FINISHED => ERROR;
ENDLOOP; 
ENDLOOP;
};
};

seqCell: CoreSequence.SequenceCellType _ NEW [CoreSequence.SequenceCellTypeRec _ [
base: baseCell,
count: count,
sequence: FindPorts[sequencePorts],
flatSequence: FindPorts[flatSequencePorts]]];
cellType _ CoreSequence.Create[args: seqCell, name: name, props: props];
};

FindWire: PUBLIC PROC [root: Wire, wr: WR] RETURNS [found: Wire _ NIL] = {

WITH wr SELECT FROM
wrwire: Wire 	=> IF CoreOps.RecursiveMember[candidate: wrwire, wire: root] THEN found _ wrwire;
wrrope: ROPE 	=> found _ CoreOps.FindWire[root, wrrope];
text: REF TEXT 	=> found _ CoreOps.FindWire[root, Rope.FromRefText[text]];
ENDCASE => ERROR;
};

END.

,CoreCreateImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Bertrand Serlet, March 20, 1986 2:03:38 am PST
Barth, May 7, 1986 10:21:40 am PDT
Louis Monier May 1, 1986 4:50:13 pm PDT

Wires




Cells

We check pas is of the right type, to detect errors as soon as possible

ส˜
codeš
œ™Kšœ
ฯm
œ1™<Kš
œ.™.K™"K™'—K™š
ฯk	˜	KšœEž
œžœ˜Z—K˜šฯnœžœ
ž˜Kšžœ@žœ˜OKšžœ˜Kšžœ
žœ˜—
head™šŸœžœ
žœžœ
žœ
žœžœžœžœžœžœ˜tKšœžœ˜š
žœžœ
žœ
žœžœžœ
ž˜4Kšžœžœ
žœ˜(Kšžœ
˜—Kš
œ2˜2Kš
œ
˜
š
žœžœ
žœ
žœžœžœ
ž˜4šžœžœ
žœ˜šœžœ
žœ
ž˜&Kš
œ˜Kšœžœ$˜.Kšœžœ
žœ6˜DKšžœžœ
˜—Kš
œ˜Kš
œ˜K˜—Kšžœ
˜—K˜K™—šŸœžœ
žœGžœžœžœžœžœžœ˜ 
KšžœžœV˜kK˜K™—šŸœžœ
žœžœžœžœžœžœ˜_Kš
œA˜Aš
žœžœ
žœ
žœžœ
žœž˜1Kš
œ˜Kš
ž˜—š	žœ
žœžœ
žœž˜Kš
œ'˜'Kšžœ
˜—K˜K™—šŸœžœ
žœžœ	žœžœžœ˜8šžœžœ
ž˜Kšœžœ˜%Kšœžœžœžœžœ
žœ˜JKš
œžœ
žœžœžœžœ
žœ˜MKšžœž˜—K˜K˜—šŸœžœžœžœžœžœžœ˜oKšžœ8˜>K˜K˜—šŸœžœ
žœNžœžœžœžœžœ˜จ
Kšœžœ
žœžœG˜aKšœžœ˜šžœžœ
žœžœžœ
ž˜5Kšžœ
žœ
žœžœžœžœ˜TKšžœ
˜—Kš
œ/˜/Kš
œ
˜
šžœžœ
žœžœžœ
ž˜5šžœ
žœ
žœ˜šžœžœ˜K˜K˜K˜
—šžœ˜šžœžœ
žœž˜#Kš
œ˜Kšžœ
˜—Kš
œ˜K˜—K˜—Kšžœ
˜—K˜K™——™šŸœžœ
žœWžœ
žœžœžœžœ˜บ
Kš	œžœ
žœ
žœžœ
˜šžœžœ
žœ
žœžœQžœžœ
ž˜{Kšžœžœ
žœ˜7Kšžœ
˜—KšžœB˜IK˜K™—šœžœผ
˜า
K˜—šŸœžœ
žœžœ
žœ
žœžœžœžœžœžœ˜‘
Kšœ.žœ(˜YK™Gš
žœžœ
žœ
žœžœ
žœ
ž˜Cšžœžœ
ž˜&K˜Kšœžœ	˜Kšœžœ
žœ˜Kšžœžœ
˜—šžœžœ
ž˜&K˜Kšœžœ	˜Kšœžœ
žœ˜Kšžœžœ
˜—Kšžœ
˜—Kš
œU˜UKš
œ˜K˜—šœ
žœžœžœ
˜&K˜—šŸœžœ
žœ/žœ"žœžœžœžœ˜ช
K˜šŸ	œžœžœžœ˜/Kšžœ>˜CK˜K˜—šŸœžœžœ˜2Kšžœžœ
žœ˜'šžœžœ
žœž˜!Kš
œ!˜!Kšžœ
˜—K˜—K˜Kšžœ
žœ
žœ4žœ
žœžœ
žœA˜ฆ
Kš
œ/˜/Kš
œ3˜3šžœ4žœ
žœ
ž˜LK˜šŸœžœžœ˜<K˜šŸœžœ˜Kš
œx˜xK˜K˜—šžœžœ7žœ
žœ˜Uš
žœ	žœ
žœ
žœžœžœ
ž˜=šžœžœ˜$Kš
œ1˜1Kšžœžœ
žœ
žœ
˜šžœžœ
ž˜$Kš
œ˜˜šŸ
œžœžœžœ˜>Kšœžœ"˜2Kšžœžœ
žœ)˜?šžœžœ
žœ˜Kšžœ
žœ˜"Jš
œ˜šžœžœ
žœž˜!Jš
œ"˜"Jšžœ
˜—Kš
œ˜—K˜K˜—Kš
œ˜Kšžœ
˜K˜—KšœžœU˜_Kšœ	žœ
žœj˜{Kšžœžœ
˜—Kš
œ˜—šžœ
žœ˜š
žœ	žœ
žœ
žœGžœžœ
ž˜rKš
œ*˜*Kšžœžœ
žœ
žœ
˜šžœ
žœ˜Kšžœžœ˜$Jš
œ*˜*šžœžœ
žœž˜#Jš
œ$˜$Jšžœ
˜—Kš
œ˜—Kšžœ
˜—K˜—Kšžœ
˜—Kšžœ
žœ?žœ
žœ
˜PK˜—K˜K˜—Kš
œ(˜(Kšœ1ฯc˜@Kš	œžœ
žœ
žœžœM˜eš
žœ	žœ
žœ
žœžœžœ
ž˜=Kš
œ@˜@šžœžœ
žœ˜Kš	œžœ
žœ
žœ2žœ˜bKšœ.žœ
žœžœ
žœžœ
žœžœ
žœZ˜ใ
K˜—Kš
œ˜Kšžœ
˜—Kš
œ5˜5šžœžœ
žœž˜*šžœ
žœHž˜RKšœ:žœ˜U—Kšžœ
˜—KšœPžœ˜UKšžœ
˜—Kš
œ|˜|Kš
œ˜K˜—šŸ
œžœ
žœ%žœ
žœžœžœžœžœ˜ 
š
œ(˜(Kš
œ1˜1Kš
œ˜Kš
œ˜—K˜K™—šŸœžœ
žœžœžœžœžœžœžœžœ˜ภ
K˜šŸ	œžœžœ$˜Išžœžœ
žœ˜Kšœžœ*˜3šžœžœ
žœž˜ šžœžœ
žœž˜*Kšœžœ'˜9š
žœžœžœ
žœJžœ˜‡
Kš
œ˜Kšžœ
˜Kš
œ˜—Kšžœ
žœžœ
˜Kšžœ˜	—Kšžœ
˜—K˜—K˜K˜—šœ)žœ&˜RKš
œ˜Kš
œ
˜
Kš
œ#˜#Kš
œ-˜-—Kš
œH˜HK˜K˜—šŸœžœ
žœžœžœžœ˜JK˜šžœžœ
ž˜Kšœžœ8žœ˜_Kšœžœ,˜8Kšœžœ
žœ<˜JKšžœžœ
˜—K˜K˜——Kšžœ
˜—…—$Œ1ื