polyorb_hi-hybrid_task_driver.adb 6.04 KB
Newer Older
1 2 3 4 5 6 7 8
------------------------------------------------------------------------------
--                                                                          --
--                          PolyORB HI COMPONENTS                           --
--                                                                          --
--        P O L Y O R B _ H I . H Y B R I D _ T A S K _ D R I V E R         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
--    Copyright (C) 2007-2009 Telecom ParisTech, 2010-2015 ESA & ISAE.      --
--                                                                          --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. PolyORB-HI is distributed in the hope that it will be useful, but  --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27 28
--              PolyORB-HI/Ada is maintained by the TASTE project           --
--                      (taste-users@lists.tuxfamily.org)                   --
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
--                                                                          --
------------------------------------------------------------------------------

with PolyORB_HI.Utils;
with PolyORB_HI.Output;
with PolyORB_HI.Port_Type_Marshallers;
with PolyORB_HI.Messages;
with PolyORB_HI.Suspenders;

package body PolyORB_HI.Hybrid_Task_Driver is

   package body Driver is
      use PolyORB_HI.Utils;
      use PolyORB_HI.Output;
      use PolyORB_HI_Generated.Deployment;
      use Ada.Real_Time;
      use PolyORB_HI.Streams;
      use Ada.Synchronous_Task_Control;
      use PolyORB_HI.Port_Type_Marshallers;
      use PolyORB_HI.Messages;
      use PolyORB_HI.Suspenders;

      procedure Trigger (T : Hybrid_Task_Info);
      --  Sends an event to the Period ports of task T.The_Task

      -------------
      -- Trigger --
      -------------

      procedure Trigger (T : Hybrid_Task_Info) is
         Message : aliased PolyORB_HI.Messages.Message_Type;
      begin
         Marshall (Internal_Code (T.Period_Event), Message);
         Deliver (T.The_Task, Encapsulate (Message, T.The_Task, T.The_Task));
      end Trigger;

      ----------------
      -- The_Driver --
      ----------------

      task body The_Driver is
         Next_Start     : Time;
         New_Next_Start : Time;
      begin
         --  Wait for the network initialization to be finished

         pragma Debug
           (Put_Line (Verbose, "Hybrid thread driver: Wait initialization"));

         Suspend_Until_True (Driver_Suspender);
         delay until System_Startup_Time;

         pragma Debug
           (Put_Line (Verbose, "Hybrid thread driver initialized"));

         Next_Start := Clock;

         --  Main task loop

         loop
            pragma Debug
              (Put_Line (Verbose, "Hybrid thread driver: new cycle"));

            --  Trigger the tasks that have to be triggered

            for TI in Hybrid_Task_Set'Range loop
               declare
                  T : Hybrid_Task_Info renames Hybrid_Task_Set (TI);
               begin
                  if T.Eligible then
                     T.Eligible := False;

                     pragma Debug
                       (Put_Line
                        (Verbose,
                         "Hybrid thread driver: Triggering task: "
105
                         + Entity_Image (T.The_Task)));
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144

                     Trigger (T);
                  end if;
               end;
            end loop;

            --  Compute the next dispatch time of each hybrid task and
            --  set Next_Start to the closest activation time.

            New_Next_Start := Time_Last;

            for TI in Hybrid_Task_Set'Range loop
               declare
                  T : Hybrid_Task_Info renames Hybrid_Task_Set (TI);
               begin
                  if T.Next_Periodic_Dispatch <= Next_Start then
                     T.Next_Periodic_Dispatch :=
                       T.Next_Periodic_Dispatch + T.Period;
                  end if;

                  if T.Next_Periodic_Dispatch <= New_Next_Start then
                     New_Next_Start := T.Next_Periodic_Dispatch;
                  end if;
               end;
            end loop;

            Next_Start := New_Next_Start;

            --  Set eligible tasks

            for TI in Hybrid_Task_Set'Range loop
               declare
                  T : Hybrid_Task_Info renames Hybrid_Task_Set (TI);
               begin
                  if T.Next_Periodic_Dispatch <= Next_Start then
                     pragma Debug
                       (Put_Line
                        (Verbose,
                         "Hybrid thread driver: Eligible task: "
145
                         + Entity_Image (T.The_Task)));
146 147 148 149 150 151 152 153 154 155 156 157

                     T.Eligible := True;
                  end if;
               end;
            end loop;

            delay until Next_Start;
         end loop;
      end The_Driver;
   end Driver;

end PolyORB_HI.Hybrid_Task_Driver;