CoreRecordCellClassImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, August 14, 1985 10:11:43 pm PDT
Spreitzer, August 12, 1985 5:21:14 pm PDT
Serlet, July 23, 1985 7:28:37 pm PDT
DIRECTORY Core, CoreOps, CoreProperties, CoreRecordCellClass, IO;
CoreRecordCellClassImpl: CEDAR PROGRAM
IMPORTS CoreOps, CoreProperties, IO
EXPORTS CoreRecordCellClass =
BEGIN OPEN Core, CoreRecordCellClass;
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 ← PropPrintRecordCellType]];
};
WriteRecord: WriteProc = {
};
ReadRecord: ReadProc = {
};
PropPrintRecordCellType: CoreOps.PrintClassProc = {
PrintRecordCellType[NARROW[data], out];
};
PrintRecordCellType: PUBLIC PROC [recordCellType: RecordCellType, out: STREAM] = {
InternalName: CoreOps.EachWireProc = {
internal: ROPENIL;
FormInternalName: PROC [context: Wire] RETURNS [quit: BOOLFALSE] = {
IF (quit ← notSubWires ← wire=context) THEN internal ← NARROW[CoreProperties.GetProp[from: context.properties, prop: $FullName]]
ELSE IF context.elements#NIL THEN {
FOR i:NAT IN [0..context.elements.size) DO
quit ← FormInternalName[context: context.elements[i]];
IF quit THEN EXIT;
ENDLOOP;
};
};
[] ← FormInternalName[context: recordCellType.internalWire];
IF notSubWires THEN IO.PutF[out, " %g", IO.rope[internal]];
};
IO.PutRope[out, "\nInternal wire:"];
CoreOps.PrintWire[recordCellType.internalWire, out];
CoreOps.NameWire[wire: recordCellType.internalWire, name: NIL];
FOR instList: LIST OF Instance ← recordCellType.instances, instList.rest UNTIL instList=NIL DO
IO.PutF[out, "\n\nInstance: %g, type: %g", IO.rope[instList.first.name], IO.rope[instList.first.type.name]];
CoreProperties.PrintProperties[instList.first.properties, out];
IO.PutRope[out, "\nActual wire:"];
CoreOps.VisitWire[wire: instList.first.actualWire, eachWire: InternalName];
ENDLOOP;
};
Start[];
END.