mentor/derived/BinpackIE.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 Binpack.evt.
      ********************************************************************


<* PRAGMA LL *>

MODULE BinpackIE;

<*NOWARN*> IMPORT IntList, ZeusClass, Zeus, BinpackAux;
<*NOWARN*> IMPORT BinpackViewClass, RealList, Algorithm;
<*NOWARN*> IMPORT BinpackAlgClass, View, Thread, AlgorithmClass;

<* FATAL Zeus.Error, Zeus.Locked *>
If you get either of these errors, contact a Zeus implementor.

TYPE
  SetupArgs = BRANDED REF RECORD
    nBins: INTEGER;
    nWts: INTEGER;
  END;

  NewWeightArgs = BRANDED REF RECORD
    id: INTEGER;
    wt: REAL;
  END;

  PackArgs = BRANDED REF RECORD
    bin: INTEGER;
    total: REAL;
  END;

  IgnoreArgs = BRANDED REF RECORD
  END;

  ProbeArgs = BRANDED REF RECORD
    bin: INTEGER;
    total: REAL;
  END;

  TryToDeleteWeightArgs = BRANDED REF RECORD
    id: INTEGER;
  END;

  TryToEmptyBinArgs = BRANDED REF RECORD
    bin: INTEGER;
  END;

  RepackBinArgs = BRANDED REF RECORD
    bin: INTEGER;
    old: IntList.T;
    new: IntList.T;
    amts: RealList.T;
  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
    | BinpackViewClass.T (view) => <*NOWARN*>
      TYPECASE evt OF
      | SetupArgs(varSetupArgs) => <*NOWARN*>
          view.oeSetup (
              varSetupArgs.nBins
                ,
              varSetupArgs.nWts
              )
      | NewWeightArgs(varNewWeightArgs) => <*NOWARN*>
          view.oeNewWeight (
              varNewWeightArgs.id
                ,
              varNewWeightArgs.wt
              )
      | PackArgs(varPackArgs) => <*NOWARN*>
          view.oePack (
              varPackArgs.bin
                ,
              varPackArgs.total
              )
      | IgnoreArgs(varIgnoreArgs) => <*NOWARN*>
          view.oeIgnore (
              )
      | ProbeArgs(varProbeArgs) => <*NOWARN*>
          view.oeProbe (
              varProbeArgs.bin
                ,
              varProbeArgs.total
              )
      | RepackBinArgs(varRepackBinArgs) => <*NOWARN*>
          view.ueRepackBin (
              varRepackBinArgs.bin
                ,
              varRepackBinArgs.old
                ,
              varRepackBinArgs.new
                ,
              varRepackBinArgs.amts
              )
      ELSE <* ASSERT FALSE *>
      END;
    ELSE (* this view isn't a BinpackViewClass, so just ignore *)
    END
  END OEDispatcher;

<*NOWARN*> PROCEDURE FEDispatcher(v: ZeusClass.T; evt: REFANY) =
  <* LL = VBT.mu *>
  BEGIN
    TYPECASE v OF
    | BinpackAlgClass.T (alg) => <*NOWARN*>
      TYPECASE evt OF
      | TryToDeleteWeightArgs(varTryToDeleteWeightArgs) => <*NOWARN*>
          alg.feTryToDeleteWeight (
              varTryToDeleteWeightArgs.id
              )
      | TryToEmptyBinArgs(varTryToEmptyBinArgs) => <*NOWARN*>
          alg.feTryToEmptyBin (
              varTryToEmptyBinArgs.bin
              )
      ELSE <* ASSERT FALSE *>
      END;
    ELSE (* this alg isn't a BinpackAlgClass, so just ignore *)
    END
  END FEDispatcher;

PROCEDURE Setup (
      initiator: Algorithm.T;
       nBins, nWts: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(SetupArgs
               , nBins := nBins
               , nWts := nWts
      );
      alg := NARROW(initiator, BinpackAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfSetup);
      alg.stopAtEvent := alg.eventDataRec.stopAtSetup;
      alg.waitAtEvent := alg.eventDataRec.waitAtSetup;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "Setup", OEDispatcher, zumeArgRec);
    END;
  END Setup;

PROCEDURE NewWeight (
      initiator: Algorithm.T;
       id: INTEGER; wt: REAL
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(NewWeightArgs
               , id := id
               , wt := wt
      );
      alg := NARROW(initiator, BinpackAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfNewWeight);
      alg.stopAtEvent := alg.eventDataRec.stopAtNewWeight;
      alg.waitAtEvent := alg.eventDataRec.waitAtNewWeight;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "NewWeight", OEDispatcher, zumeArgRec);
    END;
  END NewWeight;

PROCEDURE Pack (
      initiator: Algorithm.T;
       bin: INTEGER; total: REAL
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(PackArgs
               , bin := bin
               , total := total
      );
      alg := NARROW(initiator, BinpackAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfPack);
      alg.stopAtEvent := alg.eventDataRec.stopAtPack;
      alg.waitAtEvent := alg.eventDataRec.waitAtPack;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "Pack", OEDispatcher, zumeArgRec);
    END;
  END Pack;

PROCEDURE Ignore (
      initiator: Algorithm.T;

    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(IgnoreArgs
      );
      alg := NARROW(initiator, BinpackAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfIgnore);
      alg.stopAtEvent := alg.eventDataRec.stopAtIgnore;
      alg.waitAtEvent := alg.eventDataRec.waitAtIgnore;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "Ignore", OEDispatcher, zumeArgRec);
    END;
  END Ignore;

PROCEDURE Probe (
      initiator: Algorithm.T;
       bin: INTEGER; total: REAL
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(ProbeArgs
               , bin := bin
               , total := total
      );
      alg := NARROW(initiator, BinpackAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfProbe);
      alg.stopAtEvent := alg.eventDataRec.stopAtProbe;
      alg.waitAtEvent := alg.eventDataRec.waitAtProbe;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "Probe", OEDispatcher, zumeArgRec);
    END;
  END Probe;

PROCEDURE RepackBin (
      initiator: Algorithm.T;
       bin: INTEGER; old, new: IntList.T; amts: RealList.T
    ) RAISES {Thread.Alerted} =
  <* LL = VBT.mu *>
  VAR zumeArgRec := NEW(RepackBinArgs
               , bin := bin
               , old := old
               , new := new
               , amts := amts
      );
  BEGIN
    Zeus.Dispatch(initiator, Zeus.EventStyle.Update, 1,
                  "RepackBin", OEDispatcher, zumeArgRec);
  END RepackBin;

PROCEDURE TryToDeleteWeight (
      initiator: View.T;
       id: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = VBT.mu *>
  VAR zumeArgRec := NEW(TryToDeleteWeightArgs
               , id := id
      );
  BEGIN
    Zeus.Dispatch(initiator, Zeus.EventStyle.Notify, 1,
                  "TryToDeleteWeight", FEDispatcher, zumeArgRec);
  END TryToDeleteWeight;

PROCEDURE TryToEmptyBin (
      initiator: View.T;
       bin: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = VBT.mu *>
  VAR zumeArgRec := NEW(TryToEmptyBinArgs
               , bin := bin
      );
  BEGIN
    Zeus.Dispatch(initiator, Zeus.EventStyle.Notify, 1,
                  "TryToEmptyBin", FEDispatcher, zumeArgRec);
  END TryToEmptyBin;

BEGIN
END BinpackIE.

interface View is in: