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-2018, 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 43 ----------------- 44 -- To_Duration -- 45 ----------------- 46 47 function To_Duration (TS : timespec) return Duration is 48 begin 49 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 50 end To_Duration; 51 52 ------------------------ 53 -- To_Target_Priority -- 54 ------------------------ 55 56 function To_Target_Priority 57 (Prio : System.Any_Priority) return Interfaces.C.int 58 is 59 begin 60 return Interfaces.C.int (Prio); 61 end To_Target_Priority; 62 63 ----------------- 64 -- To_Timespec -- 65 ----------------- 66 67 function To_Timespec (D : Duration) return timespec is 68 S : time_t; 69 F : Duration; 70 71 begin 72 S := time_t (Long_Long_Integer (D)); 73 F := D - Duration (S); 74 75 -- If F has negative value due to a round-up, adjust for positive F 76 -- value. 77 78 if F < 0.0 then 79 S := S - 1; 80 F := F + 1.0; 81 end if; 82 83 return timespec'(tv_sec => S, 84 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 85 end To_Timespec; 86 87 ------------------- 88 -- clock_gettime -- 89 ------------------- 90 91 function clock_gettime 92 (clock_id : clockid_t; 93 tp : access timespec) return int 94 is 95 pragma Unreferenced (clock_id); 96 97 -- Darwin Threads don't have clock_gettime, so use gettimeofday 98 99 use Interfaces; 100 101 type timeval is array (1 .. 3) of C.long; 102 -- The timeval array is sized to contain long_long sec and long usec. 103 -- If long_long'Size = long'Size then it will be overly large but that 104 -- won't effect the implementation since it's not accessed directly. 105 106 procedure timeval_to_duration 107 (T : not null access timeval; 108 sec : not null access C.Extensions.long_long; 109 usec : not null access C.long); 110 pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); 111 112 Micro : constant := 10**6; 113 sec : aliased C.Extensions.long_long; 114 usec : aliased C.long; 115 TV : aliased timeval; 116 Result : int; 117 118 function gettimeofday 119 (Tv : access timeval; 120 Tz : System.Address := System.Null_Address) return int; 121 pragma Import (C, gettimeofday, "gettimeofday"); 122 123 begin 124 Result := gettimeofday (TV'Access, System.Null_Address); 125 pragma Assert (Result = 0); 126 timeval_to_duration (TV'Access, sec'Access, usec'Access); 127 tp.all := To_Timespec (Duration (sec) + Duration (usec) / Micro); 128 return Result; 129 end clock_gettime; 130 131 ------------------ 132 -- clock_getres -- 133 ------------------ 134 135 function clock_getres 136 (clock_id : clockid_t; 137 res : access timespec) return int 138 is 139 pragma Unreferenced (clock_id); 140 141 -- Darwin Threads don't have clock_getres. 142 143 Nano : constant := 10**9; 144 nsec : int := 0; 145 Result : int := -1; 146 147 function clock_get_res return int; 148 pragma Import (C, clock_get_res, "__gnat_clock_get_res"); 149 150 begin 151 nsec := clock_get_res; 152 res.all := To_Timespec (Duration (0.0) + Duration (nsec) / Nano); 153 154 if nsec > 0 then 155 Result := 0; 156 end if; 157 158 return Result; 159 end clock_getres; 160 161 ----------------- 162 -- sched_yield -- 163 ----------------- 164 165 function sched_yield return int is 166 procedure sched_yield_base (arg : System.Address); 167 pragma Import (C, sched_yield_base, "pthread_yield_np"); 168 169 begin 170 sched_yield_base (System.Null_Address); 171 return 0; 172 end sched_yield; 173 174 ------------------ 175 -- pthread_init -- 176 ------------------ 177 178 procedure pthread_init is 179 begin 180 null; 181 end pthread_init; 182 183 ---------------- 184 -- Stack_Base -- 185 ---------------- 186 187 function Get_Stack_Base (thread : pthread_t) return Address is 188 pragma Unreferenced (thread); 189 begin 190 return System.Null_Address; 191 end Get_Stack_Base; 192 193end System.OS_Interface; 194