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__solaris.adb \
+ s-osprim.adb<libgnat/s-osprim__unix.adb \
s-taprop.adb<libgnarl/s-taprop__solaris.adb \
s-tasinf.adb<libgnarl/s-tasinf__solaris.adb \
s-tasinf.ads<libgnarl/s-tasinf__solaris.ads \
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__solaris.adb \
+ s-osprim.adb<libgnat/s-osprim__unix.adb \
s-taprop.adb<libgnarl/s-taprop__solaris.adb \
s-tasinf.adb<libgnarl/s-tasinf__solaris.adb \
s-tasinf.ads<libgnarl/s-tasinf__solaris.ads \
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__x32.adb \
- s-parame.ads<libgnat/s-parame__posix2008.ads \
+ s-osprim.adb<libgnat/s-osprim__posix.adb \
s-taprop.adb<libgnarl/s-taprop__linux.adb \
s-tasinf.ads<libgnarl/s-tasinf__linux.ads \
s-tasinf.adb<libgnarl/s-tasinf__linux.adb \
# library. LIBGNAT_OBJS is the list of object files for libgnat.
# thread.c is special as put into GNATRTL_TASKING_OBJS
LIBGNAT_OBJS = adadecode.o adaint.o argv.o aux-io.o \
- cal.o cio.o cstreams.o ctrl_c.o \
+ cio.o cstreams.o ctrl_c.o \
env.o errno.o exit.o expect.o final.o rtfinal.o rtinit.o \
init.o initialize.o locales.o mkdir.o \
raise.o seh_init.o socket.o sysdep.o \
+++ /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.Tasking;
+with System.C_Time;
with System.OS_Interface; use System.OS_Interface;
+with System.Tasking;
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 timespec;
+ TS : aliased System.C_Time.timespec;
Clock_Id : aliased Interfaces.C.int;
Result : Interfaces.C.int;
function clock_gettime
(clock_id : Interfaces.C.int;
- tp : access timespec)
+ tp : access System.C_Time.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 (To_Duration (TS));
+ return To_CPU_Time (System.C_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 := int'Size / 8;
- sa_mask_pos : constant := int'Size / 8 +
+ sa_handler_pos : constant := Interfaces.C.int'Size / 8;
+ sa_mask_pos : constant := Interfaces.C.int'Size / 8 +
Standard'Address_Size / 8;
sa_flags_pos : constant := 0;
-- 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 := long'Size / 8;
- sa_flags_pos : constant := long'Size / 8 + 128;
+ sa_mask_pos : constant := Interfaces.C.long'Size / 8;
+ sa_flags_pos : constant := Interfaces.C.long'Size / 8 + 128;
SA_SIGINFO : constant := 16#04#;
SA_ONSTACK : constant := 16#08000000#;
-- 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 timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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;
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 timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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 timespec) return int
+ tp : access C_Time.timespec) return int
is
pragma Unreferenced (clock_id);
use Interfaces;
- type timeval is array (1 .. 3) of C.long;
- -- The timeval array is sized to contain long_long sec and long usec.
- -- If long_long'Size = long'Size then it will be overly large but that
- -- won't effect the implementation since it's not accessed directly.
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access C.Extensions.long_long;
- usec : not null access C.long);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased C.Extensions.long_long;
- usec : aliased C.long;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : int;
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return int;
pragma Import (C, gettimeofday, "gettimeofday");
begin
Result := gettimeofday (TV'Access, System.Null_Address);
pragma Assert (Result = 0);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro);
+ tp.all := C_Time.To_Timespec (TV);
return Result;
end clock_gettime;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int
+ res : access C_Time.timespec) return int
is
pragma Unreferenced (clock_id);
-- Darwin Threads don't have clock_getres.
- Nano : constant := 10**9;
nsec : int := 0;
Result : int := -1;
begin
nsec := clock_get_res;
- res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano);
+ res.all := C_Time.Nanoseconds_To_Timespec (nsec);
if nsec > 0 then
Result := 0;
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 timespec) return int;
+ tp : access C_Time.timespec) return int;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
-
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
+ res : access C_Time.timespec) return int;
-------------------------
-- Priority Scheduling --
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new unsigned_long;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
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)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
-- From: /usr/include/time.h
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-- From: /usr/include/unistd.h
function sysconf (name : int) return long;
pragma Import (C, sysconf);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
Relative_Timed_Wait : constant Boolean := False;
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 timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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)
- type timespec is private;
-
- function nanosleep (rqtp, rmtp : access timespec) return int;
+ function nanosleep (rqtp, rmtp : access C_Time.timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec)
+ tp : access C_Time.timespec)
return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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 timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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 timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
type struct_timezone is record
tz_minuteswest : int;
tz_dsttime : int;
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 timespec) return int;
+ abstime : access C_Time.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 timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-------------------------
-- Priority Scheduling --
-------------------------
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
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 timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
(clock_id : clockid_t;
- res : access timespec) return int;
+ res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
-------------------------
-- Priority Scheduling --
-------------------------
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
--------------------------
type struct_sched_param is record
sched_priority : int;
ss_low_priority : int;
- ss_replenish_period : timespec;
- ss_initial_budget : timespec;
+ ss_replenish_period : C_Time.timespec;
+ ss_initial_budget : C_Time.timespec;
sched_ss_max_repl : int;
end record;
pragma Convention (C, struct_sched_param);
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 timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
function clock_getres
- (clock_id : clockid_t; res : access timespec) return int;
+ (clock_id : clockid_t; res : access C_Time.timespec) return int;
pragma Import (C, clock_getres, "clock_getres");
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
function sysconf (name : int) return long;
pragma Import (C, sysconf);
function cond_timedwait
(cond : access cond_t;
mutex : access mutex_t;
- abstime : access timespec) return int;
+ abstime : access C_Time.timespec) return int;
pragma Import (C, cond_timedwait, "cond_timedwait");
function cond_signal (cond : access cond_t) return int;
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 timespec) return int;
+ (clock_id : clockid_t; tp : access C_Time.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; use Interfaces.C;
+with 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 timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
-------------------
function RT_Resolution return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end RT_Resolution;
-----------
Base_Time : constant Duration := Monotonic_Clock;
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
+ Request := C_Time.To_Timespec (Abs_Time);
loop
exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
Base_Time : constant Duration := Monotonic_Clock;
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
Yielded : Boolean := False;
else Duration'Min (Check_Time + Max_Sensible_Delay, Time));
if Abs_Time > Check_Time then
- Request := To_Timespec (Abs_Time);
+ Request := C_Time.To_Timespec (Abs_Time);
Self_ID.Common.State := Delay_Sleep;
pragma Assert (Check_Sleep (Delay_Sleep));
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 timespec;
+ TS : aliased C_Time.timespec;
Result : int;
begin
Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
-- 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 timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end Monotonic_Clock;
-------------------
-------------------
function RT_Resolution return Duration is
- TS : aliased timespec;
+ TS : aliased C_Time.timespec;
Result : Interfaces.C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return To_Duration (TS);
+ return C_Time.To_Duration (TS);
end RT_Resolution;
----------------------
Abs_Time : Duration;
P_Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
Exit_Outer : Boolean := False;
end if;
pragma Warnings (On);
- Request := To_Timespec (P_Abs_Time);
+ Request := C_Time.To_Timespec (P_Abs_Time);
Inner : loop
exit Outer
Check_Time : Duration;
Abs_Time : Duration;
P_Abs_Time : Duration;
- Request : aliased timespec;
+ Request : aliased C_Time.timespec;
Result : Interfaces.C.int;
Exit_Outer : Boolean := False;
end if;
pragma Warnings (On);
- Request := To_Timespec (P_Abs_Time);
+ Request := C_Time.To_Timespec (P_Abs_Time);
Inner : loop
exit Outer
------------------------------------------------------------------------------
-- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- GNAT RUN-TIME COMPONENTS --
-- --
--- S Y S T E M . O S _ I N T E R F A C E --
+-- G N A T . C _ T I M E --
-- --
--- B o d y --
+-- S p e c --
-- --
--- Copyright (C) 1995-2025, AdaCore --
+-- Copyright (C) 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/>. --
-- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
--- This is an Android version of this package.
+-- 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 package encapsulates all direct interfaces to OS services
--- that are needed by children of System.
+-- See file s-c_time.ads for full documentation of the interface
-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 System.C_Time;
+package GNAT.C_Time renames System.C_Time;
-- --
------------------------------------------------------------------------------
-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
- timeval_to_duration (T, sec'Access, usec'Access);
- pragma Annotate (CodePeer, Modified, sec);
- pragma Annotate (CodePeer, Modified, usec);
-
- return Duration (sec) + Duration (usec) / Micro;
+ return System.C_Time.To_Duration (T.all);
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
- 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;
+ return System.C_Time.To_Timeval (D);
end To_Timeval;
------------------
-- Day_Of_Week, Day_In_Year and Week_In_Year.
with Ada.Calendar.Formatting;
-with Interfaces.C;
+
+with System.C_Time;
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: Split_At_Locale is no longer aware of historic events and may
+ -- WARNING: Time_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.
- -- C timeval conversion
-
- -- C timeval represent a duration (used in Select for example). This
- -- structure is composed of a number of seconds and a number of micro
- -- seconds. The timeval structure is not exposed here because its
- -- definition is target dependent. Interface to C programs is done via a
- -- pointer to timeval structure.
-
- type timeval is private;
+ subtype timeval is System.C_Time.timeval;
+ pragma Obsolescent (timeval, "use type from GNAT.C_Time instead");
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");
+
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 Timeval;
+ TVal : aliased System.C_Time.timeval;
TPtr : Timeval_Access;
begin
if Timeout = Forever then
TPtr := null;
else
- TVal := To_Timeval (Timeout);
+ TVal := System.C_Time.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 Timeval;
+ VT : aliased System.C_Time.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 := To_Duration (VT);
+ Opt.Timeout := Forever;
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 Timeval;
+ VT : aliased System.C_Time.timeval;
Len : C.int;
Add : System.Address := Null_Address;
Res : C.int;
end if;
else
- VT := To_Timeval (Option.Timeout);
+ VT := System.C_Time.To_Timeval (Option.Timeout);
Len := VT'Size / 8;
Add := VT'Address;
end if;
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 Timeval;
+ Now : aliased System.C_Time.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 Timeval;
+ Now : aliased System.C_Time.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.Parameters;
+
+with System.C_Time;
package GNAT.Sockets.Thin_Common is
Success : constant C.int := 0;
Failure : constant C.int := -1;
- type time_t is
- range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
- for time_t'Size use System.Parameters.time_t_bits;
- pragma Convention (C, time_t);
-
- type suseconds_t is
- range -2 ** (8 * SOSC.SIZEOF_tv_usec - 1)
- .. 2 ** (8 * SOSC.SIZEOF_tv_usec - 1) - 1;
- for suseconds_t'Size use 8 * SOSC.SIZEOF_tv_usec;
- pragma Convention (C, suseconds_t);
-
- type Timeval is record
- Tv_Sec : time_t;
- Tv_Usec : suseconds_t;
- end record;
- pragma Convention (C, Timeval);
+ 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 Timeval_Access is access all Timeval;
+ type Timeval_Access is access all System.C_Time.timeval;
pragma Convention (C, Timeval_Access);
type socklen_t is mod 2 ** (8 * SOSC.SIZEOF_socklen_t);
for socklen_t'Size use (8 * SOSC.SIZEOF_socklen_t);
- Immediat : constant Timeval := (0, 0);
+ Immediat : constant System.C_Time.timeval
+ := System.C_Time.Milliseconds_To_Timeval (0);
-------------------------------------------
-- Mapping tables to low level constants --
-- --
------------------------------------------------------------------------------
-with GNAT.Sockets.Thin_Common;
+with System.C_Time;
procedure GNAT.Sockets.Poll.G_Wait
(Fds : in out Set; Timeout : Interfaces.C.int; Result : out Integer)
readfds : access FD_Set_Type;
writefds : access FD_Set_Type;
exceptfds : access FD_Set_Type;
- timeout : access Thin_Common.Timeval) return Integer
+ timeout : access System.C_Time.timeval) return Integer
with Import => True, Convention => Stdcall, External_Name => "select";
- Timeout_V : aliased Thin_Common.Timeval;
- Timeout_A : access Thin_Common.Timeval;
+ Timeout_V : aliased System.C_Time.timeval;
+ Timeout_A : access System.C_Time.timeval;
Rfds : aliased FD_Set_Type;
Rcount : Natural := 0;
if Timeout >= 0 then
Timeout_A := Timeout_V'Access;
- Timeout_V.Tv_Sec := Thin_Common.time_t (Timeout / 1000);
- Timeout_V.Tv_Usec := Thin_Common.suseconds_t (Timeout rem 1000 * 1000);
+ Timeout_V := System.C_Time.Milliseconds_To_Timeval (Timeout);
end if;
Reset_Socket_Set (Rfds);
--- /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
- Request : aliased timespec;
- Remaind : aliased timespec;
+
+ 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;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
end if;
pragma Warnings (On);
- Request := To_Timespec (Time_Chunk);
+ Request := C_Time.To_Timespec (Time_Chunk);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
-- To_Ada --
------------
- function To_Ada (Time : time_t) return OS_Time is
+ function To_Ada (Time : Long_Long_Integer) return OS_Time is
begin
return OS_Time (Time);
end To_Ada;
-- To_C --
----------
- function To_C (Time : OS_Time) return time_t is
+ function To_C (Time : OS_Time) return Long_Long_Integer is
begin
- return time_t (Time);
+ return Long_Long_Integer (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_C);
pragma Inline (To_Ada);
+ pragma Inline (To_C);
type Process_Id is new Integer;
Invalid_Pid : constant Process_Id := -1;
-- --
------------------------------------------------------------------------------
--- This version is for darwin
+-- This version is for Darwin
+
+with System.C_Time;
-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 struct_timeval;
+ (tv : not null access C_Time.timeval;
tz : struct_timezone_ptr) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
-----------
function Clock return Duration is
- TV : aliased struct_timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
-- value is never checked.
Result := gettimeofday (TV'Access, null);
- return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
(Time : Duration;
Mode : Integer)
is
- Request : aliased timespec;
- Remaind : aliased timespec;
+ Request : aliased C_Time.timespec;
+ Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
if Rel_Time > 0.0 then
loop
- Request := To_Timespec (Rel_Time);
+ Request := C_Time.To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
------------------------------------------------------------------------------
-- This version is for POSIX-like operating systems
-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;
+with System.C_Time;
- 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");
+package body System.OS_Primitives is
-----------
-- Clock --
function Clock return Duration is
- type timeval is array (1 .. 3) of Long_Integer;
- -- The timeval array is sized to contain Long_Long_Integer sec and
- -- Long_Integer usec. If Long_Long_Integer'Size = Long_Integer'Size then
- -- it will be overly large but that will not effect the implementation
- -- since it is not accessed directly.
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access Long_Long_Integer;
- usec : not null access Long_Integer);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased Long_Long_Integer;
- usec : aliased Long_Integer;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- return Duration (sec) + Duration (usec) / Micro;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
-- 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 timespec;
+ TS : aliased C_Time.timespec;
Result : int;
type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
- tp : access timespec) return int;
+ tp : access C_Time.timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
begin
Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
pragma Assert (Result = 0);
- return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
+ return C_Time.To_Duration (TS);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
-- This version is for POSIX-like operating systems
-with System.Parameters;
+with System.C_Time;
+
package body System.OS_Primitives is
-- ??? These definitions are duplicated from System.OS_Interface
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
- .. 2 ** (System.Parameters.time_t_bits - 1) - 1;
-
- type timespec is record
- tv_sec : time_t;
- tv_nsec : Long_Integer;
- end record;
- pragma Convention (C, timespec);
-
- function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
+ function nanosleep (rqtp, rmtp : not null access C_Time.timespec)
+ return Integer;
pragma Import (C, nanosleep, "nanosleep");
-----------
-----------
function Clock return Duration is
-
- type timeval is record
- tv_sec : time_t;
- tv_usec : Long_Integer;
- end record;
- pragma Convention (C, timeval);
-
- procedure timeval_to_duration
- (T : not null access timeval;
- sec : not null access Long_Long_Integer;
- usec : not null access Long_Integer);
- pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
-
- Micro : constant := 10**6;
- sec : aliased Long_Long_Integer;
- usec : aliased Long_Integer;
- TV : aliased timeval;
+ TV : aliased C_Time.timeval;
Result : Integer;
pragma Unreferenced (Result);
function gettimeofday
- (Tv : access timeval;
+ (Tv : access C_Time.timeval;
Tz : System.Address := System.Null_Address) return Integer;
pragma Import (C, gettimeofday, "gettimeofday");
-- value is never checked.
Result := gettimeofday (TV'Access, System.Null_Address);
- timeval_to_duration (TV'Access, sec'Access, usec'Access);
- return Duration (sec) + Duration (usec) / Micro;
+ return C_Time.To_Duration (TV);
end Clock;
- -----------------
- -- To_Timespec --
- -----------------
-
- function To_Timespec (D : Duration) return timespec;
-
- function To_Timespec (D : Duration) return timespec is
- S : time_t;
- F : Duration;
-
- begin
- S := time_t (Long_Long_Integer (D));
- F := D - Duration (S);
-
- -- If F has negative value due to a round-up, adjust for positive F
- -- value.
-
- if F < 0.0 then
- S := S - 1;
- F := F + 1.0;
- end if;
-
- return
- timespec'(tv_sec => S,
- tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
- end To_Timespec;
-
-----------------
-- Timed_Delay --
-----------------
(Time : Duration;
Mode : Integer)
is
- Request : aliased timespec;
- Remaind : aliased timespec;
+ Request : aliased C_Time.timespec;
+ Remaind : aliased C_Time.timespec;
Rel_Time : Duration;
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
if Rel_Time > 0.0 then
loop
- Request := To_Timespec (Rel_Time);
+ Request := C_Time.To_Timespec (Rel_Time);
Result := nanosleep (Request'Access, Remaind'Access);
Check_Time := Clock;
+++ /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 OpenNT, Dec Unix and SCO UnixWare.
+-- This file is suitable for Dec Unix, SCO UnixWare and Sun Solaris.
+
+with System.C_Time;
package body System.OS_Primitives is
-- these declarations in System.OS_Interface and move these ones in
-- the spec.
- type struct_timeval is record
- tv_sec : Integer;
- tv_usec : Integer;
- end record;
- pragma Convention (C, struct_timeval);
-
procedure gettimeofday
- (tv : not null access struct_timeval;
+ (tv : not null access C_Time.timeval;
tz : Address := Null_Address);
pragma Import (C, gettimeofday, "gettimeofday");
readfds,
writefds,
exceptfds : Address := Null_Address;
- timeout : not null access struct_timeval);
+ timeout : not null access C_Time.timeval);
pragma Import (C, C_select, "select");
-----------
-----------
function Clock return Duration is
- TV : aliased struct_timeval;
+ TV : aliased C_Time.timeval;
begin
gettimeofday (TV'Access);
- return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
+ return C_Time.To_Duration (TV);
end Clock;
-----------------
Abs_Time : Duration;
Base_Time : constant Duration := Clock;
Check_Time : Duration := Base_Time;
- timeval : aliased struct_timeval;
+ timeval : aliased C_Time.timeval;
begin
if Mode = Relative then
if Rel_Time > 0.0 then
loop
- timeval.tv_sec := Integer (Rel_Time);
-
- if Duration (timeval.tv_sec) > Rel_Time then
- timeval.tv_sec := timeval.tv_sec - 1;
- end if;
-
- timeval.tv_usec :=
- Integer ((Rel_Time - Duration (timeval.tv_sec)) * 10#1#E6);
+ timeval := C_Time.To_Timeval (Rel_Time);
C_select (timeout => timeval'Unchecked_Access);
Check_Time := Clock;
+++ /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
