g-busorg$(objext) \
g-byorma$(objext) \
g-bytswa$(objext) \
- g-c_time$(objext) \
g-calend$(objext) \
g-casuti$(objext) \
g-catiio$(objext) \
s-boarop$(objext) \
s-boustr$(objext) \
s-bytswa$(objext) \
- s-c_time$(objext) \
s-carsi8$(objext) \
s-carun8$(objext) \
s-casi16$(objext) \
s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
s-intman.adb<libgnarl/s-intman__android.adb \
s-osinte.ads<libgnarl/s-osinte__android.ads \
+ s-osinte.adb<libgnarl/s-osinte__android.adb \
s-oslock.ads<libgnat/s-oslock__posix.ads \
s-osprim.adb<libgnat/s-osprim__posix.adb \
s-parame.adb<libgnat/s-parame__aarch64-linux.adb \
s-osinte.adb<libgnarl/s-osinte__solaris.adb \
s-osinte.ads<libgnarl/s-osinte__solaris.ads \
s-oslock.ads<libgnat/s-oslock__solaris.ads \
- s-osprim.adb<libgnat/s-osprim__unix.adb \
+ s-osprim.adb<libgnat/s-osprim__solaris.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 \
s-osinte.adb<libgnarl/s-osinte__solaris.adb \
s-osinte.ads<libgnarl/s-osinte__solaris.ads \
s-oslock.ads<libgnat/s-oslock__solaris.ads \
- s-osprim.adb<libgnat/s-osprim__unix.adb \
+ s-osprim.adb<libgnat/s-osprim__solaris.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 \
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
s-oslock.ads<libgnat/s-oslock__posix.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 \
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 \
s-oslock.ads<libgnat/s-oslock__posix.ads \
- s-osprim.adb<libgnat/s-osprim__posix.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 \
# 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 \
- cio.o cstreams.o ctrl_c.o \
+ cal.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 \
--- /dev/null
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * C A L *
+ * *
+ * C Implementation File *
+ * *
+ * Copyright (C) 1992-2025, 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;
+}
General routines for swapping the bytes in 2-, 4-, and 8-byte quantities.
Machine-specific implementations are available in some cases.
-.. _`GNAT.C_Time_(g-c_time.ads)`:
-
-``GNAT.C_Time`` (:file:`g-c_time.ads`)
-======================================
-
-.. index:: GNAT.C_Time (g-c_time.ads)
-
-.. index:: Time
-
-Provides the time_t, timeval and timespec types corresponding to the C
-types defined by the OS, as well as various conversion functions.
-
.. _`GNAT.Calendar_(g-calend.ads)`:
``GNAT.Calendar`` (:file:`g-calend.ads`)
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)`:
("g-busorg", F), -- GNAT.Bubble_Sort_G
("g-byorma", F), -- GNAT.Byte_Order_Mark
("g-bytswa", F), -- GNAT.Byte_Swapping
- ("g-c_time", F), -- GNAT.C_Time
("g-calend", F), -- GNAT.Calendar
("g-catiio", F), -- GNAT.Calendar.Time_IO
("g-casuti", F), -- GNAT.Case_Util
with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Unchecked_Conversion;
-with System.C_Time;
-with System.OS_Interface; use System.OS_Interface;
with System.Tasking;
+with System.OS_Interface; use System.OS_Interface;
with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
with Interfaces.C; use Interfaces.C;
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task) return CPU_Time
is
- TS : aliased System.C_Time.timespec;
+ TS : aliased timespec;
Clock_Id : aliased Interfaces.C.int;
Result : Interfaces.C.int;
function clock_gettime
(clock_id : Interfaces.C.int;
- tp : access System.C_Time.timespec)
+ tp : access timespec)
return Interfaces.C.int;
pragma Import (C, clock_gettime, "clock_gettime");
-- Function from the POSIX.1b Realtime Extensions library
(clock_id => Clock_Id, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_CPU_Time (System.C_Time.To_Duration (TS));
+ return To_CPU_Time (To_Duration (TS));
end Clock;
--------------------------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- struct_sigaction offsets
- sa_handler_pos : constant := Interfaces.C.int'Size / 8;
- sa_mask_pos : constant := Interfaces.C.int'Size / 8 +
+ sa_handler_pos : constant := int'Size / 8;
+ sa_mask_pos : constant := int'Size / 8 +
Standard'Address_Size / 8;
sa_flags_pos : constant := 0;
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
-- struct_sigaction offsets
sa_handler_pos : constant := 0;
- sa_mask_pos : constant := Interfaces.C.long'Size / 8;
- sa_flags_pos : constant := Interfaces.C.long'Size / 8 + 128;
+ sa_mask_pos : constant := long'Size / 8;
+ sa_flags_pos : constant := long'Size / 8 + 128;
SA_SIGINFO : constant := 16#04#;
SA_ONSTACK : constant := 16#08000000#;
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
+with System.Parameters;
package System.Linux is
pragma Preelaborate;
-- 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 --
-----------
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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-2025, 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;
+
+with System.Parameters;
+
+package System.Linux is
+ pragma Preelaborate;
+
+ ----------
+ -- 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 --
+ -----------
+
+ 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;
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 --
------------------------
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 --
-----------------
with Interfaces.C;
with Interfaces.C.Extensions;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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 C_Time.timespec) return int;
+ tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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;
------------------------------------------------------------------------------
-- --
--- GNAT RUN-TIME COMPONENTS --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
--- G N A T . C _ T I M E --
+-- S Y S T E M . O S _ I N T E R F A C E --
-- --
--- S p e c --
+-- B o d y --
-- --
--- Copyright (C) 2025, AdaCore --
+-- Copyright (C) 1995-2025, 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- --
-- 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. --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
--- This package provides the time_t, timeval and timespec types corresponding
--- to the C types defined by the OS, as well as various conversion functions.
+-- This is an Android version of this package.
--- See file s-c_time.ads for full documentation of the interface
+-- This package encapsulates all direct interfaces to OS services
+-- that are needed by children of System.
-with System.C_Time;
-package GNAT.C_Time renames System.C_Time;
+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;
with Interfaces.C;
-with System.C_Time;
with System.Linux;
with System.OS_Constants;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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 C_Time.timespec) return int;
+ (clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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
with Interfaces;
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
+ type timespec is private;
+
+ function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec)
+ tp : access 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;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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_mutexattr_t is new System.Address;
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 --
------------------------
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 C_Time.timespec) return int
+ tp : access timespec) return int
is
pragma Unreferenced (clock_id);
use Interfaces;
- TV : aliased C_Time.timeval;
+ 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;
Result : int;
function gettimeofday
- (Tv : access C_Time.timeval;
+ (Tv : access 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);
- tp.all := C_Time.To_Timespec (TV);
+ timeval_to_duration (TV'Access, sec'Access, usec'Access);
+ tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro);
return Result;
end clock_gettime;
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int
+ res : access 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;
begin
nsec := clock_get_res;
- res.all := C_Time.Nanoseconds_To_Timespec (nsec);
+ res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano);
if nsec > 0 then
Result := 0;
with Interfaces.C;
-with System.C_Time;
with System.OS_Constants;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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 C_Time.timespec) return int;
+ tp : access timespec) return int;
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ 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);
-------------------------
-- Priority Scheduling --
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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
--
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 --
------------------------
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;
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
+ type timespec is private;
+
+ function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new unsigned_long;
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec)
+ tp : access 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;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
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_mutexattr_t is new System.Address;
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 --
------------------------
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;
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
+ type timespec is private;
+
+ function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec)
+ tp : access 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;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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_mutexattr_t is new System.Address;
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 --
------------------------
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;
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
+ type timespec is private;
+
+ function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
-- From: /usr/include/time.h
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec)
+ tp : access timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
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...
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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 C_Time.timespec) return int;
+ tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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;
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
Time_Slice_Supported : constant Boolean := True;
-- Indicates whether time slicing is supported (i.e SCHED_RR is supported)
- function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
+ type timespec is private;
+
+ function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec)
+ tp : access timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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;
with Interfaces.C;
-with System.C_Time;
with System.Linux;
with System.OS_Constants;
with System.OS_Locks;
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;
-- 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 C_Time.timespec) return int;
+ (clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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 --
------------------------
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 --
-------------
with Interfaces.C;
-with System.C_Time;
with System.Multiprocessors;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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 C_Time.timespec) return int;
+ tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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;
pragma Convention (C, struct_timezone);
type struct_timezone_ptr is access all struct_timezone;
+ type struct_timeval is private;
+
-------------------------
-- Priority Scheduling --
-------------------------
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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;
-- that are needed by children of System.
with Interfaces.C; use Interfaces.C;
-
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 --
------------------------
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;
-- that are needed by children of System.
with Interfaces.C; use Interfaces.C;
-
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 --
------------------------
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;
with Interfaces.C;
-with System.C_Time;
with System.OS_Constants;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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 C_Time.timespec) return int;
+ (clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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 --
-------------------------
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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
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 --
------------------------
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 --
-----------------------------
with Interfaces.C;
-with System.C_Time;
with System.OS_Constants;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
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;
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec) return int;
+ tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access C_Time.timespec) return int;
+ res : access 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 --
-------------------------
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
type struct_sched_param is record
sched_priority : int;
ss_low_priority : int;
- ss_replenish_period : C_Time.timespec;
- ss_initial_budget : C_Time.timespec;
+ ss_replenish_period : timespec;
+ ss_initial_budget : timespec;
sched_ss_max_repl : int;
end record;
pragma Convention (C, struct_sched_param);
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;
-- 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 --
------------------
with Interfaces.C;
-with System.C_Time;
with System.OS_Locks;
+with System.Parameters;
package System.OS_Interface is
pragma Preelaborate;
-- Time --
----------
+ type timespec is private;
+
type clockid_t is new int;
function clock_gettime
- (clock_id : clockid_t; tp : access C_Time.timespec) return int;
+ (clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
- (clock_id : clockid_t; res : access C_Time.timespec) return int;
+ (clock_id : clockid_t; res : access 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);
function cond_timedwait
(cond : access cond_t;
mutex : access mutex_t;
- abstime : access C_Time.timespec) return int;
+ abstime : access timespec) return int;
pragma Import (C, cond_timedwait, "cond_timedwait");
function cond_signal (cond : access cond_t) return int;
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;
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 --
-------------------------
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;
-- 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 C_Time.timespec) return int;
+ (clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
----------------------
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-with Interfaces.C;
+with Interfaces.C; use Interfaces.C;
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 --
------------------------
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;
with Interfaces.C;
+with System.Parameters;
+
package System.QNX is
pragma Preelaborate;
-- 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 --
-----------
with Interfaces.C;
-with System.C_Time;
with System.Interrupt_Management;
with System.Multiprocessors;
with System.OS_Constants;
---------------------
function Monotonic_Clock return Duration is
- TS : aliased C_Time.timespec;
+ TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return C_Time.To_Duration (TS);
+ return To_Duration (TS);
end Monotonic_Clock;
-------------------
-------------------
function RT_Resolution return Duration is
- TS : aliased C_Time.timespec;
+ TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return C_Time.To_Duration (TS);
+ return To_Duration (TS);
end RT_Resolution;
-----------
Base_Time : constant Duration := Monotonic_Clock;
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
- Request : aliased C_Time.timespec;
+ Request : aliased timespec;
Result : Interfaces.C.int;
begin
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := C_Time.To_Timespec (Abs_Time);
+ Request := To_Timespec (Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
Base_Time : constant Duration := Monotonic_Clock;
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
- Request : aliased C_Time.timespec;
+ Request : aliased timespec;
Result : Interfaces.C.int;
Yielded : Boolean := False;
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := C_Time.To_Timespec (Abs_Time);
+ Request := To_Timespec (Abs_Time);
Self_ID.Common.State := Delay_Sleep;
pragma Assert (Check_Sleep (Delay_Sleep));
with Interfaces.C;
-with System.C_Time;
with System.Float_Control;
with System.Interrupt_Management;
with System.Multiprocessors;
---------------------
function Monotonic_Clock return Duration is
- TS : aliased C_Time.timespec;
+ TS : aliased timespec;
Result : int;
begin
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return C_Time.To_Duration (TS);
+ return To_Duration (TS);
end Monotonic_Clock;
-------------------
-- 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
---------------------
function Monotonic_Clock return Duration is
- TS : aliased C_Time.timespec;
+ TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
- return C_Time.To_Duration (TS);
+ return To_Duration (TS);
end Monotonic_Clock;
-------------------
-------------------
function RT_Resolution return Duration is
- TS : aliased C_Time.timespec;
+ TS : aliased timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return C_Time.To_Duration (TS);
+ return To_Duration (TS);
end RT_Resolution;
----------------------
Abs_Time : Duration;
P_Abs_Time : Duration;
- Request : aliased C_Time.timespec;
+ Request : aliased timespec;
Result : Interfaces.C.int;
Exit_Outer : Boolean := False;
end if;
pragma Warnings (On);
- Request := C_Time.To_Timespec (P_Abs_Time);
+ Request := To_Timespec (P_Abs_Time);
Inner : loop
exit Outer
Check_Time : Duration;
Abs_Time : Duration;
P_Abs_Time : Duration;
- Request : aliased C_Time.timespec;
+ Request : aliased timespec;
Result : Interfaces.C.int;
Exit_Outer : Boolean := False;
end if;
pragma Warnings (On);
- Request := C_Time.To_Timespec (P_Abs_Time);
+ Request := To_Timespec (P_Abs_Time);
Inner : loop
exit Outer
-- --
------------------------------------------------------------------------------
+with Interfaces.C.Extensions;
+
package body GNAT.Calendar is
use Ada.Calendar;
+ use Interfaces;
-----------------
-- Day_In_Year --
-----------------
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;
+
+ pragma Unsuppress (Overflow_Check);
+
begin
- return System.C_Time.To_Duration (T.all);
+ 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;
----------------
----------------
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;
+
+ pragma Unsuppress (Overflow_Check);
+
begin
- return System.C_Time.To_Timeval (D);
+ if D = 0.0 then
+ sec := 0;
+ usec := 0;
+
+ elsif D < 0.0 then
+ sec := C.Extensions.long_long (D + 0.5);
+ if D = Duration (sec) then
+ usec := 0;
+ else
+ usec := C.long ((D - Duration (sec)) * Micro + 0.5);
+ end if;
+
+ else
+ sec := C.Extensions.long_long (D - 0.5);
+ if D = Duration (sec) then
+ usec := 0;
+ else
+ usec := C.long ((D - Duration (sec)) * Micro - 0.5);
+ end if;
+ end if;
+
+ duration_to_timeval (sec, usec, Result'Access);
+
+ return Result;
end To_Timeval;
------------------
-- Day_Of_Week, Day_In_Year and Week_In_Year.
with Ada.Calendar.Formatting;
-
-with System.C_Time;
+with Interfaces.C;
package GNAT.Calendar is
-- locale (equivalent to Clock). Due to this simplified behavior, the
-- implementation does not require expensive system calls on targets such
-- as Windows.
- -- WARNING: Time_At_Locale is no longer aware of historic events and may
+ -- WARNING: Split_At_Locale is no longer aware of historic events and may
-- produce inaccurate results over DST changes which occurred in the past.
function Week_In_Year (Date : Ada.Calendar.Time) return Week_In_Year_Number;
-- Return the week number as defined in ISO 8601 along with the year in
-- which the week occurs.
- subtype timeval is System.C_Time.timeval;
- pragma Obsolescent (timeval, "use type from GNAT.C_Time instead");
+ -- C timeval conversion
- function To_Duration (T : not null access timeval) return Duration;
- pragma Inline (To_Duration);
- pragma Obsolescent (To_Duration, "use function from GNAT.C_Time instead");
+ -- 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;
- pragma Inline (To_Timeval);
- pragma Obsolescent (To_Timeval, "use function from GNAT.C_Time instead");
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;
with System; use System;
with System.Communication; use System.Communication;
with System.CRTL; use System.CRTL;
-with System.C_Time;
with System.Task_Lock;
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)
Res : C.int;
Last : C.int;
RSig : Socket_Type := No_Socket;
- TVal : aliased System.C_Time.timeval;
+ TVal : aliased Timeval;
TPtr : Timeval_Access;
begin
if Timeout = Forever then
TPtr := null;
else
- TVal := System.C_Time.To_Timeval (Timeout);
+ TVal := To_Timeval (Timeout);
TPtr := TVal'Unchecked_Access;
end if;
U4 : aliased C.unsigned;
V1 : aliased C.unsigned_char;
VS : aliased C.char_array (1 .. NS); -- for devices name
- VT : aliased System.C_Time.timeval;
+ VT : aliased Timeval;
Len : aliased C.int;
Add : System.Address;
Res : C.int;
Opt.Timeout := Duration (U4) / 1000;
end if;
- elsif System.C_Time.In_Timeval_Duration (VT) then
- Opt.Timeout := System.C_Time.To_Duration (VT);
else
- Opt.Timeout := Forever;
+ Opt.Timeout := To_Duration (VT);
end if;
when Bind_To_Device =>
(1 .. (if Option.Name = Bind_To_Device
then C.size_t (ASU.Length (Option.Device) + 1)
else 0));
- VT : aliased System.C_Time.timeval;
+ VT : aliased Timeval;
Len : C.int;
Add : System.Address := Null_Address;
Res : C.int;
end if;
else
- VT := System.C_Time.To_Timeval (Option.Timeout);
+ VT := To_Timeval (Option.Timeout);
Len := VT'Size / 8;
Add := VT'Address;
end if;
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 --
-------------------
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);
+ if Val = Timeval_Duration (S) then
+ uS := 0;
+ else
+ uS := suseconds_t ((Val - Timeval_Duration (S)) * 1_000_000 - 0.5);
+ end if;
+ end if;
+
+ return (S, uS);
+ end To_Timeval;
+
-----------
-- Value --
-----------
with Interfaces.C; use Interfaces.C;
-with System.C_Time;
-
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : aliased Fd_Set;
declare -- unreachable if Thread_Blocking_IO is statically True
pragma Warnings (On, "unreachable code");
WSet : aliased Fd_Set;
- Now : aliased System.C_Time.timeval;
+ Now : aliased Timeval;
begin
Reset_Socket_Set (WSet'Access);
with Interfaces.C; use Interfaces.C;
-with System.C_Time;
-
package body GNAT.Sockets.Thin is
Non_Blocking_Sockets : aliased Fd_Set;
declare -- unreachable if Thread_Blocking_IO is statically True
pragma Warnings (On, "unreachable code");
WSet : aliased Fd_Set;
- Now : aliased System.C_Time.timeval;
+ Now : aliased Timeval;
begin
Reset_Socket_Set (WSet'Access);
loop
-- This package should not be directly with'ed by an applications program.
with Ada.Unchecked_Conversion;
-
with Interfaces.C.Strings;
-
-with System.C_Time;
+with System.Parameters;
package GNAT.Sockets.Thin_Common is
Success : constant C.int := 0;
Failure : constant C.int := -1;
- subtype time_t is System.C_Time.time_t;
- pragma Obsolescent (time_t, "use type from GNAT.C_Time instead");
-
- subtype suseconds_t is System.C_Time.usec_t;
- pragma Obsolescent (suseconds_t, "use type from GNAT.C_Time instead");
-
- subtype timeval is System.C_Time.timeval;
- pragma Obsolescent (timeval, "use type from GNAT.C_Time instead");
+ 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 System.C_Time.timeval;
+ type Timeval_Access is access all 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 System.C_Time.timeval
- := System.C_Time.Milliseconds_To_Timeval (0);
+ Immediat : constant Timeval := (0, 0);
-------------------------------------------
-- Mapping tables to low level constants --
-- --
------------------------------------------------------------------------------
-with System.C_Time;
+with GNAT.Sockets.Thin_Common;
procedure GNAT.Sockets.Poll.G_Wait
(Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
readfds : access FD_Set_Type;
writefds : access FD_Set_Type;
exceptfds : access FD_Set_Type;
- timeout : access System.C_Time.timeval) return Integer
+ timeout : access Thin_Common.Timeval) return Integer
with Import => True, Convention => Stdcall, External_Name => "select";
- Timeout_V : aliased System.C_Time.timeval;
- Timeout_A : access System.C_Time.timeval;
+ Timeout_V : aliased Thin_Common.Timeval;
+ Timeout_A : access Thin_Common.Timeval;
Rfds : aliased FD_Set_Type;
Rcount : Natural := 0;
if Timeout >= 0 then
Timeout_A := Timeout_V'Access;
- Timeout_V := System.C_Time.Milliseconds_To_Timeval (Timeout);
+ Timeout_V.Tv_Sec := Thin_Common.time_t (Timeout / 1000);
+ Timeout_V.Tv_Usec := Thin_Common.suseconds_t (Timeout rem 1000 * 1000);
end if;
Reset_Socket_Set (Rfds);
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- S Y S T E M . C _ T I M E --
--- --
--- B o d y --
--- --
--- Copyright (C) 2025, 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. --
--- --
-------------------------------------------------------------------------------
-
-package body System.C_Time is
-
- -- Two Duration representations are described in targparm.ads:
- -- Size Small Last = (2**(Size - 1) - 1) * Small
- -- 32 0.02 42_949_672.94
- -- 64 0.000_000_001 9_223_372_036.854_775_807
-
- Recip : constant := (if Duration'Size = 32 then 50 else 1_000_000_000);
- -- The reciprocal of the Small used to write "* Small" as "/ Recip"
-
- Milli : constant := 1_000;
- Micro : constant := 1_000_000;
- Nano : constant := 1_000_000_000;
- -- The standard divisors
-
- pragma Unsuppress (Overflow_Check);
- -- Overflow may occur during the various conversions
-
- -------------------------
- -- In_Timeval_Duration --
- -------------------------
-
- -- Immediate : constant Duration := 0.0;
-
- -- Forever : constant Duration :=
- -- Duration'Min (Duration'Last, 1.0 * OS_Constants.MAX_tv_sec);
-
- -- subtype Timeval_Duration is Duration range Immediate .. Forever;
-
- function In_Timeval_Duration (T : timeval) return Boolean is
- Max_Dur : constant := 2**(Duration'Size - 1) - 1;
- Max_Sec : constant := Max_Dur / Recip;
- Max_Usec : constant := (Max_Dur mod Recip) * Micro / Recip;
-
- -- When Duration'Size = 64 and time_t'Size = 32, the compiler
- -- complains that Max_Sec does not fit in time_t, hence cannot
- -- be compared with T.tv_sec.
- Safe_Max_Sec : constant :=
- (if Max_Sec > time_t'Last then time_t'Last else Max_Sec);
- Safe_Max_Usec : constant :=
- (if Max_Sec > time_t'Last then usec_t'Last else Max_Usec);
-
- begin
- pragma Warnings (Off, "condition is always");
- return T.tv_sec >= 0
- and then (T.tv_sec > 0 or else T.tv_usec >= 0)
- and then T.tv_sec <= Safe_Max_Sec
- and then (T.tv_sec < Safe_Max_Sec or else T.tv_usec <= Safe_Max_Usec)
- and then T.tv_sec <= OS_Constants.MAX_tv_sec
- and then (T.tv_sec < OS_Constants.MAX_tv_sec or else T.tv_usec = 0);
- pragma Warnings (On, "condition is always");
- end In_Timeval_Duration;
-
- -----------------------------
- -- Milliseconds_To_Timeval --
- -----------------------------
-
- function Milliseconds_To_Timeval (M : Interfaces.C.int) return timeval is
- use Interfaces.C;
- Q : constant int := M / Milli;
- R : constant int := M rem Milli;
-
- begin
- return (tv_sec => time_t (Q), tv_usec => usec_t (R) * (Micro / Milli));
- end Milliseconds_To_Timeval;
-
- -----------------------------
- -- Nanoseconds_To_Timespec --
- -----------------------------
-
- function Nanoseconds_To_Timespec (N : Interfaces.C.int) return timespec is
- use Interfaces.C;
- Q : constant int := N / Nano;
- R : constant int := N rem Nano;
-
- begin
- return (tv_sec => time_t (Q), tv_nsec => nsec_t (R));
- end Nanoseconds_To_Timespec;
-
- -----------------
- -- To_Duration --
- -----------------
-
- -- Duration (tv_usec) is OK even when Duration'Size = 32, see above
-
- function To_Duration (T : timeval) return Duration is
- begin
- return Duration (T.tv_sec) + Duration (T.tv_usec) / Micro;
- end To_Duration;
-
- -- Duration (tv_nsec) overflows when Duration'Size = 32, see above.
- -- Scale down nanoseconds by the value of the Small in nanoseconds.
-
- function To_Duration (T : timespec) return Duration is
- S : constant := Nano / Recip;
-
- begin
- return Duration (T.tv_sec) + Duration (T.tv_nsec / S) / (Nano / S);
- end To_Duration;
-
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (T : timeval) return timespec is
- begin
- return (tv_sec => T.tv_sec, tv_nsec => nsec_t (T.tv_usec) * Milli);
- end To_Timespec;
-
- function To_Timespec (D : Duration) return timespec is
- tv_sec : time_t;
- tv_nsec : nsec_t;
-
- begin
- if D = 0.0 then
- tv_sec := 0;
- tv_nsec := 0;
-
- elsif D < 0.0 then
- tv_sec := time_t (D + 0.5);
- if D = Duration (tv_sec) then
- tv_nsec := 0;
- else
- tv_nsec := nsec_t ((D - Duration (tv_sec)) * Nano + 0.5);
- end if;
-
- else
- tv_sec := time_t (D - 0.5);
- if D = Duration (tv_sec) then
- tv_nsec := 0;
- else
- tv_nsec := nsec_t ((D - Duration (tv_sec)) * Nano - 0.5);
- end if;
- end if;
-
- return (tv_sec, tv_nsec);
- end To_Timespec;
-
- -----------------
- -- To_Timeval --
- -----------------
-
- function To_Timeval (D : Duration) return timeval is
- tv_sec : time_t;
- tv_usec : usec_t;
-
- begin
- if D = 0.0 then
- tv_sec := 0;
- tv_usec := 0;
-
- elsif D < 0.0 then
- tv_sec := time_t (D + 0.5);
- if D = Duration (tv_sec) then
- tv_usec := 0;
- else
- tv_usec := usec_t ((D - Duration (tv_sec)) * Micro + 0.5);
- end if;
-
- else
- tv_sec := time_t (D - 0.5);
- if D = Duration (tv_sec) then
- tv_usec := 0;
- else
- tv_usec := usec_t ((D - Duration (tv_sec)) * Micro - 0.5);
- end if;
- end if;
-
- return (tv_sec, tv_usec);
- end To_Timeval;
-
-end System.C_Time;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- S Y S T E M . C _ T I M E --
--- --
--- S p e c --
--- --
--- Copyright (C) 2025, 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 package provides the time_t, timeval and timespec types corresponding
--- to the C types defined by the OS, as well as various conversion functions.
-
-with Interfaces.C;
-
-with System.OS_Constants;
-
-package System.C_Time
- with Pure
-is
- -- These two C structs represent durations with different accuracies and
- -- maximal values.
-
- 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 timeval is record
- tv_sec : time_t; -- seconds
- tv_usec : usec_t; -- microseconds
- end record
- with Convention => C;
-
- 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 timespec is record
- tv_sec : time_t; -- seconds
- tv_nsec : nsec_t; -- nanoseconds
- end record
- with Convention => C;
-
- -- All conversion functions truncate the result if it is inexact
-
- function To_Duration (T : timespec) return Duration with Inline;
- function To_Duration (T : timeval) return Duration with Inline;
-
- function To_Timespec (D : Duration) return timespec with Inline;
- function To_Timeval (D : Duration) return timeval with Inline;
-
- function In_Timeval_Duration (T : timeval) return Boolean with Inline;
- -- g-socket.adb if not Windows target
-
- function Milliseconds_To_Timeval (M : Interfaces.C.int) return timeval
- with Inline;
- -- g-sothco.ads
- -- g-spogwa.adb
-
- function Nanoseconds_To_Timespec (N : Interfaces.C.int) return timespec
- with Inline;
- function To_Timespec (T : timeval) return timespec with Inline;
- -- s-osinte__darwin.adb
-
-end System.C_Time;
(Time : Duration;
Mode : Integer)
is
-
- function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
- return Integer;
- pragma Import (C, nanosleep, "nanosleep");
-
- Request : aliased C_Time.timespec;
- Remaind : aliased C_Time.timespec;
+ Request : aliased timespec;
+ Remaind : aliased timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
end if;
pragma Warnings (On);
- Request := C_Time.To_Timespec (Time_Chunk);
+ Request := To_Timespec (Time_Chunk);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
-- To_Ada --
------------
- function To_Ada (Time : Long_Long_Integer) return OS_Time is
+ function To_Ada (Time : time_t) return OS_Time is
begin
return OS_Time (Time);
end To_Ada;
-- To_C --
----------
- function To_C (Time : OS_Time) return Long_Long_Integer is
+ function To_C (Time : OS_Time) return time_t is
begin
- return Long_Long_Integer (Time);
+ return time_t (Time);
end To_C;
------------------
-- these have Intrinsic convention, so for example it is not permissible
-- to create accesses to any of these functions.
- function To_Ada (Time : Long_Long_Integer) return OS_Time;
- -- Convert Long_Long_Integer to OS_Time
-
- function To_C (Time : OS_Time) return Long_Long_Integer;
- -- Convert OS_Time to Long_Long_Integer
-
subtype Year_Type is Integer range 1900 .. 2099;
subtype Month_Type is Integer range 1 .. 12;
subtype Day_Type is Integer range 1 .. 31;
-- component parts to be interpreted in the local time zone, and returns
-- an OS_Time. Returns Invalid_Time if the creation fails.
+ ------------------
+ -- 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;
+ -- Convert C time_t type to OS_Time
+
----------------
-- File Stuff --
----------------
pragma Import (Intrinsic, ">");
pragma Import (Intrinsic, "<=");
pragma Import (Intrinsic, ">=");
- pragma Inline (To_Ada);
pragma Inline (To_C);
+ pragma Inline (To_Ada);
type Process_Id is new Integer;
Invalid_Pid : constant Process_Id := -1;
-- --
------------------------------------------------------------------------------
--- This version is for Darwin
-
-with System.C_Time;
+-- This version is for darwin
+with System.Parameters;
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
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 C_Time.timeval;
+ (tv : not null access struct_timeval;
tz : struct_timezone_ptr) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
- function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
- return Integer;
+ 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;
pragma Import (C, nanosleep, "nanosleep");
-----------
-----------
function Clock return Duration is
- TV : aliased C_Time.timeval;
+ TV : aliased struct_timeval;
Result : Integer;
pragma Unreferenced (Result);
-- value is never checked.
Result := gettimeofday (TV'Access, null);
- return C_Time.To_Duration (TV);
+ return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
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 --
-----------------
(Time : Duration;
Mode : Integer)
is
- Request : aliased C_Time.timespec;
- Remaind : aliased C_Time.timespec;
+ Request : aliased timespec;
+ Remaind : aliased timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
if Rel_Time > 0.0 then
loop
- Request := C_Time.To_Timespec (Rel_Time);
+ Request := To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
------------------------------------------------------------------------------
-- This version is for POSIX-like operating systems
-
-with System.C_Time;
+with System.Parameters;
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 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;
+ pragma Import (C, nanosleep, "nanosleep");
+
-----------
-- Clock --
-----------
function Clock return Duration is
- TV : aliased C_Time.timeval;
+ 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;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access C_Time.timeval;
+ (Tv : access timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- return C_Time.To_Duration (TV);
+ timeval_to_duration (TV'Access, sec'Access, usec'Access);
+ return Duration (sec) + Duration (usec) / Micro;
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 --
-----------------
-- This version is for POSIX.1-2008-like operating systems
with System.CRTL;
-with System.C_Time;
with System.OS_Constants;
-
+with System.Parameters;
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.
+
+ 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;
+ pragma Import (C, nanosleep, "nanosleep");
+
-----------
-- Clock --
-----------
function Clock return Duration is
- TS : aliased C_Time.timespec;
+ TS : aliased timespec;
Result : int;
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access C_Time.timespec) return int;
+ tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
begin
Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return C_Time.To_Duration (TS);
+ return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
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 --
-----------------
-- This version is for POSIX-like operating systems
-with System.C_Time;
-
+with System.Parameters;
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
-- 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;
+ 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;
pragma Import (C, nanosleep, "nanosleep");
-----------
-----------
function Clock return Duration is
- TV : aliased C_Time.timeval;
+
+ 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;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access C_Time.timeval;
+ (Tv : access timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- return C_Time.To_Duration (TV);
+ timeval_to_duration (TV'Access, sec'Access, usec'Access);
+ return Duration (sec) + Duration (usec) / Micro;
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 --
-----------------
(Time : Duration;
Mode : Integer)
is
- Request : aliased C_Time.timespec;
- Remaind : aliased C_Time.timespec;
+ Request : aliased timespec;
+ Remaind : aliased timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
if Rel_Time > 0.0 then
loop
- Request := C_Time.To_Timespec (Rel_Time);
+ Request := To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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-2025, 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).
+
+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_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;
+ 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 struct_timeval);
+ pragma Import (C, C_select, "select");
+
+ -----------
+ -- Clock --
+ -----------
+
+ function Clock return Duration is
+ TV : aliased struct_timeval;
+
+ begin
+ gettimeofday (TV'Access);
+ return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
+ 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 struct_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.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);
+
+ 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;
------------------------------------------------------------------------------
-- This version uses gettimeofday and select
--- This file is suitable for Dec Unix, SCO UnixWare and Sun Solaris.
-
-with System.C_Time;
+-- This file is suitable for OpenNT, Dec Unix and SCO UnixWare.
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 C_Time.timeval;
+ (tv : not null access struct_timeval;
tz : Address := Null_Address);
pragma Import (C, gettimeofday, "gettimeofday");
readfds,
writefds,
exceptfds : Address := Null_Address;
- timeout : not null access C_Time.timeval);
+ timeout : not null access struct_timeval);
pragma Import (C, C_select, "select");
-----------
-----------
function Clock return Duration is
- TV : aliased C_Time.timeval;
+ TV : aliased struct_timeval;
begin
gettimeofday (TV'Access);
- return C_Time.To_Duration (TV);
+ return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
-----------------
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
Check_Time : Duration := Base_Time;
- timeval : aliased C_Time.timeval;
+ timeval : aliased struct_timeval;
begin
if Mode = Relative then
if Rel_Time > 0.0 then
loop
- timeval := C_Time.To_Timeval (Rel_Time);
+ 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);
C_select (timeout => timeval'Unchecked_Access);
Check_Time := Clock;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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-2025, 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.Parameters;
+
+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 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;
+ pragma Import (C, nanosleep, "nanosleep");
+
+ -----------
+ -- Clock --
+ -----------
+
+ 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;
+ Result : Integer;
+ pragma Unreferenced (Result);
+
+ function gettimeofday
+ (Tv : access 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);
+ timeval_to_duration (TV'Access, sec'Access, usec'Access);
+ return Duration (sec) + Duration (usec) / Micro;
+ 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 --
+ -----------------
+
+ procedure Timed_Delay
+ (Time : Duration;
+ Mode : Integer)
+ is
+ Request : aliased timespec;
+ Remaind : aliased 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 := 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;
-- 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 --
----------------------------------------------
-- 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 --
----------------------------------------------
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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-2025, 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 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 --
+ ----------------------------------------------
+
+ 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;
-- 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 --
----------------------------------------------
#endif
CNS(MAX_tv_sec, "")
}
-
-{
- struct timespec ts;
-/*
- -- Sizes (in bytes) of the components of struct timespec.
- -- The tv_sec field is the same as in struct timeval.
-*/
-#define SIZEOF_tv_nsec (sizeof (ts.tv_nsec))
-CND(SIZEOF_tv_nsec, "tv_nsec");
-}
-
/*
-- Sizes of various data types
projects / thirdparty / gcc.git / commitdiff
