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:
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]};
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.