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-2008, 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 -- Monotonic_Clock -- 95 --------------------- 96 97 function Monotonic_Clock return Duration renames Clock; 98 99 ----------------- 100 -- To_Timespec -- 101 ----------------- 102 103 function To_Timespec (D : Duration) return timespec; 104 105 function To_Timespec (D : Duration) return timespec is 106 S : time_t; 107 F : Duration; 108 109 begin 110 S := time_t (Long_Long_Integer (D)); 111 F := D - Duration (S); 112 113 -- If F has negative value due to a round-up, adjust for positive F 114 -- value. 115 116 if F < 0.0 then 117 S := S - 1; 118 F := F + 1.0; 119 end if; 120 121 return 122 timespec'(tv_sec => S, 123 tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9))); 124 end To_Timespec; 125 126 ----------------- 127 -- Timed_Delay -- 128 ----------------- 129 130 procedure Timed_Delay 131 (Time : Duration; 132 Mode : Integer) 133 is 134 Request : aliased timespec; 135 Remaind : aliased timespec; 136 Rel_Time : Duration; 137 Abs_Time : Duration; 138 Base_Time : constant Duration := Clock; 139 Check_Time : Duration := Base_Time; 140 141 Result : Integer; 142 pragma Unreferenced (Result); 143 144 begin 145 if Mode = Relative then 146 Rel_Time := Time; 147 Abs_Time := Time + Check_Time; 148 else 149 Rel_Time := Time - Check_Time; 150 Abs_Time := Time; 151 end if; 152 153 if Rel_Time > 0.0 then 154 loop 155 Request := To_Timespec (Rel_Time); 156 Result := nanosleep (Request'Access, Remaind'Access); 157 Check_Time := Clock; 158 159 exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; 160 161 Rel_Time := Abs_Time - Check_Time; 162 end loop; 163 end if; 164 end Timed_Delay; 165 166 ---------------- 167 -- Initialize -- 168 ---------------- 169 170 procedure Initialize is 171 begin 172 null; 173 end Initialize; 174 175end System.OS_Primitives; 176