File : generic_atomic_action.adb

--                              -*- Mode: Ada -*-
-- Filename        : generic_atomic_action.adb
-- Description     : automatically executes parts of an atomic action
--                    and stops them all, if at least one of them fails
--                    (by means of an exception or timing error)
-- Author          : Uwe Zimmer
-- Created On      : Wed Aug 28 17:06:35 2002
-- Last Modified By: Uwe Zimmer
-- Last Modified On: Tue Aug 21 17:21:00 2007
-- Update Count    : 0
-- Status          : Unknown, Use with caution!

with Ada.Real_Time;       use Ada.Real_Time;

with Atomic_Controller;

package body Generic_Atomic_Action is

   subtype Task_Range is Integer range Actions'Range;

   package Atomic_Action is
      new Atomic_Controller (Task_Ids => Task_Range);
   use Atomic_Action;

   procedure Perform is

      task type Action_Task;

      task body Action_Task is

         Task_Id            : Task_Range;
         Relative_Deadline,
         Real_Deadline      : Time;

      begin
         Monitor.Get_Id (Task_Id);

         Monitor.Check_In (Task_Id);

         select
            Monitor.Failed;

            Actions (Task_Id).Cleanup.all;

            Atomic_Action.Monitor.Check_Out (Failed_Check_Out) (Task_Id);

         then abort
            begin

               select
                  delay To_Duration
                    (Actions (Task_Id).Scope.Start_Delay_Max);
                  raise Late_Activation_State;
               then abort
                  delay To_Duration
                    (Actions (Task_Id).Scope.Start_Delay_Min);
               end select;

               if Actions (Task_Id).Scope.Max_Elapse = Time_Span_Last then
                  Relative_Deadline := Time_Last;
               else
                  Relative_Deadline :=
                    Clock + Actions (Task_Id).Scope.Max_Elapse;
               end if;

               if Relative_Deadline < Actions (Task_Id).Scope.Deadline then
                  Real_Deadline := Relative_Deadline;
               else
                  Real_Deadline := Actions (Task_Id).Scope.Deadline;
               end if;

               select
                  delay until Real_Deadline;
                  raise Time_Out_State;
               then abort
                  Actions (Task_Id).Action.all;
               end select;

               Atomic_Action.Monitor.Check_Out (Normal_Check_Out) (Task_Id);

           exception
               when Time_Out_State        => Monitor.Fail (Time_Out);
               when Late_Activation_State => Monitor.Fail (Late_Activation);
               when others                => Monitor.Fail (Other_Exception);
            end;
         end select;

      end Action_Task;

      Tasks: array (Task_Range) of Action_Task;

      Condition : Atomic_Condition;

   begin
      Atomic_Action.Monitor.Action_Result (Condition);
      case Condition is
         when Succeeded       => null;
         when Other_Exception => raise Failure_State;
         when Late_Activation => raise Late_Activation_State;
         when Time_Out        => raise Time_Out_State;
      end case;
   end Perform;

end Generic_Atomic_Action;