diff mbox

[Ada] Remove hard-coded clock ids

Message ID 20111123112606.GA21435@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 23, 2011, 11:26 a.m. UTC 
Remove hard-coded clock ids in s-taprop*.adb; instead, generate them
in System.OS_Constants.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-11-23  Thomas Quinot  <quinot@adacore.com>

	* s-osinte-hpux.ads, s-taprop-vxworks.adb, s-taprop-tru64.adb,
	s-osinte-vxworks.ads, s-osinte-aix.ads, s-osinte-lynxos.ads,
	s-osinte-solaris-posix.ads, s-taprop-solaris.adb, a-exetim-posix.adb,
	s-osinte-irix.ads, s-osinte-solaris.ads, s-oscons-tmplt.c,
	s-taprop-irix.adb, s-osinte-hpux-dce.ads, Makefile.rtl,
	s-osinte-tru64.ads, s-osinte-darwin.ads, s-taprop.ads,
	s-osinte-freebsd.ads, s-osinte-lynxos-3.ads, s-taprop-hpux-dce.adb,
	s-osinte-lynxos-5.ads, s-taprop-posix.adb: Remove hard-coded clock ids;
	instead, generate them in System.OS_Constants.
	(System.OS_Constants.CLOCK_RT_Ada): New constant denoting the
	id of the clock providing Ada.Real_Time.Monotonic_Clock.
	* thread.c: New file.
	(__gnat_pthread_condattr_setup): New function. For platforms where
	CLOCK_RT_Ada is not CLOCK_REALTIME, set appropriate condition
	variable attribute.
diff mbox

Patch

Index: s-osinte-hpux.ads
===================================================================
--- s-osinte-hpux.ads	(revision 181654)
+++ s-osinte-hpux.ads	(working copy)
@@ -180,11 +180,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_MONOTONIC : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -529,10 +526,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME  : constant clockid_t := 1;
-   CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
    type pthread_attr_t is new int;
    type pthread_condattr_t is new int;
    type pthread_mutexattr_t is new int;
Index: s-taprop-vxworks.adb
===================================================================
--- s-taprop-vxworks.adb	(revision 181654)
+++ s-taprop-vxworks.adb	(working copy)
@@ -718,7 +718,7 @@ 
       TS     : aliased timespec;
       Result : int;
    begin
-      Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+      Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
       pragma Assert (Result = 0);
       return To_Duration (TS);
    end Monotonic_Clock;
Index: s-taprop-tru64.adb
===================================================================
--- s-taprop-tru64.adb	(revision 181654)
+++ s-taprop-tru64.adb	(working copy)
@@ -589,7 +589,7 @@ 
       TS     : aliased timespec;
       Result : Interfaces.C.int;
    begin
-      Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+      Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
       pragma Assert (Result = 0);
       return To_Duration (TS);
    end Monotonic_Clock;
Index: s-osinte-vxworks.ads
===================================================================
--- s-osinte-vxworks.ads	(revision 181654)
+++ s-osinte-vxworks.ads	(working copy)
@@ -243,10 +243,8 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME : constant clockid_t;   --  System wide realtime clock
-
    function To_Duration (TS : timespec) return Duration;
    pragma Inline (To_Duration);
 
@@ -511,8 +509,5 @@ 
 
    ERROR_PID : constant pid_t := -1;
 
-   type clockid_t is new int;
-   CLOCK_REALTIME : constant clockid_t := 0;
-
    type sigset_t is new System.VxWorks.Ext.sigset_t;
 end System.OS_Interface;
Index: s-osinte-aix.ads
===================================================================
--- s-osinte-aix.ads	(revision 181654)
+++ s-osinte-aix.ads	(working copy)
@@ -197,11 +197,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_MONOTONIC : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -547,10 +544,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME  : constant clockid_t := 9;
-   CLOCK_MONOTONIC : constant clockid_t := 10;
-
    type pthread_attr_t is new System.Address;
    pragma Convention (C, pthread_attr_t);
    --  typedef struct __pt_attr        *pthread_attr_t;
Index: s-osinte-lynxos.ads
===================================================================
--- s-osinte-lynxos.ads	(revision 181654)
+++ s-osinte-lynxos.ads	(working copy)
@@ -197,11 +197,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_MONOTONIC : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -517,10 +514,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new unsigned_char;
-   CLOCK_REALTIME  : constant clockid_t := 1;
-   CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
    type st_attr_t is record
       stksize      : int;
       prio         : int;
