------------------------------------------------------------------------------ -- -- -- 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 -- -- . -- -- -- -- 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;