1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . O S _ I N T E R F A C E --
9 -- Copyright (C) 1991-2017, Florida State University --
10 -- Copyright (C) 1995-2024, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
28 -- GNARL was developed by the GNARL team at Florida State University. --
29 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 ------------------------------------------------------------------------------
33 -- This is a NT (native) version of this package
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.
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.
42 with Ada
.Unchecked_Conversion
;
45 with Interfaces
.C
.Strings
;
50 package System
.OS_Interface
is
53 pragma Linker_Options
("-mthreads");
55 subtype int
is Interfaces
.C
.int
;
56 subtype long
is Interfaces
.C
.long
;
58 subtype LARGE_INTEGER
is System
.Win32
.LARGE_INTEGER
;
64 subtype PSZ
is Interfaces
.C
.Strings
.chars_ptr
;
66 Null_Void
: constant Win32
.PVOID
:= System
.Null_Address
;
68 -------------------------
69 -- Handles for objects --
70 -------------------------
72 subtype Thread_Id
is Win32
.HANDLE
;
78 NO_ERROR
: constant := 0;
79 FUNC_ERR
: constant := -1;
85 Max_Interrupt
: constant := 31;
86 type Signal
is new int
range 0 .. Max_Interrupt
;
87 for Signal
'Size use int
'Size;
89 SIGINT
: constant := 2; -- interrupt (Ctrl-C)
90 SIGILL
: constant := 4; -- illegal instruction (not reset)
91 SIGFPE
: constant := 8; -- floating point exception
92 SIGSEGV
: constant := 11; -- segmentation violation
93 SIGTERM
: constant := 15; -- software termination signal from kill
94 SIGBREAK
: constant := 21; -- break (Ctrl-Break)
95 SIGABRT
: constant := 22; -- used by abort, replace SIGIOT in the future
97 type sigset_t
is private;
99 type isr_address
is access procedure (sig
: int
);
100 pragma Convention
(C
, isr_address
);
102 function intr_attach
(sig
: int
; handler
: isr_address
) return long
;
103 pragma Import
(C
, intr_attach
, "signal");
105 Intr_Attach_Reset
: constant Boolean := True;
106 -- True if intr_attach is reset after an interrupt handler is called
108 procedure kill
(sig
: Signal
);
109 pragma Import
(C
, kill
, "raise");
115 procedure QueryPerformanceFrequency
116 (lpPerformanceFreq
: access LARGE_INTEGER
);
118 (Stdcall
, QueryPerformanceFrequency
, "QueryPerformanceFrequency");
120 -- According to the spec, on XP and later than function cannot fail,
121 -- so we ignore the return value and import it as a procedure.
127 type Thread_Body
is access
128 function (arg
: System
.Address
) return System
.Address
;
129 pragma Convention
(C
, Thread_Body
);
131 function Thread_Body_Access
is new
132 Ada
.Unchecked_Conversion
(System
.Address
, Thread_Body
);
134 procedure SwitchToThread
;
135 pragma Import
(Stdcall
, SwitchToThread
, "SwitchToThread");
137 function GetThreadTimes
138 (hThread
: Win32
.HANDLE
;
139 lpCreationTime
: access Long_Long_Integer;
140 lpExitTime
: access Long_Long_Integer;
141 lpKernelTime
: access Long_Long_Integer;
142 lpUserTime
: access Long_Long_Integer) return Win32
.BOOL
;
143 pragma Import
(Stdcall
, GetThreadTimes
, "GetThreadTimes");
145 -----------------------
146 -- Critical sections --
147 -----------------------
149 subtype CRITICAL_SECTION
is System
.OS_Locks
.CRITICAL_SECTION
;
151 procedure InitializeCriticalSection
152 (pCriticalSection
: access CRITICAL_SECTION
);
154 (Stdcall
, InitializeCriticalSection
, "InitializeCriticalSection");
156 procedure EnterCriticalSection
157 (pCriticalSection
: access CRITICAL_SECTION
);
158 pragma Import
(Stdcall
, EnterCriticalSection
, "EnterCriticalSection");
160 procedure LeaveCriticalSection
161 (pCriticalSection
: access CRITICAL_SECTION
);
162 pragma Import
(Stdcall
, LeaveCriticalSection
, "LeaveCriticalSection");
164 procedure DeleteCriticalSection
165 (pCriticalSection
: access CRITICAL_SECTION
);
166 pragma Import
(Stdcall
, DeleteCriticalSection
, "DeleteCriticalSection");
168 -------------------------------------------------------------
169 -- Thread Creation, Activation, Suspension And Termination --
170 -------------------------------------------------------------
172 type PTHREAD_START_ROUTINE
is access function
173 (pThreadParameter
: Win32
.PVOID
) return Win32
.DWORD
;
174 pragma Convention
(Stdcall
, PTHREAD_START_ROUTINE
);
176 function To_PTHREAD_START_ROUTINE
is new
177 Ada
.Unchecked_Conversion
(System
.Address
, PTHREAD_START_ROUTINE
);
179 function CreateThread
180 (pThreadAttributes
: access Win32
.SECURITY_ATTRIBUTES
;
181 dwStackSize
: Win32
.DWORD
;
182 pStartAddress
: PTHREAD_START_ROUTINE
;
183 pParameter
: Win32
.PVOID
;
184 dwCreationFlags
: Win32
.DWORD
;
185 pThreadId
: access Win32
.DWORD
) return Win32
.HANDLE
;
186 pragma Import
(Stdcall
, CreateThread
, "CreateThread");
188 function BeginThreadEx
189 (pThreadAttributes
: access Win32
.SECURITY_ATTRIBUTES
;
190 dwStackSize
: Win32
.DWORD
;
191 pStartAddress
: PTHREAD_START_ROUTINE
;
192 pParameter
: Win32
.PVOID
;
193 dwCreationFlags
: Win32
.DWORD
;
194 pThreadId
: not null access Win32
.DWORD
) return Win32
.HANDLE
;
195 pragma Import
(C
, BeginThreadEx
, "_beginthreadex");
197 Debug_Process
: constant := 16#
00000001#
;
198 Debug_Only_This_Process
: constant := 16#
00000002#
;
199 Create_Suspended
: constant := 16#
00000004#
;
200 Detached_Process
: constant := 16#
00000008#
;
201 Create_New_Console
: constant := 16#
00000010#
;
203 Create_New_Process_Group
: constant := 16#
00000200#
;
205 Create_No_window
: constant := 16#
08000000#
;
207 Profile_User
: constant := 16#
10000000#
;
208 Profile_Kernel
: constant := 16#
20000000#
;
209 Profile_Server
: constant := 16#
40000000#
;
211 Stack_Size_Param_Is_A_Reservation
: constant := 16#
00010000#
;
213 function GetExitCodeThread
214 (hThread
: Win32
.HANDLE
;
215 pExitCode
: not null access Win32
.DWORD
) return Win32
.BOOL
;
216 pragma Import
(Stdcall
, GetExitCodeThread
, "GetExitCodeThread");
218 function ResumeThread
(hThread
: Win32
.HANDLE
) return Win32
.DWORD
;
219 pragma Import
(Stdcall
, ResumeThread
, "ResumeThread");
221 function SuspendThread
(hThread
: Win32
.HANDLE
) return Win32
.DWORD
;
222 pragma Import
(Stdcall
, SuspendThread
, "SuspendThread");
224 procedure ExitThread
(dwExitCode
: Win32
.DWORD
);
225 pragma Import
(Stdcall
, ExitThread
, "ExitThread");
227 procedure EndThreadEx
(dwExitCode
: Win32
.DWORD
);
228 pragma Import
(C
, EndThreadEx
, "_endthreadex");
230 function TerminateThread
231 (hThread
: Win32
.HANDLE
;
232 dwExitCode
: Win32
.DWORD
) return Win32
.BOOL
;
233 pragma Import
(Stdcall
, TerminateThread
, "TerminateThread");
235 function GetCurrentThread
return Win32
.HANDLE
;
236 pragma Import
(Stdcall
, GetCurrentThread
, "GetCurrentThread");
238 function GetCurrentProcess
return Win32
.HANDLE
;
239 pragma Import
(Stdcall
, GetCurrentProcess
, "GetCurrentProcess");
241 function GetCurrentThreadId
return Win32
.DWORD
;
242 pragma Import
(Stdcall
, GetCurrentThreadId
, "GetCurrentThreadId");
244 function TlsAlloc
return Win32
.DWORD
;
245 pragma Import
(Stdcall
, TlsAlloc
, "TlsAlloc");
247 function TlsGetValue
(dwTlsIndex
: Win32
.DWORD
) return Win32
.PVOID
;
248 pragma Import
(Stdcall
, TlsGetValue
, "TlsGetValue");
251 (dwTlsIndex
: Win32
.DWORD
; pTlsValue
: Win32
.PVOID
) return Win32
.BOOL
;
252 pragma Import
(Stdcall
, TlsSetValue
, "TlsSetValue");
254 function TlsFree
(dwTlsIndex
: Win32
.DWORD
) return Win32
.BOOL
;
255 pragma Import
(Stdcall
, TlsFree
, "TlsFree");
257 TLS_Nothing
: constant := Win32
.DWORD
'Last;
259 procedure ExitProcess
(uExitCode
: Interfaces
.C
.unsigned
);
260 pragma Import
(Stdcall
, ExitProcess
, "ExitProcess");
262 function WaitForSingleObject
263 (hHandle
: Win32
.HANDLE
;
264 dwMilliseconds
: Win32
.DWORD
) return Win32
.DWORD
;
265 pragma Import
(Stdcall
, WaitForSingleObject
, "WaitForSingleObject");
267 function WaitForSingleObjectEx
268 (hHandle
: Win32
.HANDLE
;
269 dwMilliseconds
: Win32
.DWORD
;
270 fAlertable
: Win32
.BOOL
) return Win32
.DWORD
;
271 pragma Import
(Stdcall
, WaitForSingleObjectEx
, "WaitForSingleObjectEx");
273 Wait_Infinite
: constant := Win32
.DWORD
'Last;
274 WAIT_TIMEOUT
: constant := 16#
0000_0102#
;
275 WAIT_FAILED
: constant := 16#FFFF_FFFF#
;
277 ------------------------------------
278 -- Semaphores, Events and Mutexes --
279 ------------------------------------
281 function CreateSemaphore
282 (pSemaphoreAttributes
: access Win32
.SECURITY_ATTRIBUTES
;
283 lInitialCount
: Interfaces
.C
.long
;
284 lMaximumCount
: Interfaces
.C
.long
;
285 pName
: PSZ
) return Win32
.HANDLE
;
286 pragma Import
(Stdcall
, CreateSemaphore
, "CreateSemaphoreA");
288 function OpenSemaphore
289 (dwDesiredAccess
: Win32
.DWORD
;
290 bInheritHandle
: Win32
.BOOL
;
291 pName
: PSZ
) return Win32
.HANDLE
;
292 pragma Import
(Stdcall
, OpenSemaphore
, "OpenSemaphoreA");
294 function ReleaseSemaphore
295 (hSemaphore
: Win32
.HANDLE
;
296 lReleaseCount
: Interfaces
.C
.long
;
297 pPreviousCount
: access Win32
.LONG
) return Win32
.BOOL
;
298 pragma Import
(Stdcall
, ReleaseSemaphore
, "ReleaseSemaphore");
301 (pEventAttributes
: access Win32
.SECURITY_ATTRIBUTES
;
302 bManualReset
: Win32
.BOOL
;
303 bInitialState
: Win32
.BOOL
;
304 pName
: PSZ
) return Win32
.HANDLE
;
305 pragma Import
(Stdcall
, CreateEvent
, "CreateEventA");
308 (dwDesiredAccess
: Win32
.DWORD
;
309 bInheritHandle
: Win32
.BOOL
;
310 pName
: PSZ
) return Win32
.HANDLE
;
311 pragma Import
(Stdcall
, OpenEvent
, "OpenEventA");
313 function SetEvent
(hEvent
: Win32
.HANDLE
) return Win32
.BOOL
;
314 pragma Import
(Stdcall
, SetEvent
, "SetEvent");
316 function ResetEvent
(hEvent
: Win32
.HANDLE
) return Win32
.BOOL
;
317 pragma Import
(Stdcall
, ResetEvent
, "ResetEvent");
319 function PulseEvent
(hEvent
: Win32
.HANDLE
) return Win32
.BOOL
;
320 pragma Import
(Stdcall
, PulseEvent
, "PulseEvent");
323 (pMutexAttributes
: access Win32
.SECURITY_ATTRIBUTES
;
324 bInitialOwner
: Win32
.BOOL
;
325 pName
: PSZ
) return Win32
.HANDLE
;
326 pragma Import
(Stdcall
, CreateMutex
, "CreateMutexA");
329 (dwDesiredAccess
: Win32
.DWORD
;
330 bInheritHandle
: Win32
.BOOL
;
331 pName
: PSZ
) return Win32
.HANDLE
;
332 pragma Import
(Stdcall
, OpenMutex
, "OpenMutexA");
334 function ReleaseMutex
(hMutex
: Win32
.HANDLE
) return Win32
.BOOL
;
335 pragma Import
(Stdcall
, ReleaseMutex
, "ReleaseMutex");
337 ---------------------------------------------------
338 -- Accessing properties of Threads and Processes --
339 ---------------------------------------------------
345 function SetThreadPriority
346 (hThread
: Win32
.HANDLE
;
347 nPriority
: Interfaces
.C
.int
) return Win32
.BOOL
;
348 pragma Import
(Stdcall
, SetThreadPriority
, "SetThreadPriority");
350 function GetThreadPriority
(hThread
: Win32
.HANDLE
) return Interfaces
.C
.int
;
351 pragma Import
(Stdcall
, GetThreadPriority
, "GetThreadPriority");
353 function SetPriorityClass
354 (hProcess
: Win32
.HANDLE
;
355 dwPriorityClass
: Win32
.DWORD
) return Win32
.BOOL
;
356 pragma Import
(Stdcall
, SetPriorityClass
, "SetPriorityClass");
358 procedure SetThreadPriorityBoost
359 (hThread
: Win32
.HANDLE
;
360 DisablePriorityBoost
: Win32
.BOOL
);
361 pragma Import
(Stdcall
, SetThreadPriorityBoost
, "SetThreadPriorityBoost");
363 Normal_Priority_Class
: constant := 16#
00000020#
;
364 Idle_Priority_Class
: constant := 16#
00000040#
;
365 High_Priority_Class
: constant := 16#
00000080#
;
366 Realtime_Priority_Class
: constant := 16#
00000100#
;
368 Thread_Priority_Idle
: constant := -15;
369 Thread_Priority_Lowest
: constant := -2;
370 Thread_Priority_Below_Normal
: constant := -1;
371 Thread_Priority_Normal
: constant := 0;
372 Thread_Priority_Above_Normal
: constant := 1;
373 Thread_Priority_Highest
: constant := 2;
374 Thread_Priority_Time_Critical
: constant := 15;
375 Thread_Priority_Error_Return
: constant := Interfaces
.C
.long
'Last;
379 type sigset_t
is new Interfaces
.C
.unsigned_long
;
381 end System
.OS_Interface
;