File : s-bbexti-xtratum.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
   4 --                                                                          --
   5 --              S Y S T E M . B B . E X E C U T I O N _ T I M E             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2011-2016, AdaCore                     --
  10 --                                                                          --
  11 -- GNARL is free software; you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28 
  29 --  Ravenscar version of this package for XtratuM
  30 
  31 with System.BB.Parameters;
  32 with System.BB.Board_Support;
  33 with System.BB.Threads.Queues;
  34 
  35 with System.OS_Interface;
  36 with Interfaces.C;
  37 
  38 package body System.BB.Execution_Time is
  39 
  40    use type System.BB.Time.Time;
  41    use System.BB.Interrupts;
  42    use System.BB.Threads;
  43 
  44    -----------------------
  45    -- Local Definitions --
  46    -----------------------
  47 
  48    Interrupts_Execution_Time : array (Interrupt_ID) of System.BB.Time.Time :=
  49      (others => System.BB.Time.Time'First);
  50    --  Time counter for each interrupt
  51 
  52    CPU_Clock : System.BB.Time.Time := System.BB.Time.Time'First;
  53    --  Date of the last Interrupt
  54 
  55    function Read_Execution_Clock return System.BB.Time.Time;
  56    --  Get the execution clock which counts only the time when the partition is
  57    --  active. This is different from Clock when we are on top of a partitioned
  58    --  system (like in this case).
  59 
  60    procedure Scheduling_Event;
  61    --  Assign elapsed time to the executing Task/Interrupt and reset CPU clock.
  62    --
  63    --  The Scheduling_Event procedure must be called at the end of an execution
  64    --  period:
  65    --    When the run-time switches from:
  66    --      a task to another task
  67    --      a task to an interrupt
  68    --      an interrupt to a task
  69    --      an interrupt to another interrupt
  70    --    and before idle loop.
  71 
  72    function Read_Execution_Time_Atomic
  73      (Th : System.BB.Threads.Thread_Id) return System.BB.Time.Time;
  74    --  Read the execution time of thread Th. The result is a coherent value:
  75    --  if the execution time has changed from A to B (while being read by this
  76    --  function), the result will be between A and B. The error is less
  77    --  than 2**32 and less than the increment.
  78 
  79    function To_Time (High, Low : Time.Word) return Time.Time;
  80    --  Low level routine to convert a composite execution time to type Time
  81 
  82    function To_Composite_Execution_Time
  83      (T : Time.Time) return Time.Composite_Execution_Time;
  84    --  Low level routine to convert a time to a composite execution time
  85 
  86    ----------------------------
  87    -- Global_Interrupt_Clock --
  88    ----------------------------
  89 
  90    function Global_Interrupt_Clock return System.BB.Time.Time is
  91       Sum : System.BB.Time.Time := System.BB.Time.Time'First;
  92 
  93    begin
  94       for Interrupt in Interrupt_ID loop
  95          Sum := Sum + Interrupts_Execution_Time (Interrupt);
  96       end loop;
  97 
  98       return Sum;
  99    end Global_Interrupt_Clock;
 100 
 101    ---------------------
 102    -- Interrupt_Clock --
 103    ---------------------
 104 
 105    function Interrupt_Clock
 106      (Interrupt : Interrupt_ID) return System.BB.Time.Time is
 107    begin
 108       return Interrupts_Execution_Time (Interrupt);
 109    end Interrupt_Clock;
 110 
 111    --------------------------------
 112    -- Read_Execution_Time_Atomic --
 113    --------------------------------
 114 
 115    function Read_Execution_Time_Atomic
 116      (Th : System.BB.Threads.Thread_Id) return System.BB.Time.Time
 117    is
 118       use Time;
 119       H1 : Word;
 120       L  : Word;
 121       H2 : Word;
 122 
 123    begin
 124       --  Read parts in that order
 125 
 126       H1 := Th.Execution_Time.High;
 127       L  := Th.Execution_Time.Low;
 128       H2 := Th.Execution_Time.High;
 129 
 130       --  If value has changed while being read, keep the latest high part,
 131       --  but use 0 for the low part. So the result will be greater than
 132       --  the old value and less than the new value.
 133 
 134       if H1 /= H2 then
 135          L := 0;
 136       end if;
 137 
 138       return Time.Time (H2) * 2 ** 32 + Time.Time (L);
 139    end Read_Execution_Time_Atomic;
 140 
 141    ----------------------
 142    -- Scheduling_Event --
 143    ----------------------
 144 
 145    procedure Scheduling_Event is
 146       Now            : constant System.BB.Time.Time := Read_Execution_Clock;
 147       Last_CPU_Clock : constant System.BB.Time.Time := CPU_Clock;
 148       Elapsed_Time   : System.BB.Time.Time;
 149 
 150    begin
 151       pragma Assert (Now >= Last_CPU_Clock);
 152 
 153       Elapsed_Time := Now - Last_CPU_Clock;
 154 
 155       --  Reset the clock
 156 
 157       CPU_Clock := Now;
 158 
 159       --  Case where this CPU is currently executing an interrupt
 160 
 161       if Current_Interrupt /= No_Interrupt then
 162          Interrupts_Execution_Time (Current_Interrupt) :=
 163            Interrupts_Execution_Time (Current_Interrupt) + Elapsed_Time;
 164 
 165       --  Case where this CPU is currently executing a task
 166 
 167       else
 168          declare
 169             T : Time.Time;
 170          begin
 171             T := To_Time (Thread_Self.Execution_Time.High,
 172                           Thread_Self.Execution_Time.Low);
 173             T := T + Elapsed_Time;
 174             Thread_Self.Execution_Time := To_Composite_Execution_Time (T);
 175          end;
 176       end if;
 177    end Scheduling_Event;
 178 
 179    ------------------
 180    -- Thread_Clock --
 181    ------------------
 182 
 183    function Thread_Clock
 184      (Th : System.BB.Threads.Thread_Id) return System.BB.Time.Time
 185    is
 186       Res : System.BB.Time.Time;
 187 
 188       Sec : System.BB.Time.Time;
 189       --  Second read of execution time
 190 
 191       ET : System.BB.Time.Time;
 192       --  Elapsed time
 193 
 194    begin
 195       pragma Assert (Th /= Null_Thread_Id);
 196 
 197       Res := Read_Execution_Time_Atomic (Th);
 198 
 199       --  If the thread Th is running, we need to add the elapsed time between
 200       --  the last scheduling and now. The thread Th is running if it is the
 201       --  current one and no interrupt is executed
 202 
 203       if Th = Thread_Self
 204         and then System.BB.Interrupts.Current_Interrupt = No_Interrupt
 205       then
 206 
 207          ET := Read_Execution_Clock - CPU_Clock;
 208 
 209          Sec := Read_Execution_Time_Atomic (Th);
 210 
 211          if Res /= Sec then
 212 
 213             --  The whole set of values (Res, ET and Sec) isn't coherent, as
 214             --  the execution time has been updated (might happen in case of
 215             --  interrupt). Unfortunately, the error in Sec might be as large
 216             --  as ET. So lets read again. The error will be small, as the time
 217             --  spent between this third read and the second one is small.
 218 
 219             Res := Read_Execution_Time_Atomic (Th);
 220 
 221          else
 222             Res := Res + ET;
 223          end if;
 224       end if;
 225 
 226       return Res;
 227    end Thread_Clock;
 228 
 229    --------------------------
 230    -- Read_Execution_Clock --
 231    --------------------------
 232 
 233    function Read_Execution_Clock return System.BB.Time.Time is
 234       XM_EXEC_CLOCK : constant := 1;
 235       --  Execution-time clock
 236 
 237       type XM_Time_T is range -2 ** 63 .. 2 ** 63 - 1;
 238       for XM_Time_T'Size use 64;
 239       --  Time in XtratuM
 240 
 241       procedure Get_Time
 242         (Clock_Id : Interfaces.C.unsigned;
 243          Time     : access XM_Time_T);
 244       pragma Import (C, Get_Time, "XM_get_time");
 245       --  Read clock
 246 
 247       XtratuM_Time : aliased XM_Time_T;
 248 
 249    begin
 250       --  Get the execution time and not the wall clock time because we need to
 251       --  take into account only the time when the partition is active.
 252 
 253       Get_Time (XM_EXEC_CLOCK, XtratuM_Time'Access);
 254 
 255       return System.BB.Time.Time (XtratuM_Time);
 256    end Read_Execution_Clock;
 257 
 258    ---------------------------------
 259    -- To_Composite_Execution_Time --
 260    ---------------------------------
 261 
 262    function To_Composite_Execution_Time
 263      (T : Time.Time) return Time.Composite_Execution_Time is
 264    begin
 265       return (High => Time.Word (T / 2 ** 32),
 266               Low  => Time.Word (T mod 2 ** 32));
 267    end To_Composite_Execution_Time;
 268 
 269    -------------
 270    -- To_Time --
 271    -------------
 272 
 273    function To_Time (High, Low : Time.Word) return Time.Time is
 274    begin
 275       return Time.Time (High) * 2 ** 32 + Time.Time (Low);
 276    end To_Time;
 277 
 278 --  Elaboration for package System.BB.Execution_Time
 279 
 280 begin
 281    --  Set hooks to enable computation
 282 
 283    System.BB.Time.Scheduling_Event_Hook       := Scheduling_Event'Access;
 284 
 285    --  Initialize CPU_Clock
 286 
 287    CPU_Clock := Read_Execution_Clock;
 288 end System.BB.Execution_Time;