1 |
12 |
jlechner |
------------------------------------------------------------------------------
|
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-1994, Florida State University --
|
10 |
|
|
-- Copyright (C) 1995-2005, Free Software Foundation, Inc. --
|
11 |
|
|
-- --
|
12 |
|
|
-- GNARL 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 2, or (at your option) any later ver- --
|
15 |
|
|
-- sion. GNARL 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. See the GNU General Public License --
|
18 |
|
|
-- for more details. You should have received a copy of the GNU General --
|
19 |
|
|
-- Public License distributed with GNARL; see file COPYING. If not, write --
|
20 |
|
|
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
|
21 |
|
|
-- Boston, MA 02110-1301, USA. --
|
22 |
|
|
-- --
|
23 |
|
|
-- As a special exception, if other files instantiate generics from this --
|
24 |
|
|
-- unit, or you link this unit with other files to produce an executable, --
|
25 |
|
|
-- this unit does not by itself cause the resulting executable to be --
|
26 |
|
|
-- covered by the GNU General Public License. This exception does not --
|
27 |
|
|
-- however invalidate any other reasons why the executable file might be --
|
28 |
|
|
-- covered by the GNU Public License. --
|
29 |
|
|
-- --
|
30 |
|
|
-- GNARL was developed by the GNARL team at Florida State University. --
|
31 |
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
32 |
|
|
-- --
|
33 |
|
|
------------------------------------------------------------------------------
|
34 |
|
|
|
35 |
|
|
-- This is a NT (native) version of this package
|
36 |
|
|
|
37 |
|
|
-- This package encapsulates all direct interfaces to OS services
|
38 |
|
|
-- that are needed by children of System.
|
39 |
|
|
|
40 |
|
|
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
|
41 |
|
|
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
|
42 |
|
|
|
43 |
|
|
with Interfaces.C;
|
44 |
|
|
with Interfaces.C.Strings;
|
45 |
|
|
with Unchecked_Conversion;
|
46 |
|
|
|
47 |
|
|
package System.OS_Interface is
|
48 |
|
|
pragma Preelaborate;
|
49 |
|
|
|
50 |
|
|
pragma Linker_Options ("-mthreads");
|
51 |
|
|
|
52 |
|
|
subtype int is Interfaces.C.int;
|
53 |
|
|
subtype long is Interfaces.C.long;
|
54 |
|
|
|
55 |
|
|
-------------------
|
56 |
|
|
-- General Types --
|
57 |
|
|
-------------------
|
58 |
|
|
|
59 |
|
|
type DWORD is new Interfaces.C.unsigned_long;
|
60 |
|
|
type WORD is new Interfaces.C.unsigned_short;
|
61 |
|
|
|
62 |
|
|
-- The LARGE_INTEGER type is actually a fixed point type
|
63 |
|
|
-- that only can represent integers. The reason for this is
|
64 |
|
|
-- easier conversion to Duration or other fixed point types.
|
65 |
|
|
-- (See Operations.Clock)
|
66 |
|
|
|
67 |
|
|
type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
|
68 |
|
|
|
69 |
|
|
subtype PSZ is Interfaces.C.Strings.chars_ptr;
|
70 |
|
|
subtype PCHAR is Interfaces.C.Strings.chars_ptr;
|
71 |
|
|
subtype PVOID is System.Address;
|
72 |
|
|
|
73 |
|
|
Null_Void : constant PVOID := System.Null_Address;
|
74 |
|
|
|
75 |
|
|
type PLONG is access all Interfaces.C.long;
|
76 |
|
|
type PDWORD is access all DWORD;
|
77 |
|
|
|
78 |
|
|
type BOOL is new Boolean;
|
79 |
|
|
for BOOL'Size use Interfaces.C.unsigned_long'Size;
|
80 |
|
|
|
81 |
|
|
-------------------------
|
82 |
|
|
-- Handles for objects --
|
83 |
|
|
-------------------------
|
84 |
|
|
|
85 |
|
|
type HANDLE is new Interfaces.C.long;
|
86 |
|
|
type PHANDLE is access all HANDLE;
|
87 |
|
|
|
88 |
|
|
subtype Thread_Id is HANDLE;
|
89 |
|
|
|
90 |
|
|
-----------
|
91 |
|
|
-- Errno --
|
92 |
|
|
-----------
|
93 |
|
|
|
94 |
|
|
NO_ERROR : constant := 0;
|
95 |
|
|
FUNC_ERR : constant := -1;
|
96 |
|
|
|
97 |
|
|
-------------
|
98 |
|
|
-- Signals --
|
99 |
|
|
-------------
|
100 |
|
|
|
101 |
|
|
Max_Interrupt : constant := 31;
|
102 |
|
|
type Signal is new int range 0 .. Max_Interrupt;
|
103 |
|
|
for Signal'Size use int'Size;
|
104 |
|
|
|
105 |
|
|
SIGINT : constant := 2; -- interrupt (Ctrl-C)
|
106 |
|
|
SIGILL : constant := 4; -- illegal instruction (not reset)
|
107 |
|
|
SIGFPE : constant := 8; -- floating point exception
|
108 |
|
|
SIGSEGV : constant := 11; -- segmentation violation
|
109 |
|
|
SIGTERM : constant := 15; -- software termination signal from kill
|
110 |
|
|
SIGBREAK : constant := 21; -- break (Ctrl-Break)
|
111 |
|
|
SIGABRT : constant := 22; -- used by abort, replace SIGIOT in the future
|
112 |
|
|
|
113 |
|
|
type sigset_t is private;
|
114 |
|
|
|
115 |
|
|
type isr_address is access procedure (sig : int);
|
116 |
|
|
|
117 |
|
|
function intr_attach (sig : int; handler : isr_address) return long;
|
118 |
|
|
pragma Import (C, intr_attach, "signal");
|
119 |
|
|
|
120 |
|
|
Intr_Attach_Reset : constant Boolean := True;
|
121 |
|
|
-- True if intr_attach is reset after an interrupt handler is called
|
122 |
|
|
|
123 |
|
|
procedure kill (sig : Signal);
|
124 |
|
|
pragma Import (C, kill, "raise");
|
125 |
|
|
|
126 |
|
|
---------------------
|
127 |
|
|
-- Time Management --
|
128 |
|
|
---------------------
|
129 |
|
|
|
130 |
|
|
procedure Sleep (dwMilliseconds : DWORD);
|
131 |
|
|
pragma Import (Stdcall, Sleep, External_Name => "Sleep");
|
132 |
|
|
|
133 |
|
|
type SYSTEMTIME is record
|
134 |
|
|
wYear : WORD;
|
135 |
|
|
wMonth : WORD;
|
136 |
|
|
wDayOfWeek : WORD;
|
137 |
|
|
wDay : WORD;
|
138 |
|
|
wHour : WORD;
|
139 |
|
|
wMinute : WORD;
|
140 |
|
|
wSecond : WORD;
|
141 |
|
|
wMilliseconds : WORD;
|
142 |
|
|
end record;
|
143 |
|
|
|
144 |
|
|
procedure GetSystemTime (pSystemTime : access SYSTEMTIME);
|
145 |
|
|
pragma Import (Stdcall, GetSystemTime, "GetSystemTime");
|
146 |
|
|
|
147 |
|
|
procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
|
148 |
|
|
pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
|
149 |
|
|
|
150 |
|
|
function SetSystemTime (pSystemTime : access SYSTEMTIME) return BOOL;
|
151 |
|
|
pragma Import (Stdcall, SetSystemTime, "SetSystemTime");
|
152 |
|
|
|
153 |
|
|
function FileTimeToSystemTime
|
154 |
|
|
(lpFileTime : access Long_Long_Integer;
|
155 |
|
|
lpSystemTime : access SYSTEMTIME) return BOOL;
|
156 |
|
|
pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime");
|
157 |
|
|
|
158 |
|
|
function SystemTimeToFileTime
|
159 |
|
|
(lpSystemTime : access SYSTEMTIME;
|
160 |
|
|
lpFileTime : access Long_Long_Integer) return BOOL;
|
161 |
|
|
pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime");
|
162 |
|
|
|
163 |
|
|
function FileTimeToLocalFileTime
|
164 |
|
|
(lpFileTime : access Long_Long_Integer;
|
165 |
|
|
lpLocalFileTime : access Long_Long_Integer) return BOOL;
|
166 |
|
|
pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime");
|
167 |
|
|
|
168 |
|
|
function LocalFileTimeToFileTime
|
169 |
|
|
(lpFileTime : access Long_Long_Integer;
|
170 |
|
|
lpLocalFileTime : access Long_Long_Integer) return BOOL;
|
171 |
|
|
pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime");
|
172 |
|
|
|
173 |
|
|
function QueryPerformanceCounter
|
174 |
|
|
(lpPerformanceCount : access LARGE_INTEGER) return BOOL;
|
175 |
|
|
pragma Import
|
176 |
|
|
(Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
|
177 |
|
|
|
178 |
|
|
function QueryPerformanceFrequency
|
179 |
|
|
(lpFrequency : access LARGE_INTEGER) return BOOL;
|
180 |
|
|
pragma Import
|
181 |
|
|
(Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
|
182 |
|
|
|
183 |
|
|
-------------
|
184 |
|
|
-- Threads --
|
185 |
|
|
-------------
|
186 |
|
|
|
187 |
|
|
type Thread_Body is access
|
188 |
|
|
function (arg : System.Address) return System.Address;
|
189 |
|
|
|
190 |
|
|
function Thread_Body_Access is new
|
191 |
|
|
Unchecked_Conversion (System.Address, Thread_Body);
|
192 |
|
|
|
193 |
|
|
procedure SwitchToThread;
|
194 |
|
|
pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
|
195 |
|
|
|
196 |
|
|
-----------------------
|
197 |
|
|
-- Critical sections --
|
198 |
|
|
-----------------------
|
199 |
|
|
|
200 |
|
|
type CRITICAL_SECTION is private;
|
201 |
|
|
|
202 |
|
|
procedure InitializeCriticalSection
|
203 |
|
|
(pCriticalSection : access CRITICAL_SECTION);
|
204 |
|
|
pragma Import
|
205 |
|
|
(Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
|
206 |
|
|
|
207 |
|
|
procedure EnterCriticalSection
|
208 |
|
|
(pCriticalSection : access CRITICAL_SECTION);
|
209 |
|
|
pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
|
210 |
|
|
|
211 |
|
|
procedure LeaveCriticalSection
|
212 |
|
|
(pCriticalSection : access CRITICAL_SECTION);
|
213 |
|
|
pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
|
214 |
|
|
|
215 |
|
|
procedure DeleteCriticalSection
|
216 |
|
|
(pCriticalSection : access CRITICAL_SECTION);
|
217 |
|
|
pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
|
218 |
|
|
|
219 |
|
|
-------------------------------------------------------------
|
220 |
|
|
-- Thread Creation, Activation, Suspension And Termination --
|
221 |
|
|
-------------------------------------------------------------
|
222 |
|
|
|
223 |
|
|
type PTHREAD_START_ROUTINE is access function
|
224 |
|
|
(pThreadParameter : PVOID) return DWORD;
|
225 |
|
|
pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
|
226 |
|
|
|
227 |
|
|
function To_PTHREAD_START_ROUTINE is new
|
228 |
|
|
Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
|
229 |
|
|
|
230 |
|
|
type SECURITY_ATTRIBUTES is record
|
231 |
|
|
nLength : DWORD;
|
232 |
|
|
pSecurityDescriptor : PVOID;
|
233 |
|
|
bInheritHandle : BOOL;
|
234 |
|
|
end record;
|
235 |
|
|
|
236 |
|
|
type PSECURITY_ATTRIBUTES is access all SECURITY_ATTRIBUTES;
|
237 |
|
|
|
238 |
|
|
function CreateThread
|
239 |
|
|
(pThreadAttributes : PSECURITY_ATTRIBUTES;
|
240 |
|
|
dwStackSize : DWORD;
|
241 |
|
|
pStartAddress : PTHREAD_START_ROUTINE;
|
242 |
|
|
pParameter : PVOID;
|
243 |
|
|
dwCreationFlags : DWORD;
|
244 |
|
|
pThreadId : PDWORD) return HANDLE;
|
245 |
|
|
pragma Import (Stdcall, CreateThread, "CreateThread");
|
246 |
|
|
|
247 |
|
|
function BeginThreadEx
|
248 |
|
|
(pThreadAttributes : PSECURITY_ATTRIBUTES;
|
249 |
|
|
dwStackSize : DWORD;
|
250 |
|
|
pStartAddress : PTHREAD_START_ROUTINE;
|
251 |
|
|
pParameter : PVOID;
|
252 |
|
|
dwCreationFlags : DWORD;
|
253 |
|
|
pThreadId : PDWORD) return HANDLE;
|
254 |
|
|
pragma Import (C, BeginThreadEx, "_beginthreadex");
|
255 |
|
|
|
256 |
|
|
Debug_Process : constant := 16#00000001#;
|
257 |
|
|
Debug_Only_This_Process : constant := 16#00000002#;
|
258 |
|
|
Create_Suspended : constant := 16#00000004#;
|
259 |
|
|
Detached_Process : constant := 16#00000008#;
|
260 |
|
|
Create_New_Console : constant := 16#00000010#;
|
261 |
|
|
|
262 |
|
|
Create_New_Process_Group : constant := 16#00000200#;
|
263 |
|
|
|
264 |
|
|
Create_No_window : constant := 16#08000000#;
|
265 |
|
|
|
266 |
|
|
Profile_User : constant := 16#10000000#;
|
267 |
|
|
Profile_Kernel : constant := 16#20000000#;
|
268 |
|
|
Profile_Server : constant := 16#40000000#;
|
269 |
|
|
|
270 |
|
|
function GetExitCodeThread
|
271 |
|
|
(hThread : HANDLE;
|
272 |
|
|
pExitCode : PDWORD) return BOOL;
|
273 |
|
|
pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
|
274 |
|
|
|
275 |
|
|
function ResumeThread (hThread : HANDLE) return DWORD;
|
276 |
|
|
pragma Import (Stdcall, ResumeThread, "ResumeThread");
|
277 |
|
|
|
278 |
|
|
function SuspendThread (hThread : HANDLE) return DWORD;
|
279 |
|
|
pragma Import (Stdcall, SuspendThread, "SuspendThread");
|
280 |
|
|
|
281 |
|
|
procedure ExitThread (dwExitCode : DWORD);
|
282 |
|
|
pragma Import (Stdcall, ExitThread, "ExitThread");
|
283 |
|
|
|
284 |
|
|
procedure EndThreadEx (dwExitCode : DWORD);
|
285 |
|
|
pragma Import (C, EndThreadEx, "_endthreadex");
|
286 |
|
|
|
287 |
|
|
function TerminateThread
|
288 |
|
|
(hThread : HANDLE;
|
289 |
|
|
dwExitCode : DWORD) return BOOL;
|
290 |
|
|
pragma Import (Stdcall, TerminateThread, "TerminateThread");
|
291 |
|
|
|
292 |
|
|
function GetCurrentThread return HANDLE;
|
293 |
|
|
pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
|
294 |
|
|
|
295 |
|
|
function GetCurrentProcess return HANDLE;
|
296 |
|
|
pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
|
297 |
|
|
|
298 |
|
|
function GetCurrentThreadId return DWORD;
|
299 |
|
|
pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
|
300 |
|
|
|
301 |
|
|
function TlsAlloc return DWORD;
|
302 |
|
|
pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
|
303 |
|
|
|
304 |
|
|
function TlsGetValue (dwTlsIndex : DWORD) return PVOID;
|
305 |
|
|
pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
|
306 |
|
|
|
307 |
|
|
function TlsSetValue (dwTlsIndex : DWORD; pTlsValue : PVOID) return BOOL;
|
308 |
|
|
pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
|
309 |
|
|
|
310 |
|
|
function TlsFree (dwTlsIndex : DWORD) return BOOL;
|
311 |
|
|
pragma Import (Stdcall, TlsFree, "TlsFree");
|
312 |
|
|
|
313 |
|
|
TLS_Nothing : constant := DWORD'Last;
|
314 |
|
|
|
315 |
|
|
procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
|
316 |
|
|
pragma Import (Stdcall, ExitProcess, "ExitProcess");
|
317 |
|
|
|
318 |
|
|
function WaitForSingleObject
|
319 |
|
|
(hHandle : HANDLE;
|
320 |
|
|
dwMilliseconds : DWORD) return DWORD;
|
321 |
|
|
pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
|
322 |
|
|
|
323 |
|
|
function WaitForSingleObjectEx
|
324 |
|
|
(hHandle : HANDLE;
|
325 |
|
|
dwMilliseconds : DWORD;
|
326 |
|
|
fAlertable : BOOL) return DWORD;
|
327 |
|
|
pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
|
328 |
|
|
|
329 |
|
|
Wait_Infinite : constant := DWORD'Last;
|
330 |
|
|
WAIT_TIMEOUT : constant := 16#0000_0102#;
|
331 |
|
|
WAIT_FAILED : constant := 16#FFFF_FFFF#;
|
332 |
|
|
|
333 |
|
|
------------------------------------
|
334 |
|
|
-- Semaphores, Events and Mutexes --
|
335 |
|
|
------------------------------------
|
336 |
|
|
|
337 |
|
|
function CloseHandle (hObject : HANDLE) return BOOL;
|
338 |
|
|
pragma Import (Stdcall, CloseHandle, "CloseHandle");
|
339 |
|
|
|
340 |
|
|
function CreateSemaphore
|
341 |
|
|
(pSemaphoreAttributes : PSECURITY_ATTRIBUTES;
|
342 |
|
|
lInitialCount : Interfaces.C.long;
|
343 |
|
|
lMaximumCount : Interfaces.C.long;
|
344 |
|
|
pName : PSZ) return HANDLE;
|
345 |
|
|
pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
|
346 |
|
|
|
347 |
|
|
function OpenSemaphore
|
348 |
|
|
(dwDesiredAccess : DWORD;
|
349 |
|
|
bInheritHandle : BOOL;
|
350 |
|
|
pName : PSZ) return HANDLE;
|
351 |
|
|
pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
|
352 |
|
|
|
353 |
|
|
function ReleaseSemaphore
|
354 |
|
|
(hSemaphore : HANDLE;
|
355 |
|
|
lReleaseCount : Interfaces.C.long;
|
356 |
|
|
pPreviousCount : PLONG) return BOOL;
|
357 |
|
|
pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
|
358 |
|
|
|
359 |
|
|
function CreateEvent
|
360 |
|
|
(pEventAttributes : PSECURITY_ATTRIBUTES;
|
361 |
|
|
bManualReset : BOOL;
|
362 |
|
|
bInitialState : BOOL;
|
363 |
|
|
pName : PSZ) return HANDLE;
|
364 |
|
|
pragma Import (Stdcall, CreateEvent, "CreateEventA");
|
365 |
|
|
|
366 |
|
|
function OpenEvent
|
367 |
|
|
(dwDesiredAccess : DWORD;
|
368 |
|
|
bInheritHandle : BOOL;
|
369 |
|
|
pName : PSZ) return HANDLE;
|
370 |
|
|
pragma Import (Stdcall, OpenEvent, "OpenEventA");
|
371 |
|
|
|
372 |
|
|
function SetEvent (hEvent : HANDLE) return BOOL;
|
373 |
|
|
pragma Import (Stdcall, SetEvent, "SetEvent");
|
374 |
|
|
|
375 |
|
|
function ResetEvent (hEvent : HANDLE) return BOOL;
|
376 |
|
|
pragma Import (Stdcall, ResetEvent, "ResetEvent");
|
377 |
|
|
|
378 |
|
|
function PulseEvent (hEvent : HANDLE) return BOOL;
|
379 |
|
|
pragma Import (Stdcall, PulseEvent, "PulseEvent");
|
380 |
|
|
|
381 |
|
|
function CreateMutex
|
382 |
|
|
(pMutexAttributes : PSECURITY_ATTRIBUTES;
|
383 |
|
|
bInitialOwner : BOOL;
|
384 |
|
|
pName : PSZ) return HANDLE;
|
385 |
|
|
pragma Import (Stdcall, CreateMutex, "CreateMutexA");
|
386 |
|
|
|
387 |
|
|
function OpenMutex
|
388 |
|
|
(dwDesiredAccess : DWORD;
|
389 |
|
|
bInheritHandle : BOOL;
|
390 |
|
|
pName : PSZ) return HANDLE;
|
391 |
|
|
pragma Import (Stdcall, OpenMutex, "OpenMutexA");
|
392 |
|
|
|
393 |
|
|
function ReleaseMutex (hMutex : HANDLE) return BOOL;
|
394 |
|
|
pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
|
395 |
|
|
|
396 |
|
|
---------------------------------------------------
|
397 |
|
|
-- Accessing properties of Threads and Processes --
|
398 |
|
|
---------------------------------------------------
|
399 |
|
|
|
400 |
|
|
-----------------
|
401 |
|
|
-- Priorities --
|
402 |
|
|
-----------------
|
403 |
|
|
|
404 |
|
|
function SetThreadPriority
|
405 |
|
|
(hThread : HANDLE;
|
406 |
|
|
nPriority : Interfaces.C.int) return BOOL;
|
407 |
|
|
pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
|
408 |
|
|
|
409 |
|
|
function GetThreadPriority (hThread : HANDLE) return Interfaces.C.int;
|
410 |
|
|
pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
|
411 |
|
|
|
412 |
|
|
function SetPriorityClass
|
413 |
|
|
(hProcess : HANDLE;
|
414 |
|
|
dwPriorityClass : DWORD) return BOOL;
|
415 |
|
|
pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
|
416 |
|
|
|
417 |
|
|
procedure SetThreadPriorityBoost
|
418 |
|
|
(hThread : HANDLE;
|
419 |
|
|
DisablePriorityBoost : BOOL);
|
420 |
|
|
pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
|
421 |
|
|
|
422 |
|
|
Normal_Priority_Class : constant := 16#00000020#;
|
423 |
|
|
Idle_Priority_Class : constant := 16#00000040#;
|
424 |
|
|
High_Priority_Class : constant := 16#00000080#;
|
425 |
|
|
Realtime_Priority_Class : constant := 16#00000100#;
|
426 |
|
|
|
427 |
|
|
Thread_Priority_Idle : constant := -15;
|
428 |
|
|
Thread_Priority_Lowest : constant := -2;
|
429 |
|
|
Thread_Priority_Below_Normal : constant := -1;
|
430 |
|
|
Thread_Priority_Normal : constant := 0;
|
431 |
|
|
Thread_Priority_Above_Normal : constant := 1;
|
432 |
|
|
Thread_Priority_Highest : constant := 2;
|
433 |
|
|
Thread_Priority_Time_Critical : constant := 15;
|
434 |
|
|
Thread_Priority_Error_Return : constant := Interfaces.C.long'Last;
|
435 |
|
|
|
436 |
|
|
function GetLastError return DWORD;
|
437 |
|
|
pragma Import (Stdcall, GetLastError, "GetLastError");
|
438 |
|
|
|
439 |
|
|
private
|
440 |
|
|
|
441 |
|
|
type sigset_t is new Interfaces.C.unsigned_long;
|
442 |
|
|
|
443 |
|
|
type CRITICAL_SECTION is record
|
444 |
|
|
DebugInfo : System.Address;
|
445 |
|
|
-- The following three fields control entering and
|
446 |
|
|
-- exiting the critical section for the resource
|
447 |
|
|
LockCount : Long_Integer;
|
448 |
|
|
RecursionCount : Long_Integer;
|
449 |
|
|
OwningThread : HANDLE;
|
450 |
|
|
LockSemaphore : HANDLE;
|
451 |
|
|
Reserved : DWORD;
|
452 |
|
|
end record;
|
453 |
|
|
|
454 |
|
|
end System.OS_Interface;
|