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, HashTable, PWCore, Rope, RTBasic, RTCoreUtil;
RTCoreUtilImpl:
CEDAR
PROGRAM
IMPORTS CoreClasses, CoreFlat, CoreOps, CoreProperties, HashTable, 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]]};
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:
BOOL ←
FALSE] = {
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:
BOOL ←
FALSE] = {
DoWire: CoreOps.EachWireProc = {
IF wire.size = 0 THEN [subWires, quit] ← eachWire[wire]};
quit ← CoreOps.VisitWire[wire, DoWire]};
EnumFlatInstancePins:
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[CoreProperties.GetCellTypeProp[cellType, $SCPlacableElement]=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] = {
name: Rope.ROPE;
flatWire: CoreFlat.FlatWire = NEW [CoreFlat.FlatWireRec ← [wire: wire]];
IF HashTable.Fetch[rootFlatsToInternals, flatWire].value#NIL THEN RETURN; -- public already seen
name ← CoreOps.GetFullWireName[root.public, wire];
[] ← HashTable.Store[rootFlatsToInternals, flatWire, wire];
[] ← defineInternalWire[wire, name];
[] ← definePublicWire[wire, name];
};
EachInstance: CoreFlat.BoundFlatCellProc = {
BuildActual:
PROC [public: Core.Wire]
RETURNS [actual: Core.Wire] = {
IF public.size=0
THEN {
flatWire: CoreFlat.FlatWire ← NARROW [HashTable.Fetch[bindings, public].value];
wireName: Rope.ROPE ← CoreFlat.WirePathRope[root, flatWire^];
actual ← NARROW [HashTable.Fetch[rootFlatsToInternals, flatWire].value];
IF actual#NIL THEN RETURN;
actual ← CoreOps.CopyWire[flatWire.wire];
actual.properties ← CopyProps[flatWire.wire.properties, interestingProperties];
[] ← HashTable.Store[rootFlatsToInternals, flatWire, actual];
[] ← defineInternalWire[actual, wireName]}
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]) THEN CoreFlat.NextBoundCellType[cell, target, flatCell, instance, index, parent, flatParent, data, bindings, EachInstance]
ELSE {
actual: Core.Wire ← NIL;
name: Rope.ROPE ← CoreFlat.CellTypePathRope[root, flatCell];
recasted: Core.CellType ← cell;
IF cell.public.size>0 THEN actual ← BuildActual[cell.public];
-- make an instance from basic
UNTIL PWCore.GetLayoutAtom[recasted]#
NIL
OR recasted.class.recast=
NIL
DO
recasted ← CoreOps.ToBasic[recasted];
ENDLOOP;
[] ← defineInstance[CoreClasses.CreateInstance[actual, recasted, name, instance.properties], name];
};
};
rootFlatsToInternals: CoreFlat.Bindings ← HashTable.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.