From 5099bde3f031b35e98cf790718e699ad04357434 Mon Sep 17 00:00:00 2001 From: Sebastian Huber Date: Mon, 4 Dec 2017 13:41:46 +0000 Subject: [PATCH] RTEMS/Ada: Account for 64-bit time_t The Newlib time_t has now 64 bits for RTEMS. gcc/ada * gcc-interface/Makefile.in (RTEMS): Use s-osprim.adb. * s-osprim-rtems.adb: New file. * s-osinte-rtems.adb (pthread_cond_t): Fix alignment. (pthread_mutexattr_t): Likewise. (pthread_rwlockattr_t): Likewise. (pthread_rwlock_t): Likewise. (time_t): Use 64-bit integer. From-SVN: r255381 --- gcc/ada/ChangeLog | 10 ++ gcc/ada/gcc-interface/Makefile.in | 2 +- gcc/ada/s-osinte-rtems.ads | 10 +- gcc/ada/s-osprim-rtems.adb | 172 ++++++++++++++++++++++++++++++ 4 files changed, 188 insertions(+), 6 deletions(-) create mode 100644 gcc/ada/s-osprim-rtems.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ecc822580a3..6bd75a8bdd3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2017-12-04 Sebastian Huber + + * gcc-interface/Makefile.in (RTEMS): Use s-osprim.adb. + * s-osprim-rtems.adb: New file. + * s-osinte-rtems.adb (pthread_cond_t): Fix alignment. + (pthread_mutexattr_t): Likewise. + (pthread_rwlockattr_t): Likewise. + (pthread_rwlock_t): Likewise. + (time_t): Use 64-bit integer. + 2017-12-01 Sebastian Huber * s-osinte-rtems.ads (pthread_cond_t): Use correct size and diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index d94fadf508b..7a570196a88 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1726,7 +1726,7 @@ ifeq ($(strip $(filter-out rtems%,$(target_os))),) s-intman.adb. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for POSIX-like operating systems + +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 new Long_Long_Integer; + + type timespec is record + tv_sec : time_t; + tv_nsec : Long_Integer; + end record; + pragma Convention (C, timespec); + + function nanosleep (rqtp, rmtp : not null access timespec) return Integer; + pragma Import (C, nanosleep, "nanosleep"); + + ----------- + -- Clock -- + ----------- + + 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; + 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_Integer (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;