Re: Ada.Execution_Time

[jpwoodruff <jpwoodruff@gmail.com>]

BrianG's discussion spurred my interest, so now I am able to
contradict his

On Dec 14, 5:16 pm, BrianG <briang...@gmail.com> wrote:
>
> Given the rest of this thread, I would guess my answer is "No, no one
> actually uses Ada.Execution_Time".
>

Let me describe my experiment, which ends in a disappointing
observation about Ada.Execution_Time.

For some years I've had a package that defines a "Counter" object that
resembles a stop-watch.  Made curious by BrianG's question, I
re-implemented the abstraction over Ada.Execution_Time.

Unfortunately introduction of Ada.Real_Time can  cause an otherwise
successful program to raise STORAGE_ERROR :EXCEPTION_STACK_OVERFLOW.
This happens even if the program formerly ran only in an environment
task.


with Ada.Real_Time ;   -- This context leads to failure
Procedure Stack_Splat is
   Too_Big : array (1..1_000_000) of Float ;
begin
   null ;
end Stack_Splat ;


I haven't found the documentation that explains my observation, but
it's pretty clear that Ada.Real_Time in the context implies
substantially different run-time memory strategy.  I suppose there are
compile options to affect this; it can be an exercise for a later day.

Here is the package CPU, which is potentially useful in programs that
use stack gently.

-- PACKAGE FOR CPU TIME CALCULATIONS.
-----------------------------------------------------------------------
--
--              Author:         John P Woodruff
--                              jpwoodruff@gmail.com
--

-- This package owes a historic debt to the similarly named service
-- Created 19-SEP-1986 by Mats Weber.  This specification is largely
-- defined by that work.