Index: s-osinte-solaris-posix.ads
===================================================================
--- s-osinte-solaris-posix.ads	(revision 181654)
+++ s-osinte-solaris-posix.ads	(working copy)
@@ -187,11 +187,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_MONOTONIC : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -520,10 +517,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME  : constant clockid_t := 3;
-   CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
    type pthread_attr_t is record
       pthread_attrp : System.Address;
    end record;
Index: s-taprop-solaris.adb
===================================================================
--- s-taprop-solaris.adb	(revision 181654)
+++ s-taprop-solaris.adb	(working copy)
@@ -773,7 +773,7 @@ 
       TS     : aliased timespec;
       Result : Interfaces.C.int;
    begin
-      Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+      Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
       pragma Assert (Result = 0);
       return To_Duration (TS);
    end Monotonic_Clock;
Index: a-exetim-posix.adb
===================================================================
--- a-exetim-posix.adb	(revision 181654)
+++ a-exetim-posix.adb	(working copy)
@@ -34,6 +34,7 @@ 
 with Ada.Task_Identification;  use Ada.Task_Identification;
 with Ada.Unchecked_Conversion;
 
+with System.OS_Constants; use System.OS_Constants;
 with System.OS_Interface; use System.OS_Interface;
 
 with Interfaces.C; use Interfaces.C;
@@ -112,9 +113,6 @@ 
       pragma Import (C, clock_gettime, "clock_gettime");
       --  Function from the POSIX.1b Realtime Extensions library
 
-      CLOCK_THREAD_CPUTIME_ID : constant := 3;
-      --  Identifier for the clock returning per-task CPU time
-
    begin
       if T = Ada.Task_Identification.Null_Task_Id then
          raise Program_Error;
Index: s-osinte-irix.ads
===================================================================
--- s-osinte-irix.ads	(revision 181654)
+++ s-osinte-irix.ads	(working copy)
@@ -172,12 +172,8 @@ 
    type timespec is private;
    type timespec_ptr is access all timespec;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_SGI_FAST  : constant clockid_t;
-   CLOCK_SGI_CYCLE : constant clockid_t;
-
    SGI_CYCLECNTR_SIZE : constant := 165;
 
    function syssgi (request : Interfaces.C.int) return Interfaces.C.ptrdiff_t;
@@ -486,11 +482,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME  : constant clockid_t := 1;
-   CLOCK_SGI_CYCLE : constant clockid_t := 2;
-   CLOCK_SGI_FAST  : constant clockid_t := 3;
-
    type array_type_9 is array (Integer range 0 .. 4) of long;
    type pthread_attr_t is record
       X_X_D : array_type_9;
Index: s-osinte-solaris.ads
===================================================================
--- s-osinte-solaris.ads	(revision 181654)
+++ s-osinte-solaris.ads	(working copy)
@@ -243,10 +243,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t; tp : access timespec) return int;
    pragma Import (C, clock_gettime, "clock_gettime");
@@ -531,9 +529,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME : constant clockid_t := 0;
-
    type array_type_9 is array (0 .. 3) of unsigned_char;
    type record_type_3 is record
       flag  : array_type_9;
Index: thread.c
===================================================================
--- thread.c	(revision 0)
+++ thread.c	(revision 0)
@@ -0,0 +1,50 @@ 
+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                               T H R E A D                                *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *             Copyright (C) 2011, Free Software Foundation, Inc.           *
+ *                                                                          *
+ * GNAT is free software;  you can  redistribute it  and/or modify it 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.  GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT 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/>.                                          *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc.      *
+ *                                                                          *
+ ****************************************************************************/
+
+/*  This file provides utility functions to access the threads API          */
+
+#include <pthread.h>
+#include <time.h>
+#include "s-oscons.h"
+
+int
+__gnat_pthread_condattr_setup(pthread_condattr_t *attr) {
+/*
+ * If using a clock other than CLOCK_REALTIME for the Ada Monotonic_Clock,
+ * the corresponding clock id must be set for condition variables.
+ * There are no clock_id's on Darwin.
+ */
+#if defined(__APPLE__) || ((CLOCK_RT_Ada) == (CLOCK_REALTIME))
+  return 0;
+#else
+  return pthread_condattr_setclock (attr, CLOCK_RT_Ada);
+#endif
+}
Index: s-oscons-tmplt.c
===================================================================
--- s-oscons-tmplt.c	(revision 181654)
+++ s-oscons-tmplt.c	(working copy)
@@ -97,6 +97,7 @@ 
 #include <string.h>
 #include <limits.h>
 #include <fcntl.h>
