* [PATCH v8] ada: fix timeval timespec on 32 bits archs with 64 bits time_t [PR114065]
@ 2024-05-04 15:41 Nicolas Boulenguez
2024-05-15 14:29 ` Arnaud Charlet
0 siblings, 1 reply; 2+ messages in thread
From: Nicolas Boulenguez @ 2024-05-04 15:41 UTC (permalink / raw)
To: gcc-patches
[-- Attachment #1: Type: text/plain, Size: 918 bytes --]
PR ada/114065
Ada.Calendar.Clock returns nonsense on 32 bits architectures with 64
bits time_t, because gettimeofday is then a preprocessor macro for
__gettimeofday64, so linking from Ada with "gettimeofday" gets the
wrong version.
On such architectures and also on x32, some Ada declarations for the
time{val,spec} C structs are wrong (for example timespec.tv_nsec is a
not a long int on x32). This also results in wrong results for Clock.
The attached commits
* merge or remove all declarations for timeval and timespec
* calls the 64 bit functions when __USE_TIME_BITS64
* fixes various overflows with 32 bits Duration detected during tests
* removes a lot of duplicated code
The bug attachements (v7) contains a python script testing
s-c_time.adb for each combination of type sizes.
The whole patch queue, applied on gcc-13, builds on all Debian
architectures and fixes the original issue on arm{el,hf}.
[-- Attachment #2: 0001-Ada-remove-conversions-with-C-struct-timeval-from-GN.patch --]
[-- Type: text/x-diff, Size: 4668 bytes --]
From bedb7553c420da59938eacb115fd9384e54ceae0 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Fri, 5 Apr 2024 16:51:54 +0200
Subject: [PATCH v8 1/9] Ada: remove conversions with C struct timeval from
GNAT.Calendar [PR114065]
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/doc/gnat_rm/the_gnat_library.rst | 2 -
gcc/ada/libgnat/g-calend.adb | 58 ------------------------
gcc/ada/libgnat/g-calend.ads | 18 --------
3 files changed, 78 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/the_gnat_library.rst b/gcc/ada/doc/gnat_rm/the_gnat_library.rst
index 3aae70a..bcec49f 100644
--- a/gcc/ada/doc/gnat_rm/the_gnat_library.rst
+++ b/gcc/ada/doc/gnat_rm/the_gnat_library.rst
@@ -674,8 +674,6 @@ Machine-specific implementations are available in some cases.
Extends the facilities provided by ``Ada.Calendar`` to include handling
of days of the week, an extended ``Split`` and ``Time_Of`` capability.
-Also provides conversion of ``Ada.Calendar.Time`` values to and from the
-C ``timeval`` format.
.. _`GNAT.Calendar.Time_IO_(g-catiio.ads)`:
diff --git a/gcc/ada/libgnat/g-calend.adb b/gcc/ada/libgnat/g-calend.adb
index 0a98eb2..e0d34f5 100644
--- a/gcc/ada/libgnat/g-calend.adb
+++ b/gcc/ada/libgnat/g-calend.adb
@@ -29,11 +29,8 @@
-- --
------------------------------------------------------------------------------
-with Interfaces.C.Extensions;
-
package body GNAT.Calendar is
use Ada.Calendar;
- use Interfaces;
-----------------
-- Day_In_Year --
@@ -328,61 +325,6 @@ package body GNAT.Calendar is
Time_Zone => 0);
end Time_Of_At_Locale;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (T : not null access timeval) return Duration is
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access C.Extensions.long_long;
- usec : not null access C.long);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased C.Extensions.long_long;
- usec : aliased C.long;
-
- begin
- timeval_to_duration (T, sec'Access, usec'Access);
- pragma Annotate (CodePeer, Modified, sec);
- pragma Annotate (CodePeer, Modified, usec);
-
- return Duration (sec) + Duration (usec) / Micro;
- end To_Duration;
-
- ----------------
- -- To_Timeval --
- ----------------
-
- function To_Timeval (D : Duration) return timeval is
-
- procedure duration_to_timeval
- (Sec : C.Extensions.long_long;
- Usec : C.long;
- T : not null access timeval);
- pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
-
- Micro : constant := 10**6;
- Result : aliased timeval;
- sec : C.Extensions.long_long;
- usec : C.long;
-
- begin
- if D = 0.0 then
- sec := 0;
- usec := 0;
- else
- sec := C.Extensions.long_long (D - 0.5);
- usec := C.long ((D - Duration (sec)) * Micro - 0.5);
- end if;
-
- duration_to_timeval (sec, usec, Result'Access);
-
- return Result;
- end To_Timeval;
-
------------------
-- Week_In_Year --
------------------
diff --git a/gcc/ada/libgnat/g-calend.ads b/gcc/ada/libgnat/g-calend.ads
index b9dd15d..f317ab4 100644
--- a/gcc/ada/libgnat/g-calend.ads
+++ b/gcc/ada/libgnat/g-calend.ads
@@ -40,7 +40,6 @@
-- Day_Of_Week, Day_In_Year and Week_In_Year.
with Ada.Calendar.Formatting;
-with Interfaces.C;
package GNAT.Calendar is
@@ -145,24 +144,7 @@ package GNAT.Calendar is
-- Return the week number as defined in ISO 8601 along with the year in
-- which the week occurs.
- -- C timeval conversion
-
- -- C timeval represent a duration (used in Select for example). This
- -- structure is composed of a number of seconds and a number of micro
- -- seconds. The timeval structure is not exposed here because its
- -- definition is target dependent. Interface to C programs is done via a
- -- pointer to timeval structure.
-
- type timeval is private;
-
- function To_Duration (T : not null access timeval) return Duration;
- function To_Timeval (D : Duration) return timeval;
-
private
- -- This is a dummy declaration that should be the largest possible timeval
- -- structure of all supported targets.
-
- type timeval is array (1 .. 3) of Interfaces.C.long;
function Julian_Day
(Year : Ada.Calendar.Year_Number;
--
2.39.2
[-- Attachment #3: 0002-Ada-remove-conversions-with-C-struct-timespec-from-A.patch --]
[-- Type: text/x-diff, Size: 5378 bytes --]
From 4099038b7c9c5a5b5747ddc3a05dbb6b5d95f544 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Thu, 4 Apr 2024 16:50:18 +0200
Subject: [PATCH v8 2/9] Ada: remove conversions with C struct timespec from
Ada.Calendar [PR114065]
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/libgnat/a-calcon.adb | 33 -------------------------------
gcc/ada/libgnat/a-calcon.ads | 18 +----------------
gcc/ada/libgnat/a-calend.adb | 38 ------------------------------------
gcc/ada/libgnat/a-calend.ads | 11 -----------
4 files changed, 1 insertion(+), 99 deletions(-)
diff --git a/gcc/ada/libgnat/a-calcon.adb b/gcc/ada/libgnat/a-calcon.adb
index 8654d1e..3c5ec21 100644
--- a/gcc/ada/libgnat/a-calcon.adb
+++ b/gcc/ada/libgnat/a-calcon.adb
@@ -69,39 +69,6 @@ package body Ada.Calendar.Conversions is
(Year, Month, Day, Hour, Minute, Second, DST);
end To_Ada_Time;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration
- (tv_sec : long;
- tv_nsec : long) return Duration
- is
- Secs : constant Long_Integer := Long_Integer (tv_sec);
- Nano_Secs : constant Long_Integer := Long_Integer (tv_nsec);
- begin
- return Conversion_Operations.To_Duration (Secs, Nano_Secs);
- end To_Duration;
-
- ------------------------
- -- To_Struct_Timespec --
- ------------------------
-
- procedure To_Struct_Timespec
- (D : Duration;
- tv_sec : out long;
- tv_nsec : out long)
- is
- Secs : Long_Integer;
- Nano_Secs : Long_Integer;
-
- begin
- Conversion_Operations.To_Struct_Timespec (D, Secs, Nano_Secs);
-
- tv_sec := long (Secs);
- tv_nsec := long (Nano_Secs);
- end To_Struct_Timespec;
-
------------------
-- To_Struct_Tm --
------------------
diff --git a/gcc/ada/libgnat/a-calcon.ads b/gcc/ada/libgnat/a-calcon.ads
index 97df2a9..ad4ca64 100644
--- a/gcc/ada/libgnat/a-calcon.ads
+++ b/gcc/ada/libgnat/a-calcon.ads
@@ -30,7 +30,7 @@
------------------------------------------------------------------------------
-- This package provides various routines for conversion between Ada and Unix
--- time models - Time, Duration, struct tm and struct timespec.
+-- time models - Time, Duration and struct tm.
with Interfaces.C;
@@ -67,22 +67,6 @@ package Ada.Calendar.Conversions is
-- the input values are out of the defined ranges or if tm_sec equals 60
-- and the instance in time is not a leap second occurrence.
- function To_Duration
- (tv_sec : Interfaces.C.long;
- tv_nsec : Interfaces.C.long) return Duration;
- -- Convert an elapsed time value expressed in Unix-like fields of struct
- -- timespec into a Duration value. The expected ranges are:
-
- -- tv_sec - seconds
- -- tv_nsec - nanoseconds
-
- procedure To_Struct_Timespec
- (D : Duration;
- tv_sec : out Interfaces.C.long;
- tv_nsec : out Interfaces.C.long);
- -- Convert a Duration value into the constituents of struct timespec.
- -- Formal tv_sec denotes seconds and tv_nsecs denotes nanoseconds.
-
procedure To_Struct_Tm
(T : Time;
tm_year : out Interfaces.C.int;
diff --git a/gcc/ada/libgnat/a-calend.adb b/gcc/ada/libgnat/a-calend.adb
index 1083ece..06946a5 100644
--- a/gcc/ada/libgnat/a-calend.adb
+++ b/gcc/ada/libgnat/a-calend.adb
@@ -990,44 +990,6 @@ is
raise Time_Error;
end To_Ada_Time;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration
- (tv_sec : Long_Integer;
- tv_nsec : Long_Integer) return Duration
- is
- pragma Unsuppress (Overflow_Check);
- begin
- return Duration (tv_sec) + Duration (tv_nsec) / Nano_F;
- end To_Duration;
-
- ------------------------
- -- To_Struct_Timespec --
- ------------------------
-
- procedure To_Struct_Timespec
- (D : Duration;
- tv_sec : out Long_Integer;
- tv_nsec : out Long_Integer)
- is
- pragma Unsuppress (Overflow_Check);
- Secs : Duration;
- Nano_Secs : Duration;
-
- begin
- -- Seconds extraction, avoid potential rounding errors
-
- Secs := D - 0.5;
- tv_sec := Long_Integer (Secs);
-
- -- Nanoseconds extraction
-
- Nano_Secs := D - Duration (tv_sec);
- tv_nsec := Long_Integer (Nano_Secs * Nano);
- end To_Struct_Timespec;
-
------------------
-- To_Struct_Tm --
------------------
diff --git a/gcc/ada/libgnat/a-calend.ads b/gcc/ada/libgnat/a-calend.ads
index 9625f4d..cfffc70 100644
--- a/gcc/ada/libgnat/a-calend.ads
+++ b/gcc/ada/libgnat/a-calend.ads
@@ -303,17 +303,6 @@ private
tm_isdst : Integer) return Time;
-- Struct tm to Ada Epoch conversion
- function To_Duration
- (tv_sec : Long_Integer;
- tv_nsec : Long_Integer) return Duration;
- -- Struct timespec to Duration conversion
-
- procedure To_Struct_Timespec
- (D : Duration;
- tv_sec : out Long_Integer;
- tv_nsec : out Long_Integer);
- -- Duration to struct timespec conversion
-
procedure To_Struct_Tm
(T : Time;
tm_year : out Integer;
--
2.39.2
[-- Attachment #4: 0003-Ada-remove-conversions-with-C-time_t-from-System.OS_.patch --]
[-- Type: text/x-diff, Size: 2696 bytes --]
From 3e2838d416c7dbe4100625302a899a5b0194e8b6 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Sat, 13 Apr 2024 19:31:25 +0200
Subject: [PATCH v8 3/9] Ada: remove conversions with C time_t from System.OS_Lib [PR114065]
Only one conversion is used by Ada.Calendar, and it is unrelated with
the C time_t type.
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/libgnat/s-os_lib.adb | 11 +----------
gcc/ada/libgnat/s-os_lib.ads | 17 +----------------
2 files changed, 2 insertions(+), 26 deletions(-)
diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb
index 20e109a..976d39c 100644
--- a/gcc/ada/libgnat/s-os_lib.adb
+++ b/gcc/ada/libgnat/s-os_lib.adb
@@ -2980,7 +2980,7 @@ package body System.OS_Lib is
-- To_Ada --
------------
- function To_Ada (Time : time_t) return OS_Time is
+ function To_Ada (Time : Long_Long_Integer) return OS_Time is
begin
return OS_Time (Time);
end To_Ada;
@@ -3014,15 +3014,6 @@ package body System.OS_Lib is
return Return_Val;
end To_Path_String_Access;
- ----------
- -- To_C --
- ----------
-
- function To_C (Time : OS_Time) return time_t is
- begin
- return time_t (Time);
- end To_C;
-
------------------
-- Wait_Process --
------------------
diff --git a/gcc/ada/libgnat/s-os_lib.ads b/gcc/ada/libgnat/s-os_lib.ads
index 46e11f7..c69e357 100644
--- a/gcc/ada/libgnat/s-os_lib.ads
+++ b/gcc/ada/libgnat/s-os_lib.ads
@@ -165,21 +165,7 @@ package System.OS_Lib is
-- Time_t Stuff --
------------------
- -- Note: Do not use time_t in the compiler and host-based tools; instead
- -- use OS_Time.
-
- subtype time_t is Long_Long_Integer;
- -- C time_t can be either long or long long, so we choose the Ada
- -- equivalent of the latter because eventually that will be the
- -- type used out of necessity. This may affect some user code on 32-bit
- -- targets that have not yet migrated to the Posix 2008 standard,
- -- particularly pre version 5 32-bit Linux. Do not change this
- -- declaration without coordinating it with conversions in Ada.Calendar.
-
- function To_C (Time : OS_Time) return time_t;
- -- Convert OS_Time to C time_t type
-
- function To_Ada (Time : time_t) return OS_Time;
+ function To_Ada (Time : Long_Long_Integer) return OS_Time;
-- Convert C time_t type to OS_Time
----------------
@@ -1119,7 +1105,6 @@ private
pragma Import (Intrinsic, ">");
pragma Import (Intrinsic, "<=");
pragma Import (Intrinsic, ">=");
- pragma Inline (To_C);
pragma Inline (To_Ada);
type Process_Id is new Integer;
--
2.39.2
[-- Attachment #5: 0004-Ada-merge-all-timeval-and-timespec-definitions-and-c.patch --]
[-- Type: text/x-diff, Size: 140086 bytes --]
From be56bfda5d311d4e957f667003db6866f996a98f Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Tue, 23 Apr 2024 08:37:43 +0200
Subject: [PATCH v8 4/9] Ada: merge all timeval and timespec definitions and
conversions [PR114065]
Add a new System.C_Time unit in libgnat,
* not in libgnarl like OS_Interface,
* not used by the host compiler like System.CRTL
(because it requires the target System.OS_Constants)
OS_Primitives is a candidate, but has several variants
and would cause duplication again.
The System.OS_Interface specification for Android now forbids a body.
Remove lots of variants of the conversion functions with Duration.
Remove the C wrapper using long long int as an intermediate 64 bits type.
When Duration'Size = 32 bits
* round correctly in both variants of To_Duration.
* prevent an overflow in To_Duration when nsec = 999_999_999.
* prevent an overflow in To_Timespec without intermediate 64 bits.
Provide direct conversions for System.OS_Interface (Darwin) and
GNAt.Sockets.Poll.G_Wait, replacing an intermediate Duration that may
loose overflow or loose precision.
Provide a test checking if a timeval value can be converted to
Duration for GNAT.Sockets.
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/Makefile.rtl | 4 +-
gcc/ada/cal.c | 74 --------
gcc/ada/gcc-interface/Makefile.in | 1 -
gcc/ada/libgnarl/a-exetim__posix.adb | 7 +-
gcc/ada/libgnarl/s-linux.ads | 17 --
gcc/ada/libgnarl/s-linux__alpha.ads | 17 --
gcc/ada/libgnarl/s-linux__android.ads | 17 --
gcc/ada/libgnarl/s-linux__hppa.ads | 17 --
gcc/ada/libgnarl/s-linux__loongarch.ads | 18 --
gcc/ada/libgnarl/s-linux__mips.ads | 22 +--
gcc/ada/libgnarl/s-linux__riscv.ads | 22 +--
gcc/ada/libgnarl/s-linux__sparc.ads | 17 --
gcc/ada/libgnarl/s-linux__x32.ads | 19 --
gcc/ada/libgnarl/s-osinte__aix.adb | 32 ----
gcc/ada/libgnarl/s-osinte__aix.ads | 25 +--
gcc/ada/libgnarl/s-osinte__android.adb | 74 --------
gcc/ada/libgnarl/s-osinte__android.ads | 25 +--
gcc/ada/libgnarl/s-osinte__darwin.adb | 61 +------
gcc/ada/libgnarl/s-osinte__darwin.ads | 25 +--
gcc/ada/libgnarl/s-osinte__dragonfly.adb | 33 ----
gcc/ada/libgnarl/s-osinte__dragonfly.ads | 27 +--
gcc/ada/libgnarl/s-osinte__freebsd.adb | 32 ----
gcc/ada/libgnarl/s-osinte__freebsd.ads | 27 +--
gcc/ada/libgnarl/s-osinte__gnu.adb | 33 ----
gcc/ada/libgnarl/s-osinte__gnu.ads | 27 +--
gcc/ada/libgnarl/s-osinte__hpux-dce.adb | 36 +---
gcc/ada/libgnarl/s-osinte__hpux-dce.ads | 25 +--
gcc/ada/libgnarl/s-osinte__hpux.ads | 25 +--
gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads | 27 +--
gcc/ada/libgnarl/s-osinte__linux.ads | 18 +-
gcc/ada/libgnarl/s-osinte__lynxos178.adb | 32 ----
gcc/ada/libgnarl/s-osinte__lynxos178e.ads | 35 +---
gcc/ada/libgnarl/s-osinte__posix.adb | 33 ----
gcc/ada/libgnarl/s-osinte__qnx.adb | 33 ----
gcc/ada/libgnarl/s-osinte__qnx.ads | 25 +--
gcc/ada/libgnarl/s-osinte__rtems.adb | 30 ----
gcc/ada/libgnarl/s-osinte__rtems.ads | 29 +--
gcc/ada/libgnarl/s-osinte__solaris.adb | 34 ----
gcc/ada/libgnarl/s-osinte__solaris.ads | 25 +--
gcc/ada/libgnarl/s-osinte__vxworks.adb | 32 ----
gcc/ada/libgnarl/s-osinte__vxworks.ads | 28 +--
gcc/ada/libgnarl/s-osinte__x32.adb | 33 ----
gcc/ada/libgnarl/s-qnx.ads | 17 --
gcc/ada/libgnarl/s-taprop__hpux-dce.adb | 13 +-
gcc/ada/libgnarl/s-taprop__solaris.adb | 17 +-
gcc/ada/libgnarl/s-taprop__vxworks.adb | 5 +-
gcc/ada/libgnarl/s-tpopmo.adb | 18 +-
gcc/ada/libgnat/g-socket.adb | 79 +-------
gcc/ada/libgnat/g-socthi.adb | 4 +-
gcc/ada/libgnat/g-socthi__vxworks.adb | 4 +-
gcc/ada/libgnat/g-sothco.ads | 24 +--
gcc/ada/libgnat/g-spogwa.adb | 11 +-
gcc/ada/libgnat/s-c_time.adb | 188 ++++++++++++++++++++
gcc/ada/libgnat/s-c_time.ads | 115 ++++++++++++
gcc/ada/libgnat/s-optide.adb | 6 +-
gcc/ada/libgnat/s-osprim__darwin.adb | 59 +-----
gcc/ada/libgnat/s-osprim__posix.adb | 63 +------
gcc/ada/libgnat/s-osprim__posix2008.adb | 48 +----
gcc/ada/libgnat/s-osprim__rtems.adb | 71 ++------
gcc/ada/libgnat/s-osprim__solaris.adb | 27 +--
gcc/ada/libgnat/s-osprim__unix.adb | 27 +--
gcc/ada/libgnat/s-osprim__x32.adb | 65 +------
gcc/ada/libgnat/s-parame.ads | 7 -
gcc/ada/libgnat/s-parame__hpux.ads | 7 -
gcc/ada/libgnat/s-parame__posix2008.ads | 8 -
gcc/ada/libgnat/s-parame__vxworks.ads | 15 --
gcc/ada/s-oscons-tmplt.c | 15 +-
67 files changed, 510 insertions(+), 1576 deletions(-)
delete mode 100644 gcc/ada/cal.c
delete mode 100644 gcc/ada/libgnarl/s-osinte__android.adb
create mode 100644 gcc/ada/libgnat/s-c_time.adb
create mode 100644 gcc/ada/libgnat/s-c_time.ads
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 6e1ca30..8b34047 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -752,6 +752,7 @@ GNATRTL_NONTASKING_OBJS= \
s-string$(objext) \
s-ststop$(objext) \
s-tasloc$(objext) \
+ s-c_time$(objext) \
s-traceb$(objext) \
s-traent$(objext) \
s-trasym$(objext) \
@@ -1384,7 +1385,6 @@ ifeq ($(strip $(filter-out arm% linux-androideabi,$(target_cpu) $(target_os))),)
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__android.adb \
s-linux.ads<libgnarl/s-linux__android.ads \
- s-osinte.adb<libgnarl/s-osinte__android.adb \
s-osinte.ads<libgnarl/s-osinte__android.ads \
s-osprim.adb<libgnat/s-osprim__posix.adb \
s-taprop.adb<libgnarl/s-taprop__posix.adb \
@@ -2843,7 +2843,7 @@ LIBGNAT_TARGET_PAIRS += \
# library. LIBGNAT_OBJS is the list of object files for libgnat.
# thread.c is special as put into GNATRTL_TASKING_OBJS
LIBGNAT_OBJS = adadecode.o adaint.o argv.o aux-io.o \
- cal.o cio.o cstreams.o ctrl_c.o \
+ cio.o cstreams.o ctrl_c.o \
env.o errno.o exit.o expect.o final.o rtfinal.o rtinit.o \
init.o initialize.o locales.o mkdir.o \
raise.o seh_init.o socket.o sysdep.o \
diff --git a/gcc/ada/cal.c b/gcc/ada/cal.c
deleted file mode 100644
index 4485af0..0000000
--- a/gcc/ada/cal.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/****************************************************************************
- * *
- * GNAT COMPILER COMPONENTS *
- * *
- * C A L *
- * *
- * C Implementation File *
- * *
- * Copyright (C) 1992-2024, 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 contains routines marked with pragmas Import in package */
-/* GNAT.Calendar. It is used to do Duration to timeval conversion. */
-/* These are simple wrapper functions to abstract the fact that the C */
-/* struct timeval fields are not normalized (they are generally */
-/* defined as int or long values). */
-
-#if defined (__vxworks)
-#ifdef __RTP__
-#include <time.h>
-#include <version.h>
-#if (_WRS_VXWORKS_MAJOR == 7) || (_WRS_VXWORKS_MINOR != 0)
-#include <sys/time.h>
-#endif
-#else
-#include <sys/times.h>
-#endif
-#elif defined (__nucleus__)
-#include <time.h>
-#else
-#include <sys/time.h>
-#endif
-
-#ifdef __MINGW32__
-#include "mingw32.h"
-#include <winsock.h>
-#endif
-
-void
-__gnat_timeval_to_duration (struct timeval *t, long long *sec, long *usec)
-{
- *sec = (long long) t->tv_sec;
- *usec = (long) t->tv_usec;
-}
-
-void
-__gnat_duration_to_timeval (long long sec, long usec, struct timeval *t)
-{
- /* here we are doing implicit conversion to the struct timeval
- fields types. */
-
- t->tv_sec = sec;
- t->tv_usec = usec;
-}
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index 0666fc0..976dae5 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -918,7 +918,6 @@ tracebak.o : tracebak.c
adadecode.o : adadecode.c adadecode.h
aux-io.o : aux-io.c
argv.o : argv.c
-cal.o : cal.c
deftarg.o : deftarg.c
errno.o : errno.c
exit.o : adaint.h exit.c
diff --git a/gcc/ada/libgnarl/a-exetim__posix.adb b/gcc/ada/libgnarl/a-exetim__posix.adb
index 05c55c5..db873fb 100644
--- a/gcc/ada/libgnarl/a-exetim__posix.adb
+++ b/gcc/ada/libgnarl/a-exetim__posix.adb
@@ -34,6 +34,7 @@
with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Unchecked_Conversion;
+with System.C_Time;
with System.Tasking;
with System.OS_Interface; use System.OS_Interface;
with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
@@ -98,7 +99,7 @@ package body Ada.Execution_Time is
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task) return CPU_Time
is
- TS : aliased timespec;
+ TS : aliased System.C_Time.timespec;
Clock_Id : aliased Interfaces.C.int;
Result : Interfaces.C.int;
@@ -112,7 +113,7 @@ package body Ada.Execution_Time is
function clock_gettime
(clock_id : Interfaces.C.int;
- tp : access timespec)
+ tp : access System.C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
-- Function from the POSIX.1b Realtime Extensions library
@@ -139,7 +140,7 @@ package body Ada.Execution_Time is
(clock_id => Clock_Id, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_CPU_Time (To_Duration (TS));
+ return To_CPU_Time (System.C_Time.To_Duration (TS));
end Clock;
--------------------------
diff --git a/gcc/ada/libgnarl/s-linux.ads b/gcc/ada/libgnarl/s-linux.ads
index 233b831..5ce6c70 100644
--- a/gcc/ada/libgnarl/s-linux.ads
+++ b/gcc/ada/libgnarl/s-linux.ads
@@ -36,7 +36,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -45,24 +44,8 @@ package System.Linux is
-- Time --
----------
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-linux__alpha.ads b/gcc/ada/libgnarl/s-linux__alpha.ads
index 72d703d..20dce8d 100644
--- a/gcc/ada/libgnarl/s-linux__alpha.ads
+++ b/gcc/ada/libgnarl/s-linux__alpha.ads
@@ -36,7 +36,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -45,24 +44,8 @@ package System.Linux is
-- Time --
----------
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-linux__android.ads b/gcc/ada/libgnarl/s-linux__android.ads
index ff369d5..601aec7 100644
--- a/gcc/ada/libgnarl/s-linux__android.ads
+++ b/gcc/ada/libgnarl/s-linux__android.ads
@@ -36,7 +36,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -45,24 +44,8 @@ package System.Linux is
-- Time --
----------
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-linux__hppa.ads b/gcc/ada/libgnarl/s-linux__hppa.ads
index aaa15f8..362408e 100644
--- a/gcc/ada/libgnarl/s-linux__hppa.ads
+++ b/gcc/ada/libgnarl/s-linux__hppa.ads
@@ -36,7 +36,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -45,24 +44,8 @@ package System.Linux is
-- Time --
----------
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-linux__loongarch.ads b/gcc/ada/libgnarl/s-linux__loongarch.ads
index 5673335..ae22441 100644
--- a/gcc/ada/libgnarl/s-linux__loongarch.ads
+++ b/gcc/ada/libgnarl/s-linux__loongarch.ads
@@ -35,7 +35,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -44,25 +43,8 @@ package System.Linux is
-- Time --
----------
- subtype int is Interfaces.C.int;
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-linux__mips.ads b/gcc/ada/libgnarl/s-linux__mips.ads
index e7a4597..395d125 100644
--- a/gcc/ada/libgnarl/s-linux__mips.ads
+++ b/gcc/ada/libgnarl/s-linux__mips.ads
@@ -35,7 +35,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -44,25 +43,8 @@ package System.Linux is
-- Time --
----------
- subtype int is Interfaces.C.int;
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
@@ -125,8 +107,8 @@ package System.Linux is
-- struct_sigaction offsets
- sa_handler_pos : constant := int'Size / 8;
- sa_mask_pos : constant := int'Size / 8 +
+ sa_handler_pos : constant := Interfaces.C.int'Size / 8;
+ sa_mask_pos : constant := Interfaces.C.int'Size / 8 +
Standard'Address_Size / 8;
sa_flags_pos : constant := 0;
diff --git a/gcc/ada/libgnarl/s-linux__riscv.ads b/gcc/ada/libgnarl/s-linux__riscv.ads
index 17df094..5ef97a3 100644
--- a/gcc/ada/libgnarl/s-linux__riscv.ads
+++ b/gcc/ada/libgnarl/s-linux__riscv.ads
@@ -35,7 +35,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -44,25 +43,8 @@ package System.Linux is
-- Time --
----------
- subtype int is Interfaces.C.int;
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
@@ -125,8 +107,8 @@ package System.Linux is
-- struct_sigaction offsets
sa_handler_pos : constant := 0;
- sa_mask_pos : constant := long'Size / 8;
- sa_flags_pos : constant := long'Size / 8 + 128;
+ sa_mask_pos : constant := Interfaces.C.long'Size / 8;
+ sa_flags_pos : constant := Interfaces.C.long'Size / 8 + 128;
SA_SIGINFO : constant := 16#04#;
SA_ONSTACK : constant := 16#08000000#;
diff --git a/gcc/ada/libgnarl/s-linux__sparc.ads b/gcc/ada/libgnarl/s-linux__sparc.ads
index 9bfefc2..4f42192 100644
--- a/gcc/ada/libgnarl/s-linux__sparc.ads
+++ b/gcc/ada/libgnarl/s-linux__sparc.ads
@@ -36,7 +36,6 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
package System.Linux is
pragma Preelaborate;
@@ -45,24 +44,8 @@ package System.Linux is
-- Time --
----------
- subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-linux__x32.ads b/gcc/ada/libgnarl/s-linux__x32.ads
index 93a2718..e586ae0 100644
--- a/gcc/ada/libgnarl/s-linux__x32.ads
+++ b/gcc/ada/libgnarl/s-linux__x32.ads
@@ -38,8 +38,6 @@
with Interfaces.C;
-with System.Parameters;
-
package System.Linux is
pragma Preelaborate;
@@ -47,25 +45,8 @@ package System.Linux is
-- Time --
----------
- subtype suseconds_t is Long_Long_Integer;
- -- Note that suseconds_t is 64 bits.
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Long_Integer;
- -- Note that tv_nsec is 64 bits.
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-osinte__aix.adb b/gcc/ada/libgnarl/s-osinte__aix.adb
index 6ca3d98..2cd23b5 100644
--- a/gcc/ada/libgnarl/s-osinte__aix.adb
+++ b/gcc/ada/libgnarl/s-osinte__aix.adb
@@ -35,15 +35,6 @@ package body System.OS_Interface is
use Interfaces.C;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -72,29 +63,6 @@ package body System.OS_Interface is
end if;
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F is negative due to a round-up, adjust for positive F value
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- sched_yield --
-----------------
diff --git a/gcc/ada/libgnarl/s-osinte__aix.ads b/gcc/ada/libgnarl/s-osinte__aix.ads
index 9212d33..6bcb564 100644
--- a/gcc/ada/libgnarl/s-osinte__aix.ads
+++ b/gcc/ada/libgnarl/s-osinte__aix.ads
@@ -43,7 +43,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
with Interfaces.C.Extensions;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -199,26 +199,18 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported
- type timespec is private;
-
type clockid_t is new long_long;
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
@@ -419,7 +411,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -542,15 +534,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type pthread_attr_t is new System.Address;
pragma Convention (C, pthread_attr_t);
-- typedef struct __pt_attr *pthread_attr_t;
diff --git a/gcc/ada/libgnarl/s-osinte__android.adb b/gcc/ada/libgnarl/s-osinte__android.adb
deleted file mode 100644
index 4670807..0000000
--- a/gcc/ada/libgnarl/s-osinte__android.adb
+++ /dev/null
@@ -1,74 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . O S _ I N T E R F A C E --
--- --
--- B o d y --
--- --
--- Copyright (C) 1995-2024, AdaCore --
--- --
--- 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/>. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This is an Android version of this package.
-
--- This package encapsulates all direct interfaces to OS services
--- that are needed by children of System.
-
-with Interfaces.C; use Interfaces.C;
-
-package body System.OS_Interface is
-
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads
index ca35aab..ee3a5dc 100644
--- a/gcc/ada/libgnarl/s-osinte__android.ads
+++ b/gcc/ada/libgnarl/s-osinte__android.ads
@@ -40,9 +40,9 @@
with Ada.Unchecked_Conversion;
with Interfaces.C;
+with System.C_Time;
with System.Linux;
with System.OS_Constants;
-with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
@@ -204,25 +204,17 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported
- type timespec is private;
-
type clockid_t is new int;
function clock_gettime
- (clock_id : clockid_t; tp : access timespec) return int;
+ (clock_id : clockid_t; tp : access C_time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -412,7 +404,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -594,15 +586,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type unsigned_long_long_t is mod 2 ** 64;
-- Local type only used to get the alignment of this type below
diff --git a/gcc/ada/libgnarl/s-osinte__darwin.adb b/gcc/ada/libgnarl/s-osinte__darwin.adb
index a2ab6d2..4d4cec4 100644
--- a/gcc/ada/libgnarl/s-osinte__darwin.adb
+++ b/gcc/ada/libgnarl/s-osinte__darwin.adb
@@ -36,15 +36,6 @@ with Interfaces.C.Extensions;
package body System.OS_Interface is
use Interfaces.C;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -56,37 +47,13 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-------------------
-- clock_gettime --
-------------------
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int
+ tp : access C_Time.timespec) return int
is
pragma Unreferenced (clock_id);
@@ -94,33 +61,18 @@ package body System.OS_Interface is
use Interfaces;
- type timeval is array (1 .. 3) of C.long;
- -- The timeval array is sized to contain long_long sec and long usec.
- -- If long_long'Size = long'Size then it will be overly large but that
- -- won't effect the implementation since it's not accessed directly.
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access C.Extensions.long_long;
- usec : not null access C.long);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased C.Extensions.long_long;
- usec : aliased C.long;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : int;
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return int;
pragma Import (C, gettimeofday, "gettimeofday");
begin
Result := gettimeofday (TV'Access, System.Null_Address);
pragma Assert (Result = 0);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro);
+ tp.all := C_Time.To_Timespec (TV);
return Result;
end clock_gettime;
@@ -130,13 +82,12 @@ package body System.OS_Interface is
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int
+ res : access C_Time.timespec) return int
is
pragma Unreferenced (clock_id);
-- Darwin Threads don't have clock_getres.
- Nano : constant := 10**9;
nsec : int := 0;
Result : int := -1;
@@ -145,7 +96,7 @@ package body System.OS_Interface is
begin
nsec := clock_get_res;
- res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano);
+ res.all := C_Time.Nanoseconds_To_Timespec (nsec);
if nsec > 0 then
Result := 0;
diff --git a/gcc/ada/libgnarl/s-osinte__darwin.ads b/gcc/ada/libgnarl/s-osinte__darwin.ads
index af5dce5..8e25dff 100644
--- a/gcc/ada/libgnarl/s-osinte__darwin.ads
+++ b/gcc/ada/libgnarl/s-osinte__darwin.ads
@@ -39,8 +39,8 @@
-- Elaborate_Body. It is designed to be a bottom-level (leaf) package.
with Interfaces.C;
+with System.C_Time;
with System.OS_Constants;
-with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
@@ -182,23 +182,15 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported
- type timespec is private;
-
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
-
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
+ res : access C_Time.timespec) return int;
-------------------------
-- Priority Scheduling --
@@ -395,7 +387,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -515,15 +507,6 @@ private
type pid_t is new int32_t;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
--
-- Darwin specific signal implementation
--
diff --git a/gcc/ada/libgnarl/s-osinte__dragonfly.adb b/gcc/ada/libgnarl/s-osinte__dragonfly.adb
index 6f9c955..96d6c21 100644
--- a/gcc/ada/libgnarl/s-osinte__dragonfly.adb
+++ b/gcc/ada/libgnarl/s-osinte__dragonfly.adb
@@ -69,15 +69,6 @@ package body System.OS_Interface is
null;
end pthread_init;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -89,28 +80,4 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(ts_sec => S,
- ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-osinte__dragonfly.ads b/gcc/ada/libgnarl/s-osinte__dragonfly.ads
index bf078dd..875fbb5 100644
--- a/gcc/ada/libgnarl/s-osinte__dragonfly.ads
+++ b/gcc/ada/libgnarl/s-osinte__dragonfly.ads
@@ -43,7 +43,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -197,30 +197,22 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new unsigned_long;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
@@ -431,7 +423,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
@@ -635,15 +627,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- ts_sec : time_t;
- ts_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type pthread_t is new System.Address;
type pthread_attr_t is new System.Address;
type pthread_mutex_t is new System.Address;
diff --git a/gcc/ada/libgnarl/s-osinte__freebsd.adb b/gcc/ada/libgnarl/s-osinte__freebsd.adb
index 1692536..0553771 100644
--- a/gcc/ada/libgnarl/s-osinte__freebsd.adb
+++ b/gcc/ada/libgnarl/s-osinte__freebsd.adb
@@ -69,15 +69,6 @@ package body System.OS_Interface is
null;
end pthread_init;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -89,27 +80,4 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(ts_sec => S,
- ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-osinte__freebsd.ads b/gcc/ada/libgnarl/s-osinte__freebsd.ads
index 8724ddc..4b60386 100644
--- a/gcc/ada/libgnarl/s-osinte__freebsd.ads
+++ b/gcc/ada/libgnarl/s-osinte__freebsd.ads
@@ -43,7 +43,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -197,30 +197,22 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
@@ -430,7 +422,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -632,15 +624,6 @@ private
type pid_t is new int;
Self_PID : constant pid_t := 0;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- ts_sec : time_t;
- ts_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type pthread_t is new System.Address;
type pthread_attr_t is new System.Address;
type pthread_mutex_t is new System.Address;
diff --git a/gcc/ada/libgnarl/s-osinte__gnu.adb b/gcc/ada/libgnarl/s-osinte__gnu.adb
index f5a0311..9ebcb9e 100644
--- a/gcc/ada/libgnarl/s-osinte__gnu.adb
+++ b/gcc/ada/libgnarl/s-osinte__gnu.adb
@@ -93,15 +93,6 @@ package body System.OS_Interface is
return 0;
end pthread_setschedparam;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -113,28 +104,4 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-osinte__gnu.ads b/gcc/ada/libgnarl/s-osinte__gnu.ads
index 8e5760d..b4597c5 100644
--- a/gcc/ada/libgnarl/s-osinte__gnu.ads
+++ b/gcc/ada/libgnarl/s-osinte__gnu.ads
@@ -39,7 +39,7 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
-with System.Parameters;
+with System.C_Time;
with Ada.Unchecked_Conversion;
package System.OS_Interface is
@@ -207,9 +207,7 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
@@ -218,21 +216,15 @@ package System.OS_Interface is
-- From: /usr/include/time.h
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-- From: /usr/include/unistd.h
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -484,7 +476,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
@@ -653,15 +645,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
-- From: /usr/include/pthread/pthreadtypes.h:
-- typedef struct __pthread_attr pthread_attr_t;
-- /usr/include/i386-gnu/bits/thread-attr.h: struct __pthread_attr...
diff --git a/gcc/ada/libgnarl/s-osinte__hpux-dce.adb b/gcc/ada/libgnarl/s-osinte__hpux-dce.adb
index ff1e0d4..1cac79f 100644
--- a/gcc/ada/libgnarl/s-osinte__hpux-dce.adb
+++ b/gcc/ada/libgnarl/s-osinte__hpux-dce.adb
@@ -40,38 +40,6 @@ with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-------------------------
-- POSIX.1c Section 3 --
-------------------------
@@ -298,12 +266,12 @@ package body System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int
+ abstime : access C_Time.timespec) return int
is
function pthread_cond_timedwait_base
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
begin
diff --git a/gcc/ada/libgnarl/s-osinte__hpux-dce.ads b/gcc/ada/libgnarl/s-osinte__hpux-dce.ads
index b1ccd96..780ccf3 100644
--- a/gcc/ada/libgnarl/s-osinte__hpux-dce.ads
+++ b/gcc/ada/libgnarl/s-osinte__hpux-dce.ads
@@ -42,7 +42,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -188,23 +188,15 @@ package System.OS_Interface is
-- Time --
----------
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep);
type clockid_t is new int;
function Clock_Gettime
- (Clock_Id : clockid_t; Tp : access timespec) return int;
+ (Clock_Id : clockid_t; Tp : access C_Time.timespec) return int;
pragma Import (C, Clock_Gettime);
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-------------------------
-- Priority Scheduling --
-------------------------
@@ -354,7 +346,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Inline (pthread_cond_timedwait);
-- DCE_THREADS has a nonstandard pthread_cond_timedwait
@@ -446,15 +438,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
CLOCK_REALTIME : constant clockid_t := 1;
type cma_t_address is new System.Address;
diff --git a/gcc/ada/libgnarl/s-osinte__hpux.ads b/gcc/ada/libgnarl/s-osinte__hpux.ads
index 52d5995..46f2199 100644
--- a/gcc/ada/libgnarl/s-osinte__hpux.ads
+++ b/gcc/ada/libgnarl/s-osinte__hpux.ads
@@ -42,7 +42,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -180,26 +180,18 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported
- type timespec is private;
-
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
@@ -399,7 +391,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -516,15 +508,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type pthread_attr_t is new int;
type pthread_condattr_t is new int;
type pthread_mutexattr_t is new int;
diff --git a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads
index 9383759..9b40c9a 100644
--- a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads
+++ b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads
@@ -40,7 +40,7 @@
with Ada.Unchecked_Conversion;
with Interfaces.C;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -202,9 +202,7 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
@@ -212,21 +210,15 @@ package System.OS_Interface is
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -427,7 +419,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -599,15 +591,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type pthread_attr_t is record
detachstate : int;
schedpolicy : int;
diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads
index 1bf4d96..9de227e 100644
--- a/gcc/ada/libgnarl/s-osinte__linux.ads
+++ b/gcc/ada/libgnarl/s-osinte__linux.ads
@@ -40,6 +40,7 @@
with Ada.Unchecked_Conversion;
with Interfaces.C;
+with System.C_Time;
with System.Linux;
with System.OS_Constants;
@@ -51,8 +52,6 @@ package System.OS_Interface is
pragma Linker_Options ("-lpthread");
- use type System.Linux.time_t;
-
subtype int is Interfaces.C.int;
subtype char is Interfaces.C.char;
subtype short is Interfaces.C.short;
@@ -226,26 +225,17 @@ package System.OS_Interface is
-- Time --
----------
- subtype time_t is System.Linux.time_t;
- subtype timespec is System.Linux.timespec;
- subtype timeval is System.Linux.timeval;
subtype clockid_t is System.Linux.clockid_t;
function clock_gettime
- (clock_id : clockid_t; tp : access timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -454,7 +444,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178.adb b/gcc/ada/libgnarl/s-osinte__lynxos178.adb
index ea8cfab..bd941dd 100644
--- a/gcc/ada/libgnarl/s-osinte__lynxos178.adb
+++ b/gcc/ada/libgnarl/s-osinte__lynxos178.adb
@@ -85,15 +85,6 @@ package body System.OS_Interface is
return int (sysconf (SC_PAGESIZE));
end Get_Page_Size;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -105,29 +96,6 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F is negative due to a round-up, adjust for positive F value
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-------------
-- sigwait --
-------------
diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads
index 23ea89a..7047652 100644
--- a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads
+++ b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads
@@ -42,8 +42,8 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
+with System.C_Time;
with System.Multiprocessors;
-with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
@@ -192,26 +192,18 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported
- type timespec is private;
-
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
@@ -219,8 +211,6 @@ package System.OS_Interface is
pragma Convention (C, struct_timezone);
type struct_timezone_ptr is access all struct_timezone;
- type struct_timeval is private;
-
-------------------------
-- Priority Scheduling --
-------------------------
@@ -414,7 +404,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -540,23 +530,6 @@ private
type pid_t is new long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type suseconds_t is new int;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type struct_timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, struct_timeval);
-
type st_attr is record
stksize : int;
prio : int;
diff --git a/gcc/ada/libgnarl/s-osinte__posix.adb b/gcc/ada/libgnarl/s-osinte__posix.adb
index a91a9ae..70a3f2e 100644
--- a/gcc/ada/libgnarl/s-osinte__posix.adb
+++ b/gcc/ada/libgnarl/s-osinte__posix.adb
@@ -58,15 +58,6 @@ package body System.OS_Interface is
null;
end pthread_init;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -78,28 +69,4 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-osinte__qnx.adb b/gcc/ada/libgnarl/s-osinte__qnx.adb
index d752eca..aef5465 100644
--- a/gcc/ada/libgnarl/s-osinte__qnx.adb
+++ b/gcc/ada/libgnarl/s-osinte__qnx.adb
@@ -70,15 +70,6 @@ package body System.OS_Interface is
null;
end pthread_init;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -90,28 +81,4 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads b/gcc/ada/libgnarl/s-osinte__qnx.ads
index b1de1c6..e6febdb 100644
--- a/gcc/ada/libgnarl/s-osinte__qnx.ads
+++ b/gcc/ada/libgnarl/s-osinte__qnx.ads
@@ -40,7 +40,7 @@
with Ada.Unchecked_Conversion;
with Interfaces.C;
with System.OS_Constants;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -210,25 +210,17 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported
- type timespec is private;
-
type clockid_t is new int;
function clock_gettime
- (clock_id : clockid_t; tp : access timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-------------------------
-- Priority Scheduling --
-------------------------
@@ -415,7 +407,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -569,15 +561,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type unsigned_long_long_t is mod 2 ** 64;
-- Local type only used to get the alignment of this type below
diff --git a/gcc/ada/libgnarl/s-osinte__rtems.adb b/gcc/ada/libgnarl/s-osinte__rtems.adb
index 19b45c4..15e13c9 100644
--- a/gcc/ada/libgnarl/s-osinte__rtems.adb
+++ b/gcc/ada/libgnarl/s-osinte__rtems.adb
@@ -92,15 +92,6 @@ package body System.OS_Interface is
return int
with Import, External_Name => "rtems_semaphore_release", Convention => C;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -112,27 +103,6 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to round-up, adjust for positive F value
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------------------
-- Binary_Semaphore_Create --
-----------------------------
diff --git a/gcc/ada/libgnarl/s-osinte__rtems.ads b/gcc/ada/libgnarl/s-osinte__rtems.ads
index 6a7487c..b383a88 100644
--- a/gcc/ada/libgnarl/s-osinte__rtems.ads
+++ b/gcc/ada/libgnarl/s-osinte__rtems.ads
@@ -51,8 +51,8 @@
-- It is designed to be a bottom-level (leaf) package.
with Interfaces.C;
+with System.C_Time;
with System.OS_Constants;
-with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
@@ -179,8 +179,6 @@ package System.OS_Interface is
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- type timespec is private;
-
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t;
@@ -188,20 +186,14 @@ package System.OS_Interface is
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-------------------------
-- Priority Scheduling --
-------------------------
@@ -426,7 +418,7 @@ package System.OS_Interface is
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
@@ -452,8 +444,8 @@ package System.OS_Interface is
type struct_sched_param is record
sched_priority : int;
ss_low_priority : int;
- ss_replenish_period : timespec;
- ss_initial_budget : timespec;
+ ss_replenish_period : C_Time.timespec;
+ ss_initial_budget : C_Time.timespec;
sched_ss_max_repl : int;
end record;
pragma Convention (C, struct_sched_param);
@@ -589,15 +581,6 @@ private
type pid_t is new int;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
CLOCK_REALTIME : constant clockid_t := System.OS_Constants.CLOCK_REALTIME;
CLOCK_MONOTONIC : constant clockid_t := System.OS_Constants.CLOCK_MONOTONIC;
diff --git a/gcc/ada/libgnarl/s-osinte__solaris.adb b/gcc/ada/libgnarl/s-osinte__solaris.adb
index 32e5911..21cb90f 100644
--- a/gcc/ada/libgnarl/s-osinte__solaris.adb
+++ b/gcc/ada/libgnarl/s-osinte__solaris.adb
@@ -35,42 +35,8 @@
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-with Interfaces.C; use Interfaces.C;
-
package body System.OS_Interface is
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
------------------
-- pthread_init --
------------------
diff --git a/gcc/ada/libgnarl/s-osinte__solaris.ads b/gcc/ada/libgnarl/s-osinte__solaris.ads
index a7ee96d..fe180fd 100644
--- a/gcc/ada/libgnarl/s-osinte__solaris.ads
+++ b/gcc/ada/libgnarl/s-osinte__solaris.ads
@@ -42,7 +42,7 @@ with Interfaces.C;
with Ada.Unchecked_Conversion;
-with System.Parameters;
+with System.C_Time;
package System.OS_Interface is
pragma Preelaborate;
@@ -240,24 +240,16 @@ package System.OS_Interface is
-- Time --
----------
- type timespec is private;
-
type clockid_t is new int;
function clock_gettime
- (clock_id : clockid_t; tp : access timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
- (clock_id : clockid_t; res : access timespec) return int;
+ (clock_id : clockid_t; res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -346,7 +338,7 @@ package System.OS_Interface is
function cond_timedwait
(cond : access cond_t;
mutex : access mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, cond_timedwait, "cond_timedwait");
function cond_signal (cond : access cond_t) return int;
@@ -525,15 +517,6 @@ private
type pid_t is new long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type array_type_9 is array (0 .. 3) of unsigned_char;
type record_type_3 is record
flag : array_type_9;
diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.adb b/gcc/ada/libgnarl/s-osinte__vxworks.adb
index b4f5a6b..675b603 100644
--- a/gcc/ada/libgnarl/s-osinte__vxworks.adb
+++ b/gcc/ada/libgnarl/s-osinte__vxworks.adb
@@ -41,38 +41,6 @@ package body System.OS_Interface is
Low_Priority : constant := 255;
-- VxWorks native (default) lowest scheduling priority
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
- end To_Duration;
-
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F is negative due to a round-up, adjust for positive F value
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(ts_sec => S,
- ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-------------------------
-- To_VxWorks_Priority --
-------------------------
diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.ads b/gcc/ada/libgnarl/s-osinte__vxworks.ads
index 5e4e8ce..a62ec51 100644
--- a/gcc/ada/libgnarl/s-osinte__vxworks.ads
+++ b/gcc/ada/libgnarl/s-osinte__vxworks.ads
@@ -39,10 +39,10 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
+with System.C_Time;
with System.VxWorks;
with System.VxWorks.Ext;
with System.Multiprocessors;
-with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
@@ -243,37 +243,13 @@ package System.OS_Interface is
-- Time --
----------
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
- -- Time_t here used to be unsigned to match the VxWorks header declaration.
- -- The header declaration has changed in newer releases and is now signed
- -- for applications.
-
- type timespec is record
- ts_sec : time_t;
- ts_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
type clockid_t is new int;
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
- -- Convert a Duration value to a timespec value. Note that in VxWorks,
- -- timespec is always non-negative (since time_t is defined above as
- -- unsigned long). This means that there is a potential problem if a
- -- negative argument is passed for D. However, in actual usage, the
- -- value of the input argument D is always non-negative, so no problem
- -- arises in practice.
-
function To_Clock_Ticks (D : Duration) return int;
-- Convert a duration value (in seconds) into clock ticks
function clock_gettime
- (clock_id : clockid_t; tp : access timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
----------------------
diff --git a/gcc/ada/libgnarl/s-osinte__x32.adb b/gcc/ada/libgnarl/s-osinte__x32.adb
index ad21941..3bf9623 100644
--- a/gcc/ada/libgnarl/s-osinte__x32.adb
+++ b/gcc/ada/libgnarl/s-osinte__x32.adb
@@ -59,15 +59,6 @@ package body System.OS_Interface is
null;
end pthread_init;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (TS : timespec) return Duration is
- begin
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
- end To_Duration;
-
------------------------
-- To_Target_Priority --
------------------------
@@ -79,28 +70,4 @@ package body System.OS_Interface is
return Interfaces.C.int (Prio);
end To_Target_Priority;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return timespec'(tv_sec => S,
- tv_nsec => Long_Long_Integer (F * 10#1#E9));
- end To_Timespec;
-
end System.OS_Interface;
diff --git a/gcc/ada/libgnarl/s-qnx.ads b/gcc/ada/libgnarl/s-qnx.ads
index 6fd02b8..61cfcca 100644
--- a/gcc/ada/libgnarl/s-qnx.ads
+++ b/gcc/ada/libgnarl/s-qnx.ads
@@ -37,8 +37,6 @@
with Interfaces.C;
-with System.Parameters;
-
package System.QNX is
pragma Preelaborate;
@@ -47,23 +45,8 @@ package System.QNX is
----------
subtype long is Interfaces.C.long;
- subtype suseconds_t is Interfaces.C.long;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
subtype clockid_t is Interfaces.C.int;
- type timespec is record
- tv_sec : time_t;
- tv_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : suseconds_t;
- end record;
- pragma Convention (C, timeval);
-
-----------
-- Errno --
-----------
diff --git a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
index fb95f76..bcd2a17 100644
--- a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
+++ b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb
@@ -38,6 +38,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
+with System.C_Time;
with System.Tasking.Debug;
with System.Interrupt_Management;
with System.OS_Constants;
@@ -426,7 +427,7 @@ package body System.Task_Primitives.Operations is
Check_Time : constant Duration := Monotonic_Clock;
Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
@@ -439,7 +440,7 @@ package body System.Task_Primitives.Operations is
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
+ Request := C_Time.To_Timespec (Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
@@ -476,7 +477,7 @@ package body System.Task_Primitives.Operations is
is
Check_Time : constant Duration := Monotonic_Clock;
Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
pragma Warnings (Off, Result);
@@ -490,7 +491,7 @@ package body System.Task_Primitives.Operations is
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
+ Request := C_Time.To_Timespec (Abs_Time);
Self_ID.Common.State := Delay_Sleep;
loop
@@ -521,12 +522,12 @@ package body System.Task_Primitives.Operations is
---------------------
function Monotonic_Clock return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := Clock_Gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb
index 657ad55..6429895 100644
--- a/gcc/ada/libgnarl/s-taprop__solaris.adb
+++ b/gcc/ada/libgnarl/s-taprop__solaris.adb
@@ -36,6 +36,7 @@
with Interfaces.C;
+with System.C_Time;
with System.Multiprocessors;
with System.Tasking.Debug;
with System.Interrupt_Management;
@@ -759,12 +760,12 @@ package body System.Task_Primitives.Operations is
---------------------
function Monotonic_Clock return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
@@ -772,13 +773,13 @@ package body System.Task_Primitives.Operations is
-------------------
function RT_Resolution return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end RT_Resolution;
-----------
@@ -1173,7 +1174,7 @@ package body System.Task_Primitives.Operations is
Base_Time : constant Duration := Monotonic_Clock;
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
@@ -1187,7 +1188,7 @@ package body System.Task_Primitives.Operations is
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
+ Request := C_Time.To_Timespec (Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
@@ -1228,7 +1229,7 @@ package body System.Task_Primitives.Operations is
Base_Time : constant Duration := Monotonic_Clock;
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
Yielded : Boolean := False;
@@ -1241,7 +1242,7 @@ package body System.Task_Primitives.Operations is
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
+ Request := C_Time.To_Timespec (Abs_Time);
Self_ID.Common.State := Delay_Sleep;
pragma Assert (Check_Sleep (Delay_Sleep));
diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb
index 8b146f9..01632fa 100644
--- a/gcc/ada/libgnarl/s-taprop__vxworks.adb
+++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb
@@ -38,6 +38,7 @@ with Ada.Unchecked_Conversion;
with Interfaces.C;
+with System.C_Time;
with System.Multiprocessors;
with System.Tasking.Debug;
with System.Interrupt_Management;
@@ -679,12 +680,12 @@ package body System.Task_Primitives.Operations is
---------------------
function Monotonic_Clock return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : int;
begin
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
diff --git a/gcc/ada/libgnarl/s-tpopmo.adb b/gcc/ada/libgnarl/s-tpopmo.adb
index a38f9f4..7fb0dea 100644
--- a/gcc/ada/libgnarl/s-tpopmo.adb
+++ b/gcc/ada/libgnarl/s-tpopmo.adb
@@ -31,6 +31,8 @@
-- This is the Monotonic version of this package for Posix and Linux targets.
+with System.C_Time;
+
separate (System.Task_Primitives.Operations)
package body Monotonic is
@@ -54,14 +56,14 @@ package body Monotonic is
---------------------
function Monotonic_Clock return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
@@ -69,14 +71,14 @@ package body Monotonic is
-------------------
function RT_Resolution return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end RT_Resolution;
----------------------
@@ -150,7 +152,7 @@ package body Monotonic is
Abs_Time : Duration;
P_Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
Exit_Outer : Boolean := False;
@@ -184,7 +186,7 @@ package body Monotonic is
end if;
pragma Warnings (On);
- Request := To_Timespec (P_Abs_Time);
+ Request := C_Time.To_Timespec (P_Abs_Time);
Inner : loop
exit Outer
@@ -236,7 +238,7 @@ package body Monotonic is
Check_Time : Duration;
Abs_Time : Duration;
P_Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
Exit_Outer : Boolean := False;
@@ -271,7 +273,7 @@ package body Monotonic is
end if;
pragma Warnings (On);
- Request := To_Timespec (P_Abs_Time);
+ Request := C_Time.To_Timespec (P_Abs_Time);
Inner : loop
exit Outer
diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index e2f91b3..02c2bab 100644
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -45,6 +45,7 @@ pragma Warnings (Off, GNAT.Sockets.Linker_Options);
with GNAT.Sockets.Poll;
with System; use System;
+with System.C_Time;
with System.Communication; use System.Communication;
with System.CRTL; use System.CRTL;
with System.Task_Lock;
@@ -179,13 +180,6 @@ package body GNAT.Sockets is
function Value (S : System.Address) return String;
-- Same as Interfaces.C.Strings.Value but taking a System.Address
- function To_Timeval (Val : Timeval_Duration) return Timeval;
- -- Separate Val in seconds and microseconds
-
- function To_Duration (Val : Timeval) return Timeval_Duration;
- -- Reconstruct a Duration value from a Timeval record (seconds and
- -- microseconds).
-
function Dedot (Value : String) return String
is (if Value /= "" and then Value (Value'Last) = '.'
then Value (Value'First .. Value'Last - 1)
@@ -528,7 +522,7 @@ package body GNAT.Sockets is
Res : C.int;
Last : C.int;
RSig : Socket_Type := No_Socket;
- TVal : aliased Timeval;
+ TVal : aliased System.C_Time.timeval;
TPtr : Timeval_Access;
begin
@@ -543,7 +537,7 @@ package body GNAT.Sockets is
if Timeout = Forever then
TPtr := null;
else
- TVal := To_Timeval (Timeout);
+ TVal := System.C_Time.To_Timeval (Timeout);
TPtr := TVal'Unchecked_Access;
end if;
@@ -1423,7 +1417,7 @@ package body GNAT.Sockets is
U4 : aliased C.unsigned;
V1 : aliased C.unsigned_char;
VS : aliased C.char_array (1 .. NS); -- for devices name
- VT : aliased Timeval;
+ VT : aliased System.C_Time.timeval;
Len : aliased C.int;
Add : System.Address;
Res : C.int;
@@ -1596,8 +1590,10 @@ package body GNAT.Sockets is
Opt.Timeout := Duration (U4) / 1000;
end if;
+ elsif System.C_Time.In_Duration (VT) then
+ Opt.Timeout := System.C_Time.To_Duration (VT);
else
- Opt.Timeout := To_Duration (VT);
+ Opt.Timeout := Forever;
end if;
when Bind_To_Device =>
@@ -2633,7 +2629,7 @@ package body GNAT.Sockets is
(1 .. (if Option.Name = Bind_To_Device
then C.size_t (ASU.Length (Option.Device) + 1)
else 0));
- VT : aliased Timeval;
+ VT : aliased System.C_Time.timeval;
Len : C.int;
Add : System.Address := Null_Address;
Res : C.int;
@@ -2767,7 +2763,7 @@ package body GNAT.Sockets is
end if;
else
- VT := To_Timeval (Option.Timeout);
+ VT := System.C_Time.To_Timeval (Option.Timeout);
Len := VT'Size / 8;
Add := VT'Address;
end if;
@@ -2865,33 +2861,6 @@ package body GNAT.Sockets is
return Integer (Socket);
end To_C;
- -----------------
- -- To_Duration --
- -----------------
-
- function To_Duration (Val : Timeval) return Timeval_Duration is
- Max_D : constant Long_Long_Integer := Long_Long_Integer (Forever - 0.5);
- Tv_sec_64 : constant Boolean := SOSC.SIZEOF_tv_sec = 8;
- -- Need to separate this condition into the constant declaration to
- -- avoid GNAT warning about "always true" or "always false".
- begin
- if Tv_sec_64 then
- -- Check for possible Duration overflow when Tv_Sec field is 64 bit
- -- integer.
-
- if Val.Tv_Sec > time_t (Max_D)
- or else
- (Val.Tv_Sec = time_t (Max_D)
- and then
- Val.Tv_Usec > suseconds_t ((Forever - Duration (Max_D)) * 1E6))
- then
- return Forever;
- end if;
- end if;
-
- return Duration (Val.Tv_Sec) + Duration (Val.Tv_Usec) * 1.0E-6;
- end To_Duration;
-
-------------------
-- To_Host_Entry --
-------------------
@@ -3041,36 +3010,6 @@ package body GNAT.Sockets is
return HN.Name (1 .. HN.Length);
end To_String;
- ----------------
- -- To_Timeval --
- ----------------
-
- function To_Timeval (Val : Timeval_Duration) return Timeval is
- S : time_t;
- uS : suseconds_t;
-
- begin
- -- If zero, set result as zero (otherwise it gets rounded down to -1)
-
- if Val = 0.0 then
- S := 0;
- uS := 0;
-
- -- Normal case where we do round down
-
- else
- S := time_t (Val - 0.5);
- uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)) - 0.5);
-
- if uS = -1 then
- -- It happen on integer duration
- uS := 0;
- end if;
- end if;
-
- return (S, uS);
- end To_Timeval;
-
-----------
-- Value --
-----------
diff --git a/gcc/ada/libgnat/g-socthi.adb b/gcc/ada/libgnat/g-socthi.adb
index dce2717..f03e7e2 100644
--- a/gcc/ada/libgnat/g-socthi.adb
+++ b/gcc/ada/libgnat/g-socthi.adb
@@ -40,6 +40,8 @@ with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
+with System.C_Time;
+
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : aliased Fd_Set;
@@ -191,7 +193,7 @@ package body GNAT.Sockets.Thin is
declare -- unreachable if Thread_Blocking_IO is statically True
pragma Warnings (On, "unreachable code");
WSet : aliased Fd_Set;
- Now : aliased Timeval;
+ Now : aliased System.C_Time.timeval;
begin
Reset_Socket_Set (WSet'Access);
diff --git a/gcc/ada/libgnat/g-socthi__vxworks.adb b/gcc/ada/libgnat/g-socthi__vxworks.adb
index 53ddc43..7621ea5 100644
--- a/gcc/ada/libgnat/g-socthi__vxworks.adb
+++ b/gcc/ada/libgnat/g-socthi__vxworks.adb
@@ -40,6 +40,8 @@ with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
+with System.C_Time;
+
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : aliased Fd_Set;
@@ -194,7 +196,7 @@ package body GNAT.Sockets.Thin is
declare -- unreachable if Thread_Blocking_IO is statically True
pragma Warnings (On, "unreachable code");
WSet : aliased Fd_Set;
- Now : aliased Timeval;
+ Now : aliased System.C_Time.timeval;
begin
Reset_Socket_Set (WSet'Access);
loop
diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads
index 8c21933..c6df5a4 100644
--- a/gcc/ada/libgnat/g-sothco.ads
+++ b/gcc/ada/libgnat/g-sothco.ads
@@ -34,7 +34,7 @@
with Ada.Unchecked_Conversion;
with Interfaces.C.Strings;
-with System.Parameters;
+with System.C_Time;
package GNAT.Sockets.Thin_Common is
@@ -44,31 +44,13 @@ package GNAT.Sockets.Thin_Common is
Success : constant C.int := 0;
Failure : constant C.int := -1;
- type time_t is
- range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
- for time_t'Size use System.Parameters.time_t_bits;
- pragma Convention (C, time_t);
-
- type suseconds_t is
- range -2 ** (8 * SOSC.SIZEOF_tv_usec - 1)
- .. 2 ** (8 * SOSC.SIZEOF_tv_usec - 1) - 1;
- for suseconds_t'Size use 8 * SOSC.SIZEOF_tv_usec;
- pragma Convention (C, suseconds_t);
-
- type Timeval is record
- Tv_Sec : time_t;
- Tv_Usec : suseconds_t;
- end record;
- pragma Convention (C, Timeval);
-
- type Timeval_Access is access all Timeval;
+ type Timeval_Access is access all System.C_Time.timeval;
pragma Convention (C, Timeval_Access);
type socklen_t is mod 2 ** (8 * SOSC.SIZEOF_socklen_t);
for socklen_t'Size use (8 * SOSC.SIZEOF_socklen_t);
- Immediat : constant Timeval := (0, 0);
+ Immediat : System.C_Time.timeval renames System.C_Time.Timeval_Zero;
-------------------------------------------
-- Mapping tables to low level constants --
diff --git a/gcc/ada/libgnat/g-spogwa.adb b/gcc/ada/libgnat/g-spogwa.adb
index c16674e..530a6cd 100644
--- a/gcc/ada/libgnat/g-spogwa.adb
+++ b/gcc/ada/libgnat/g-spogwa.adb
@@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-with GNAT.Sockets.Thin_Common;
+with System.C_Time;
procedure GNAT.Sockets.Poll.G_Wait
(Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
@@ -41,11 +41,11 @@ is
readfds : access FD_Set_Type;
writefds : access FD_Set_Type;
exceptfds : access FD_Set_Type;
- timeout : access Thin_Common.Timeval) return Integer
+ timeout : access System.C_Time.timeval) return Integer
with Import => True, Convention => Stdcall, External_Name => "select";
- Timeout_V : aliased Thin_Common.Timeval;
- Timeout_A : access Thin_Common.Timeval;
+ Timeout_V : aliased System.C_Time.timeval;
+ Timeout_A : access System.C_Time.timeval;
Rfds : aliased FD_Set_Type;
Rcount : Natural := 0;
@@ -63,8 +63,7 @@ begin
if Timeout >= 0 then
Timeout_A := Timeout_V'Access;
- Timeout_V.Tv_Sec := Thin_Common.time_t (Timeout / 1000);
- Timeout_V.Tv_Usec := Thin_Common.suseconds_t (Timeout rem 1000 * 1000);
+ Timeout_V := System.C_Time.Milliseconds_To_Timeval (Timeout);
end if;
Reset_Socket_Set (Rfds);
diff --git a/gcc/ada/libgnat/s-c_time.adb b/gcc/ada/libgnat/s-c_time.adb
new file mode 100644
index 0000000..26820a4
--- /dev/null
+++ b/gcc/ada/libgnat/s-c_time.adb
@@ -0,0 +1,188 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . C _ T I M E --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1998-2024, Free Software Foundation, Inc. --
+-- --
+-- GNARL 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/>. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+package body System.C_Time is
+
+ -- Two Duration representations are described in targparm.ads.
+ -- Size Delta Last = (2**(Size - 1) - 1) * Delta
+ -- 32 0.02 42_949_672.94
+ -- 64 0.000_000_001 9_223_372_036.854_775_807
+
+ -----------------
+ -- In_Duration --
+ -----------------
+
+ function In_Duration (T : timeval) return Boolean is
+
+ -- Mimic To_Timeval (Duration'Last), except that
+ -- * this computation happens at compile time
+ -- * Sec may be far above MAX_tv_sec
+ -- * on 64 bits, Usec is truncated instead of rounded up
+ Sec : constant := (if Duration'Size = 64
+ then (2**63 - 1) / 1_000_000_000
+ else (2**31 - 1) / 50);
+ Usec : constant := (if Duration'Size = 64
+ then (2**63 - 1) mod 1_000_000_000 / 1_000
+ else (2**31 - 1) mod 50 * 20_000);
+
+ pragma Warnings (Off, "condition is always");
+ Dur_Covers_Tv_Sec : constant Boolean := OS_Constants.MAX_tv_sec < Sec;
+ pragma Warnings (On, "condition is always");
+
+ -- When Duration'Size = 64 and time_t'Size = 32, the compiler
+ -- complains that Sec does not fit in time_t, hence cannot be
+ -- compared with T.tv_sec. But then Dur_Covers_Tv_Sec is True
+ -- and the following comparisons are skipped.
+ Maybe_Sec : constant := (if Dur_Covers_Tv_Sec then 1 else Sec);
+ begin
+ return Dur_Covers_Tv_Sec
+ or else T.tv_sec < Maybe_Sec
+ or else (T.tv_sec = Maybe_Sec and then T.tv_usec <= Usec);
+ end In_Duration;
+
+ -----------------------------
+ -- Milliseconds_To_Timeval --
+ -----------------------------
+
+ function Milliseconds_To_Timeval (M : Interfaces.C.int) return timeval is
+ use Interfaces.C;
+ Q : constant int range 0 .. int'Last / 1_000 := M / 1_000;
+ R : constant int range 0 .. 999 := M mod 1_000;
+ begin
+ return (tv_sec => time_t (Q),
+ tv_usec => 1_000 * usec_t (R));
+ end Milliseconds_To_Timeval;
+
+ -----------------------------
+ -- Nanoseconds_To_Timespec --
+ -----------------------------
+
+ function Nanoseconds_To_Timespec (N : Interfaces.C.int) return timespec is
+ use Interfaces.C;
+ Q : constant int range 0 .. int'Last / 10**9 := N / 10**9;
+ R : constant int range 0 .. 999_999_999 := N mod 10**9;
+ begin
+ return (tv_sec => time_t (Q),
+ tv_nsec => nsec_t (R));
+ end Nanoseconds_To_Timespec;
+
+ -----------------
+ -- To_Duration --
+ -----------------
+
+ function To_Duration (T : timeval) return Duration is
+ Frac : Duration range 0.0 .. 1.0;
+ begin
+ if Duration'Size = 64 then
+ Frac := Duration (T.tv_usec) / 1_000_000;
+ else
+ -- Fix the rounding (999_999.0 / 1_000_000 = 0.98).
+ Frac := Duration (T.tv_usec + 10_000) / 1_000_000;
+ end if;
+ return Duration (T.tv_sec) + Frac;
+ end To_Duration;
+
+ function To_Duration (T : timespec) return Duration is
+ Frac : Duration range 0.0 .. 1.0;
+ begin
+ if Duration'Size = 64 then
+ Frac := Duration (T.tv_nsec) / 1_000_000_000;
+ else
+ -- Avoid an overflow (Duration'Last < 999_999_999).
+ -- Fix the rounding (999_999_999.0 / 1_000_000_000 = 0.98).
+ Frac := Duration (T.tv_nsec / 10_000_000 + 1) / 100;
+ end if;
+ return Duration (T.tv_sec) + Frac;
+ end To_Duration;
+
+ -----------------
+ -- To_Timespec --
+ -----------------
+
+ function To_Timespec (T : timeval) return timespec is
+ begin
+ return (tv_sec => T.tv_sec,
+ tv_nsec => 1_000 * nsec_t (T.tv_usec));
+ end To_Timespec;
+
+ function To_Timespec (D : Duration) return timespec is
+ -- See To_Timeval.
+ Dm1 : constant Duration range -1.0 .. Duration'Last - 1.0 := D - 1.0;
+ Sec : constant time_t range -1 .. time_t'Last := time_t (Dm1);
+ Frac : constant Duration range -0.5 .. 0.5 := Dm1 - Duration (Sec);
+ Nsec : nsec_t range -500_000_000 .. 500_000_000;
+ begin
+ if Duration'Size = 64 then
+ Nsec := nsec_t (1_000_000_000 * Frac);
+ else
+ -- Avoid an overflow when Duration'Last < 999_999_999.
+ Nsec := 10_000_000 * nsec_t (100 * Frac);
+ end if;
+ if Nsec < 0 then
+ return (Sec, Nsec + 1_000_000_000);
+ else
+ return (Sec + 1, Nsec);
+ end if;
+ end To_Timespec;
+
+ -----------------
+ -- To_Timeval --
+ -----------------
+
+ function To_Timeval (D : Duration) return timeval is
+
+ -- Sec := time_t (D);
+ -- Usec := usec_t (1_000_000 * (D - Duration (Sec)));
+ -- fails when D is
+ -- Duration'Last (Sec is rounded up and Duration (Sec) overflows)
+ -- 0.9 (Sec is rounded up and Usec < 0)
+
+ -- Sec := time_t (D - 0.5);
+ -- Usec := usec_t (1_000_000 * (D - Duration (Sec)));
+ -- fails when D is
+ -- 0.0 (Sec is rounded down and Usec = 1_000_000)
+ -- 0.999_999_999 (Usec is rounded up to 1_000_000)
+
+ -- Converting D - 1 seems to solve overflow and simplify roundings.
+ Dm1 : constant Duration range -1.0 .. Duration'Last - 1.0 := D - 1.0;
+ Sec : constant time_t range -1 .. time_t'Last := time_t (Dm1);
+ Frac : constant Duration range -0.5 .. 0.5 := Dm1 - Duration (Sec);
+ Usec : constant usec_t range -500_000 .. 500_000
+ := usec_t (1_000_000 * Frac);
+ begin
+ if Usec < 0 then
+ return (tv_sec => Sec, tv_usec => Usec + 1_000_000);
+ else
+ return (tv_sec => Sec + 1, tv_usec => Usec);
+ end if;
+ end To_Timeval;
+
+end System.C_Time;
diff --git a/gcc/ada/libgnat/s-c_time.ads b/gcc/ada/libgnat/s-c_time.ads
new file mode 100644
index 0000000..e943dd0
--- /dev/null
+++ b/gcc/ada/libgnat/s-c_time.ads
@@ -0,0 +1,115 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . C _ T I M E --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1998-2024, Free Software Foundation, Inc. --
+-- --
+-- GNARL 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/>. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides the timeval, timespec C types and conversions.
+-- It hides all details about time_t, suseconds_t.
+
+with Interfaces.C;
+private with System.OS_Constants;
+
+package System.C_Time
+ with Preelaborate
+is
+
+ type timeval is private; -- Non negative duration in microseconds.
+
+ Timeval_Zero : constant timeval;
+ -- g-sothco.ads
+
+ function To_Timeval (D : Duration) return timeval
+ with Pre => 0.0 <= D;
+ -- The value is rounded if Duration'Size = 64.
+
+ function In_Duration (T : timeval) return Boolean
+ with Inline;
+ -- True if computing To_Duration (T) is safe,
+ -- False if Constraint Error would be raised.
+
+ function To_Duration (T : timeval) return Duration
+ with Post => 0.0 <= To_Duration'Result;
+ -- The value is rounded if Duration'Size = 32.
+
+ type timespec is private; -- Non negative duration in nanoseconds.
+
+ function To_Timespec (D : Duration) return timespec
+ with Pre => 0.0 <= D;
+
+ function To_Duration (T : timespec) return Duration
+ with Post => 0.0 <= To_Duration'Result;
+ -- The value is rounded if Duration'Size = 32.
+
+ -- Direct conversions avoiding an intermediate Duration that may
+ -- loose precision (when Duration'Size = 32) or overflow (when
+ -- time_t'Size = 64).
+
+ function Milliseconds_To_Timeval (M : Interfaces.C.int) return timeval
+ with Inline,
+ Pre => Interfaces.C."<=" (0, M);
+
+ function Nanoseconds_To_Timespec (N : Interfaces.C.int) return timespec
+ with Inline,
+ Pre => Interfaces.C."<=" (0, N);
+
+ function To_Timespec (T : timeval) return timespec
+ with Inline;
+
+private
+
+ type time_t is range -2 ** (OS_Constants.SIZEOF_tv_sec * 8 - 1) ..
+ 2 ** (OS_Constants.SIZEOF_tv_sec * 8 - 1) - 1
+ with Convention => C, Size => OS_Constants.SIZEOF_tv_sec * 8;
+
+ type usec_t is range -2 ** (OS_Constants.SIZEOF_tv_usec * 8 - 1) ..
+ 2 ** (OS_Constants.SIZEOF_tv_usec * 8 - 1) - 1
+ with Convention => C, Size => OS_Constants.SIZEOF_tv_usec * 8;
+ -- Larger than the suseconds_t C type on ARM 32 bits with GNU libc
+ -- when __TIME_BITS=64.
+
+ type nsec_t is range -2 ** (OS_Constants.SIZEOF_tv_nsec * 8 - 1) ..
+ 2 ** (OS_Constants.SIZEOF_tv_nsec * 8 - 1) - 1
+ with Convention => C, Size => OS_Constants.SIZEOF_tv_nsec * 8;
+ -- Larger than the signed long int C type on x32.
+
+ type timeval is record
+ tv_sec : time_t range 0 .. OS_Constants.MAX_tv_sec; -- seconds
+ tv_usec : usec_t range 0 .. 999_999; -- microseconds
+ end record
+ with Convention => C;
+
+ type timespec is record
+ tv_sec : time_t range 0 .. OS_Constants.MAX_tv_sec; -- seconds
+ tv_nsec : nsec_t range 0 .. 999_999_999; -- nanoseconds
+ end record
+ with Convention => C;
+
+ Timeval_Zero : constant timeval := (tv_sec => 0, tv_usec => 0);
+
+end System.C_Time;
diff --git a/gcc/ada/libgnat/s-optide.adb b/gcc/ada/libgnat/s-optide.adb
index c73d44f..e15493c 100644
--- a/gcc/ada/libgnat/s-optide.adb
+++ b/gcc/ada/libgnat/s-optide.adb
@@ -36,8 +36,8 @@ procedure Timed_Delay
(Time : Duration;
Mode : Integer)
is
- Request : aliased timespec;
- Remaind : aliased timespec;
+ Request : aliased C_Time.timespec;
+ Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
@@ -71,7 +71,7 @@ begin
end if;
pragma Warnings (On);
- Request := To_Timespec (Time_Chunk);
+ Request := C_Time.To_Timespec (Time_Chunk);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
diff --git a/gcc/ada/libgnat/s-osprim__darwin.adb b/gcc/ada/libgnat/s-osprim__darwin.adb
index ce1ec3f..5f75688 100644
--- a/gcc/ada/libgnat/s-osprim__darwin.adb
+++ b/gcc/ada/libgnat/s-osprim__darwin.adb
@@ -31,7 +31,7 @@
-- This version is for darwin
-with System.Parameters;
+with System.C_Time;
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
@@ -46,27 +46,13 @@ package body System.OS_Primitives is
pragma Convention (C, struct_timezone);
type struct_timezone_ptr is access all struct_timezone;
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type struct_timeval is record
- tv_sec : time_t;
- tv_usec : Integer;
- end record;
- pragma Convention (C, struct_timeval);
-
function gettimeofday
- (tv : not null access struct_timeval;
+ (tv : not null access C_Time.timeval;
tz : struct_timezone_ptr) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
@@ -74,7 +60,7 @@ package body System.OS_Primitives is
-----------
function Clock return Duration is
- TV : aliased struct_timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
@@ -89,36 +75,9 @@ package body System.OS_Primitives is
-- value is never checked.
Result := gettimeofday (TV'Access, null);
- return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
@@ -127,8 +86,8 @@ package body System.OS_Primitives is
(Time : Duration;
Mode : Integer)
is
- Request : aliased timespec;
- Remaind : aliased timespec;
+ Request : aliased C_Time.timespec;
+ Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
@@ -148,7 +107,7 @@ package body System.OS_Primitives is
if Rel_Time > 0.0 then
loop
- Request := To_Timespec (Rel_Time);
+ Request := C_Time.To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
diff --git a/gcc/ada/libgnat/s-osprim__posix.adb b/gcc/ada/libgnat/s-osprim__posix.adb
index ba61a0c..bb9a28d 100644
--- a/gcc/ada/libgnat/s-osprim__posix.adb
+++ b/gcc/ada/libgnat/s-osprim__posix.adb
@@ -30,7 +30,7 @@
------------------------------------------------------------------------------
-- This version is for POSIX-like operating systems
-with System.Parameters;
+with System.C_Time;
package body System.OS_Primitives is
@@ -39,16 +39,8 @@ package body System.OS_Primitives is
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
@@ -57,27 +49,12 @@ package body System.OS_Primitives is
function Clock return Duration is
- type timeval is array (1 .. 3) of Long_Integer;
- -- The timeval array is sized to contain Long_Long_Integer sec and
- -- Long_Integer usec. If Long_Long_Integer'Size = Long_Integer'Size then
- -- it will be overly large but that will not effect the implementation
- -- since it is not accessed directly.
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access Long_Long_Integer;
- usec : not null access Long_Integer);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased Long_Long_Integer;
- usec : aliased Long_Integer;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
@@ -91,37 +68,9 @@ package body System.OS_Primitives is
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- return Duration (sec) + Duration (usec) / Micro;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
diff --git a/gcc/ada/libgnat/s-osprim__posix2008.adb b/gcc/ada/libgnat/s-osprim__posix2008.adb
index d819858..377fb3a 100644
--- a/gcc/ada/libgnat/s-osprim__posix2008.adb
+++ b/gcc/ada/libgnat/s-osprim__posix2008.adb
@@ -31,9 +31,10 @@
-- This version is for POSIX.1-2008-like operating systems
+with System.C_Time;
with System.CRTL;
with System.OS_Constants;
-with System.Parameters;
+
package body System.OS_Primitives is
subtype int is System.CRTL.int;
@@ -42,16 +43,8 @@ package body System.OS_Primitives is
-- we don't want to depend on any package. Consider removing these
-- declarations in System.OS_Interface and move these ones to the spec.
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
@@ -59,7 +52,7 @@ package body System.OS_Primitives is
-----------
function Clock return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : int;
type clockid_t is new int;
@@ -68,42 +61,15 @@ package body System.OS_Primitives is
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
begin
Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
+ return C_Time.To_Duration (TS);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
diff --git a/gcc/ada/libgnat/s-osprim__rtems.adb b/gcc/ada/libgnat/s-osprim__rtems.adb
index 2d1302c..f7b607a 100644
--- a/gcc/ada/libgnat/s-osprim__rtems.adb
+++ b/gcc/ada/libgnat/s-osprim__rtems.adb
@@ -31,7 +31,8 @@
-- This version is for POSIX-like operating systems
-with System.Parameters;
+with System.C_Time;
+
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
@@ -39,16 +40,8 @@ package body System.OS_Primitives is
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
@@ -56,28 +49,12 @@ package body System.OS_Primitives is
-----------
function Clock return Duration is
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : Long_Integer;
- end record;
- pragma Convention (C, timeval);
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access Long_Long_Integer;
- usec : not null access Long_Integer);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased Long_Long_Integer;
- usec : aliased Long_Integer;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
@@ -91,37 +68,9 @@ package body System.OS_Primitives is
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- return Duration (sec) + Duration (usec) / Micro;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
@@ -130,8 +79,8 @@ package body System.OS_Primitives is
(Time : Duration;
Mode : Integer)
is
- Request : aliased timespec;
- Remaind : aliased timespec;
+ Request : aliased C_Time.timespec;
+ Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
@@ -151,7 +100,7 @@ package body System.OS_Primitives is
if Rel_Time > 0.0 then
loop
- Request := To_Timespec (Rel_Time);
+ Request := C_Time.To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
diff --git a/gcc/ada/libgnat/s-osprim__solaris.adb b/gcc/ada/libgnat/s-osprim__solaris.adb
index e41d074..70c8dc4 100644
--- a/gcc/ada/libgnat/s-osprim__solaris.adb
+++ b/gcc/ada/libgnat/s-osprim__solaris.adb
@@ -32,6 +32,8 @@
-- This version uses gettimeofday and select
-- This file is suitable for Solaris (32 and 64 bits).
+with System.C_Time;
+
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
@@ -39,14 +41,8 @@ package body System.OS_Primitives is
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type struct_timeval is record
- tv_sec : Long_Integer;
- tv_usec : Long_Integer;
- end record;
- pragma Convention (C, struct_timeval);
-
procedure gettimeofday
- (tv : not null access struct_timeval;
+ (tv : not null access C_Time.timeval;
tz : Address := Null_Address);
pragma Import (C, gettimeofday, "gettimeofday");
@@ -55,7 +51,7 @@ package body System.OS_Primitives is
readfds,
writefds,
exceptfds : Address := Null_Address;
- timeout : not null access struct_timeval);
+ timeout : not null access C_Time.timeval);
pragma Import (C, C_select, "select");
-----------
@@ -63,11 +59,11 @@ package body System.OS_Primitives is
-----------
function Clock return Duration is
- TV : aliased struct_timeval;
+ TV : aliased C_Time.timeval;
begin
gettimeofday (TV'Access);
- return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
+ return C_Time.To_Duration (TV);
end Clock;
-----------------
@@ -82,7 +78,7 @@ package body System.OS_Primitives is
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
Check_Time : Duration := Base_Time;
- timeval : aliased struct_timeval;
+ timeval : aliased C_Time.timeval;
begin
if Mode = Relative then
@@ -95,14 +91,7 @@ package body System.OS_Primitives is
if Rel_Time > 0.0 then
loop
- timeval.tv_sec := Long_Integer (Rel_Time);
-
- if Duration (timeval.tv_sec) > Rel_Time then
- timeval.tv_sec := timeval.tv_sec - 1;
- end if;
-
- timeval.tv_usec :=
- Long_Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6);
+ timeval := C_Time.To_Timeval (Rel_Time);
C_select (timeout => timeval'Unchecked_Access);
Check_Time := Clock;
diff --git a/gcc/ada/libgnat/s-osprim__unix.adb b/gcc/ada/libgnat/s-osprim__unix.adb
index e7a66aa..c1c7e51 100644
--- a/gcc/ada/libgnat/s-osprim__unix.adb
+++ b/gcc/ada/libgnat/s-osprim__unix.adb
@@ -32,6 +32,8 @@
-- This version uses gettimeofday and select
-- This file is suitable for OpenNT, Dec Unix and SCO UnixWare.
+with System.C_Time;
+
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
@@ -39,14 +41,8 @@ package body System.OS_Primitives is
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type struct_timeval is record
- tv_sec : Integer;
- tv_usec : Integer;
- end record;
- pragma Convention (C, struct_timeval);
-
procedure gettimeofday
- (tv : not null access struct_timeval;
+ (tv : not null access C_Time.timeval;
tz : Address := Null_Address);
pragma Import (C, gettimeofday, "gettimeofday");
@@ -55,7 +51,7 @@ package body System.OS_Primitives is
readfds,
writefds,
exceptfds : Address := Null_Address;
- timeout : not null access struct_timeval);
+ timeout : not null access C_Time.timeval);
pragma Import (C, C_select, "select");
-----------
@@ -63,11 +59,11 @@ package body System.OS_Primitives is
-----------
function Clock return Duration is
- TV : aliased struct_timeval;
+ TV : aliased C_Time.timeval;
begin
gettimeofday (TV'Access);
- return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
+ return C_Time.To_Duration (TV);
end Clock;
-----------------
@@ -82,7 +78,7 @@ package body System.OS_Primitives is
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
Check_Time : Duration := Base_Time;
- timeval : aliased struct_timeval;
+ timeval : aliased C_Time.timeval;
begin
if Mode = Relative then
@@ -95,14 +91,7 @@ package body System.OS_Primitives is
if Rel_Time > 0.0 then
loop
- timeval.tv_sec := Integer (Rel_Time);
-
- if Duration (timeval.tv_sec) > Rel_Time then
- timeval.tv_sec := timeval.tv_sec - 1;
- end if;
-
- timeval.tv_usec :=
- Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6);
+ timeval := C_Time.To_Timeval (Rel_Time);
C_select (timeout => timeval'Unchecked_Access);
Check_Time := Clock;
diff --git a/gcc/ada/libgnat/s-osprim__x32.adb b/gcc/ada/libgnat/s-osprim__x32.adb
index 2340866..644c41c 100644
--- a/gcc/ada/libgnat/s-osprim__x32.adb
+++ b/gcc/ada/libgnat/s-osprim__x32.adb
@@ -31,7 +31,7 @@
-- This version is for Linux/x32
-with System.Parameters;
+with System.C_Time;
package body System.OS_Primitives is
@@ -40,16 +40,8 @@ package body System.OS_Primitives is
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
@@ -57,23 +49,12 @@ package body System.OS_Primitives is
-----------
function Clock return Duration is
- type timeval is array (1 .. 2) of Long_Long_Integer;
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access Long_Integer;
- usec : not null access Long_Integer);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased Long_Integer;
- usec : aliased Long_Integer;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
@@ -87,37 +68,9 @@ package body System.OS_Primitives is
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- return Duration (sec) + Duration (usec) / Micro;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Long_Integer (F * 10#1#E9));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
@@ -126,8 +79,8 @@ package body System.OS_Primitives is
(Time : Duration;
Mode : Integer)
is
- Request : aliased timespec;
- Remaind : aliased timespec;
+ Request : aliased C_Time.timespec;
+ Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
@@ -147,7 +100,7 @@ package body System.OS_Primitives is
if Rel_Time > 0.0 then
loop
- Request := To_Timespec (Rel_Time);
+ Request := C_Time.To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
diff --git a/gcc/ada/libgnat/s-parame.ads b/gcc/ada/libgnat/s-parame.ads
index e5ed7bf..81bd839 100644
--- a/gcc/ada/libgnat/s-parame.ads
+++ b/gcc/ada/libgnat/s-parame.ads
@@ -96,13 +96,6 @@ package System.Parameters is
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
- ------------------------------------
- -- Characteristics of time_t type --
- ------------------------------------
-
- time_t_bits : constant := Long_Integer'Size;
- -- Number of bits in type time_t
-
----------------------------------------------
-- Characteristics of types in Interfaces.C --
----------------------------------------------
diff --git a/gcc/ada/libgnat/s-parame__hpux.ads b/gcc/ada/libgnat/s-parame__hpux.ads
index cd98dc7..264e12a 100644
--- a/gcc/ada/libgnat/s-parame__hpux.ads
+++ b/gcc/ada/libgnat/s-parame__hpux.ads
@@ -96,13 +96,6 @@ package System.Parameters is
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
- ------------------------------------
- -- Characteristics of time_t type --
- ------------------------------------
-
- time_t_bits : constant := Long_Integer'Size;
- -- Number of bits in type time_t
-
----------------------------------------------
-- Characteristics of Types in Interfaces.C --
----------------------------------------------
diff --git a/gcc/ada/libgnat/s-parame__posix2008.ads b/gcc/ada/libgnat/s-parame__posix2008.ads
index 2652e56..5d4cf28 100644
--- a/gcc/ada/libgnat/s-parame__posix2008.ads
+++ b/gcc/ada/libgnat/s-parame__posix2008.ads
@@ -96,14 +96,6 @@ package System.Parameters is
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
- ------------------------------------
- -- Characteristics of time_t type --
- ------------------------------------
-
- time_t_bits : constant := Long_Long_Integer'Size;
- -- Number of bits in type time_t. Use for targets that are Posix 2008
- -- compliant (fixes the year 2038 time_t overflow).
-
----------------------------------------------
-- Characteristics of types in Interfaces.C --
----------------------------------------------
diff --git a/gcc/ada/libgnat/s-parame__vxworks.ads b/gcc/ada/libgnat/s-parame__vxworks.ads
index 802357e..d0bcecd 100644
--- a/gcc/ada/libgnat/s-parame__vxworks.ads
+++ b/gcc/ada/libgnat/s-parame__vxworks.ads
@@ -98,21 +98,6 @@ package System.Parameters is
-- Indicates if secondary stacks can grow and shrink at run-time. If False,
-- the size of a secondary stack is fixed at the point of its creation.
- ------------------------------------
- -- Characteristics of time_t type --
- ------------------------------------
-
- -- IMPORTANT NOTE:
- -- Select the appropriate time_t_bits for the VSB in use, then rebuild
- -- the runtime using instructions in adainclude/libada.gpr.
-
- -- time_t_bits : constant := Long_Integer'Size;
- -- Number of bits in type time_t for SR0650 and before and SR0660 with
- -- non-default configuration.
-
- time_t_bits : constant := Long_Long_Integer'Size;
- -- Number of bits in type time_t for SR0660 with default configuration.
-
----------------------------------------------
-- Characteristics of types in Interfaces.C --
----------------------------------------------
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 4e512b9..5beb929 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -1740,9 +1740,9 @@ CND(IPV6_V6ONLY, "Restricted to IPv6 communications only")
-- Sizes (in bytes) of the components of struct timeval
*/
#define SIZEOF_tv_sec (sizeof tv.tv_sec)
-CND(SIZEOF_tv_sec, "tv_sec")
+CND(SIZEOF_tv_sec, "tv_sec, time_t")
#define SIZEOF_tv_usec (sizeof tv.tv_usec)
-CND(SIZEOF_tv_usec, "tv_usec")
+CND(SIZEOF_tv_usec, "tv_usec, suseconds_t")
/*
-- Maximum allowed value for tv_sec
@@ -1764,6 +1764,17 @@ CND(SIZEOF_tv_usec, "tv_usec")
#endif
CNS(MAX_tv_sec, "")
}
+
+{
+ struct timespec ts;
+/*
+ -- Sizes (in bytes) of the components of struct timespec.
+ -- The tv_sec field is the same than in struct timeval.
+*/
+#define SIZEOF_tv_nsec (sizeof (ts.tv_nsec))
+CND(SIZEOF_tv_nsec, "tv_nsec, long except on x32");
+}
+
/*
-- Sizes of various data types
--
2.39.2
[-- Attachment #6: 0005-Ada-drop-unneeded-x32-variant-of-System.Linux.patch --]
[-- Type: text/x-diff, Size: 7027 bytes --]
From fd4d89b0c388af456cff6f0c34e9bb74e5248479 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Mon, 1 Apr 2024 12:20:43 +0200
Subject: [PATCH v8 5/9] Ada: drop unneeded x32 variant of System.Linux [PR114065]
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/Makefile.rtl | 1 -
gcc/ada/libgnarl/s-linux__x32.ads | 114 ------------------------------
2 files changed, 115 deletions(-)
delete mode 100644 gcc/ada/libgnarl/s-linux__x32.ads
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 8b34047..7bcfb81 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -2618,7 +2618,6 @@ ifeq ($(strip $(filter-out %x32 linux%,$(target_cpu) $(target_os))),)
a-synbar.ads<libgnarl/a-synbar__posix.ads \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__posix.adb \
- s-linux.ads<libgnarl/s-linux__x32.ads \
s-mudido.adb<libgnarl/s-mudido__affinity.adb \
s-osinte.ads<libgnarl/s-osinte__linux.ads \
s-osinte.adb<libgnarl/s-osinte__x32.adb \
diff --git a/gcc/ada/libgnarl/s-linux__x32.ads b/gcc/ada/libgnarl/s-linux__x32.ads
deleted file mode 100644
index e586ae0..0000000
--- a/gcc/ada/libgnarl/s-linux__x32.ads
+++ /dev/null
@@ -1,114 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . L I N U X --
--- --
--- S p e c --
--- --
--- Copyright (C) 2013-2024, Free Software Foundation, Inc. --
---
--- --
--- GNARL 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/>. --
--- --
--- --
-------------------------------------------------------------------------------
-
--- This is the x32 version of this package
-
--- This package encapsulates cpu specific differences between implementations
--- of GNU/Linux, in order to share s-osinte-linux.ads.
-
--- PLEASE DO NOT add any with-clauses to this package or remove the pragma
--- Preelaborate. This package is designed to be a bottom-level (leaf) package
-
-with Interfaces.C;
-
-package System.Linux is
- pragma Preelaborate;
-
- ----------
- -- Time --
- ----------
-
- subtype clockid_t is Interfaces.C.int;
-
- -----------
- -- Errno --
- -----------
-
- EAGAIN : constant := 11;
- EINTR : constant := 4;
- EINVAL : constant := 22;
- ENOMEM : constant := 12;
- EPERM : constant := 1;
- ETIMEDOUT : constant := 110;
-
- -------------
- -- Signals --
- -------------
-
- SIGHUP : constant := 1; -- hangup
- SIGINT : constant := 2; -- interrupt (rubout)
- SIGQUIT : constant := 3; -- quit (ASCD FS)
- SIGILL : constant := 4; -- illegal instruction (not reset)
- SIGTRAP : constant := 5; -- trace trap (not reset)
- SIGIOT : constant := 6; -- IOT instruction
- SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future
- SIGFPE : constant := 8; -- floating point exception
- SIGKILL : constant := 9; -- kill (cannot be caught or ignored)
- SIGBUS : constant := 7; -- bus error
- SIGUSR1 : constant := 10; -- user defined signal 1
- SIGSEGV : constant := 11; -- segmentation violation
- SIGUSR2 : constant := 12; -- user defined signal 2
- SIGPIPE : constant := 13; -- write on a pipe with no one to read it
- SIGALRM : constant := 14; -- alarm clock
- SIGTERM : constant := 15; -- software termination signal from kill
- SIGSTKFLT : constant := 16; -- coprocessor stack fault (Linux)
- SIGCLD : constant := 17; -- alias for SIGCHLD
- SIGCHLD : constant := 17; -- child status change
- SIGSTOP : constant := 19; -- stop (cannot be caught or ignored)
- SIGTSTP : constant := 20; -- user stop requested from tty
- SIGCONT : constant := 18; -- stopped process has been continued
- SIGTTIN : constant := 21; -- background tty read attempted
- SIGTTOU : constant := 22; -- background tty write attempted
- SIGURG : constant := 23; -- urgent condition on IO channel
- SIGXCPU : constant := 24; -- CPU time limit exceeded
- SIGXFSZ : constant := 25; -- filesize limit exceeded
- SIGVTALRM : constant := 26; -- virtual timer expired
- SIGPROF : constant := 27; -- profiling timer expired
- SIGWINCH : constant := 28; -- window size change
- SIGPOLL : constant := 29; -- pollable event occurred
- SIGIO : constant := 29; -- I/O now possible (4.2 BSD)
- SIGLOST : constant := 29; -- File lock lost
- SIGPWR : constant := 30; -- power-fail restart
- SIGSYS : constant := 31; -- bad system call
- SIGUNUSED : constant := 31; -- unused signal (mapped to SIGSYS)
- SIG32 : constant := 32; -- glibc internal signal
- SIG33 : constant := 33; -- glibc internal signal
- SIG34 : constant := 34; -- glibc internal signal
-
- -- struct_sigaction offsets
-
- sa_handler_pos : constant := 0;
- sa_mask_pos : constant := Standard'Address_Size / 8;
- sa_flags_pos : constant := 128 + sa_mask_pos;
-
- SA_SIGINFO : constant := 16#04#;
- SA_ONSTACK : constant := 16#08000000#;
-
-end System.Linux;
--
2.39.2
[-- Attachment #7: 0006-Ada-drop-unneeded-posix2008-variant-of-System.Parame.patch --]
[-- Type: text/x-diff, Size: 10877 bytes --]
From 2b24999b8cf787bf6724a9c649d1d25f6548a36b Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Sat, 30 Mar 2024 17:32:51 +0100
Subject: [PATCH v8 6/9] Ada: drop unneeded posix2008 variant of System.Parameters [PR114065]
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/Makefile.rtl | 3 -
gcc/ada/libgnat/s-parame__posix2008.ads | 181 ------------------------
2 files changed, 184 deletions(-)
delete mode 100644 gcc/ada/libgnat/s-parame__posix2008.ads
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 7bcfb81..82d01b2 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -1955,7 +1955,6 @@ ifeq ($(strip $(filter-out lynxos178%,$(target_os))),)
ifeq ($(strip $(filter-out lynxos178e,$(target_os))),)
LIBGNAT_TARGET_PAIRS += \
- s-parame.ads<libgnat/s-parame__posix2008.ads \
s-osinte.ads<libgnarl/s-osinte__lynxos178e.ads \
s-osprim.adb<libgnat/s-osprim__posix2008.adb \
s-tracon.adb<hie/s-tracon__ppc-eabi.adb
@@ -1976,7 +1975,6 @@ ifeq ($(strip $(filter-out rtems%,$(target_os))),)
s-osinte.ads<libgnarl/s-osinte__rtems.ads \
s-osprim.adb<libgnat/s-osprim__rtems.adb \
s-parame.adb<libgnat/s-parame__rtems.adb \
- s-parame.ads<libgnat/s-parame__posix2008.ads \
s-taprop.adb<libgnarl/s-taprop__rtems.adb \
s-taspri.ads<libgnarl/s-taspri__posix.ads \
s-tpopsp.adb<libgnarl/s-tpopsp__tls.adb \
@@ -2622,7 +2620,6 @@ ifeq ($(strip $(filter-out %x32 linux%,$(target_cpu) $(target_os))),)
s-osinte.ads<libgnarl/s-osinte__linux.ads \
s-osinte.adb<libgnarl/s-osinte__x32.adb \
s-osprim.adb<libgnat/s-osprim__x32.adb \
- s-parame.ads<libgnat/s-parame__posix2008.ads \
s-taprop.adb<libgnarl/s-taprop__linux.adb \
s-tasinf.ads<libgnarl/s-tasinf__linux.ads \
s-tasinf.adb<libgnarl/s-tasinf__linux.adb \
diff --git a/gcc/ada/libgnat/s-parame__posix2008.ads b/gcc/ada/libgnat/s-parame__posix2008.ads
deleted file mode 100644
index 5d4cf28..0000000
--- a/gcc/ada/libgnat/s-parame__posix2008.ads
+++ /dev/null
@@ -1,181 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S Y S T E M . P A R A M E T E R S --
--- --
--- S p e c --
--- --
--- Copyright (C) 1992-2024, 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 is the Posix 2008 version for 64 bit time_t.
-
--- This package defines some system dependent parameters for GNAT. These
--- are values that are referenced by the runtime library and are therefore
--- relevant to the target machine.
-
--- The parameters whose value is defined in the spec are not generally
--- expected to be changed. If they are changed, it will be necessary to
--- recompile the run-time library.
-
--- The parameters which are defined by functions can be changed by modifying
--- the body of System.Parameters in file s-parame.adb. A change to this body
--- requires only rebinding and relinking of the application.
-
--- Note: do not introduce any pragma Inline statements into this unit, since
--- otherwise the relinking and rebinding capability would be deactivated.
-
-package System.Parameters is
- pragma Pure;
-
- ---------------------------------------
- -- Task And Stack Allocation Control --
- ---------------------------------------
-
- type Size_Type is range -Memory_Size / 2 .. Memory_Size / 2 - 1;
- -- Type used to provide task stack sizes to the runtime. Sized to permit
- -- stack sizes of up to half the total addressable memory space. This may
- -- seem excessively large (even for 32-bit systems), however there are many
- -- instances of users requiring large stack sizes (for example string
- -- processing).
-
- Unspecified_Size : constant Size_Type := Size_Type'First;
- -- Value used to indicate that no size type is set
-
- function Default_Stack_Size return Size_Type;
- -- Default task stack size used if none is specified
-
- function Minimum_Stack_Size return Size_Type;
- -- Minimum task stack size permitted
-
- function Adjust_Storage_Size (Size : Size_Type) return Size_Type;
- -- Given the storage size stored in the TCB, return the Storage_Size
- -- value required by the RM for the Storage_Size attribute. The
- -- required adjustment is as follows:
- --
- -- when Size = Unspecified_Size, return Default_Stack_Size
- -- when Size < Minimum_Stack_Size, return Minimum_Stack_Size
- -- otherwise return given Size
-
- Default_Env_Stack_Size : constant Size_Type := 8_192_000;
- -- Assumed size of the environment task, if no other information is
- -- available. This value is used when stack checking is enabled and
- -- no GNAT_STACK_LIMIT environment variable is set.
-
- Stack_Grows_Down : constant Boolean := True;
- -- This constant indicates whether the stack grows up (False) or
- -- down (True) in memory as functions are called. It is used for
- -- proper implementation of the stack overflow check.
-
- Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024;
- -- The run-time chosen default size for secondary stacks that may be
- -- overridden by the user with the use of binder -D switch.
-
- Sec_Stack_Dynamic : constant Boolean := True;
- -- Indicates if secondary stacks can grow and shrink at run-time. If False,
- -- the size of a secondary stack is fixed at the point of its creation.
-
- ----------------------------------------------
- -- Characteristics of types in Interfaces.C --
- ----------------------------------------------
-
- long_bits : constant := Long_Integer'Size;
- -- Number of bits in type long and unsigned_long. The normal convention
- -- is that this is the same as type Long_Integer, but this may not be true
- -- of all targets.
-
- ptr_bits : constant := Standard'Address_Size;
- subtype C_Address is System.Address;
- -- Number of bits in Interfaces.C pointers, normally a standard address
-
- C_Malloc_Linkname : constant String := "__gnat_malloc";
- -- Name of runtime function used to allocate such a pointer
-
- ----------------------------------------------
- -- Behavior of Pragma Finalize_Storage_Only --
- ----------------------------------------------
-
- -- Garbage_Collected is a Boolean constant whose value indicates the
- -- effect of the pragma Finalize_Storage_Entry on a controlled type.
-
- -- Garbage_Collected = False
-
- -- The system releases all storage on program termination only,
- -- but not other garbage collection occurs, so finalization calls
- -- are omitted only for outer level objects can be omitted if
- -- pragma Finalize_Storage_Only is used.
-
- -- Garbage_Collected = True
-
- -- The system provides full garbage collection, so it is never
- -- necessary to release storage for controlled objects for which
- -- a pragma Finalize_Storage_Only is used.
-
- Garbage_Collected : constant Boolean := False;
- -- The storage mode for this system (release on program exit)
-
- ---------------------
- -- Tasking Profile --
- ---------------------
-
- -- In the following sections, constant parameters are defined to
- -- allow some optimizations and fine tuning within the tasking run time
- -- based on restrictions on the tasking features.
-
- -------------------
- -- Task Abortion --
- -------------------
-
- No_Abort : constant Boolean := False;
- -- This constant indicates whether abort statements and asynchronous
- -- transfer of control (ATC) are disallowed. If set to True, it is
- -- assumed that neither construct is used, and the run time does not
- -- need to defer/undefer abort and check for pending actions at
- -- completion points. A value of True for No_Abort corresponds to:
- -- pragma Restrictions (No_Abort_Statements);
- -- pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
-
- ---------------------
- -- Task Attributes --
- ---------------------
-
- Max_Attribute_Count : constant := 32;
- -- Number of task attributes stored in the task control block
-
- -----------------------
- -- Task Image Length --
- -----------------------
-
- Max_Task_Image_Length : constant := 256;
- -- This constant specifies the maximum length of a task's image
-
- ------------------------------
- -- Exception Message Length --
- ------------------------------
-
- Default_Exception_Msg_Max_Length : constant := 200;
- -- This constant specifies the default number of characters to allow
- -- in an exception message (200 is minimum required by RM 11.4.1(18)).
-
-end System.Parameters;
--
2.39.2
[-- Attachment #8: 0007-Ada-drop-unneeded-darwin-solaris-x32-variants-of-Sys.patch --]
[-- Type: text/x-diff, Size: 19506 bytes --]
From cb0055c725001350fa5409313e62eae0bddd3155 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Sun, 21 Apr 2024 19:52:28 +0200
Subject: [PATCH v8 7/9] Ada: drop unneeded darwin, solaris, x32 variants of
System.OS_Primitives [PR114065]
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/Makefile.rtl | 14 +--
gcc/ada/libgnat/s-osprim__darwin.adb | 130 --------------------------
gcc/ada/libgnat/s-osprim__solaris.adb | 115 -----------------------
gcc/ada/libgnat/s-osprim__x32.adb | 123 ------------------------
4 files changed, 7 insertions(+), 375 deletions(-)
delete mode 100644 gcc/ada/libgnat/s-osprim__darwin.adb
delete mode 100644 gcc/ada/libgnat/s-osprim__solaris.adb
delete mode 100644 gcc/ada/libgnat/s-osprim__x32.adb
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 82d01b2..1f339f3 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -1461,7 +1461,7 @@ ifeq ($(strip $(filter-out sparc% sun solaris%,$(target_cpu) $(target_vendor) $(
s-mudido.adb<libgnarl/s-mudido__affinity.adb \
s-osinte.adb<libgnarl/s-osinte__solaris.adb \
s-osinte.ads<libgnarl/s-osinte__solaris.ads \
- s-osprim.adb<libgnat/s-osprim__solaris.adb \
+ s-osprim.adb<libgnat/s-osprim__unix.adb \
s-taprop.adb<libgnarl/s-taprop__solaris.adb \
s-tasinf.adb<libgnarl/s-tasinf__solaris.adb \
s-tasinf.ads<libgnarl/s-tasinf__solaris.ads \
@@ -1504,7 +1504,7 @@ ifeq ($(strip $(filter-out %86 %x86_64 solaris2%,$(target_cpu) $(target_os))),)
s-mudido.adb<libgnarl/s-mudido__affinity.adb \
s-osinte.adb<libgnarl/s-osinte__solaris.adb \
s-osinte.ads<libgnarl/s-osinte__solaris.ads \
- s-osprim.adb<libgnat/s-osprim__solaris.adb \
+ s-osprim.adb<libgnat/s-osprim__unix.adb \
s-taprop.adb<libgnarl/s-taprop__solaris.adb \
s-tasinf.adb<libgnarl/s-tasinf__solaris.adb \
s-tasinf.ads<libgnarl/s-tasinf__solaris.ads \
@@ -2619,7 +2619,7 @@ ifeq ($(strip $(filter-out %x32 linux%,$(target_cpu) $(target_os))),)
s-mudido.adb<libgnarl/s-mudido__affinity.adb \
s-osinte.ads<libgnarl/s-osinte__linux.ads \
s-osinte.adb<libgnarl/s-osinte__x32.adb \
- s-osprim.adb<libgnat/s-osprim__x32.adb \
+ s-osprim.adb<libgnat/s-osprim__rtems.adb \
s-taprop.adb<libgnarl/s-taprop__linux.adb \
s-tasinf.ads<libgnarl/s-tasinf__linux.ads \
s-tasinf.adb<libgnarl/s-tasinf__linux.adb \
@@ -2703,7 +2703,7 @@ ifeq ($(strip $(filter-out darwin%,$(target_os))),)
ifeq ($(strip $(filter-out %86,$(target_cpu))),)
LIBGNAT_TARGET_PAIRS += \
s-intman.adb<libgnarl/s-intman__susv3.adb \
- s-osprim.adb<libgnat/s-osprim__darwin.adb \
+ s-osprim.adb<libgnat/s-osprim__rtems.adb \
$(ATOMICS_TARGET_PAIRS) \
system.ads<libgnat/system-darwin-x86.ads
@@ -2722,7 +2722,7 @@ ifeq ($(strip $(filter-out darwin%,$(target_os))),)
ifeq ($(strip $(filter-out %x86_64,$(target_cpu))),)
LIBGNAT_TARGET_PAIRS += \
s-intman.adb<libgnarl/s-intman__susv3.adb \
- s-osprim.adb<libgnat/s-osprim__darwin.adb \
+ s-osprim.adb<libgnat/s-osprim__rtems.adb \
a-exetim.ads<libgnarl/a-exetim__default.ads \
a-exetim.adb<libgnarl/a-exetim__darwin.adb \
$(ATOMICS_TARGET_PAIRS) \
@@ -2769,7 +2769,7 @@ ifeq ($(strip $(filter-out darwin%,$(target_os))),)
ifeq ($(strip $(filter-out arm,$(target_cpu))),)
LIBGNAT_TARGET_PAIRS += \
s-intman.adb<libgnarl/s-intman__susv3.adb \
- s-osprim.adb<libgnat/s-osprim__darwin.adb \
+ s-osprim.adb<libgnat/s-osprim__rtems.adb \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS)
@@ -2782,7 +2782,7 @@ ifeq ($(strip $(filter-out darwin%,$(target_os))),)
a-nallfl.ads<libgnat/a-nallfl__wraplf.ads \
s-intman.adb<libgnarl/s-intman__susv3.adb \
s-dorepr.adb<libgnat/s-dorepr__fma.adb \
- s-osprim.adb<libgnat/s-osprim__darwin.adb \
+ s-osprim.adb<libgnat/s-osprim__rtems.adb \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS) \
$(GNATRTL_128BIT_PAIRS)
diff --git a/gcc/ada/libgnat/s-osprim__darwin.adb b/gcc/ada/libgnat/s-osprim__darwin.adb
deleted file mode 100644
index 5f75688..0000000
--- a/gcc/ada/libgnat/s-osprim__darwin.adb
+++ /dev/null
@@ -1,130 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . O S _ P R I M I T I V E S --
--- --
--- B o d y --
--- --
--- Copyright (C) 1998-2024, Free Software Foundation, Inc. --
--- --
--- GNARL 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/>. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version is for darwin
-
-with System.C_Time;
-package body System.OS_Primitives is
-
- -- ??? These definitions are duplicated from System.OS_Interface
- -- because we don't want to depend on any package. Consider removing
- -- these declarations in System.OS_Interface and move these ones in
- -- the spec.
-
- type struct_timezone is record
- tz_minuteswest : Integer;
- tz_dsttime : Integer;
- end record;
- pragma Convention (C, struct_timezone);
- type struct_timezone_ptr is access all struct_timezone;
-
- function gettimeofday
- (tv : not null access C_Time.timeval;
- tz : struct_timezone_ptr) return Integer;
- pragma Import (C, gettimeofday, "gettimeofday");
-
- function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
- return Integer;
- pragma Import (C, nanosleep, "nanosleep");
-
- -----------
- -- Clock --
- -----------
-
- function Clock return Duration is
- TV : aliased C_Time.timeval;
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- begin
- -- The return codes for gettimeofday are as follows (from man pages):
- -- EPERM settimeofday is called by someone other than the superuser
- -- EINVAL Timezone (or something else) is invalid
- -- EFAULT One of tv or tz pointed outside accessible address space
-
- -- None of these codes signal a potential clock skew, hence the return
- -- value is never checked.
-
- Result := gettimeofday (TV'Access, null);
- return C_Time.To_Duration (TV);
- end Clock;
-
- -----------------
- -- Timed_Delay --
- -----------------
-
- procedure Timed_Delay
- (Time : Duration;
- Mode : Integer)
- is
- Request : aliased C_Time.timespec;
- Remaind : aliased C_Time.timespec;
- Rel_Time : Duration;
- Abs_Time : Duration;
- Base_Time : constant Duration := Clock;
- Check_Time : Duration := Base_Time;
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- begin
- if Mode = Relative then
- Rel_Time := Time;
- Abs_Time := Time + Check_Time;
- else
- Rel_Time := Time - Check_Time;
- Abs_Time := Time;
- end if;
-
- if Rel_Time > 0.0 then
- loop
- Request := C_Time.To_Timespec (Rel_Time);
- Result := nanosleep (Request'Access, Remaind'Access);
- Check_Time := Clock;
-
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- Rel_Time := Abs_Time - Check_Time;
- end loop;
- end if;
- end Timed_Delay;
-
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize is
- begin
- null;
- end Initialize;
-
-end System.OS_Primitives;
diff --git a/gcc/ada/libgnat/s-osprim__solaris.adb b/gcc/ada/libgnat/s-osprim__solaris.adb
deleted file mode 100644
index 70c8dc4..0000000
--- a/gcc/ada/libgnat/s-osprim__solaris.adb
+++ /dev/null
@@ -1,115 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . O S _ P R I M I T I V E S --
--- --
--- B o d y --
--- --
--- Copyright (C) 1998-2024, Free Software Foundation, Inc. --
--- --
--- GNARL 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/>. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version uses gettimeofday and select
--- This file is suitable for Solaris (32 and 64 bits).
-
-with System.C_Time;
-
-package body System.OS_Primitives is
-
- -- ??? These definitions are duplicated from System.OS_Interface
- -- because we don't want to depend on any package. Consider removing
- -- these declarations in System.OS_Interface and move these ones in
- -- the spec.
-
- procedure gettimeofday
- (tv : not null access C_Time.timeval;
- tz : Address := Null_Address);
- pragma Import (C, gettimeofday, "gettimeofday");
-
- procedure C_select
- (n : Integer := 0;
- readfds,
- writefds,
- exceptfds : Address := Null_Address;
- timeout : not null access C_Time.timeval);
- pragma Import (C, C_select, "select");
-
- -----------
- -- Clock --
- -----------
-
- function Clock return Duration is
- TV : aliased C_Time.timeval;
-
- begin
- gettimeofday (TV'Access);
- return C_Time.To_Duration (TV);
- end Clock;
-
- -----------------
- -- Timed_Delay --
- -----------------
-
- procedure Timed_Delay
- (Time : Duration;
- Mode : Integer)
- is
- Rel_Time : Duration;
- Abs_Time : Duration;
- Base_Time : constant Duration := Clock;
- Check_Time : Duration := Base_Time;
- timeval : aliased C_Time.timeval;
-
- begin
- if Mode = Relative then
- Rel_Time := Time;
- Abs_Time := Time + Check_Time;
- else
- Rel_Time := Time - Check_Time;
- Abs_Time := Time;
- end if;
-
- if Rel_Time > 0.0 then
- loop
- timeval := C_Time.To_Timeval (Rel_Time);
-
- C_select (timeout => timeval'Unchecked_Access);
- Check_Time := Clock;
-
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- Rel_Time := Abs_Time - Check_Time;
- end loop;
- end if;
- end Timed_Delay;
-
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize is
- begin
- null;
- end Initialize;
-
-end System.OS_Primitives;
diff --git a/gcc/ada/libgnat/s-osprim__x32.adb b/gcc/ada/libgnat/s-osprim__x32.adb
deleted file mode 100644
index 644c41c..0000000
--- a/gcc/ada/libgnat/s-osprim__x32.adb
+++ /dev/null
@@ -1,123 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . O S _ P R I M I T I V E S --
--- --
--- B o d y --
--- --
--- Copyright (C) 2013-2024, Free Software Foundation, Inc. --
--- --
--- GNARL 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/>. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This version is for Linux/x32
-
-with System.C_Time;
-
-package body System.OS_Primitives is
-
- -- ??? These definitions are duplicated from System.OS_Interface
- -- because we don't want to depend on any package. Consider removing
- -- these declarations in System.OS_Interface and move these ones in
- -- the spec.
-
- function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
- return Integer;
- pragma Import (C, nanosleep, "nanosleep");
-
- -----------
- -- Clock --
- -----------
-
- function Clock return Duration is
- TV : aliased C_Time.timeval;
- Result : Integer;
- pragma Unreferenced (Result);
-
- function gettimeofday
- (Tv : access C_Time.timeval;
- Tz : System.Address := System.Null_Address) return Integer;
- pragma Import (C, gettimeofday, "gettimeofday");
-
- begin
- -- The return codes for gettimeofday are as follows (from man pages):
- -- EPERM settimeofday is called by someone other than the superuser
- -- EINVAL Timezone (or something else) is invalid
- -- EFAULT One of tv or tz pointed outside accessible address space
-
- -- None of these codes signal a potential clock skew, hence the return
- -- value is never checked.
-
- Result := gettimeofday (TV'Access, System.Null_Address);
- return C_Time.To_Duration (TV);
- end Clock;
-
- -----------------
- -- Timed_Delay --
- -----------------
-
- procedure Timed_Delay
- (Time : Duration;
- Mode : Integer)
- is
- Request : aliased C_Time.timespec;
- Remaind : aliased C_Time.timespec;
- Rel_Time : Duration;
- Abs_Time : Duration;
- Base_Time : constant Duration := Clock;
- Check_Time : Duration := Base_Time;
-
- Result : Integer;
- pragma Unreferenced (Result);
-
- begin
- if Mode = Relative then
- Rel_Time := Time;
- Abs_Time := Time + Check_Time;
- else
- Rel_Time := Time - Check_Time;
- Abs_Time := Time;
- end if;
-
- if Rel_Time > 0.0 then
- loop
- Request := C_Time.To_Timespec (Rel_Time);
- Result := nanosleep (Request'Access, Remaind'Access);
- Check_Time := Clock;
-
- exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
- Rel_Time := Abs_Time - Check_Time;
- end loop;
- end if;
- end Timed_Delay;
-
- ----------------
- -- Initialize --
- ----------------
-
- procedure Initialize is
- begin
- null;
- end Initialize;
-
-end System.OS_Primitives;
--
2.39.2
[-- Attachment #9: 0008-Ada-import-nanosleep-from-System.OS_Primitives.Timed.patch --]
[-- Type: text/x-diff, Size: 2684 bytes --]
From 6f681ffcdf15932f73ceee7b695117dcd175aab6 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Wed, 3 Apr 2024 17:43:50 +0200
Subject: [PATCH v8 8/9] Ada: import nanosleep from
System.OS_Primitives.Timed_Delay [PR114065]
It improves readability to import this C function in the file where it
is actually used.
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/libgnat/s-optide.adb | 7 +++++++
gcc/ada/libgnat/s-osprim__posix.adb | 9 ---------
gcc/ada/libgnat/s-osprim__posix2008.adb | 8 --------
3 files changed, 7 insertions(+), 17 deletions(-)
diff --git a/gcc/ada/libgnat/s-optide.adb b/gcc/ada/libgnat/s-optide.adb
index e15493c..4ad16a2 100644
--- a/gcc/ada/libgnat/s-optide.adb
+++ b/gcc/ada/libgnat/s-optide.adb
@@ -36,6 +36,13 @@ procedure Timed_Delay
(Time : Duration;
Mode : Integer)
is
+
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer
+ with Import,
+ Convention => C,
+ External_Name => "nanosleep";
+
Request : aliased C_Time.timespec;
Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
diff --git a/gcc/ada/libgnat/s-osprim__posix.adb b/gcc/ada/libgnat/s-osprim__posix.adb
index bb9a28d..b331d5c 100644
--- a/gcc/ada/libgnat/s-osprim__posix.adb
+++ b/gcc/ada/libgnat/s-osprim__posix.adb
@@ -34,15 +34,6 @@ with System.C_Time;
package body System.OS_Primitives is
- -- ??? These definitions are duplicated from System.OS_Interface
- -- because we don't want to depend on any package. Consider removing
- -- these declarations in System.OS_Interface and move these ones in
- -- the spec.
-
- function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
- return Integer;
- pragma Import (C, nanosleep, "nanosleep");
-
-----------
-- Clock --
-----------
diff --git a/gcc/ada/libgnat/s-osprim__posix2008.adb b/gcc/ada/libgnat/s-osprim__posix2008.adb
index 377fb3a..7f44efa 100644
--- a/gcc/ada/libgnat/s-osprim__posix2008.adb
+++ b/gcc/ada/libgnat/s-osprim__posix2008.adb
@@ -39,14 +39,6 @@ package body System.OS_Primitives is
subtype int is System.CRTL.int;
- -- ??? These definitions are duplicated from System.OS_Interface because
- -- we don't want to depend on any package. Consider removing these
- -- declarations in System.OS_Interface and move these ones to the spec.
-
- function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
- return Integer;
- pragma Import (C, nanosleep, "nanosleep");
-
-----------
-- Clock --
-----------
--
2.39.2
[-- Attachment #10: 0009-Ada-select-64-bits-time-functions-from-GNU-libc-when.patch --]
[-- Type: text/x-diff, Size: 11147 bytes --]
From 0f2eba5fd9b6c5a0cd67f5cf6a13e5650ebe4514 Mon Sep 17 00:00:00 2001
From: Nicolas Boulenguez <nicolas@debian.org>
Date: Fri, 26 Apr 2024 20:08:21 +0200
Subject: [PATCH v8 9/9] Ada: select 64 bits time functions from GNU libc when
__USE_TIME_BITS64 [PR114065]
else Ada.Calendar returns random dates on system affected by the
Y2038 Glibc transition (pr114065).
PR ada/114065
Signed-off-by: Nicolas Boulenguez <nicolas@debian.org>
---
gcc/ada/libgnarl/a-exetim__posix.adb | 5 ++++-
gcc/ada/libgnarl/s-osinte__gnu.ads | 14 ++++++++++----
gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads | 14 ++++++++++----
gcc/ada/libgnarl/s-osinte__linux.ads | 10 +++++++---
gcc/ada/libgnat/g-spogwa.adb | 4 +++-
gcc/ada/libgnat/s-optide.adb | 3 ++-
gcc/ada/libgnat/s-osprim__posix.adb | 4 +++-
gcc/ada/libgnat/s-osprim__posix2008.adb | 3 ++-
gcc/ada/s-oscons-tmplt.c | 16 ++++++++++++++++
9 files changed, 57 insertions(+), 16 deletions(-)
diff --git a/gcc/ada/libgnarl/a-exetim__posix.adb b/gcc/ada/libgnarl/a-exetim__posix.adb
index db873fb..7fbd6c1 100644
--- a/gcc/ada/libgnarl/a-exetim__posix.adb
+++ b/gcc/ada/libgnarl/a-exetim__posix.adb
@@ -35,6 +35,7 @@ with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Unchecked_Conversion;
with System.C_Time;
+with System.OS_Constants;
with System.Tasking;
with System.OS_Interface; use System.OS_Interface;
with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
@@ -115,7 +116,9 @@ package body Ada.Execution_Time is
(clock_id : Interfaces.C.int;
tp : access System.C_Time.timespec)
return int;
- pragma Import (C, clock_gettime, "clock_gettime");
+ pragma Import (C, clock_gettime,
+ (if System.OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_gettime64" else "clock_gettime"));
-- Function from the POSIX.1b Realtime Extensions library
function pthread_getcpuclockid
diff --git a/gcc/ada/libgnarl/s-osinte__gnu.ads b/gcc/ada/libgnarl/s-osinte__gnu.ads
index b4597c5..90ef2d5 100644
--- a/gcc/ada/libgnarl/s-osinte__gnu.ads
+++ b/gcc/ada/libgnarl/s-osinte__gnu.ads
@@ -39,6 +39,7 @@
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Os_Constants;
with System.C_Time;
with Ada.Unchecked_Conversion;
@@ -208,7 +209,8 @@ package System.OS_Interface is
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
- pragma Import (C, nanosleep, "nanosleep");
+ pragma Import (C, nanosleep, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__nanosleep64" else "nanosleep"));
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
@@ -218,12 +220,14 @@ package System.OS_Interface is
(clock_id : clockid_t;
tp : access C_Time.timespec)
return int;
- pragma Import (C, clock_gettime, "clock_gettime");
+ pragma Import (C, clock_gettime, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_gettime64" else "clock_gettime"));
function clock_getres
(clock_id : clockid_t;
res : access C_Time.timespec) return int;
- pragma Import (C, clock_getres, "clock_getres");
+ pragma Import (C, clock_getres, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_getres64" else "clock_getres"));
-- From: /usr/include/unistd.h
function sysconf (name : int) return long;
@@ -477,7 +481,9 @@ package System.OS_Interface is
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access C_Time.timespec) return int;
- pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
+ pragma Import (C, pthread_cond_timedwait,
+ (if OS_Constants.Glibc_Use_Time_Bits64 then "__pthread_cond_timedwait64"
+ else "pthread_cond_timedwait"));
Relative_Timed_Wait : constant Boolean := False;
-- pthread_cond_timedwait requires an absolute delay time
diff --git a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads
index 9b40c9a..59e6f79 100644
--- a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads
+++ b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads
@@ -40,6 +40,7 @@
with Ada.Unchecked_Conversion;
with Interfaces.C;
+with System.OS_Constants;
with System.C_Time;
package System.OS_Interface is
@@ -203,7 +204,8 @@ package System.OS_Interface is
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
- pragma Import (C, nanosleep, "nanosleep");
+ pragma Import (C, nanosleep, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__nanosleep64" else "nanosleep"));
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
@@ -212,12 +214,14 @@ package System.OS_Interface is
(clock_id : clockid_t;
tp : access C_Time.timespec)
return int;
- pragma Import (C, clock_gettime, "clock_gettime");
+ pragma Import (C, clock_gettime, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_gettime64" else "clock_gettime");
function clock_getres
(clock_id : clockid_t;
res : access C_Time.timespec) return int;
- pragma Import (C, clock_getres, "clock_getres");
+ pragma Import (C, clock_getres, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_getres64" else "clock_getres");
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -420,7 +424,9 @@ package System.OS_Interface is
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access C_Time.timespec) return int;
- pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
+ pragma Import (C, pthread_cond_timedwait,
+ (if OS_Constants.Glibc_Use_Time_Bits64 then "__pthread_cond_timedwait64"
+ else "pthread_cond_timedwait");
--------------------------
-- POSIX.1c Section 13 --
diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads
index 9de227e..7a0d37d 100644
--- a/gcc/ada/libgnarl/s-osinte__linux.ads
+++ b/gcc/ada/libgnarl/s-osinte__linux.ads
@@ -229,12 +229,14 @@ package System.OS_Interface is
function clock_gettime
(clock_id : clockid_t; tp : access C_Time.timespec) return int;
- pragma Import (C, clock_gettime, "clock_gettime");
+ pragma Import (C, clock_gettime, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_gettime64" else "clock_gettime"));
function clock_getres
(clock_id : clockid_t;
res : access C_Time.timespec) return int;
- pragma Import (C, clock_getres, "clock_getres");
+ pragma Import (C, clock_getres, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__clock_getres64" else "clock_getres"));
function sysconf (name : int) return long;
pragma Import (C, sysconf);
@@ -445,7 +447,9 @@ package System.OS_Interface is
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access C_Time.timespec) return int;
- pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
+ pragma Import (C, pthread_cond_timedwait,
+ (if OS_Constants.Glibc_Use_Time_Bits64 then "__pthread_cond_timedwait64"
+ else "pthread_cond_timedwait"));
--------------------------
-- POSIX.1c Section 13 --
diff --git a/gcc/ada/libgnat/g-spogwa.adb b/gcc/ada/libgnat/g-spogwa.adb
index 530a6cd..598f3fc 100644
--- a/gcc/ada/libgnat/g-spogwa.adb
+++ b/gcc/ada/libgnat/g-spogwa.adb
@@ -42,7 +42,9 @@ is
writefds : access FD_Set_Type;
exceptfds : access FD_Set_Type;
timeout : access System.C_Time.timeval) return Integer
- with Import => True, Convention => Stdcall, External_Name => "select";
+ with Import => True, Convention => Stdcall,
+ External_Name => (if System.OS_Constants.Glibc_Use_Time_Bits64
+ then "__select64" else "select");
Timeout_V : aliased System.C_Time.timeval;
Timeout_A : access System.C_Time.timeval;
diff --git a/gcc/ada/libgnat/s-optide.adb b/gcc/ada/libgnat/s-optide.adb
index 4ad16a2..a9025d0 100644
--- a/gcc/ada/libgnat/s-optide.adb
+++ b/gcc/ada/libgnat/s-optide.adb
@@ -41,7 +41,8 @@ is
return Integer
with Import,
Convention => C,
- External_Name => "nanosleep";
+ External_Name => (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__nanosleep64" else "nanosleep");
Request : aliased C_Time.timespec;
Remaind : aliased C_Time.timespec;
diff --git a/gcc/ada/libgnat/s-osprim__posix.adb b/gcc/ada/libgnat/s-osprim__posix.adb
index b331d5c..f647968 100644
--- a/gcc/ada/libgnat/s-osprim__posix.adb
+++ b/gcc/ada/libgnat/s-osprim__posix.adb
@@ -31,6 +31,7 @@
-- This version is for POSIX-like operating systems
with System.C_Time;
+with System.OS_Constants;
package body System.OS_Primitives is
@@ -47,7 +48,8 @@ package body System.OS_Primitives is
function gettimeofday
(Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return Integer;
- pragma Import (C, gettimeofday, "gettimeofday");
+ pragma Import (C, gettimeofday, (if OS_Constants.Glibc_Use_Time_Bits64
+ then "__gettimeofday64" else "gettimeofday"));
begin
-- The return codes for gettimeofday are as follows (from man pages):
diff --git a/gcc/ada/libgnat/s-osprim__posix2008.adb b/gcc/ada/libgnat/s-osprim__posix2008.adb
index 7f44efa..0dbde83 100644
--- a/gcc/ada/libgnat/s-osprim__posix2008.adb
+++ b/gcc/ada/libgnat/s-osprim__posix2008.adb
@@ -54,7 +54,8 @@ package body System.OS_Primitives is
function clock_gettime
(clock_id : clockid_t;
tp : access C_Time.timespec) return int;
- pragma Import (C, clock_gettime, "clock_gettime");
+ pragma Import (C, clock_gettime, (if OS_Constants.Glibc_Use_Time_Bits64
+ thon "__clock_gettime64" else "clock_gettime"));
begin
Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 5beb929..8551d78 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -1775,6 +1775,22 @@ CNS(MAX_tv_sec, "")
CND(SIZEOF_tv_nsec, "tv_nsec, long except on x32");
}
+/*
+
+ -- Functions with time_t suseconds_t timeval timespec parameters like
+ -- clock_get{res,time} gettimeofday nanosleep
+ -- pthread_cond_{,timed}wait select
+ -- must be imported from the GNU C library with
+ -- External_Name => (if Glibc_Use_Time_Bits64 then "__foo64" else "foo")
+ -- The test is safe in files that do not require GNU specifically.
+
+*/
+#ifdef __USE_TIME_BITS64
+ C("Glibc_Use_Time_Bits64", Boolean, "True", "Y2038 Glibc transition")
+#else
+ C("Glibc_Use_Time_Bits64", Boolean, "False", "Y2038 Glibc transition")
+#endif
+
/*
-- Sizes of various data types
--
2.39.2
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [PATCH v8] ada: fix timeval timespec on 32 bits archs with 64 bits time_t [PR114065]
2024-05-04 15:41 [PATCH v8] ada: fix timeval timespec on 32 bits archs with 64 bits time_t [PR114065] Nicolas Boulenguez
@ 2024-05-15 14:29 ` Arnaud Charlet
0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2024-05-15 14:29 UTC (permalink / raw)
To: Nicolas Boulenguez; +Cc: gcc-patches
Nicolas,
Thank you for such a large and delicate change!
This looks generally good, except for the first parts: we cannot change documented/user
packages, meaning that GNAT.Calendar, System.OS_Lib (via the documented GNAT.OS_Lib) and
Ada.Calendar.Conversion cannot be changed: we need to keep the current interface or else existing user code will break.
Arno
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2024-05-15 14:29 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-05-04 15:41 [PATCH v8] ada: fix timeval timespec on 32 bits archs with 64 bits time_t [PR114065] Nicolas Boulenguez
2024-05-15 14:29 ` Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).