--  15-apr-2004: However, Weber's package was implemented by unix
calls
--  (alternatively VMS calls).  JPW has adapted this package
--  specification twice: first to use the Ada.Calendar.Clock
--  functions, then later (when I discovered deMontmollin's WIN-PAQ)
--  to use windows32 low-level calls. Now only the thinnest of Mats
--  Weber's traces can be seen.

--  December 2010: the ultimate version is possible now that Ada2005
--  gives us Ada.Execution_Time.  The object CPU_Counter times a task
--  (presently limited to the current task), and a Report about a
--  CPU_Counter might make interesting reading. Unhappily when this
--  package is introduced, gnat allocates smaller space for the
--  environment task than in the absence of tasking.  Therefore
--  instrumented programs may blow stack in cases that uninstrumented
--  programs do not.

with Ada.Execution_Time ;

package CPU is

   -- Type of a CPU time counter.  Each object of this type is an
   --  independent stop-watch that times the task in which it is
   --  declared.  Possible enhancement: bind a CPU_Counter to a
   --  Task_ID different from Current_Task.

   type CPU_Counter is limited private;

   ------------------------------------------------------------------
   -- The operations for a counter are Start, Stop and Clear.
   -- A counter that is Stopped retains the time already accrued,
until
   -- it is Cleared.

   --  A stopped counter can be started and will add to the time
   --  already accrued - just as though it had run continuously.
   --  It is not necessary to stop a counter in order to read
   --  its value.

   procedure Start_Counter (The_Counter : in out CPU_Counter);
   procedure Stop_Counter  (The_Counter : in out CPU_Counter);
   procedure Clear_Counter (The_Counter : in out CPU_Counter);

   ------------------------------------------------------------------
   -- There are two groups of reporting functions:

   --  CPU_Time returns the time used during while the counter has
   --  been running.


   function CPU_Time (Of_Counter : CPU_Counter) return Duration ;

   -- Process_Lifespan returns the total CPU since the process
   --  started.  (Does not rely on any CPU_counter having been
   --  started.)

   function Process_Lifespan  return Duration ;


   Counter_Not_Started : exception;

   --------------------------------------------------------------
   --  The other reporting functions produce printable reports for
   --  a counter, or for the process as a whole (the procedure
   --  writes to standard output). Reports do not effect the
   --  counter.  Use a prefix string to label the output according
   --  to the activity being timed.

   procedure Report_Clock (Watch      : in CPU_Counter;
                           Prefix     : in String := "") ;

   function  Report_Clock (Watch      : in CPU_Counter) return
String ;


   procedure Report_Process_Lifespan ;

   function  Report_Process_Lifespan return String ;

private

   type CPU_Counter is
      record
         Identity       : Natural := 0 ;
         Accrued_Time   : Ada.Execution_Time.CPU_Time
                        := Ada.Execution_Time.CPU_Time_First ;
         Running        : Boolean := False;
         Start_CPU      : Ada.Execution_Time.Cpu_Time
                        := Ada.Execution_Time.Clock ;
      end record;

end CPU ;

---------------------------------
-- Creation : 19-SEP-1986 by Mats Weber.
-- Revision : 16-Jul-1992 by Mats Weber, enhanced portability by
adding
--                                       separate package
System_Interface.
-- JPW 23 Sep 00 use ada.calendar.clock (because it works on Windows)
-- jpw 14apr04 *found* the alternative.  Montmollin's win-paq product
--     defines win32_timing: the operating system function.
-- jpw 14dec10  reimplement and substantially simplify using
Ada.Execution_Time


with Ada.Text_Io;
with Ada.Real_Time ;

package body CPU is
   ----------------
   use type Ada.Execution_Time.Cpu_Time ;

   Next_Counter_Identity : Natural := 0 ;

   function To_Duration (Time : Ada.Execution_Time.CPU_Time) return
Duration is
      -- thanks to Jeff Carter comp.lang.ada 11dec10
      Seconds  : Ada.Real_Time.Seconds_Count;
      Fraction : Ada.Real_Time.Time_Span;
   begin     -- To_Duration
      Ada.Execution_Time.Split (Time, Seconds, Fraction);
      return Duration (Seconds) + Ada.Real_Time.To_Duration
(Fraction);
   end To_Duration;


   procedure Start_Counter (The_Counter : in out CPU_Counter) is
   begin
      if The_Counter.Identity > 0 then
         --  This is a restart:  identity and accrued times remain
         if not The_Counter.Running then
            The_Counter.Start_CPU := Ada.Execution_Time.Clock ;
         end if ;
         The_Counter.Running   := True ;
      else   -- this clock has never started before
         Next_Counter_Identity       := Next_Counter_Identity + 1;
         The_Counter.Identity        := Next_Counter_Identity ;
         The_Counter.Running         := True ;
         The_Counter.Start_CPU       := Ada.Execution_Time.Clock ;
      end if ;
   end Start_Counter;


   procedure Stop_Counter  (The_Counter : in out CPU_Counter)is
      Now : Ada.Execution_Time.Cpu_Time
          := Ada.Execution_Time.Clock ;
   begin
      if  The_Counter.Identity > 0 and The_Counter.Running then
         -- accrue time observed up to now
         The_Counter.Accrued_Time := The_Counter.Accrued_Time +
           (Now - The_Counter.Start_CPU) ;
         The_Counter.Running := False ;
      end if ;
   end Stop_Counter ;


   procedure Clear_Counter  (The_Counter : in out CPU_Counter) is
      -- the counter becomes "as new" ready to start.
   begin
      The_Counter.Running := False ;
      The_Counter.Accrued_Time := Ada.Execution_Time.CPU_Time_First ;
   end Clear_Counter ;


   function CPU_Time (Of_Counter  : CPU_Counter) return Duration is
      Now : Ada.Execution_Time.Cpu_Time
          := Ada.Execution_Time.Clock ;
   begin
      if Of_Counter.Identity <= 0 then
         raise Counter_Not_Started ;
      end if;
      if not Of_Counter.Running then
         return To_Duration (Of_Counter.Accrued_Time) ;
      else
         return To_Duration (Of_Counter.Accrued_Time +
                             (Now - Of_Counter.Start_CPU)) ;
      end if ;
   end CPU_Time;

   function Process_Lifespan return Duration is
   begin
      return To_Duration (Ada.Execution_Time.Clock) ;
   end Process_Lifespan ;

   function Report_Duration (D : in Duration) return String is
   begin
      if D < 1.0 then
         declare
            Millisec : String := Duration'Image (1_000.0 * D);
         begin
            return  MilliSec(MilliSec'First .. MilliSec'Last-6) & "
msec" ;
         end ;
      elsif D < 60.0 then
         declare Sec : String :=  Duration'Image (D);
         begin
            return Sec(Sec'First .. Sec'Last-6)  & " sec" ;  -- fewer
signficant figs
         end ;
      else
         declare
            Minutes : Integer := Integer(D) / 60 ;
            Seconds : Duration := D - Duration(Minutes) * 60.0 ;
            Sec : String := Duration'Image (Seconds) ;
         begin
            return Integer'Image (Minutes) & " min " &
              Sec(Sec'First .. Sec'Last-6) & " sec" ;
         end ;
      end if ;
   end Report_Duration ;


   procedure Report_Clock (Watch      : in CPU_Counter;
                           Prefix     : in String := "") is
      use Ada.Text_IO ;
   begin
      Put (Prefix & Report_Clock (Watch)) ;
      New_Line ;
   end Report_Clock;


   function Report_Clock (Watch      : in CPU_Counter) return String
is
   begin
      return
        " <" & Integer'Image(Watch.Identity) & "> " &
        Report_Duration (CPU_Time (Watch)) ;
   end Report_Clock ;


   procedure Report_Process_Lifespan is
      use Ada.Text_IO ;
   begin
      Put (Report_Process_Lifespan) ;
      New_Line ;
   end Report_Process_Lifespan ;


   function  Report_Process_Lifespan return String is
      use Ada.Text_IO ;
   begin
      return "Process Lifespan: " & Report_Duration
(Process_Lifespan) ;
   end Report_Process_Lifespan ;

end CPU ;