|
111
|
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 -- S p e c --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1991-2017, Florida State University --
|
|
131
|
10 -- Copyright (C) 1995-2018, Free Software Foundation, Inc. --
|
|
111
|
11 -- --
|
|
|
12 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
13 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
14 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
17 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
18 -- --
|
|
|
19 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
20 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
21 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
22 -- --
|
|
|
23 -- You should have received a copy of the GNU General Public License and --
|
|
|
24 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
25 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
26 -- <http://www.gnu.org/licenses/>. --
|
|
|
27 -- --
|
|
|
28 -- GNARL was developed by the GNARL team at Florida State University. --
|
|
|
29 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
30 -- --
|
|
|
31 ------------------------------------------------------------------------------
|
|
|
32
|
|
|
33 -- This is a NT (native) version of this package
|
|
|
34
|
|
|
35 -- This package encapsulates all direct interfaces to OS services
|
|
|
36 -- that are needed by the tasking run-time (libgnarl). For non tasking
|
|
|
37 -- oriented services consider declaring them into system-win32.
|
|
|
38
|
|
|
39 -- PLEASE DO NOT add any with-clauses to this package or remove the pragma
|
|
|
40 -- Preelaborate. This package is designed to be a bottom-level (leaf) package.
|
|
|
41
|
|
|
42 with Ada.Unchecked_Conversion;
|
|
|
43
|
|
|
44 with Interfaces.C;
|
|
|
45 with Interfaces.C.Strings;
|
|
|
46 with System.Win32;
|
|
|
47
|
|
|
48 package System.OS_Interface is
|
|
|
49 pragma Preelaborate;
|
|
|
50
|
|
|
51 pragma Linker_Options ("-mthreads");
|
|
|
52
|
|
|
53 subtype int is Interfaces.C.int;
|
|
|
54 subtype long is Interfaces.C.long;
|
|
|
55
|
|
|
56 subtype LARGE_INTEGER is System.Win32.LARGE_INTEGER;
|
|
|
57
|
|
|
58 -------------------
|
|
|
59 -- General Types --
|
|
|
60 -------------------
|
|
|
61
|
|
|
62 subtype PSZ is Interfaces.C.Strings.chars_ptr;
|
|
|
63
|
|
|
64 Null_Void : constant Win32.PVOID := System.Null_Address;
|
|
|
65
|
|
|
66 -------------------------
|
|
|
67 -- Handles for objects --
|
|
|
68 -------------------------
|
|
|
69
|
|
|
70 subtype Thread_Id is Win32.HANDLE;
|
|
|
71
|
|
|
72 -----------
|
|
|
73 -- Errno --
|
|
|
74 -----------
|
|
|
75
|
|
|
76 NO_ERROR : constant := 0;
|
|
|
77 FUNC_ERR : constant := -1;
|
|
|
78
|
|
|
79 -------------
|
|
|
80 -- Signals --
|
|
|
81 -------------
|
|
|
82
|
|
|
83 Max_Interrupt : constant := 31;
|
|
|
84 type Signal is new int range 0 .. Max_Interrupt;
|
|
|
85 for Signal'Size use int'Size;
|
|
|
86
|
|
|
87 SIGINT : constant := 2; -- interrupt (Ctrl-C)
|
|
|
88 SIGILL : constant := 4; -- illegal instruction (not reset)
|
|
|
89 SIGFPE : constant := 8; -- floating point exception
|
|
|
90 SIGSEGV : constant := 11; -- segmentation violation
|
|
|
91 SIGTERM : constant := 15; -- software termination signal from kill
|
|
|
92 SIGBREAK : constant := 21; -- break (Ctrl-Break)
|
|
|
93 SIGABRT : constant := 22; -- used by abort, replace SIGIOT in the future
|
|
|
94
|
|
|
95 type sigset_t is private;
|
|
|
96
|
|
|
97 type isr_address is access procedure (sig : int);
|
|
|
98 pragma Convention (C, isr_address);
|
|
|
99
|
|
|
100 function intr_attach (sig : int; handler : isr_address) return long;
|
|
|
101 pragma Import (C, intr_attach, "signal");
|
|
|
102
|
|
|
103 Intr_Attach_Reset : constant Boolean := True;
|
|
|
104 -- True if intr_attach is reset after an interrupt handler is called
|
|
|
105
|
|
|
106 procedure kill (sig : Signal);
|
|
|
107 pragma Import (C, kill, "raise");
|
|
|
108
|
|
|
109 ------------
|
|
|
110 -- Clock --
|
|
|
111 ------------
|
|
|
112
|
|
|
113 procedure QueryPerformanceFrequency
|
|
|
114 (lpPerformanceFreq : access LARGE_INTEGER);
|
|
|
115 pragma Import
|
|
|
116 (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
|
|
|
117
|
|
|
118 -- According to the spec, on XP and later than function cannot fail,
|
|
|
119 -- so we ignore the return value and import it as a procedure.
|
|
|
120
|
|
|
121 -------------
|
|
|
122 -- Threads --
|
|
|
123 -------------
|
|
|
124
|
|
|
125 type Thread_Body is access
|
|
|
126 function (arg : System.Address) return System.Address;
|
|
|
127 pragma Convention (C, Thread_Body);
|
|
|
128
|
|
|
129 function Thread_Body_Access is new
|
|
|
130 Ada.Unchecked_Conversion (System.Address, Thread_Body);
|
|
|
131
|
|
|
132 procedure SwitchToThread;
|
|
|
133 pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
|
|
|
134
|
|
|
135 function GetThreadTimes
|
|
|
136 (hThread : Win32.HANDLE;
|
|
|
137 lpCreationTime : access Long_Long_Integer;
|
|
|
138 lpExitTime : access Long_Long_Integer;
|
|
|
139 lpKernelTime : access Long_Long_Integer;
|
|
|
140 lpUserTime : access Long_Long_Integer) return Win32.BOOL;
|
|
|
141 pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes");
|
|
|
142
|
|
|
143 -----------------------
|
|
|
144 -- Critical sections --
|
|
|
145 -----------------------
|
|
|
146
|
|
|
147 type CRITICAL_SECTION is private;
|
|
|
148
|
|
|
149 -------------------------------------------------------------
|
|
|
150 -- Thread Creation, Activation, Suspension And Termination --
|
|
|
151 -------------------------------------------------------------
|
|
|
152
|
|
|
153 type PTHREAD_START_ROUTINE is access function
|
|
|
154 (pThreadParameter : Win32.PVOID) return Win32.DWORD;
|
|
|
155 pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
|
|
|
156
|
|
|
157 function To_PTHREAD_START_ROUTINE is new
|
|
|
158 Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
|
|
|
159
|
|
|
160 function CreateThread
|
|
|
161 (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES;
|
|
|
162 dwStackSize : Win32.DWORD;
|
|
|
163 pStartAddress : PTHREAD_START_ROUTINE;
|
|
|
164 pParameter : Win32.PVOID;
|
|
|
165 dwCreationFlags : Win32.DWORD;
|
|
|
166 pThreadId : access Win32.DWORD) return Win32.HANDLE;
|
|
|
167 pragma Import (Stdcall, CreateThread, "CreateThread");
|
|
|
168
|
|
|
169 function BeginThreadEx
|
|
|
170 (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES;
|
|
|
171 dwStackSize : Win32.DWORD;
|
|
|
172 pStartAddress : PTHREAD_START_ROUTINE;
|
|
|
173 pParameter : Win32.PVOID;
|
|
|
174 dwCreationFlags : Win32.DWORD;
|
|
|
175 pThreadId : not null access Win32.DWORD) return Win32.HANDLE;
|
|
|
176 pragma Import (C, BeginThreadEx, "_beginthreadex");
|
|
|
177
|
|
|
178 Debug_Process : constant := 16#00000001#;
|
|
|
179 Debug_Only_This_Process : constant := 16#00000002#;
|
|
|
180 Create_Suspended : constant := 16#00000004#;
|
|
|
181 Detached_Process : constant := 16#00000008#;
|
|
|
182 Create_New_Console : constant := 16#00000010#;
|
|
|
183
|
|
|
184 Create_New_Process_Group : constant := 16#00000200#;
|
|
|
185
|
|
|
186 Create_No_window : constant := 16#08000000#;
|
|
|
187
|
|
|
188 Profile_User : constant := 16#10000000#;
|
|
|
189 Profile_Kernel : constant := 16#20000000#;
|
|
|
190 Profile_Server : constant := 16#40000000#;
|
|
|
191
|
|
|
192 Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#;
|
|
|
193
|
|
|
194 function GetExitCodeThread
|
|
|
195 (hThread : Win32.HANDLE;
|
|
|
196 pExitCode : not null access Win32.DWORD) return Win32.BOOL;
|
|
|
197 pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
|
|
|
198
|
|
|
199 function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD;
|
|
|
200 pragma Import (Stdcall, ResumeThread, "ResumeThread");
|
|
|
201
|
|
|
202 function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD;
|
|
|
203 pragma Import (Stdcall, SuspendThread, "SuspendThread");
|
|
|
204
|
|
|
205 procedure ExitThread (dwExitCode : Win32.DWORD);
|
|
|
206 pragma Import (Stdcall, ExitThread, "ExitThread");
|
|
|
207
|
|
|
208 procedure EndThreadEx (dwExitCode : Win32.DWORD);
|
|
|
209 pragma Import (C, EndThreadEx, "_endthreadex");
|
|
|
210
|
|
|
211 function TerminateThread
|
|
|
212 (hThread : Win32.HANDLE;
|
|
|
213 dwExitCode : Win32.DWORD) return Win32.BOOL;
|
|
|
214 pragma Import (Stdcall, TerminateThread, "TerminateThread");
|
|
|
215
|
|
|
216 function GetCurrentThread return Win32.HANDLE;
|
|
|
217 pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
|
|
|
218
|
|
|
219 function GetCurrentProcess return Win32.HANDLE;
|
|
|
220 pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
|
|
|
221
|
|
|
222 function GetCurrentThreadId return Win32.DWORD;
|
|
|
223 pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
|
|
|
224
|
|
|
225 function TlsAlloc return Win32.DWORD;
|
|
|
226 pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
|
|
|
227
|
|
|
228 function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID;
|
|
|
229 pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
|
|
|
230
|
|
|
231 function TlsSetValue
|
|
|
232 (dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL;
|
|
|
233 pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
|
|
|
234
|
|
|
235 function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL;
|
|
|
236 pragma Import (Stdcall, TlsFree, "TlsFree");
|
|
|
237
|
|
|
238 TLS_Nothing : constant := Win32.DWORD'Last;
|
|
|
239
|
|
|
240 procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
|
|
|
241 pragma Import (Stdcall, ExitProcess, "ExitProcess");
|
|
|
242
|
|
|
243 function WaitForSingleObject
|
|
|
244 (hHandle : Win32.HANDLE;
|
|
|
245 dwMilliseconds : Win32.DWORD) return Win32.DWORD;
|
|
|
246 pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
|
|
|
247
|
|
|
248 function WaitForSingleObjectEx
|
|
|
249 (hHandle : Win32.HANDLE;
|
|
|
250 dwMilliseconds : Win32.DWORD;
|
|
|
251 fAlertable : Win32.BOOL) return Win32.DWORD;
|
|
|
252 pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
|
|
|
253
|
|
|
254 Wait_Infinite : constant := Win32.DWORD'Last;
|
|
|
255 WAIT_TIMEOUT : constant := 16#0000_0102#;
|
|
|
256 WAIT_FAILED : constant := 16#FFFF_FFFF#;
|
|
|
257
|
|
|
258 ------------------------------------
|
|
|
259 -- Semaphores, Events and Mutexes --
|
|
|
260 ------------------------------------
|
|
|
261
|
|
|
262 function CreateSemaphore
|
|
|
263 (pSemaphoreAttributes : access Win32.SECURITY_ATTRIBUTES;
|
|
|
264 lInitialCount : Interfaces.C.long;
|
|
|
265 lMaximumCount : Interfaces.C.long;
|
|
|
266 pName : PSZ) return Win32.HANDLE;
|
|
|
267 pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
|
|
|
268
|
|
|
269 function OpenSemaphore
|
|
|
270 (dwDesiredAccess : Win32.DWORD;
|
|
|
271 bInheritHandle : Win32.BOOL;
|
|
|
272 pName : PSZ) return Win32.HANDLE;
|
|
|
273 pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
|
|
|
274
|
|
|
275 function ReleaseSemaphore
|
|
|
276 (hSemaphore : Win32.HANDLE;
|
|
|
277 lReleaseCount : Interfaces.C.long;
|
|
|
278 pPreviousCount : access Win32.LONG) return Win32.BOOL;
|
|
|
279 pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
|
|
|
280
|
|
|
281 function CreateEvent
|
|
|
282 (pEventAttributes : access Win32.SECURITY_ATTRIBUTES;
|
|
|
283 bManualReset : Win32.BOOL;
|
|
|
284 bInitialState : Win32.BOOL;
|
|
|
285 pName : PSZ) return Win32.HANDLE;
|
|
|
286 pragma Import (Stdcall, CreateEvent, "CreateEventA");
|
|
|
287
|
|
|
288 function OpenEvent
|
|
|
289 (dwDesiredAccess : Win32.DWORD;
|
|
|
290 bInheritHandle : Win32.BOOL;
|
|
|
291 pName : PSZ) return Win32.HANDLE;
|
|
|
292 pragma Import (Stdcall, OpenEvent, "OpenEventA");
|
|
|
293
|
|
|
294 function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
|
|
|
295 pragma Import (Stdcall, SetEvent, "SetEvent");
|
|
|
296
|
|
|
297 function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
|
|
|
298 pragma Import (Stdcall, ResetEvent, "ResetEvent");
|
|
|
299
|
|
|
300 function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
|
|
|
301 pragma Import (Stdcall, PulseEvent, "PulseEvent");
|
|
|
302
|
|
|
303 function CreateMutex
|
|
|
304 (pMutexAttributes : access Win32.SECURITY_ATTRIBUTES;
|
|
|
305 bInitialOwner : Win32.BOOL;
|
|
|
306 pName : PSZ) return Win32.HANDLE;
|
|
|
307 pragma Import (Stdcall, CreateMutex, "CreateMutexA");
|
|
|
308
|
|
|
309 function OpenMutex
|
|
|
310 (dwDesiredAccess : Win32.DWORD;
|
|
|
311 bInheritHandle : Win32.BOOL;
|
|
|
312 pName : PSZ) return Win32.HANDLE;
|
|
|
313 pragma Import (Stdcall, OpenMutex, "OpenMutexA");
|
|
|
314
|
|
|
315 function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL;
|
|
|
316 pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
|
|
|
317
|
|
|
318 ---------------------------------------------------
|
|
|
319 -- Accessing properties of Threads and Processes --
|
|
|
320 ---------------------------------------------------
|
|
|
321
|
|
|
322 -----------------
|
|
|
323 -- Priorities --
|
|
|
324 -----------------
|
|
|
325
|
|
|
326 function SetThreadPriority
|
|
|
327 (hThread : Win32.HANDLE;
|
|
|
328 nPriority : Interfaces.C.int) return Win32.BOOL;
|
|
|
329 pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
|
|
|
330
|
|
|
331 function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int;
|
|
|
332 pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
|
|
|
333
|
|
|
334 function SetPriorityClass
|
|
|
335 (hProcess : Win32.HANDLE;
|
|
|
336 dwPriorityClass : Win32.DWORD) return Win32.BOOL;
|
|
|
337 pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
|
|
|
338
|
|
|
339 procedure SetThreadPriorityBoost
|
|
|
340 (hThread : Win32.HANDLE;
|
|
|
341 DisablePriorityBoost : Win32.BOOL);
|
|
|
342 pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
|
|
|
343
|
|
|
344 Normal_Priority_Class : constant := 16#00000020#;
|
|
|
345 Idle_Priority_Class : constant := 16#00000040#;
|
|
|
346 High_Priority_Class : constant := 16#00000080#;
|
|
|
347 Realtime_Priority_Class : constant := 16#00000100#;
|
|
|
348
|
|
|
349 Thread_Priority_Idle : constant := -15;
|
|
|
350 Thread_Priority_Lowest : constant := -2;
|
|
|
351 Thread_Priority_Below_Normal : constant := -1;
|
|
|
352 Thread_Priority_Normal : constant := 0;
|
|
|
353 Thread_Priority_Above_Normal : constant := 1;
|
|
|
354 Thread_Priority_Highest : constant := 2;
|
|
|
355 Thread_Priority_Time_Critical : constant := 15;
|
|
|
356 Thread_Priority_Error_Return : constant := Interfaces.C.long'Last;
|
|
|
357
|
|
|
358 private
|
|
|
359
|
|
|
360 type sigset_t is new Interfaces.C.unsigned_long;
|
|
|
361
|
|
|
362 type CRITICAL_SECTION is record
|
|
|
363 DebugInfo : System.Address;
|
|
|
364
|
|
|
365 LockCount : Long_Integer;
|
|
|
366 RecursionCount : Long_Integer;
|
|
|
367 OwningThread : Win32.HANDLE;
|
|
|
368 -- The above three fields control entering and exiting the critical
|
|
|
369 -- section for the resource.
|
|
|
370
|
|
|
371 LockSemaphore : Win32.HANDLE;
|
|
|
372 SpinCount : Win32.DWORD;
|
|
|
373 end record;
|
|
|
374
|
|
|
375 end System.OS_Interface;
|
