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