RoseBindImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, August 28, 1985 4:05:21 pm PDT
Spreitzer, October 2, 1985 9:23:51 pm PDT
DIRECTORY Basics, BasicTime, Commander, Core, CoreProperties, List, MakeDo, ProcessProps, RedBlackTree, RedBlackTreeExtras, Rope, RoseBehavior, RoseBind, RoseBindPrivate, RoseDeps, RosePrivates, RoseRecognizeTransistors, RoseTranslate, RoseWireTypes, RoseWiring, TimeStamp;
RoseBindImpl: CEDAR MONITOR
IMPORTS BasicTime, CP: CoreProperties, List, MakeDo, ProcessProps, RedBlackTree, RedBlackTreeExtras, Rope, RoseDeps, RoseRecognizeTransistors, RoseWiring
EXPORTS RoseBehavior, RoseBind, RoseBindPrivate, RosePrivates =
BEGIN OPEN RoseBehavior, RosePrivates, RoseWireTypes, RoseBindPrivate;
BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
classKey: PUBLIC ATOM ← CP.RegisterProperty[$RoseClassName];
argsKey: PUBLIC ATOM ← CP.RegisterProperty[$RoseArgs];
variableWire: PUBLIC ATOM ← CP.RegisterProperty[$RoseVariableWire];
switchWire: PUBLIC ATOM ← CP.RegisterProperty[$RoseSwitchWire];
complexDrive: PUBLIC ATOM ← CP.RegisterProperty[$RoseComplexDrive];
simpleDrive: PUBLIC ATOM ← CP.RegisterProperty[$RoseSimpleDrive];
testerSwitchWire
: PUBLIC ATOM
← CP.RegisterProperty[
$RoseTesterSwitchWire,
CP.Props[[CP.propCopy, CP.PropDoCopy]]
];
testerComplexDrive
: PUBLIC ATOM
← CP.RegisterProperty[
$RoseTesterComplexDrive,
CP.Props[[CP.propCopy, CP.PropDoCopy]]
];
testerSimpleDrive
: PUBLIC ATOM
← CP.RegisterProperty[
$RoseTesterSimpleDrive,
CP.Props[[CP.propCopy, CP.PropDoCopy]]
];
typeKey: ATOM ← CP.RegisterProperty[$RoseCoreCellTypeToBehaviorType];
roots: RedBlackTree.Table ← RedBlackTree.Create[GetModuleRootKey, CompareModuleRoots];
GetModuleRootKey: PROC [data: REF ANY] RETURNS [ROPE] --RedBlackTree.GetKey-- = {
mr: ModuleRoot = NARROW[data];
RETURN [mr.name];
};
CompareModuleRoots: PROC [k, data: REF ANY] RETURNS [Basics.Comparison] --RedBlackTree.Compare-- = {
k1: ROPE = NARROW[k];
k2: ROPE = GetModuleRootKey[data];
RETURN [k1.Compare[k2]];
};
EnsureModuleRoot: PUBLIC ENTRY PROC [name: ROPE] RETURNS [mr: ModuleRoot] =
{mr ← InnerEnsureModuleRoot[name]};
InnerEnsureModuleRoot: INTERNAL PROC [name: ROPE] RETURNS [mr: ModuleRoot] = {
mr ← NARROW[roots.Lookup[name]];
IF mr # NIL THEN RETURN;
mr ← NEW [ModuleRootRec ← [
name: name,
classes: RedBlackTreeExtras.NewRefTable[],
lastUpdate: BasicTime.Now[]
]];
roots.Insert[mr, name];
};
classes: RedBlackTree.Table ← RedBlackTree.Create[GetBehaviorClassKey, CompareBehaviorClasses];
GetBehaviorClassKey: PROC [data: REF ANY] RETURNS [ROPE] --RedBlackTree.GetKey-- = {
class: BehaviorClass = NARROW[data];
RETURN [class.name];
};
CompareBehaviorClasses: PROC [k, data: REF ANY] RETURNS [Basics.Comparison] --RedBlackTree.Compare-- = {
k1: ROPE = NARROW[k];
k2: ROPE = GetBehaviorClassKey[data];
RETURN [k1.Compare[k2]];
};
Insert: PROC [class: BehaviorClass] = {
classes.Insert[class, class.name];
};
Fetch: PUBLIC PROC [name: ROPE] RETURNS [class: BehaviorClass] = {
class ← NARROW[classes.Lookup[name]];
};
EnsureBehaviorClass: PUBLIC PROC [name: ROPE, publicWirePrototype: Core.Wire, moduleNameRoot: ROPE ← NIL] RETURNS [bc: BehaviorClass] = {
IF publicWirePrototype = NIL THEN ERROR;
bc ← ReallyEnsureBehaviorClass[name, publicWirePrototype, IF moduleNameRoot # NIL THEN moduleNameRoot ELSE name, FALSE];
};
ReallyEnsureBehaviorClass: PROC [name: ROPE, publicWirePrototype: Core.Wire, moduleNameRoot: ROPE, useOld: BOOL] RETURNS [bc: BehaviorClass] = {
moduleRoot: ModuleRoot;
bc ← Fetch[name];
IF bc = NIL
THEN {
moduleRoot ← EnsureModuleRoot[moduleNameRoot];
bc ← NEW [BehaviorClassRec ← [
name: name,
moduleRoot: moduleRoot,
pwpTime: BasicTime.Now[],
publicWirePrototype: publicWirePrototype
]];
Insert[bc];
moduleRoot.classes.Insert[bc, bc];
moduleRoot.lastUpdate ← BasicTime.Now[];
MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassPWPNode[bc]];
MakeDo.SuspectNodeChange[RoseDeps.GetModuleRootNode[moduleRoot]];
}
ELSE {
IF NOT useOld THEN {
moduleRoot ← EnsureModuleRoot[moduleNameRoot];
IF moduleRoot # bc.moduleRoot THEN {
oldRoot: ModuleRoot = bc.moduleRoot;
IF RedBlackTreeExtras.DeleteData[oldRoot.classes, bc] # bc THEN ERROR;
moduleRoot.classes.Insert[bc, bc];
bc.moduleRoot ← moduleRoot;
oldRoot.lastUpdate ← moduleRoot.lastUpdate ← BasicTime.Now[];
MakeDo.SuspectNodeChange[RoseDeps.GetModuleRootNode[oldRoot]];
MakeDo.SuspectNodeChange[RoseDeps.GetModuleRootNode[moduleRoot]];
};
IF publicWirePrototype # bc.publicWirePrototype THEN {
bc.pwpTime ← BasicTime.Now[];
bc.publicWirePrototype ← publicWirePrototype;
MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassPWPNode[bc]];
};
};
};
};
EnsureBCParts: PUBLIC PROC [class: BehaviorClass, details, private, wiring: BOOL ← TRUE] RETURNS [goodDetails, goodPrivate: BOOL ← FALSE] = {
IF wiring THEN {
IF class.publicWirePrototypeWiringIsFrom # class.publicWirePrototype THEN {
class.wiring ← RoseWiring.ComputeWiring[class.publicWirePrototype, class.name];
class.publicWirePrototypeWiringIsFrom ← class.publicWirePrototype;
};
};
IF private
THEN {
ch: Commander.Handle ← GetHandle[];
nFailed, nSucceeded: NAT;
goals: MakeDo.RefTable = MakeDo.MakeRefTable[];
MakeDo.AddToRefTable[
RoseDeps.GetBehaviorClassPrivateNode[class],
goals];
[nSucceeded, nFailed] ← MakeDo.Ensure[goals: goals, modifiabilitySpec: NIL];
IF nFailed + nSucceeded # 1 THEN ERROR--impossible--;
goodPrivate ← nSucceeded = 1 AND class.private # NIL
}
ELSE goodPrivate ← FALSE;
IF details
THEN {
ch: Commander.Handle ← GetHandle[];
nFailed, nSucceeded: NAT;
goals: MakeDo.RefTable = MakeDo.MakeRefTable[];
MakeDo.AddToRefTable[
RoseDeps.GetBehaviorClassDetailsNode[class],
goals];
[nSucceeded, nFailed] ← MakeDo.Ensure[goals: goals, modifiabilitySpec: NIL];
IF nFailed + nSucceeded # 1 THEN ERROR--impossible--;
goodDetails ← nSucceeded = 1 AND class.details # NIL;
}
ELSE goodDetails ← FALSE;
};
GetBehaviorClass: PUBLIC PROC [cellType: Core.CellType, details, private, wiring: BOOL ← TRUE] RETURNS [class: BehaviorClass, goodDetails, goodPrivate: BOOL ← FALSE] = {
class ← NARROW[CP.GetCellTypeProp[cellType, classKey]];
IF class = NIL THEN {
class ← RoseRecognizeTransistors.Recognize[cellType];
IF class = NIL THEN class ← ReallyEnsureBehaviorClass[cellType.name, cellType.public, cellType.name, TRUE];
CP.PutCellTypeProp[cellType, classKey, class];
};
[goodDetails, goodPrivate] ← EnsureBCParts[class, details, private, wiring];
};
GetHandle: PROC RETURNS [ch: Commander.Handle] = {
pp: List.AList ← ProcessProps.GetPropList[];
ch ← NARROW[List.Assoc[key: $CommanderHandle, aList: pp]];
IF ch = NIL THEN ERROR;
};
GetBehaviorType: PUBLIC PROC [cellType: Core.CellType] RETURNS [behaviorType: BehaviorType] = {
behaviorType ← NARROW[CP.GetCellTypeProp[cellType, typeKey]];
IF behaviorType = NIL THEN {
class: BehaviorClass;
goodDetails, goodPrivate: BOOL;
[class, goodDetails, goodPrivate] ← GetBehaviorClass[cellType];
IF NOT (goodDetails AND goodPrivate) THEN ERROR;
behaviorType ← NEW [BehaviorTypeRec ← [
class: class,
wiring: NEW [BehaviorTypeWiringRep ← ALL[NIL]]
]];
FOR wf: WireFlavor IN WireFlavor DO
behaviorType.wiring[wf] ← class.wiring[wf].super.GetType[class.wiring[wf], cellType.public];
ENDLOOP;
CP.PutCellTypeProp[cellType, typeKey, behaviorType];
};
};
EnumerateModuleClasses: PUBLIC PROC [mr: ModuleRoot, to: PROC [BehaviorClass]] = {
PerClassNode: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
to[NARROW[data]];
};
mr ← mr;
RedBlackTreeExtras.StatelessEnumerateIncreasing[mr.classes, PerClassNode, RedBlackTreeExtras.GetIDKey];
mr ← mr;
};
RegisterDetails: PUBLIC PROC [behaviorClassName: ROPE, details: Details, versionStamp: VersionStamp] = {
class: BehaviorClass = Fetch[behaviorClassName];
IF class = NIL THEN ERROR;
class.detailsTime ← BasicTime.Now[];
class.detailsStamp ← versionStamp;
class.details ← details;
MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassDetailsNode[class]];
};
RegisterPrivates: PUBLIC PROC [className: ROPE, privates: Privates, versionStamp: VersionStamp] = {
class: BehaviorClass = Fetch[className];
IF class = NIL THEN ERROR;
class.privateTime ← BasicTime.Now[];
class.privateStamp ← versionStamp;
class.private ← privates;
MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassPrivateNode[class]];
};
END.