RTCoreUtilImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Bryan Preas, September 8, 1986 5:19:30 pm PDT
Last Edited by: Bryan Preas October 31, 1986 2:55:12 pm PST
Barth, February 18, 1987 9:44:27 pm PST
DIRECTORY
Core, CoreClasses, CoreFlat, CoreOps, CoreProperties, RefTab, PWCore, Rope, RTBasic, RTCoreUtil;
RTCoreUtilImpl: CEDAR PROGRAM
IMPORTS CoreFlat, CoreOps, CoreProperties, RefTab, PWCore, Rope, RTBasic
EXPORTS RTCoreUtil =
BEGIN
GetCoreIntProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM, default: INT] RETURNS [num: INT] ~ {
get a number property from a cell
value: REF ← CoreProperties.GetCellTypeProp[cellType, prop];
IF value=NIL THEN num ← default
ELSE WITH value SELECT FROM
nat: REF NAT => num ← nat^;
int: REF INT => num ← int^;
ENDCASE => RTBasic.Error[callingError, "NAT or INT expected"]};
PutCoreIntProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM, num: INT] = {
put a integer number property from a cell
CoreProperties.PutCellTypeProp[cellType, prop, NEW[INT ← num]]};
GetCoreRealProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM, default: REAL] RETURNS [num: REAL] ~ {
get a number property from a cell
value: REF ← CoreProperties.GetCellTypeProp[cellType, prop];
IF value=NIL THEN num ← default
ELSE num ← NARROW[value, REF REAL]^};
PutCoreRealProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM, num: REAL] = {
put a real number property from a cell
CoreProperties.PutCellTypeProp[cellType, prop, NEW[REAL ← num]]};
GetCoreBoolProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM, default: BOOL] RETURNS [val: BOOL] ~ {
get a Bool property from a cell
value: REF ← CoreProperties.GetCellTypeProp[cellType, prop];
IF value=NIL THEN val ← default
ELSE val ← NARROW[value, REF BOOL]^};
PutCoreBoolProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM, val: BOOL] = {
put a Bool property on a cell
CoreProperties.PutCellTypeProp[cellType, prop, NEW[BOOL ← val]]};
GetCoreAtomProp: PUBLIC PROC [cellType: Core.CellType, prop: ATOM] RETURNS [ATOM] ~ {
get a Atom property from a cell
RETURN[NARROW[CoreProperties.GetCellTypeProp[cellType, prop]]]};
EnumerateInstances: PUBLIC PROC [cellType: Core.CellType, eachInstance: RTCoreUtil.EachInstanceProc] RETURNS [quit: BOOLFALSE] = {
May raise StructureError[MissingParameter].
parentRCT: CoreClasses.RecordCellType ← NARROW[cellType.data];
IF parentRCT = NIL THEN
RTBasic.Error[callingError, Rope.Cat["Invalid Record Cell: ", CoreOps.GetCellTypeName[cellType]]];
FOR in: NAT IN [0..parentRCT.size) DO
instance: CoreClasses.CellInstance ← parentRCT[in];
quit ← eachInstance[instance];
ENDLOOP};
EnumerateFlatWires: PUBLIC PROC [wire: Core.Wire, eachWire: RTCoreUtil.EachWireProc] RETURNS [quit: BOOLFALSE] = {
DoWire: CoreOps.EachWireProc = {
IF wire.size = 0 THEN [subWires, quit] ← eachWire[wire]};
quit ← CoreOps.VisitWire[wire, DoWire]};
EnumerateFlatInstancePins: PUBLIC PROC [cellInstance: CoreClasses.CellInstance, eachInstancePin: RTCoreUtil.EachInstancePinProc] = {
DoWire: CoreOps.EachWirePairProc = {
added test for actualWire = NIL - Frank Bowers January 10, 1986 11:05:46 am PST
IF actualWire # NIL AND actualWire.size = 0 AND publicWire.size = 0 THEN
[subWires, quit] ← eachInstancePin[actualWire, publicWire]};
[] ← CoreOps.VisitBinding[cellInstance.actual, cellInstance.type.public, DoWire]};
-- Flatten until the cellType has a $Layout property
defaultFlatten: PUBLIC RTCoreUtil.FlattenCellTypeProc = {
RETURN[PWCore.GetLayoutAtom[cellType]=NIL]}; -- $Layout
Flatten: PUBLIC PROC [root: Core.CellType, flattenCellType: RTCoreUtil.FlattenCellTypeProc, definePublicWire, defineInternalWire: RTCoreUtil.FlatWireProc, defineInstance: RTCoreUtil.FlatInstanceProc, interestingProperties: RTCoreUtil.PropertyKeys] = {
BuildPublic: PROC [wire: Core.Wire] = {
flatWire: CoreFlat.FlatWire = NEW [CoreFlat.FlatWireRec ← [wire: wire]];
IF RefTab.Fetch[rootFlatsToInternals, flatWire].val = NIL THEN { -- public not seen
[] ← RefTab.Store[rootFlatsToInternals, flatWire, wire];
[] ← defineInternalWire[flatWire^];
[] ← definePublicWire[flatWire^]}};
EachInstance: CoreFlat.BoundFlatCellProc = {
PROC [cell: CellType, target: FlatCellTypeRec ← allFlatCells, flatCell: FlatCellTypeRec ← [], instance: CellInstance ← NIL, index: NAT ← LAST[NAT], parent: CellType ← NIL, flatParent: FlatCellTypeRec ← [], data: REF ANY ← NIL, bindings: Bindings ← NIL];
BuildActual: PROC [public: Core.Wire] RETURNS [actual: Core.Wire] = {
IF public.size=0 THEN {
flatWire: CoreFlat.FlatWire ← NARROW [RefTab.Fetch[bindings, public].val];
actual ← NARROW [RefTab.Fetch[rootFlatsToInternals, flatWire].val];
IF actual = NIL THEN {
actual ← CoreOps.CopyWire[flatWire.wire];
actual.properties ← CopyProps[flatWire.wire.properties, interestingProperties];
[] ← RefTab.Store[rootFlatsToInternals, flatWire, actual];
[] ← defineInternalWire[flatWire^]}}
ELSE {
actual ← CoreOps.CreateWires[size: public.size];
FOR i: NAT IN [0 .. public.size) DO
actual[i] ← BuildActual[public[i]];
ENDLOOP}};
IF instance=NIL OR (flattenCellType # NIL AND flattenCellType[cell]) OR (PWCore.GetLayoutAtom[cell]=NIL AND cell.class.recast#NIL) THEN
CoreFlat.NextBoundCellType[cell, target, flatCell, instance, index, parent, flatParent, data, bindings, EachInstance]
ELSE {
IF cell.public.size>0 THEN [] ← BuildActual[cell.public];
[] ← defineInstance[flatCell, cell, bindings, instance.properties]}};
rootFlatsToInternals: CoreFlat.Bindings ← RefTab.Create[equal: CoreFlat.FlatWireEqual, hash: CoreFlat.FlatWireHash];
CoreOps.VisitRootAtomics[root.public, BuildPublic];
EachInstance[cell: root, bindings: CoreFlat.InitialBindingTable[root]]};
CopyProps: PUBLIC PROC [sourceProperties: Core.Properties, interestingProperties: RTCoreUtil.PropertyKeys] RETURNS [destProperties: Core.Properties ← NIL] ~ {
copy the interesting properties
Consume: PROC [prop: ATOM, value: REF ANY] ~ {
FOR index: NAT IN [0 .. interestingProperties.size) DO
IF prop = interestingProperties[index] THEN {
destProperties ← CoreProperties.PutProp[destProperties, prop, value];
EXIT};
ENDLOOP};
CoreProperties.Enumerate[sourceProperties, Consume]};
END.