CoreOpsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, October 2, 1985 11:28:58 am PDT
Spreitzer, October 3, 1985 5:16:15 pm PDT
Bertrand Serlet October 2, 1985 12:18:37 pm PDT
DIRECTORY Core, CoreOps, CorePrivate, CoreProperties, CoreRecord, IO, Rope, SymTab;
CoreOpsImpl: CEDAR PROGRAM
IMPORTS CoreProperties, CoreRecord, IO, Rope, SymTab
EXPORTS Core, CoreOps =
BEGIN OPEN Core, CoreOps;
DesignDataRec: PUBLIC TYPE = CorePrivate.DesignDataRec;
StructureError: PUBLIC SIGNAL [type: StructureErrorType, message: ROPE, data: REF ANY ← NIL] RETURNS [newData: REF ANY ← NIL] = CODE;
cellClasses: SymTab.Ref ← SymTab.Create[];
Start: PROC = {
CoreProperties.PropDontPrint[publicWireFullName];
RegisterCellClass[identityCellClass];
};
Designs
CreateDesign: PUBLIC PROC [name: ROPE ← NIL, props: Properties ← NIL] RETURNS [design: Design] = {
design ← NEW[DesignRec ← [
name: name, 
data: NEW[DesignDataRec ← [cellTypes: SymTab.Create[]]],
properties: props]];
};
PrintDesign: PUBLIC PROC [design: Design, out: STREAM] = {
PrintDesignCellType: EachEntryAction = {
PrintCellType[cellType: cellType, out: out];
};
IO.PutF[out, "\nDesign: %g", IO.rope[design.name]];
CoreProperties.PrintProperties[props: design.properties, out: out];
[] ← EnumerateCellTypes[design: design, action: PrintDesignCellType];
};
Cell Classes
printClassProcProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CorePrintClassProc];
RegisterCellClass: PUBLIC PROC [class: CellClass] = {
IF class=NIL OR class.name=NIL THEN [] ← SIGNAL StructureError[MissingParameter, NIL];
IF NOT SymTab.Store[x: cellClasses, key: class.name, val: class] THEN [] ← SIGNAL StructureError[DuplicateName, class.name];
};
Cell Types
InsertCellType: PUBLIC PROC [design: Design, cellType: CellType] = {
createdName: BOOL ← FALSE;
concrete: CorePrivate.ConcreteDesignData ← design.data;
IF design=NIL OR cellType=NIL OR cellType.class=NIL THEN [] ← SIGNAL StructureError[MissingParameter, NIL];
IF cellType.name = NIL THEN {
IF concrete.fakeName=LAST[NAT] THEN {
concrete.fakeNamePrefix ← Rope.Cat[concrete.fakeNamePrefix, "@"];
concrete.fakeName ← 0;
}
ELSE concrete.fakeName ← concrete.fakeName+1;
cellType.name ← IO.PutFR["-noname-%g%g", IO.rope[concrete.fakeNamePrefix], IO.int[concrete.fakeName]];
createdName ← TRUE;
};
IF NOT SymTab.Store[x: concrete.cellTypes, key: cellType.name, val: cellType] THEN IF createdName THEN [] ← SIGNAL StructureError[InvariantFailed, NIL] ELSE [] ← SIGNAL StructureError[DuplicateName, cellType.name];
};
FetchCellType: PUBLIC PROC [design: Design, name: ROPE] RETURNS [cellType: CellType] = {
concrete: CorePrivate.ConcreteDesignData ← design.data;
IF design=NIL OR name=NIL THEN [] ← SIGNAL StructureError[MissingParameter, NIL];
cellType ← NARROW[SymTab.Fetch[x: concrete.cellTypes, key: name].val];
};
EnumerateCellTypes: PUBLIC PROC [design: Design, action: EachEntryAction] RETURNS [quit: BOOL] = {
concrete: CorePrivate.ConcreteDesignData ← design.data;
LclEntryAction: SymTab.EachPairAction = {
quit ← action[cellType: NARROW[val]];
};
IF design=NIL OR action=NIL THEN [] ← SIGNAL StructureError[MissingParameter, NIL];
quit ← SymTab.Pairs[x: concrete.cellTypes, action: LclEntryAction];
};
PrintCellType: PUBLIC PROC [cellType: CellType, out: STREAM] = {
classProc: REF PrintClassProc;
IO.PutF[out, "\n\nCell type: %g", IO.rope[cellType.name]];
IO.PutF[out, ", Cell class: %g", IO.rope[cellType.class.name]];
IO.PutRope[out, "\nPublic wire:"];
PrintWire[cellType.publicWire, out];
IF (classProc ← NARROW[CoreProperties.GetProp[from: cellType.class.properties, prop: printClassProcProp]]) # NIL THEN classProc[cellType.data, out];
CoreProperties.PrintProperties[props: cellType.properties, out: out];
};
identityCellClass: CellClass ← NEW[CellClassRec ← [name: "Identity", recast: IdentityRecast, read: IdentityRead, write: IdentityWrite, properties: CoreProperties.Props[[printClassProcProp, NEW[PrintClassProc ← IdentityPrint]]]]];
Identity: PUBLIC PROC [cellType: CellType, name: ROPE, props: Properties ← NIL] RETURNS [identity: CellType] = {
identity ← NEW[CellTypeRec ← [
name: name,
class: identityCellClass,
publicWire: CopyWire[wire: cellType.publicWire],
data: cellType,
properties: props]];
};
IdentityRecast: RecastProc = {
new ← me;
WHILE new.class=identityCellClass DO new ← NARROW[new.data]; ENDLOOP;
};
IdentityRead: ReadProc = {
ERROR;
};
IdentityWrite: WriteProc = {
ERROR;
};
IdentityPrint: PrintClassProc = {
ct: CellType ← NARROW[data];
out.PutF["\nIdentity of %g", IO.rope[ct.name]];
};
recastCacheProp: ATOM ← CoreProperties.RegisterProperty[$CoreRecastCache];
Recast: PUBLIC RecastProc = {
value: REF ← CoreProperties.GetProp[me.properties, recastCacheProp];
IF value#NIL THEN RETURN [NARROW[value]];
new ← me.class.recast[me];
me.properties ← CoreProperties.PutProp[me.properties, recastCacheProp, new];
};
Wires
CreateSequenceWire: PUBLIC PROC [name: ROPE ← NIL, components: LIST OF Wire, props: Properties ← NIL] RETURNS [wire: Wire] = {
wire ← CreateRecordWire[name, components, props];
FOR w: NAT IN [1..wire.elements.size) DO
IF NOT CoreRecord.Conform[w1: wire.elements[0], w2: wire.elements[w]] THEN ERROR;
ENDLOOP;
};
CreateRecordWire: PUBLIC PROC [name: ROPE ← NIL, components: LIST OF Wire, props: Properties ← NIL] RETURNS [wire: Wire] = {
fieldCount: NAT ← 0;
FOR c: LIST OF Wire ← components, c.rest UNTIL c=NIL DO
fieldCount ← fieldCount + 1;
ENDLOOP;
wire ← NEW[WireRec ← [
name: name,
structure: record,
elements: NEW[WireSequenceRec[fieldCount]],
properties: props]];
fieldCount ← 0;
FOR c: LIST OF Wire ← components, c.rest UNTIL c=NIL DO
wire.elements[fieldCount] ← c.first;
fieldCount ← fieldCount + 1;
ENDLOOP;
};
CreateAtomWire: PUBLIC PROC [name: ROPE ← NIL, props: Properties ← NIL] RETURNS [wire: Wire] = {
wire ← NEW[WireRec ← [
name: name,
structure: atom,
properties: props]];
};
CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = {
RecurseCopy: PROC [wire: Wire] RETURNS [new: Wire] = {
IF wire=NIL THEN RETURN[NIL];
new ← NEW[WireRec ← wire^];
IF wire.elements#NIL THEN {
new.elements ← NEW[WireSequenceRec[wire.elements.size]];
FOR i:NAT IN [0..wire.elements.size) DO
new.elements[i] ← RecurseCopy[wire.elements[i]];
ENDLOOP;
};
new.properties ← CoreProperties.CopyProps[propList: wire.properties];
};
new ← RecurseCopy[wire];
};
VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc]= {
RecurseOnWire: PROC [wire: Wire] RETURNS [quit: BOOL ← FALSE] = {
notSubWires: BOOL;
[notSubWires, quit] ← eachWire[wire];
IF NOT quit AND NOT notSubWires AND wire.elements#NIL THEN
FOR i:NAT IN [0..wire.elements.size) DO
quit ← RecurseOnWire[wire.elements[i]];
IF quit THEN EXIT;
ENDLOOP;
};
IF wire#NIL THEN [] ← RecurseOnWire[wire];
};
PrintWire: PUBLIC PROC [wire: Wire, out: STREAM] = {
depth: NAT ← 1;
RecursePrintWire: PROC [wire: Wire] = {
PrintIndent[depth, out];
IO.PutF[out, "%g, %g", IF wire.name=NIL THEN IO.rope["<no name>"] ELSE IO.refAny[wire.name], IO.rope[SELECT wire.structure FROM
atom => "atom",
record => "record",
sequence => "sequence",
ENDCASE => ERROR]];
IF wire.structure#atom THEN IO.PutF[out, ", %g elements", IO.int[wire.elements.size]];
CoreProperties.PrintProperties[props: wire.properties, out: out, depth: depth+1];
IF wire.elements#NIL THEN {
depth ← depth + 1;
IF wire.structure=record THEN FOR i: NAT IN [0..wire.elements.size) DO
RecursePrintWire[wire.elements[i]];
ENDLOOP
ELSE RecursePrintWire[wire.elements[0]];
depth ← depth - 1;
};
};
RecursePrintWire[wire: wire];
};
PrintIndent: PUBLIC PROC [depth: NAT, out: STREAM] = {
IO.PutChar[out, IO.CR];
FOR i: NAT IN [0..depth) DO
IO.PutRope[out, " "];
ENDLOOP;
};
NameWire: PUBLIC PROC [wire: Wire, name: ROPE, prop: ATOM] = {
wire.properties ← CoreProperties.PutProp[on: wire.properties, prop: prop, value: name];
IF wire.elements#NIL THEN {
FOR i:NAT IN [0..wire.elements.size) DO
new: ROPE ← SELECT wire.structure FROM
sequence => IO.PutFR["%g[%g]", IO.rope[name], IO.int[i]],
record => IF wire.elements[i].name#NIL THEN Rope.Cat[name, ".", wire.elements[i].name] ELSE Rope.Cat[name, ".?"],
ENDCASE => ERROR;
NameWire[wire: wire.elements[i], name: new, prop: prop];
ENDLOOP;
};
};
nameClassWireProcProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CoreClassWireNameProc];
publicWireFullName: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CorePublicWireFullName];
NameAllWires: PUBLIC PROC [design: Design] = {
NameCellTypeWires: EachEntryAction = {
classProc: REF NameWireProc;
NameWire[wire: cellType.publicWire, name: cellType.publicWire.name, prop: publicWireFullName];
IF (classProc ← NARROW[CoreProperties.GetProp[from: cellType.class.properties, prop: nameClassWireProcProp]]) # NIL THEN classProc[cellType.data];
};
[] ← EnumerateCellTypes[design: design, action: NameCellTypeWires];
};
Start[];
END.