1. -- 
  2. -- Uwe R. Zimmer, Australia, 2013 
  3. -- 
  4.  
  5. with Ada.Real_Time;             use Ada.Real_Time; 
  6. with Atomic_Actions_Exceptions; use Atomic_Actions_Exceptions; 
  7. with Atomic_Controller; 
  8.  
  9. package body Generic_Atomic_Action is 
  10.  
  11.    use Atomic_Action_Types; 
  12.  
  13.    package Atomic_Action is 
  14.      new Atomic_Controller (Task_Ids => Parts_Enum); 
  15.    use Atomic_Action; 
  16.  
  17.    task type Action_Task is 
  18.       entry Identify (Id : Parts_Enum); 
  19.    end Action_Task; 
  20.  
  21.    Tasks : array (Parts_Enum) of Action_Task; 
  22.  
  23.    task body Action_Task is 
  24.  
  25.       Task_Id : Parts_Enum; 
  26.  
  27.    begin 
  28.       accept Identify (Id : Parts_Enum) do 
  29.          Task_Id := Id; 
  30.       end Identify; 
  31.  
  32.       select 
  33.          Monitor.Failed; 
  34.  
  35.          -- Abort and clean up in case of a global Failed state 
  36.          Actions (Task_Id).Cleanup.all; 
  37.          Atomic_Action.Monitor.Check_Out (Failed_Check_Out) (Task_Id); 
  38.  
  39.       then abort 
  40.  
  41.          Monitor.Check_In (Task_Id); 
  42.  
  43.          begin 
  44.  
  45.             declare 
  46.                Min_Delay_Deadline : constant Time := Clock + Actions (Task_Id).Scope.Start_Delay_Min; 
  47.                Max_Delay_Deadline : constant Time := Clock + Actions (Task_Id).Scope.Start_Delay_Max; 
  48.             begin 
  49.  
  50.                -- Observe required startup delays. 
  51.                select 
  52.                   delay until Max_Delay_Deadline; 
  53.                   raise Late_Activation; 
  54.                then abort 
  55.                   delay until Min_Delay_Deadline; 
  56.                end select; 
  57.             end; 
  58.  
  59.             declare 
  60.                function Time_Min (t_1, t_2 : Time) return Time is (if t_1 < t_2 then t_1 else t_2); 
  61.  
  62.                Relative_Deadline : constant Time := (if Actions (Task_Id).Scope.Max_Elapse = Time_Span_Last then 
  63.                                                      Time_Last else Clock + Actions (Task_Id).Scope.Max_Elapse); 
  64.                Absolute_Deadline : constant Time := Actions (Task_Id).Scope.Deadline; 
  65.                Closer_Deadline   : constant Time := Time_Min (Relative_Deadline, Absolute_Deadline); 
  66.             begin 
  67.  
  68.                -- Execute this action part while observing the required deadline. 
  69.                select 
  70.                   delay until Closer_Deadline; 
  71.                   raise Time_Out; 
  72.                then abort 
  73.                   Actions (Task_Id).Action.all; 
  74.                end select; 
  75.             end; 
  76.  
  77.             Atomic_Action.Monitor.Check_Out (Normal_Check_Out) (Task_Id); 
  78.  
  79.          exception 
  80.                -- All exceptions in all parts are caught 
  81.                -- and the central atomic action monitor is informed. 
  82.             when Time_Out        => Monitor.Fail (Time_Out_Condition); 
  83.             when Late_Activation => Monitor.Fail (Late_Condition); 
  84.             when others          => Monitor.Fail (Other_Exception); 
  85.          end; 
  86.       end select; 
  87.  
  88.    end Action_Task; 
  89.  
  90.    procedure Perform is 
  91.  
  92.    begin 
  93.       for Id in Parts_Enum loop 
  94.          Tasks (Id).Identify (Id); 
  95.       end loop; 
  96.  
  97.       declare 
  98.          Condition : Atomic_Condition; 
  99.       begin 
  100.          Atomic_Action.Monitor.Action_Result (Condition); 
  101.  
  102.          case Condition is 
  103.             when Succeeded          => null; 
  104.                -- Conditions which lead to an abort of the atomic action 
  105.                -- are re-raised here again to inform the outer process. 
  106.             when Late_Condition     => raise Late_Activation; 
  107.             when Time_Out_Condition => raise Time_Out; 
  108.             when Other_Exception    => raise Uncaught_Exception; 
  109.          end case; 
  110.       end; 
  111.    end Perform; 
  112.  
  113. end Generic_Atomic_Action;