+#include <time.h>
 
 #if defined (__alpha__) && defined (__osf__)
 /** Tru64 is unable to do vector IO operations with default value of IOV_MAX,
@@ -1207,8 +1208,57 @@ 
 #endif
 CND(IP_PKTINFO, "Get datagram info")
 
+#endif /* HAVE_SOCKETS */
+
 /*
 
+   ------------
+   -- Clocks --
+   ------------
+
+*/
+
+#ifdef CLOCK_REALTIME
+CND(CLOCK_REALTIME, "System realtime clock")
+#endif
+
+#ifdef CLOCK_MONOTONIC
+CND(CLOCK_MONOTONIC, "System monotonic clock")
+#endif
+
+#ifdef CLOCK_FASTEST
+CND(CLOCK_FASTEST, "Fastest clock")
+#endif
+
+#if defined (__sgi)
+CND(CLOCK_SGI_FAST,  "SGI fast clock")
+CND(CLOCK_SGI_CYCLE, "SGI CPU clock")
+#endif
+
+#if defined(__APPLE__)
+/* There's no clock_gettime or clock_id's on Darwin */
+# define CLOCK_RT_Ada "-1"
+
+#elif defined(FreeBSD) || defined(_AIX)
+/* On these platforms use system provided monotonic clock */
+# define CLOCK_RT_Ada "CLOCK_MONOTONIC"
+
+#elif defined(CLOCK_REALTIME)
+/* By default use CLOCK_REALTIME */
+# define CLOCK_RT_Ada "CLOCK_REALTIME"
+#endif
+
+#ifdef CLOCK_RT_Ada
+CNS(CLOCK_RT_Ada, "Ada realtime clock")
+#endif
+
+#ifndef CLOCK_THREAD_CPUTIME_ID
+# define CLOCK_THREAD_CPUTIME_ID -1
+#endif
+CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
+
+/*
+
    ----------------------
    -- Type definitions --
    ----------------------
Index: s-taprop-irix.adb
===================================================================
--- s-taprop-irix.adb	(revision 181654)
+++ s-taprop-irix.adb	(working copy)
@@ -89,8 +89,6 @@ 
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   Real_Time_Clock_Id : constant clockid_t := CLOCK_REALTIME;
-
    Unblocked_Signal_Mask : aliased sigset_t;
 
    Foreign_Task_Elaborated : aliased Boolean := True;
@@ -572,7 +570,7 @@ 
       TS     : aliased timespec;
       Result : Interfaces.C.int;
    begin
-      Result := clock_gettime (Real_Time_Clock_Id, TS'Unchecked_Access);
+      Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
       pragma Assert (Result = 0);
       return To_Duration (TS);
    end Monotonic_Clock;
@@ -583,7 +581,7 @@ 
 
    function RT_Resolution return Duration is
    begin
-      --  The clock_getres (Real_Time_Clock_Id) function appears to return
+      --  The clock_getres (OSC.CLOCK_RT_Ada) function appears to return
       --  the interrupt resolution of the realtime clock and not the actual
       --  resolution of reading the clock. Even though this last value is
       --  only guaranteed to be 100 Hz, at least the Origin 200 appears to
Index: Makefile.rtl
===================================================================
--- Makefile.rtl	(revision 181655)
+++ Makefile.rtl	(working copy)
@@ -75,7 +75,9 @@ 
   s-tpoben$(objext) \
   s-tpobop$(objext) \
   s-tposen$(objext) \
-  s-tratas$(objext) $(EXTRA_GNATRTL_TASKING_OBJS)
+  s-tratas$(objext) \
+  thread$(objext) \
+  $(EXTRA_GNATRTL_TASKING_OBJS)
 
 # Objects needed for non-tasking.
 GNATRTL_NONTASKING_OBJS= \
Index: s-osinte-tru64.ads
===================================================================
--- s-osinte-tru64.ads	(revision 181654)
+++ s-osinte-tru64.ads	(working copy)
@@ -7,7 +7,7 @@ 
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -191,10 +191,8 @@ 
    function nanosleep (rqtp, rmtp : access timespec)  return int;
    pragma Import (C, nanosleep);
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -506,9 +504,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME : constant clockid_t := 1;
-
    type unsigned_long_array is array (Natural range <>) of unsigned_long;
 
    type pthread_t is new System.Address;
Index: s-osinte-darwin.ads
===================================================================
--- s-osinte-darwin.ads	(revision 181654)
+++ s-osinte-darwin.ads	(working copy)
@@ -183,11 +183,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_MONOTONIC : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -524,10 +521,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME  : constant clockid_t := 0;
-   CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
    --
    --  Darwin specific signal implementation
    --
Index: s-taprop.ads
===================================================================
--- s-taprop.ads	(revision 181654)
+++ s-taprop.ads	(working copy)
@@ -34,12 +34,14 @@ 
 
 with System.Parameters;
 with System.Tasking;
+with System.OS_Constants;
 with System.OS_Interface;
 
 package System.Task_Primitives.Operations is
    pragma Preelaborate;
 
    package ST renames System.Tasking;
+   package OSC renames System.OS_Constants;
    package OSI renames System.OS_Interface;
 
    procedure Initialize (Environment_Task : ST.Task_Id);
Index: s-osinte-freebsd.ads
===================================================================
--- s-osinte-freebsd.ads	(revision 181654)
+++ s-osinte-freebsd.ads	(working copy)
@@ -200,11 +200,8 @@ 
    function nanosleep (rqtp, rmtp : access timespec)  return int;
    pragma Import (C, nanosleep, "nanosleep");
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME  : constant clockid_t;
-   CLOCK_MONOTONIC : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec)
@@ -643,13 +640,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new int;
-   CLOCK_REALTIME  : constant clockid_t := 0;
-   CLOCK_MONOTONIC : constant clockid_t := 0;
-   --  On FreeBSD, pthread_cond_timedwait assumes a CLOCK_REALTIME time by
-   --  default (unless pthread_condattr_setclock is used to set an alternate
-   --  clock).
-
    type pthread_t           is new System.Address;
    type pthread_attr_t      is new System.Address;
    type pthread_mutex_t     is new System.Address;
Index: s-osinte-lynxos-3.ads
===================================================================
--- s-osinte-lynxos-3.ads	(revision 181654)
+++ s-osinte-lynxos-3.ads	(working copy)
@@ -177,10 +177,8 @@ 
 
    type timespec is private;
 
-   type clockid_t is private;
+   type clockid_t is new int;
 
-   CLOCK_REALTIME : constant clockid_t;
-
    function clock_gettime
      (clock_id : clockid_t;
       tp       : access timespec) return int;
@@ -516,9 +514,6 @@ 
    end record;
    pragma Convention (C, timespec);
 
-   type clockid_t is new unsigned_char;
-   CLOCK_REALTIME : constant clockid_t := 0;
-
    type st_t is record
       stksize      : int;
       prio         : int;
Index: s-taprop-hpux-dce.adb
===================================================================
--- s-taprop-hpux-dce.adb	(revision 181654)
+++ s-taprop-hpux-dce.adb	(working copy)
@@ -555,7 +555,7 @@ 
       TS     : aliased timespec;
       Result : Interfaces.C.int;
    begin
-      Result := Clock_Gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+      Result := Clock_Gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
       pragma Assert (Result = 0);
       return To_Duration (TS);
    end Monotonic_Clock;
Index: s-taprop-posix.adb
===================================================================
--- s-taprop-posix.adb	(revision 181654)
+++ s-taprop-posix.adb	(working copy)
@@ -171,6 +171,11 @@ 
    function To_Address is
      new Ada.Unchecked_Conversion (Task_Id, System.Address);
 
+   function GNAT_pthread_condattr_setup
+     (attr : access pthread_condattr_t) return int;
+   pragma Import (C,
+     GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+
    -------------------
    -- Abort_Handler --
    -------------------
@@ -666,7 +671,7 @@ 
       Result : Interfaces.C.int;
    begin
       Result := clock_gettime
-        (clock_id => CLOCK_MONOTONIC, tp => TS'Unchecked_Access);
+        (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
       pragma Assert (Result = 0);
       return To_Duration (TS);
    end Monotonic_Clock;
@@ -869,6 +874,9 @@ 
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = 0 then
+         Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+         pragma Assert (Result = 0);
+
          Result :=
            pthread_cond_init
              (Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
@@ -1099,6 +1107,10 @@ 
          --  underlying OS entities fails.
 
          raise Storage_Error;
+
+      else
+         Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+         pragma Assert (Result = 0);
       end if;
 
       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);