CoreRecordImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, October 2, 1985 10:36:07 am PDT
Spreitzer, October 3, 1985 4:47:45 pm PDT
Serlet, July 23, 1985 7:28:37 pm PDT
DIRECTORY Core, CoreOps, CoreProperties, CoreRecord, IO;
CoreRecordImpl:
CEDAR
PROGRAM
IMPORTS CoreOps, CoreProperties, IO
EXPORTS CoreRecord =
BEGIN OPEN Core, CoreRecord;
recordCellClass: PUBLIC CellClass ← NEW[CellClassRec ← [name: "Record", recast: NIL, write: WriteRecord, read: ReadRecord]];
Start:
PROC = {
CoreOps.RegisterCellClass[recordCellClass];
recordCellClass.properties ← CoreProperties.PutProp[on: recordCellClass.properties, prop: CoreOps.printClassProcProp, value: NEW[CoreOps.PrintClassProc ← PropPrint]];
recordCellClass.properties ← CoreProperties.PutProp[on: recordCellClass.properties, prop: CoreOps.nameClassWireProcProp, value: NEW[CoreOps.NameWireProc ← NameInternalWire]];
CoreProperties.PropDontPrint[internalWireFullName];
};
WriteRecord: WriteProc = {
};
ReadRecord: ReadProc = {
};
PropPrint: CoreOps.PrintClassProc = {
Print[NARROW[data], out];
};
Print:
PUBLIC
PROC [recordCellType: RecordCellType, out:
STREAM] = {
IO.PutRope[out, "\nInternal wire:"];
CoreOps.NameWire[wire: recordCellType.internalWire, name: recordCellType.internalWire.name, prop: internalWireFullName];
CoreOps.PrintWire[recordCellType.internalWire, out];
FOR instList: CellInstanceList ← recordCellType.instances, instList.rest
UNTIL instList=
NIL
DO
firstActual: BOOL ← TRUE;
RecurseOnWires:
PROC [actual, public: Wire] = {
internalName: ROPE;
IF (internalName ←
NARROW[CoreProperties.GetProp[from: actual.properties, prop: internalWireFullName]]) #
NIL
THEN {
IF NOT firstActual THEN out.PutChar[',];
firstActual ← FALSE;
out.PutF[" %g: %g", IO.rope[NARROW[CoreProperties.GetProp[from: public.properties, prop: CoreOps.publicWireFullName]]], IO.rope[internalName]];
}
ELSE
IF actual.elements#
NIL
THEN
FOR i:
NAT
IN [0..actual.elements.size)
DO
RecurseOnWires[actual.elements[i], public.elements[i]];
ENDLOOP;
};
IO.PutF[out, "\nCellInstance: %g, type: %g", IO.rope[instList.first.name], IO.rope[instList.first.type.name]];
CoreProperties.PrintProperties[props: instList.first.properties, out: out, depth: 1];
IO.PutRope[out, "\n Actual wire:"];
CoreOps.NameWire[wire: instList.first.type.publicWire, name: instList.first.type.publicWire.name, prop: CoreOps.publicWireFullName];
RecurseOnWires[actual: instList.first.actualWire, public: instList.first.type.publicWire];
ENDLOOP;
};
Conform:
PUBLIC
PROC [w1, w2: Wire]
RETURNS [c:
BOOL] = {
IF NOT (c ← w1.structure = w2.structure) THEN RETURN;
IF w1.structure = atom THEN RETURN;
IF NOT (c ← w1.elements.size = w2.elements.size) THEN RETURN;
FOR i:
NAT
IN [0 .. w1.elements.size)
DO
IF NOT Conform[w1.elements[i], w2.elements[i]] THEN RETURN [FALSE];
ENDLOOP;
c ← TRUE;
};
Bound:
PUBLIC
PROC [instance1, instance2: CellInstance, public1, public2: Wire]
RETURNS [b:
BOOL] = {
matchActual, matchPublic: Wire;
MatchWire:
PROC [actual, public: Wire]
RETURNS [quit:
BOOL ←
FALSE] = {
IF matchPublic=public THEN {matchActual ← actual; quit ← TRUE}
ELSE
IF actual.elements#
NIL
THEN
FOR i:
NAT
IN [0..actual.elements.size)
DO
IF MatchWire[actual.elements[i], public.elements[i]] THEN EXIT;
ENDLOOP;
};
actual1: Wire;
matchPublic ← public1;
[] ← MatchWire[instance1.actualWire, instance1.type.publicWire];
actual1 ← matchActual;
matchPublic ← public2;
[] ← MatchWire[instance2.actualWire, instance2.type.publicWire];
b ← actual1=matchActual;
};
internalWireFullName:
PUBLIC ATOM ← CoreProperties.RegisterProperty[$CoreInternalWireFullName];
NameInternalWire: CoreOps.NameWireProc = {
rct: RecordCellType ← NARROW[data];
CoreOps.NameWire[wire: rct.internalWire, name: rct.internalWire.name, prop: internalWireFullName];
};
Start[];
END.