CoreCreateImpl.mesa
Copyright © 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
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;
Wires
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;
};
Cells
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];
We check pas is of the right type, to detect errors as soon as possible
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.