1------------------------------------------------------------------------------ 2-- -- 3-- GNU ADA 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-2002 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 2, or (at your option) any later ver- -- 14-- sion. GNARL 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. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNARL; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from this -- 23-- unit, or you link this unit with other files to produce an executable, -- 24-- this unit does not by itself cause the resulting executable to be -- 25-- covered by the GNU General Public License. This exception does not -- 26-- however invalidate any other reasons why the executable file might be -- 27-- covered by the GNU Public License. -- 28-- -- 29-- GNARL was developed by the GNARL team at Florida State University. -- 30-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 31-- -- 32------------------------------------------------------------------------------ 33 34-- This is a UnixWare (Native) version of this package 35 36pragma Polling (Off); 37-- Turn off polling, we do not want ATC polling to take place during 38-- tasking operations. It causes infinite loops and other problems. 39 40with Interfaces.C; 41 42package body System.OS_Interface is 43 44 use Interfaces.C; 45 46 ----------------- 47 -- To_Duration -- 48 ----------------- 49 50 function To_Duration (TS : timespec) return Duration is 51 begin 52 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 53 end To_Duration; 54 55 function To_Duration (TV : struct_timeval) return Duration is 56 begin 57 return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; 58 end To_Duration; 59 60 ----------------- 61 -- To_Timespec -- 62 ----------------- 63 64 function To_Timespec (D : Duration) return timespec is 65 S : time_t; 66 F : Duration; 67 68 begin 69 S := time_t (Long_Long_Integer (D)); 70 F := D - Duration (S); 71 72 -- If F has negative value due to a round-up, adjust for positive F 73 -- value. 74 75 if F < 0.0 then 76 S := S - 1; 77 F := F + 1.0; 78 end if; 79 80 return timespec'(tv_sec => S, 81 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 82 end To_Timespec; 83 84 ---------------- 85 -- To_Timeval -- 86 ---------------- 87 88 function To_Timeval (D : Duration) return struct_timeval is 89 S : long; 90 F : Duration; 91 92 begin 93 S := long (Long_Long_Integer (D)); 94 F := D - Duration (S); 95 96 -- If F has negative value due to a round-up, adjust for positive F 97 -- value. 98 99 if F < 0.0 then 100 S := S - 1; 101 F := F + 1.0; 102 end if; 103 104 return 105 struct_timeval' 106 (tv_sec => S, 107 tv_usec => long (Long_Long_Integer (F * 10#1#E6))); 108 end To_Timeval; 109 110 ------------------- 111 -- clock_gettime -- 112 ------------------- 113 114 function clock_gettime 115 (clock_id : clockid_t; 116 tp : access timespec) 117 return int 118 is 119 pragma Warnings (Off, clock_id); 120 121 Result : int; 122 tv : aliased struct_timeval; 123 124 function gettimeofday 125 (tv : access struct_timeval; 126 tz : System.Address := System.Null_Address) 127 return int; 128 pragma Import (C, gettimeofday, "gettimeofday"); 129 130 begin 131 Result := gettimeofday (tv'Unchecked_Access); 132 tp.all := To_Timespec (To_Duration (tv)); 133 return Result; 134 end clock_gettime; 135 136 --------------------------- 137 -- POSIX.1c Section 3 -- 138 --------------------------- 139 140 function sigwait (set : access sigset_t; sig : access Signal) return int is 141 Result : int; 142 143 function sigwait (set : access sigset_t) return int; 144 pragma Import (C, sigwait, "sigwait"); 145 146 begin 147 Result := sigwait (set); 148 149 if Result < 0 then 150 sig.all := 0; 151 return errno; 152 end if; 153 154 sig.all := Signal (Result); 155 return 0; 156 end sigwait; 157 158 function pthread_kill (thread : pthread_t; sig : Signal) return int is 159 function pthread_kill_base 160 (thread : access pthread_t; sig : access Signal) return int; 161 pragma Import (C, pthread_kill_base, "pthread_kill"); 162 163 thr : aliased pthread_t := thread; 164 signo : aliased Signal := sig; 165 166 begin 167 return pthread_kill_base (thr'Unchecked_Access, signo'Unchecked_Access); 168 end pthread_kill; 169 170 function Get_Stack_Base (thread : pthread_t) return Address is 171 pragma Warnings (Off, thread); 172 173 begin 174 return Null_Address; 175 end Get_Stack_Base; 176 177 procedure pthread_init is 178 begin 179 null; 180 end pthread_init; 181 182end System.OS_Interface; 183