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) 1998-2015, 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 darwin 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 struct_timezone is record 42 tz_minuteswest : Integer; 43 tz_dsttime : Integer; 44 end record; 45 pragma Convention (C, struct_timezone); 46 type struct_timezone_ptr is access all struct_timezone; 47 48 type time_t is new Long_Integer; 49 50 type struct_timeval is record 51 tv_sec : time_t; 52 tv_usec : Integer; 53 end record; 54 pragma Convention (C, struct_timeval); 55 56 function gettimeofday 57 (tv : not null access struct_timeval; 58 tz : struct_timezone_ptr) return Integer; 59 pragma Import (C, gettimeofday, "gettimeofday"); 60 61 type timespec is record 62 tv_sec : time_t; 63 tv_nsec : Long_Integer; 64 end record; 65 pragma Convention (C, timespec); 66 67 function nanosleep (rqtp, rmtp : not null access timespec) return Integer; 68 pragma Import (C, nanosleep, "nanosleep"); 69 70 ----------- 71 -- Clock -- 72 ----------- 73 74 function Clock return Duration is 75 TV : aliased struct_timeval; 76 77 Result : Integer; 78 pragma Unreferenced (Result); 79 80 begin 81 -- The return codes for gettimeofday are as follows (from man pages): 82 -- EPERM settimeofday is called by someone other than the superuser 83 -- EINVAL Timezone (or something else) is invalid 84 -- EFAULT One of tv or tz pointed outside accessible address space 85 86 -- None of these codes signal a potential clock skew, hence the return 87 -- value is never checked. 88 89 Result := gettimeofday (TV'Access, null); 90 return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; 91 end Clock; 92 93 ----------------- 94 -- To_Timespec -- 95 ----------------- 96 97 function To_Timespec (D : Duration) return timespec; 98 99 function To_Timespec (D : Duration) return timespec is 100 S : time_t; 101 F : Duration; 102 103 begin 104 S := time_t (Long_Long_Integer (D)); 105 F := D - Duration (S); 106 107 -- If F has negative value due to a round-up, adjust for positive F 108 -- value. 109 110 if F < 0.0 then 111 S := S - 1; 112 F := F + 1.0; 113 end if; 114 115 return 116 timespec'(tv_sec => S, 117 tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9))); 118 end To_Timespec; 119 120 ----------------- 121 -- Timed_Delay -- 122 ----------------- 123 124 procedure Timed_Delay 125 (Time : Duration; 126 Mode : Integer) 127 is 128 Request : aliased timespec; 129 Remaind : aliased timespec; 130 Rel_Time : Duration; 131 Abs_Time : Duration; 132 Base_Time : constant Duration := Clock; 133 Check_Time : Duration := Base_Time; 134 135 Result : Integer; 136 pragma Unreferenced (Result); 137 138 begin 139 if Mode = Relative then 140 Rel_Time := Time; 141 Abs_Time := Time + Check_Time; 142 else 143 Rel_Time := Time - Check_Time; 144 Abs_Time := Time; 145 end if; 146 147 if Rel_Time > 0.0 then 148 loop 149 Request := To_Timespec (Rel_Time); 150 Result := nanosleep (Request'Access, Remaind'Access); 151 Check_Time := Clock; 152 153 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; 154 155 Rel_Time := Abs_Time - Check_Time; 156 end loop; 157 end if; 158 end Timed_Delay; 159 160 ---------------- 161 -- Initialize -- 162 ---------------- 163 164 procedure Initialize is 165 begin 166 null; 167 end Initialize; 168 169end System.OS_Primitives; 170