1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 4-- -- 5-- S Y S T E M . O S _ I N T E R F A C E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1999-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 is a Darwin Threads version of this package 33 34pragma Polling (Off); 35-- Turn off polling, we do not want ATC polling to take place during 36-- tasking operations. It causes infinite loops and other problems. 37 38with Interfaces.C.Extensions; 39 40package body System.OS_Interface is 41 use Interfaces.C; 42 use Interfaces.C.Extensions; 43 44 ----------------- 45 -- To_Duration -- 46 ----------------- 47 48 function To_Duration (TS : timespec) return Duration is 49 begin 50 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 51 end To_Duration; 52 53 ------------------------ 54 -- To_Target_Priority -- 55 ------------------------ 56 57 function To_Target_Priority 58 (Prio : System.Any_Priority) return Interfaces.C.int 59 is 60 begin 61 return Interfaces.C.int (Prio); 62 end To_Target_Priority; 63 64 ----------------- 65 -- To_Timespec -- 66 ----------------- 67 68 function To_Timespec (D : Duration) return timespec is 69 S : time_t; 70 F : Duration; 71 72 begin 73 S := time_t (Long_Long_Integer (D)); 74 F := D - Duration (S); 75 76 -- If F has negative value due to a round-up, adjust for positive F 77 -- value. 78 79 if F < 0.0 then 80 S := S - 1; 81 F := F + 1.0; 82 end if; 83 84 return timespec'(tv_sec => S, 85 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 86 end To_Timespec; 87 88 ------------------- 89 -- clock_gettime -- 90 ------------------- 91 92 function clock_gettime 93 (clock_id : clockid_t; 94 tp : access timespec) return int 95 is 96 pragma Unreferenced (clock_id); 97 98 -- Darwin Threads don't have clock_gettime, so use gettimeofday 99 100 use Interfaces; 101 102 type timeval is array (1 .. 3) of C.long; 103 -- The timeval array is sized to contain long_long sec and long usec. 104 -- If long_long'Size = long'Size then it will be overly large but that 105 -- won't effect the implementation since it's not accessed directly. 106 107 procedure timeval_to_duration 108 (T : not null access timeval; 109 sec : not null access C.Extensions.long_long; 110 usec : not null access C.long); 111 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); 112 113 Micro : constant := 10**6; 114 sec : aliased C.Extensions.long_long; 115 usec : aliased C.long; 116 TV : aliased timeval; 117 Result : int; 118 119 function gettimeofday 120 (Tv : access timeval; 121 Tz : System.Address := System.Null_Address) return int; 122 pragma Import (C, gettimeofday, "gettimeofday"); 123 124 begin 125 Result := gettimeofday (TV'Access, System.Null_Address); 126 pragma Assert (Result = 0); 127 timeval_to_duration (TV'Access, sec'Access, usec'Access); 128 tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro); 129 return Result; 130 end clock_gettime; 131 132 ------------------ 133 -- clock_getres -- 134 ------------------ 135 136 function clock_getres 137 (clock_id : clockid_t; 138 res : access timespec) return int 139 is 140 pragma Unreferenced (clock_id); 141 142 -- Darwin Threads don't have clock_getres. 143 144 Nano : constant := 10**9; 145 nsec : int := 0; 146 Result : int := -1; 147 148 function clock_get_res return int; 149 pragma Import (C, clock_get_res, "__gnat_clock_get_res"); 150 151 begin 152 nsec := clock_get_res; 153 res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano); 154 155 if nsec > 0 then 156 Result := 0; 157 end if; 158 159 return Result; 160 end clock_getres; 161 162 ----------------- 163 -- sched_yield -- 164 ----------------- 165 166 function sched_yield return int is 167 procedure sched_yield_base (arg : System.Address); 168 pragma Import (C, sched_yield_base, "pthread_yield_np"); 169 170 begin 171 sched_yield_base (System.Null_Address); 172 return 0; 173 end sched_yield; 174 175 -------------- 176 -- lwp_self -- 177 -------------- 178 179 function lwp_self return Address is 180 function pthread_mach_thread_np (thread : pthread_t) return Address; 181 pragma Import (C, pthread_mach_thread_np, "pthread_mach_thread_np"); 182 begin 183 return pthread_mach_thread_np (pthread_self); 184 end lwp_self; 185 186 ------------------ 187 -- pthread_init -- 188 ------------------ 189 190 procedure pthread_init is 191 begin 192 null; 193 end pthread_init; 194 195 ---------------- 196 -- Stack_Base -- 197 ---------------- 198 199 function Get_Stack_Base (thread : pthread_t) return Address is 200 pragma Unreferenced (thread); 201 begin 202 return System.Null_Address; 203 end Get_Stack_Base; 204 205end System.OS_Interface; 206