File : s-osinte.ads
------------------------------------------------------------------------------
-- --
-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
5 -- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- S p e c --
-- --
-- $Revision: 1.20 $
10 -- --
-- Copyright (C) 1997-2001, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
30 -- --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com). --
-- --
35 ------------------------------------------------------------------------------
-- This is a NT (native) version of this package.
-- This package encapsulates all direct interfaces to OS services
40 -- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
45
with Interfaces.C;
with Interfaces.C.Strings;
package System.OS_Interface is
50 pragma Preelaborate;
subtype int is Interfaces.C.int;
subtype long is Interfaces.C.long;
55 -------------------
-- General Types --
-------------------
type DWORD is new Interfaces.C.unsigned_long;
60 type WORD is new Interfaces.C.unsigned_short;
-- The LARGE_INTEGER type is actually a fixed point type
-- that only can represent integers. The reason for this is
-- easier conversion to Duration or other fixed point types.
65 -- (See Operations.Clock)
type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
for LARGE_INTEGER'Alignment use 4;
70 subtype PSZ is Interfaces.C.Strings.chars_ptr;
subtype PCHAR is Interfaces.C.Strings.chars_ptr;
subtype PVOID is System.Address;
Null_Void : constant PVOID := System.Null_Address;
75 type PLONG is access all Interfaces.C.long;
type PDWORD is access all DWORD;
type BOOL is new Boolean;
for BOOL'Size use Interfaces.C.unsigned_long'Size;
80
-------------------------
-- Handles for objects --
-------------------------
85 type HANDLE is new Interfaces.C.long;
type PHANDLE is access all HANDLE;
subtype Thread_Id is HANDLE;
90 -----------
-- Errno --
-----------
NO_ERROR : constant := 0;
95 FUNC_ERR : constant := -1;
-------------
-- Signals --
-------------
100
Max_Interrupt : constant := 31;
type Signal is new int range 0 .. Max_Interrupt;
for Signal'Size use int'Size;
105 SIGINT : constant := 2; -- interrupt (Ctrl-C)
SIGILL : constant := 4; -- illegal instruction (not reset)
SIGFPE : constant := 8; -- floating point exception
SIGSEGV : constant := 11; -- segmentation violation
SIGTERM : constant := 15; -- software termination signal from kill
110 SIGBREAK : constant := 21; -- break (Ctrl-Break)
SIGABRT : constant := 22; -- used by abort, replace SIGIOT in the future
type sigset_t is private;
115 type isr_address is access procedure (sig : int);
function intr_attach (sig : int; handler : isr_address) return long;
pragma Import (C, intr_attach, "signal");
120 Intr_Attach_Reset : constant Boolean := True;
-- True if intr_attach is reset after an interrupt handler is called
procedure kill (sig : Signal);
pragma Import (C, kill, "raise");
125
---------------------
-- Time Management --
---------------------
130 procedure Sleep (dwMilliseconds : DWORD);
pragma Import (Stdcall, Sleep, External_Name => "Sleep");
type SYSTEMTIME is record
wYear : WORD;
135 wMonth : WORD;
wDayOfWeek : WORD;
wDay : WORD;
wHour : WORD;
wMinute : WORD;
140 wSecond : WORD;
wMilliseconds : WORD;
end record;
procedure GetSystemTime (pSystemTime : access SYSTEMTIME);
145 pragma Import (Stdcall, GetSystemTime, "GetSystemTime");
procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
150 function SetSystemTime (pSystemTime : access SYSTEMTIME) return BOOL;
pragma Import (Stdcall, SetSystemTime, "SetSystemTime");
function FileTimeToSystemTime
(lpFileTime : access Long_Long_Integer;
155 lpSystemTime : access SYSTEMTIME) return BOOL;
pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime");
function SystemTimeToFileTime
(lpSystemTime : access SYSTEMTIME;
160 lpFileTime : access Long_Long_Integer) return BOOL;
pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime");
function FileTimeToLocalFileTime
(lpFileTime : access Long_Long_Integer;
165 lpLocalFileTime : access Long_Long_Integer) return BOOL;
pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime");
function LocalFileTimeToFileTime
(lpFileTime : access Long_Long_Integer;
170 lpLocalFileTime : access Long_Long_Integer) return BOOL;
pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime");
function QueryPerformanceCounter
(lpPerformanceCount : access LARGE_INTEGER) return BOOL;
175 pragma Import
(Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
function QueryPerformanceFrequency
(lpFrequency : access LARGE_INTEGER) return BOOL;
180 pragma Import
(Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
-------------
-- Threads --
185 -------------
type Thread_Body is access
function (arg : System.Address) return System.Address;
190 -----------------------
-- Critical sections --
-----------------------
type CRITICAL_SECTION is private;
195 type PCRITICAL_SECTION is access all CRITICAL_SECTION;
procedure InitializeCriticalSection (pCriticalSection : PCRITICAL_SECTION);
pragma Import
(Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
200
procedure EnterCriticalSection (pCriticalSection : PCRITICAL_SECTION);
pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
procedure LeaveCriticalSection (pCriticalSection : PCRITICAL_SECTION);
205 pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
procedure DeleteCriticalSection (pCriticalSection : PCRITICAL_SECTION);
pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
210 -------------------------------------------------------------
-- Thread Creation, Activation, Suspension And Termination --
-------------------------------------------------------------
type PTHREAD_START_ROUTINE is access function
215 (pThreadParameter : PVOID) return DWORD;
pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
type SECURITY_ATTRIBUTES is record
nLength : DWORD;
220 pSecurityDescriptor : PVOID;
bInheritHandle : BOOL;
end record;
type PSECURITY_ATTRIBUTES is access all SECURITY_ATTRIBUTES;
225
function CreateThread
(pThreadAttributes : PSECURITY_ATTRIBUTES;
dwStackSize : DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
230 pParameter : PVOID;
dwCreationFlags : DWORD;
pThreadId : PDWORD) return HANDLE;
pragma Import (Stdcall, CreateThread, "CreateThread");
235 function BeginThreadEx
(pThreadAttributes : PSECURITY_ATTRIBUTES;
dwStackSize : DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : PVOID;
240 dwCreationFlags : DWORD;
pThreadId : PDWORD) return HANDLE;
pragma Import (C, BeginThreadEx, "_beginthreadex");
Debug_Process : constant := 16#00000001#;
245 Debug_Only_This_Process : constant := 16#00000002#;
Create_Suspended : constant := 16#00000004#;
Detached_Process : constant := 16#00000008#;
Create_New_Console : constant := 16#00000010#;
250 Create_New_Process_Group : constant := 16#00000200#;
Create_No_window : constant := 16#08000000#;
Profile_User : constant := 16#10000000#;
255 Profile_Kernel : constant := 16#20000000#;
Profile_Server : constant := 16#40000000#;
function GetExitCodeThread
(hThread : HANDLE;
260 pExitCode : PDWORD) return BOOL;
pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
function ResumeThread (hThread : HANDLE) return DWORD;
pragma Import (Stdcall, ResumeThread, "ResumeThread");
265
function SuspendThread (hThread : HANDLE) return DWORD;
pragma Import (Stdcall, SuspendThread, "SuspendThread");
procedure ExitThread (dwExitCode : DWORD);
270 pragma Import (Stdcall, ExitThread, "ExitThread");
procedure EndThreadEx (dwExitCode : DWORD);
pragma Import (C, EndThreadEx, "_endthreadex");
275 function TerminateThread
(hThread : HANDLE;
dwExitCode : DWORD) return BOOL;
pragma Import (Stdcall, TerminateThread, "TerminateThread");
280 function GetCurrentThread return HANDLE;
pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
function GetCurrentProcess return HANDLE;
pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
285
function GetCurrentThreadId return DWORD;
pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
function TlsAlloc return DWORD;
290 pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
function TlsGetValue (dwTlsIndex : DWORD) return PVOID;
pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
295 function TlsSetValue (dwTlsIndex : DWORD; pTlsValue : PVOID) return BOOL;
pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
function TlsFree (dwTlsIndex : DWORD) return BOOL;
pragma Import (Stdcall, TlsFree, "TlsFree");
300
TLS_Nothing : constant := DWORD'Last;
procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
pragma Import (Stdcall, ExitProcess, "ExitProcess");
305
function WaitForSingleObject
(hHandle : HANDLE;
dwMilliseconds : DWORD) return DWORD;
pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
310
function WaitForSingleObjectEx
(hHandle : HANDLE;
dwMilliseconds : DWORD;
fAlertable : BOOL) return DWORD;
315 pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
Wait_Infinite : constant := DWORD'Last;
WAIT_TIMEOUT : constant := 16#0000_0102#;
WAIT_FAILED : constant := 16#FFFF_FFFF#;
320
------------------------------------
-- Semaphores, Events and Mutexes --
------------------------------------
325 function CloseHandle (hObject : HANDLE) return BOOL;
pragma Import (Stdcall, CloseHandle, "CloseHandle");
function CreateSemaphore
(pSemaphoreAttributes : PSECURITY_ATTRIBUTES;
330 lInitialCount : Interfaces.C.long;
lMaximumCount : Interfaces.C.long;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
335 function OpenSemaphore
(dwDesiredAccess : DWORD;
bInheritHandle : BOOL;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
340
function ReleaseSemaphore
(hSemaphore : HANDLE;
lReleaseCount : Interfaces.C.long;
pPreviousCount : PLONG) return BOOL;
345 pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
function CreateEvent
(pEventAttributes : PSECURITY_ATTRIBUTES;
bManualReset : BOOL;
350 bInitialState : BOOL;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, CreateEvent, "CreateEventA");
function OpenEvent
355 (dwDesiredAccess : DWORD;
bInheritHandle : BOOL;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, OpenEvent, "OpenEventA");
360 function SetEvent (hEvent : HANDLE) return BOOL;
pragma Import (Stdcall, SetEvent, "SetEvent");
function ResetEvent (hEvent : HANDLE) return BOOL;
pragma Import (Stdcall, ResetEvent, "ResetEvent");
365
function PulseEvent (hEvent : HANDLE) return BOOL;
pragma Import (Stdcall, PulseEvent, "PulseEvent");
function CreateMutex
370 (pMutexAttributes : PSECURITY_ATTRIBUTES;
bInitialOwner : BOOL;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, CreateMutex, "CreateMutexA");
375 function OpenMutex
(dwDesiredAccess : DWORD;
bInheritHandle : BOOL;
pName : PSZ) return HANDLE;
pragma Import (Stdcall, OpenMutex, "OpenMutexA");
380
function ReleaseMutex (hMutex : HANDLE) return BOOL;
pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
---------------------------------------------------
385 -- Accessing properties of Threads and Processes --
---------------------------------------------------
-----------------
-- Priorities --
390 -----------------
function SetThreadPriority
(hThread : HANDLE;
nPriority : Interfaces.C.int) return BOOL;
395 pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
function GetThreadPriority (hThread : HANDLE) return Interfaces.C.int;
pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
400 function SetPriorityClass
(hProcess : HANDLE;
dwPriorityClass : DWORD) return BOOL;
pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
405 Normal_Priority_Class : constant := 16#00000020#;
Idle_Priority_Class : constant := 16#00000040#;
High_Priority_Class : constant := 16#00000080#;
Realtime_Priority_Class : constant := 16#00000100#;
410 Thread_Priority_Idle : constant := -15;
Thread_Priority_Lowest : constant := -2;
Thread_Priority_Below_Normal : constant := -1;
Thread_Priority_Normal : constant := 0;
Thread_Priority_Above_Normal : constant := 1;
415 Thread_Priority_Highest : constant := 2;
Thread_Priority_Time_Critical : constant := 15;
Thread_Priority_Error_Return : constant := Interfaces.C.long'Last;
function GetLastError return DWORD;
420 pragma Import (Stdcall, GetLastError, "GetLastError");
private
type sigset_t is new Interfaces.C.unsigned_long;
425
type CRITICAL_SECTION is record
DebugInfo : System.Address;
-- The following three fields control entering and
-- exiting the critical section for the resource
430 LockCount : Long_Integer;
RecursionCount : Long_Integer;
OwningThread : HANDLE;
LockSemaphore : HANDLE;
Reserved : DWORD;
435 end record;
end System.OS_Interface;