RoseTweakImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reversed.
Barth, August 1, 1985 2:31:39 pm PDT
Spreitzer, November 18, 1985 10:10:16 pm PST
DIRECTORY Asserting, BitTwiddling, Core, IO, PrincOps, PrincOpsUtils, RoseBehavior, RoseControl, RoseEngine, RoseEvents, RoseSimTypes, RoseWireClasses, RoseWireTwiddling, RoseWireTypes;
RoseTweakImpl: CEDAR PROGRAM
IMPORTS Asserting, BitTwiddling, PrincOpsUtils, RoseControl, RoseEngine, RoseEvents, RoseWireTwiddling, RoseWireTypes
EXPORTS RoseControl
=
BEGIN OPEN RoseControl, RoseWireTypes, RoseSimTypes, RoseEngine;
SimulationRec: PUBLIC TYPE = RoseSimTypes.SimulationRec;
RoseWireRep: PUBLIC TYPE = RoseSimTypes.RoseWireRep;
ExhibitValue: PUBLIC PROC [rw: RoseWire, to: PROC [rwt: RoseWireType, ptr: Ptr]] = {
bbTableSpace: PrincOps.BBTableSpace;
bbTable: PrincOps.BitBltTablePtr;
UpdateValue: PROC [rw: RoseWire, rwt: RoseWireType, ptr: Ptr] = {
SELECT rw.group FROM
aboveLeaf => {
FOR i: NAT IN [0 .. rw.subWires.length) DO
sel: Selector = SELECT StructureOfWire[rw.core] FROM
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
st: RoseWireType = rw.type.class.super.SubType[rw.type, sel];
sp: Ptr = BitTwiddling.OffsetPtr[rw.valPtr, rw.type.class.super.SelectorOffset[rw.type, sel]];
UpdateValue[rw.subWires[i], st, sp];
ENDLOOP;
rw ← rw;
};
leaf => NULL;
belowLeaf => NULL;
ENDCASE => ERROR;
IF ptr # rw.valPtr THEN RoseWireTwiddling.CopyVal[
fromT: rw.type,
fromP: rw.valPtr,
toT: rwt,
toP: ptr,
bbTable: bbTable
];
};
TRUSTED {bbTable ← PrincOpsUtils.AlignedBBTable[@bbTableSpace]};
UpdateValue[rw, rw.type, rw.valPtr];
to[rw.type, rw.valPtr];
};
ConsumeValue: PUBLIC PROC [rw: RoseWire, produce: PROC [rwt: RoseWireType, ptr: Ptr]] = {
bbTableSpace: PrincOps.BBTableSpace;
bbTable: PrincOps.BitBltTablePtr;
SetValue: PROC [rw: RoseWire, rwt: RoseWireType, ptr: Ptr] = {
IF ptr # rw.valPtr THEN RoseWireTwiddling.CopyVal[
fromT: rwt,
fromP: ptr,
toT: rw.type,
toP: rw.valPtr,
bbTable: bbTable
];
SELECT rw.group FROM
aboveLeaf => {
FOR i: NAT IN [0 .. rw.subWires.length) DO
sel: Selector = SELECT StructureOfWire[rw.core] FROM
record => [field[i]],
sequence => [subscript[i]],
ENDCASE => ERROR;
st: RoseWireType = rw.type.class.super.SubType[rw.type, sel];
sp: Ptr = BitTwiddling.OffsetPtr[rw.valPtr, rw.type.class.super.SelectorOffset[rw.type, sel]];
SetValue[rw.subWires[i], st, sp];
ENDLOOP;
rw ← rw;
};
leaf => NoteTweak[rw, bbTable];
belowLeaf => SetValue[rw.parent, rw.parent.type, rw.parent.valPtr];
ENDCASE => ERROR;
};
TRUSTED {bbTable ← PrincOpsUtils.AlignedBBTable[@bbTableSpace]};
produce[rw.type, rw.valPtr];
SetValue[rw, rw.type, rw.valPtr];
};
SetForce: PUBLIC PROC [rw: RoseWire, fs: ForceScope] = {
SELECT rw.group FROM
aboveLeaf => {
rw ← rw;
FOR i: NAT IN [0 .. rw.subWires.length) DO
SetForce[rw.subWires[i], fs];
ENDLOOP;
rw ← rw;
};
leaf => {
sim: Simulation = rw.schIn.sim;
rw.forceScope ← fs;
SELECT fs FROM
notForced => {
rw.holdStrength ← rw.capStrength;
};
tillSettle => {
rw.holdStrength ← input;
sim.other ← Asserting.AssertFn1[unforceAtSettle, $T, sim.other, LIST[rw], TRUE];
};
forever => {
rw.holdStrength ← input;
};
ENDCASE => ERROR;
PerturbWire[rw, nilModelSlot, TRUE];
};
belowLeaf => ERROR Error["Attempt to force wire below the simulation frontier", rw];
ENDCASE => ERROR;
};
unforceAtSettle: ATOM = $unforceAtSettle;
UnforceAtSettle: PROC [event: ATOM, watched, watcherData, arg: REF ANY] = {
sim: Simulation = NARROW[watched];
unsets: Assertions;
Unforce: PROC [assertion: Assertion] = {
rw: RoseWire = NARROW[Asserting.TermsOf[assertion].first];
IF rw.forceScope = tillSettle THEN {
rw.forceScope ← notForced;
rw.holdStrength ← rw.capStrength;
PerturbWire[rw, nilModelSlot, TRUE];
};
};
[unsets, sim.other] ← Asserting.Filter[unforceAtSettle, sim.other, TRUE];
Asserting.EnumerateAssertionsAbout[unforceAtSettle, unsets, Unforce];
};
NotificationRegistration: TYPE = REF NotificationRegistrationPrivate;
NotificationRegistrationPrivate: PUBLIC TYPE = RECORD [
event: Event,
watcherData: WatcherData
];
WatcherData: TYPE = REF WatcherDataRec;
WatcherDataRec: TYPE = RECORD [
event: Event,
on: RoseWire,
notify: EventConsumerProc,
data: REF ANY
];
AddNotification
: PUBLIC
PROC [
event: Event,
on: RoseWire,
notify: EventConsumerProc,
data: REF ANYNIL]
RETURNS [registration: NotificationRegistration]
= {
registration ← NEW [NotificationRegistrationPrivate ← [
event: event,
watcherData: NEW [WatcherDataRec ← [event, on, notify, data]]
]];
RoseEvents.AddWatcher[
event: eventKeys[event],
watcher: [Notify, registration.watcherData],
watched: on];
};
RemoveNotification: PUBLIC PROC [registration: NotificationRegistration] = {
RoseEvents.RemoveWatcher[
event: eventKeys[registration.event],
watcher: [Notify, registration.watcherData],
watched: registration.watcherData.on];
};
Notify: PROC [event: ATOM, watched, watcherData, arg: REF ANY] = {
base: RoseWire = NARROW[watched];
wd: WatcherData = NARROW[watcherData];
ptr: Ptr;
IF moveValue[wd.event]
THEN {
bbTableSpace: PrincOps.BBTableSpace;
bbTable: PrincOps.BitBltTablePtr;
TRUSTED {bbTable ← PrincOpsUtils.AlignedBBTable[@bbTableSpace]};
SELECT wd.on.group FROM
aboveLeaf => {
arg ← arg;
FOR child: RoseWire ← base, child.parent WHILE child # wd.on DO
parent: RoseWire = child.parent;
sel: Selector = SELECT StructureOfWire[parent.core] FROM
record => [field[child.myIndex]],
sequence => [subscript[child.myIndex]],
ENDCASE => ERROR;
pp: Ptr = BitTwiddling.OffsetPtr[parent.valPtr, parent.type.class.super.SelectorOffset[parent.type, sel]];
pt: RoseWireType = parent.type.class.super.SubType[parent.type, sel];
IF pp # child.valPtr THEN RoseWireTwiddling.CopyVal[
fromT: child.type,
fromP: child.valPtr,
toT: pt,
toP: pp,
bbTable: bbTable];
ENDLOOP;
arg ← arg;
};
leaf => NULL;
belowLeaf => NULL;
ENDCASE => ERROR;
ptr ← wd.on.valPtr;
}
ELSE {
ptr ← nilPtr;
};
wd.notify[event: wd.event, on: wd.on, type: wd.on.type, ptr: ptr, data: wd.data];
arg ← arg;
};
eventKeys: ARRAY Event OF ATOM = [
Perturbed: $Perturbed,
Found: $Found,
NewQ: $NewNodeQ,
NewUD: $NewNodeUD,
NewVal: $ChangeLate
];
moveValue: ARRAY Event OF BOOL = [
Perturbed: FALSE,
Found: FALSE,
NewQ: TRUE,
NewUD: TRUE,
NewVal: TRUE
];
Start: PROC = {
RoseEvents.AddWatcher[event: $Settle, watcher: [UnforceAtSettle], watched: RoseEvents.all];
};
Start[];
FetchValue: PUBLIC PROC [simulation: Simulation, wire: Wire] RETURNS [value: ROPE] = {
rw: RoseWire ← GetRoseWire[simulation, wire];
fmt: Format ← rw.type.class.super.GetFormat[rw.type, NIL];
value ← fmt.FormatValue[rw.type, fmt, rw.valPtr];
};
ForceValue: PUBLIC PROC [simulation: Simulation, wire: Wire, value: ROPE, persistence: Persistence ← tillSettle] = {
rw: RoseWire ← GetRoseWire[simulation, wire];
fmt: Format ← rw.type.class.super.GetFormat[rw.type, NIL];
in: IO.STREAM = IO.RIS[value];
ok: BOOL;
SELECT persistence FROM
instantaneous => NULL;
tillSettle, forever => Force[simulation, wire, persistence];
ENDCASE => ERROR;
ok ← fmt.ParseValue[rw.type, fmt, rw.valPtr, in];
IF NOT ok THEN ERROR;
NoteTweak[rw];
};
NotifyValue
: PUBLIC
PROC [
simulation: Simulation,
wire: Wire,
Notify: NotifyValueProc,
data: REF ANYNIL
]
RETURNS [registration: REF ANY]
= {
rw: RoseWire ← GetRoseWire[simulation, wire];
RoseEvents.AddWatcher[
event: $ChangeLate,
watcher: [
ValueNotify,
registration ← NEW [ValueNotifyingRec ← [Notify, data, rw]]
],
watched: rw
];
};
CeaseNotifyingValue: PUBLIC PROC [registration: REF ANY] = {
vn: ValueNotifying = NARROW[registration];
RoseEvents.RemoveWatcher[
event: $ChangeLate,
watcher: [ValueNotify, registration],
watched: vn.rw
];
};
ValueNotifying: TYPE = REF ValueNotifyingRec;
ValueNotifyingRec: TYPE = RECORD [
Notify: NotifyValueProc,
data: REF ANY,
rw: RoseWire];
ValueNotify: PROC [event: ATOM, watched, watcherData, arg: REF ANY] = {
rw: RoseWire = NARROW[watched];
vn: ValueNotifying = NARROW[watcherData];
fmt: Format = rw.type.class.super.GetFormat[rw.type, NIL];
value: ROPE = fmt.FormatValue[rw.type, fmt, rw.valPtr];
vn.Notify[rw.core, value, vn.data];
};
FetchLevel: PUBLIC PROC [simulation: Simulation, wire: Wire] RETURNS [level: RoseBehavior.Level] = {
rw: RoseWire ← GetRoseWire[simulation, wire];
IF rw.type.class # RoseWireClasses.GetBit[] THEN ERROR;
level ← RoseControl.ReadSwitch[rw.valPtr].val;
};
ForceLevel: PUBLIC PROC [simulation: Simulation, wire: Wire, level: RoseBehavior.Level, persistence: Persistence ← tillSettle] = {
rw: RoseWire ← GetRoseWire[simulation, wire];
IF rw.type.class # RoseWireClasses.GetBit[] THEN ERROR;
SELECT persistence FROM
instantaneous => NULL;
tillSettle, forever => Force[simulation, wire, persistence];
ENDCASE => ERROR;
RoseControl.WriteSwitch[rw.valPtr, [[none, none, none], level]];
NoteTweak[rw];
};
NotifyLevel
: PUBLIC
PROC [
simulation: Simulation,
wire: Wire,
Notify: NotifyLevelProc,
data: REF ANYNIL
]
RETURNS [registration: REF ANY]
= {
rw: RoseWire ← GetRoseWire[simulation, wire];
IF rw.type.class # RoseWireClasses.GetBit[] THEN ERROR;
RoseEvents.AddWatcher[
event: $ChangeLate,
watcher: [
LevelNotify,
registration ← NEW [LevelNotifyingRec ← [Notify, data, rw]]
],
watched: rw
];
};
CeaseNotifyingLevel: PUBLIC PROC [registration: REF ANY] = {
vn: LevelNotifying = NARROW[registration];
RoseEvents.RemoveWatcher[
event: $ChangeLate,
watcher: [LevelNotify, registration],
watched: vn.rw
];
};
LevelNotifying: TYPE = REF LevelNotifyingRec;
LevelNotifyingRec: TYPE = RECORD [
Notify: NotifyLevelProc,
data: REF ANY,
rw: RoseWire];
LevelNotify: PROC [event: ATOM, watched, watcherData, arg: REF ANY] = {
rw: RoseWire = NARROW[watched];
vn: LevelNotifying = NARROW[watcherData];
vn.Notify[rw.core, RoseControl.ReadSwitch[rw.valPtr].val, vn.data];
};
END.