********************************************************************
* NOTE: This file is generated automatically from the event
* definition file SearchTree.evt.
********************************************************************
<* PRAGMA LL *>
MODULE SearchTreeIE ;
<*NOWARN*> IMPORT ZeusClass, Zeus, Algorithm, RedBlackAlg;
<*NOWARN*> IMPORT SearchTreeViewClass, SearchTreeAlgClass, View;
<*NOWARN*> IMPORT Thread, AlgorithmClass;
<* FATAL Zeus.Error, Zeus.Locked *>
If you get either of these errors, contact a Zeus implementor.
TYPE
NewNodeArgs = BRANDED REF RECORD
node: INTEGER;
key: INTEGER;
END;
CompareKeysArgs = BRANDED REF RECORD
node: INTEGER;
END;
AddLeafArgs = BRANDED REF RECORD
node: INTEGER;
childNum: CARDINAL;
END;
NewSearchKeyArgs = BRANDED REF RECORD
key: INTEGER;
END;
SearchEndArgs = BRANDED REF RECORD
node: INTEGER;
END;
GoLeftArgs = BRANDED REF RECORD
node: INTEGER;
END;
SpliceOutArgs = BRANDED REF RECORD
parent: INTEGER;
child: INTEGER;
save: BOOLEAN;
END;
CopyArgs = BRANDED REF RECORD
source: INTEGER;
dest: INTEGER;
END;
CurrentNodeArgs = BRANDED REF RECORD
node: INTEGER;
END;
SetTypeArgs = BRANDED REF RECORD
node: INTEGER;
type: RedBlackAlg.NodeType;
pType: RedBlackAlg.NodeType;
END;
RedRedClashArgs = BRANDED REF RECORD
child: INTEGER;
parent: INTEGER;
on: BOOLEAN;
END;
CheckUncleArgs = BRANDED REF RECORD
child: INTEGER;
END;
RotateArgs = BRANDED REF RECORD
child: INTEGER;
parent: INTEGER;
END;
Zeus calls the following to invoke vbt v's event handler:
<*NOWARN*> PROCEDURE OEDispatcher (v: ZeusClass.T; evt: REFANY) RAISES {Thread.Alerted} =
<* LL <= VBT.mu *>
(* LL = {} if event style is output, LL = VBT.mu if event style is update. *)
BEGIN
TYPECASE v OF
| SearchTreeViewClass.T (view) => <*NOWARN*>
TYPECASE evt OF
| NewNodeArgs(varNewNodeArgs) => <*NOWARN*>
view.oeNewNode (
varNewNodeArgs.node
,
varNewNodeArgs.key
)
| CompareKeysArgs(varCompareKeysArgs) => <*NOWARN*>
view.oeCompareKeys (
varCompareKeysArgs.node
)
| AddLeafArgs(varAddLeafArgs) => <*NOWARN*>
view.oeAddLeaf (
varAddLeafArgs.node
,
varAddLeafArgs.childNum
)
| NewSearchKeyArgs(varNewSearchKeyArgs) => <*NOWARN*>
view.oeNewSearchKey (
varNewSearchKeyArgs.key
)
| SearchEndArgs(varSearchEndArgs) => <*NOWARN*>
view.oeSearchEnd (
varSearchEndArgs.node
)
| GoLeftArgs(varGoLeftArgs) => <*NOWARN*>
view.oeGoLeft (
varGoLeftArgs.node
)
| SpliceOutArgs(varSpliceOutArgs) => <*NOWARN*>
view.oeSpliceOut (
varSpliceOutArgs.parent
,
varSpliceOutArgs.child
,
varSpliceOutArgs.save
)
| CopyArgs(varCopyArgs) => <*NOWARN*>
view.oeCopy (
varCopyArgs.source
,
varCopyArgs.dest
)
| CurrentNodeArgs(varCurrentNodeArgs) => <*NOWARN*>
view.oeCurrentNode (
varCurrentNodeArgs.node
)
| SetTypeArgs(varSetTypeArgs) => <*NOWARN*>
view.oeSetType (
varSetTypeArgs.node
,
varSetTypeArgs.type
,
varSetTypeArgs.pType
)
| RedRedClashArgs(varRedRedClashArgs) => <*NOWARN*>
view.oeRedRedClash (
varRedRedClashArgs.child
,
varRedRedClashArgs.parent
,
varRedRedClashArgs.on
)
| CheckUncleArgs(varCheckUncleArgs) => <*NOWARN*>
view.oeCheckUncle (
varCheckUncleArgs.child
)
| RotateArgs(varRotateArgs) => <*NOWARN*>
view.oeRotate (
varRotateArgs.child
,
varRotateArgs.parent
)
ELSE <* ASSERT FALSE *>
END;
ELSE (* this view isn't a SearchTreeViewClass, so just ignore *)
END
END OEDispatcher;
<*NOWARN*> PROCEDURE FEDispatcher (v: ZeusClass.T; evt: REFANY) =
<* LL = VBT.mu *>
BEGIN
TYPECASE v OF
| SearchTreeAlgClass.T (alg) => <*NOWARN*>
TYPECASE evt OF
ELSE <* ASSERT FALSE *>
END;
ELSE (* this alg isn't a SearchTreeAlgClass, so just ignore *)
END
END FEDispatcher;
PROCEDURE NewNode (
initiator: Algorithm.T;
node: INTEGER; key: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(NewNodeArgs
, node := node
, key := key
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfNewNode);
alg.stopAtEvent := alg.eventDataRec.stopAtNewNode;
alg.waitAtEvent := alg.eventDataRec.waitAtNewNode;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"NewNode", OEDispatcher, zumeArgRec);
END;
END NewNode;
PROCEDURE CompareKeys (
initiator: Algorithm.T;
node: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(CompareKeysArgs
, node := node
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfCompareKeys);
alg.stopAtEvent := alg.eventDataRec.stopAtCompareKeys;
alg.waitAtEvent := alg.eventDataRec.waitAtCompareKeys;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"CompareKeys", OEDispatcher, zumeArgRec);
END;
END CompareKeys;
PROCEDURE AddLeaf (
initiator: Algorithm.T;
node: INTEGER; childNum: CARDINAL
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(AddLeafArgs
, node := node
, childNum := childNum
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfAddLeaf);
alg.stopAtEvent := alg.eventDataRec.stopAtAddLeaf;
alg.waitAtEvent := alg.eventDataRec.waitAtAddLeaf;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"AddLeaf", OEDispatcher, zumeArgRec);
END;
END AddLeaf;
PROCEDURE NewSearchKey (
initiator: Algorithm.T;
key: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(NewSearchKeyArgs
, key := key
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfNewSearchKey);
alg.stopAtEvent := alg.eventDataRec.stopAtNewSearchKey;
alg.waitAtEvent := alg.eventDataRec.waitAtNewSearchKey;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"NewSearchKey", OEDispatcher, zumeArgRec);
END;
END NewSearchKey;
PROCEDURE SearchEnd (
initiator: Algorithm.T;
node: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(SearchEndArgs
, node := node
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfSearchEnd);
alg.stopAtEvent := alg.eventDataRec.stopAtSearchEnd;
alg.waitAtEvent := alg.eventDataRec.waitAtSearchEnd;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"SearchEnd", OEDispatcher, zumeArgRec);
END;
END SearchEnd;
PROCEDURE GoLeft (
initiator: Algorithm.T;
node: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(GoLeftArgs
, node := node
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfGoLeft);
alg.stopAtEvent := alg.eventDataRec.stopAtGoLeft;
alg.waitAtEvent := alg.eventDataRec.waitAtGoLeft;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"GoLeft", OEDispatcher, zumeArgRec);
END;
END GoLeft;
PROCEDURE SpliceOut (
initiator: Algorithm.T;
parent, child: INTEGER; save: BOOLEAN
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(SpliceOutArgs
, parent := parent
, child := child
, save := save
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfSpliceOut);
alg.stopAtEvent := alg.eventDataRec.stopAtSpliceOut;
alg.waitAtEvent := alg.eventDataRec.waitAtSpliceOut;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"SpliceOut", OEDispatcher, zumeArgRec);
END;
END SpliceOut;
PROCEDURE Copy (
initiator: Algorithm.T;
source, dest: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(CopyArgs
, source := source
, dest := dest
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfCopy);
alg.stopAtEvent := alg.eventDataRec.stopAtCopy;
alg.waitAtEvent := alg.eventDataRec.waitAtCopy;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"Copy", OEDispatcher, zumeArgRec);
END;
END Copy;
PROCEDURE CurrentNode (
initiator: Algorithm.T;
node: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(CurrentNodeArgs
, node := node
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfCurrentNode);
alg.stopAtEvent := alg.eventDataRec.stopAtCurrentNode;
alg.waitAtEvent := alg.eventDataRec.waitAtCurrentNode;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"CurrentNode", OEDispatcher, zumeArgRec);
END;
END CurrentNode;
PROCEDURE SetType (
initiator: Algorithm.T;
node: INTEGER; type, pType: RedBlackAlg.NodeType
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(SetTypeArgs
, node := node
, type := type
, pType := pType
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfSetType);
alg.stopAtEvent := alg.eventDataRec.stopAtSetType;
alg.waitAtEvent := alg.eventDataRec.waitAtSetType;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"SetType", OEDispatcher, zumeArgRec);
END;
END SetType;
PROCEDURE RedRedClash (
initiator: Algorithm.T;
child, parent: INTEGER; on: BOOLEAN
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(RedRedClashArgs
, child := child
, parent := parent
, on := on
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfRedRedClash);
alg.stopAtEvent := alg.eventDataRec.stopAtRedRedClash;
alg.waitAtEvent := alg.eventDataRec.waitAtRedRedClash;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"RedRedClash", OEDispatcher, zumeArgRec);
END;
END RedRedClash;
PROCEDURE CheckUncle (
initiator: Algorithm.T;
child: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(CheckUncleArgs
, child := child
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfCheckUncle);
alg.stopAtEvent := alg.eventDataRec.stopAtCheckUncle;
alg.waitAtEvent := alg.eventDataRec.waitAtCheckUncle;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"CheckUncle", OEDispatcher, zumeArgRec);
END;
END CheckUncle;
PROCEDURE Rotate (
initiator: Algorithm.T;
child, parent: INTEGER
) RAISES {Thread.Alerted} =
<* LL = {} *>
VAR zumeArgRec := NEW(RotateArgs
, child := child
, parent := parent
);
alg := NARROW(initiator, SearchTreeAlgClass.T);
BEGIN
LOCK alg.evtMu DO
INC(alg.eventDataRec.ctOfRotate);
alg.stopAtEvent := alg.eventDataRec.stopAtRotate;
alg.waitAtEvent := alg.eventDataRec.waitAtRotate;
Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
"Rotate", OEDispatcher, zumeArgRec);
END;
END Rotate;
BEGIN
END SearchTreeIE.