mentor/derived/SearchTreeIE.m3


 Copyright (C) 1995, Digital Equipment Corporation.       
 All rights reserved.                                     
 See the file COPYRIGHT for a full description.           
                                                          
 Last modified on Thu Feb  9 08:50:48 PST 1995 by kalsow  
      modified on Sun Jun  5 21:59:57 PDT 1994 by mhb     
      modified on Wed Feb 17 16:46:47 PST 1993 by johnh   

********************************************************************

      *  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.

interface View is in: