blob: 8b05f41b2fa29b3f58c70781215a4a5f5d3b16ae [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2017, Florida State University --
-- Copyright (C) 1995-2022, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is a NT (native) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by the tasking run-time (libgnarl). For non tasking
-- oriented services consider declaring them into system-win32.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Ada.Unchecked_Conversion;
with Interfaces.C;
with Interfaces.C.Strings;
with System.Win32;
package System.OS_Interface is
pragma Preelaborate;
pragma Linker_Options ("-mthreads");
subtype int is Interfaces.C.int;
subtype long is Interfaces.C.long;
subtype LARGE_INTEGER is System.Win32.LARGE_INTEGER;
-------------------
-- General Types --
-------------------
subtype PSZ is Interfaces.C.Strings.chars_ptr;
Null_Void : constant Win32.PVOID := System.Null_Address;
-------------------------
-- Handles for objects --
-------------------------
subtype Thread_Id is Win32.HANDLE;
-----------
-- Errno --
-----------
NO_ERROR : constant := 0;
FUNC_ERR : constant := -1;
-------------
-- Signals --
-------------
Max_Interrupt : constant := 31;
type Signal is new int range 0 .. Max_Interrupt;
for Signal'Size use int'Size;
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
SIGBREAK : constant := 21; -- break (Ctrl-Break)
SIGABRT : constant := 22; -- used by abort, replace SIGIOT in the future
type sigset_t is private;
type isr_address is access procedure (sig : int);
pragma Convention (C, isr_address);
function intr_attach (sig : int; handler : isr_address) return long;
pragma Import (C, intr_attach, "signal");
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");
------------
-- Clock --
------------
procedure QueryPerformanceFrequency
(lpPerformanceFreq : access LARGE_INTEGER);
pragma Import
(Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
-- According to the spec, on XP and later than function cannot fail,
-- so we ignore the return value and import it as a procedure.
-------------
-- Threads --
-------------
type Thread_Body is access
function (arg : System.Address) return System.Address;
pragma Convention (C, Thread_Body);
function Thread_Body_Access is new
Ada.Unchecked_Conversion (System.Address, Thread_Body);
procedure SwitchToThread;
pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
function GetThreadTimes
(hThread : Win32.HANDLE;
lpCreationTime : access Long_Long_Integer;
lpExitTime : access Long_Long_Integer;
lpKernelTime : access Long_Long_Integer;
lpUserTime : access Long_Long_Integer) return Win32.BOOL;
pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes");
-----------------------
-- Critical sections --
-----------------------
type CRITICAL_SECTION is private;
-------------------------------------------------------------
-- Thread Creation, Activation, Suspension And Termination --
-------------------------------------------------------------
type PTHREAD_START_ROUTINE is access function
(pThreadParameter : Win32.PVOID) return Win32.DWORD;
pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
function To_PTHREAD_START_ROUTINE is new
Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
function CreateThread
(pThreadAttributes : access Win32.SECURITY_ATTRIBUTES;
dwStackSize : Win32.DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : Win32.PVOID;
dwCreationFlags : Win32.DWORD;
pThreadId : access Win32.DWORD) return Win32.HANDLE;
pragma Import (Stdcall, CreateThread, "CreateThread");
function BeginThreadEx
(pThreadAttributes : access Win32.SECURITY_ATTRIBUTES;
dwStackSize : Win32.DWORD;
pStartAddress : PTHREAD_START_ROUTINE;
pParameter : Win32.PVOID;
dwCreationFlags : Win32.DWORD;
pThreadId : not null access Win32.DWORD) return Win32.HANDLE;
pragma Import (C, BeginThreadEx, "_beginthreadex");
Debug_Process : constant := 16#00000001#;
Debug_Only_This_Process : constant := 16#00000002#;
Create_Suspended : constant := 16#00000004#;
Detached_Process : constant := 16#00000008#;
Create_New_Console : constant := 16#00000010#;
Create_New_Process_Group : constant := 16#00000200#;
Create_No_window : constant := 16#08000000#;
Profile_User : constant := 16#10000000#;
Profile_Kernel : constant := 16#20000000#;
Profile_Server : constant := 16#40000000#;
Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#;
function GetExitCodeThread
(hThread : Win32.HANDLE;
pExitCode : not null access Win32.DWORD) return Win32.BOOL;
pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD;
pragma Import (Stdcall, ResumeThread, "ResumeThread");
function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD;
pragma Import (Stdcall, SuspendThread, "SuspendThread");
procedure ExitThread (dwExitCode : Win32.DWORD);
pragma Import (Stdcall, ExitThread, "ExitThread");
procedure EndThreadEx (dwExitCode : Win32.DWORD);
pragma Import (C, EndThreadEx, "_endthreadex");
function TerminateThread
(hThread : Win32.HANDLE;
dwExitCode : Win32.DWORD) return Win32.BOOL;
pragma Import (Stdcall, TerminateThread, "TerminateThread");
function GetCurrentThread return Win32.HANDLE;
pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
function GetCurrentProcess return Win32.HANDLE;
pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
function GetCurrentThreadId return Win32.DWORD;
pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
function TlsAlloc return Win32.DWORD;
pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID;
pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
function TlsSetValue
(dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL;
pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL;
pragma Import (Stdcall, TlsFree, "TlsFree");
TLS_Nothing : constant := Win32.DWORD'Last;
procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
pragma Import (Stdcall, ExitProcess, "ExitProcess");
function WaitForSingleObject
(hHandle : Win32.HANDLE;
dwMilliseconds : Win32.DWORD) return Win32.DWORD;
pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
function WaitForSingleObjectEx
(hHandle : Win32.HANDLE;
dwMilliseconds : Win32.DWORD;
fAlertable : Win32.BOOL) return Win32.DWORD;
pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
Wait_Infinite : constant := Win32.DWORD'Last;
WAIT_TIMEOUT : constant := 16#0000_0102#;
WAIT_FAILED : constant := 16#FFFF_FFFF#;
------------------------------------
-- Semaphores, Events and Mutexes --
------------------------------------
function CreateSemaphore
(pSemaphoreAttributes : access Win32.SECURITY_ATTRIBUTES;
lInitialCount : Interfaces.C.long;
lMaximumCount : Interfaces.C.long;
pName : PSZ) return Win32.HANDLE;
pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
function OpenSemaphore
(dwDesiredAccess : Win32.DWORD;
bInheritHandle : Win32.BOOL;
pName : PSZ) return Win32.HANDLE;
pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
function ReleaseSemaphore
(hSemaphore : Win32.HANDLE;
lReleaseCount : Interfaces.C.long;
pPreviousCount : access Win32.LONG) return Win32.BOOL;
pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
function CreateEvent
(pEventAttributes : access Win32.SECURITY_ATTRIBUTES;
bManualReset : Win32.BOOL;
bInitialState : Win32.BOOL;
pName : PSZ) return Win32.HANDLE;
pragma Import (Stdcall, CreateEvent, "CreateEventA");
function OpenEvent
(dwDesiredAccess : Win32.DWORD;
bInheritHandle : Win32.BOOL;
pName : PSZ) return Win32.HANDLE;
pragma Import (Stdcall, OpenEvent, "OpenEventA");
function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
pragma Import (Stdcall, SetEvent, "SetEvent");
function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
pragma Import (Stdcall, ResetEvent, "ResetEvent");
function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
pragma Import (Stdcall, PulseEvent, "PulseEvent");
function CreateMutex
(pMutexAttributes : access Win32.SECURITY_ATTRIBUTES;
bInitialOwner : Win32.BOOL;
pName : PSZ) return Win32.HANDLE;
pragma Import (Stdcall, CreateMutex, "CreateMutexA");
function OpenMutex
(dwDesiredAccess : Win32.DWORD;
bInheritHandle : Win32.BOOL;
pName : PSZ) return Win32.HANDLE;
pragma Import (Stdcall, OpenMutex, "OpenMutexA");
function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL;
pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
---------------------------------------------------
-- Accessing properties of Threads and Processes --
---------------------------------------------------
-----------------
-- Priorities --
-----------------
function SetThreadPriority
(hThread : Win32.HANDLE;
nPriority : Interfaces.C.int) return Win32.BOOL;
pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int;
pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
function SetPriorityClass
(hProcess : Win32.HANDLE;
dwPriorityClass : Win32.DWORD) return Win32.BOOL;
pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
procedure SetThreadPriorityBoost
(hThread : Win32.HANDLE;
DisablePriorityBoost : Win32.BOOL);
pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
Normal_Priority_Class : constant := 16#00000020#;
Idle_Priority_Class : constant := 16#00000040#;
High_Priority_Class : constant := 16#00000080#;
Realtime_Priority_Class : constant := 16#00000100#;
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;
Thread_Priority_Highest : constant := 2;
Thread_Priority_Time_Critical : constant := 15;
Thread_Priority_Error_Return : constant := Interfaces.C.long'Last;
private
type sigset_t is new Interfaces.C.unsigned_long;
type CRITICAL_SECTION is record
DebugInfo : System.Address;
LockCount : Long_Integer;
RecursionCount : Long_Integer;
OwningThread : Win32.HANDLE;
-- The above three fields control entering and exiting the critical
-- section for the resource.
LockSemaphore : Win32.HANDLE;
SpinCount : Interfaces.C.size_t;
end record;
end System.OS_Interface;