1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- S Y S T E M . O S _ P R I M I T I V E S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2013-2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNARL is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This version is for Linux/x32 33 34package body System.OS_Primitives is 35 36 -- ??? These definitions are duplicated from System.OS_Interface 37 -- because we don't want to depend on any package. Consider removing 38 -- these declarations in System.OS_Interface and move these ones in 39 -- the spec. 40 41 type time_t is new Long_Long_Integer; 42 43 type timespec is record 44 tv_sec : time_t; 45 tv_nsec : Long_Long_Integer; 46 end record; 47 pragma Convention (C, timespec); 48 49 function nanosleep (rqtp, rmtp : not null access timespec) return Integer; 50 pragma Import (C, nanosleep, "nanosleep"); 51 52 ----------- 53 -- Clock -- 54 ----------- 55 56 function Clock return Duration is 57 type timeval is array (1 .. 2) of Long_Long_Integer; 58 59 procedure timeval_to_duration 60 (T : not null access timeval; 61 sec : not null access Long_Integer; 62 usec : not null access Long_Integer); 63 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); 64 65 Micro : constant := 10**6; 66 sec : aliased Long_Integer; 67 usec : aliased Long_Integer; 68 TV : aliased timeval; 69 Result : Integer; 70 pragma Unreferenced (Result); 71 72 function gettimeofday 73 (Tv : access timeval; 74 Tz : System.Address := System.Null_Address) return Integer; 75 pragma Import (C, gettimeofday, "gettimeofday"); 76 77 begin 78 -- The return codes for gettimeofday are as follows (from man pages): 79 -- EPERM settimeofday is called by someone other than the superuser 80 -- EINVAL Timezone (or something else) is invalid 81 -- EFAULT One of tv or tz pointed outside accessible address space 82 83 -- None of these codes signal a potential clock skew, hence the return 84 -- value is never checked. 85 86 Result := gettimeofday (TV'Access, System.Null_Address); 87 timeval_to_duration (TV'Access, sec'Access, usec'Access); 88 return Duration (sec) + Duration (usec) / Micro; 89 end Clock; 90 91 --------------------- 92 -- Monotonic_Clock -- 93 --------------------- 94 95 function Monotonic_Clock return Duration renames Clock; 96 97 ----------------- 98 -- To_Timespec -- 99 ----------------- 100 101 function To_Timespec (D : Duration) return timespec; 102 103 function To_Timespec (D : Duration) return timespec is 104 S : time_t; 105 F : Duration; 106 107 begin 108 S := time_t (Long_Long_Integer (D)); 109 F := D - Duration (S); 110 111 -- If F has negative value due to a round-up, adjust for positive F 112 -- value. 113 114 if F < 0.0 then 115 S := S - 1; 116 F := F + 1.0; 117 end if; 118 119 return 120 timespec'(tv_sec => S, 121 tv_nsec => Long_Long_Integer (F * 10#1#E9)); 122 end To_Timespec; 123 124 ----------------- 125 -- Timed_Delay -- 126 ----------------- 127 128 procedure Timed_Delay 129 (Time : Duration; 130 Mode : Integer) 131 is 132 Request : aliased timespec; 133 Remaind : aliased timespec; 134 Rel_Time : Duration; 135 Abs_Time : Duration; 136 Base_Time : constant Duration := Clock; 137 Check_Time : Duration := Base_Time; 138 139 Result : Integer; 140 pragma Unreferenced (Result); 141 142 begin 143 if Mode = Relative then 144 Rel_Time := Time; 145 Abs_Time := Time + Check_Time; 146 else 147 Rel_Time := Time - Check_Time; 148 Abs_Time := Time; 149 end if; 150 151 if Rel_Time > 0.0 then 152 loop 153 Request := To_Timespec (Rel_Time); 154 Result := nanosleep (Request'Access, Remaind'Access); 155 Check_Time := Clock; 156 157 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; 158 159 Rel_Time := Abs_Time - Check_Time; 160 end loop; 161 end if; 162 end Timed_Delay; 163 164 ---------------- 165 -- Initialize -- 166 ---------------- 167 168 procedure Initialize is 169 begin 170 null; 171 end Initialize; 172 173end System.OS_Primitives; 174