gcc/ada/libgnarl/s-osinte__mingw.ads

   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            --
  10 --          Copyright (C) 1995-2024, Free Software Foundation, Inc.         --
  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
  47 with System.OS_Locks;
  48 with System.Win32;
  49
  50 package System.OS_Interface is
  51    pragma Preelaborate;
  52
  53    pragma Linker_Options ("-mthreads");
  54
  55    subtype int  is Interfaces.C.int;
  56    subtype long is Interfaces.C.long;
  57
  58    subtype LARGE_INTEGER is System.Win32.LARGE_INTEGER;
  59
  60    -------------------
  61    -- General Types --
  62    -------------------
  63
  64    subtype PSZ   is Interfaces.C.Strings.chars_ptr;
  65
  66    Null_Void : constant Win32.PVOID := System.Null_Address;
  67
  68    -------------------------
  69    -- Handles for objects --
  70    -------------------------
  71
  72    subtype Thread_Id is Win32.HANDLE;
  73
  74    -----------
  75    -- Errno --
  76    -----------
  77
  78    NO_ERROR : constant := 0;
  79    FUNC_ERR : constant := -1;
  80
  81    -------------
  82    -- Signals --
  83    -------------
  84
  85    Max_Interrupt : constant := 31;
  86    type Signal is new int range 0 .. Max_Interrupt;
  87    for Signal'Size use int'Size;
  88
  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
  96
  97    type sigset_t is private;
  98
  99    type isr_address is access procedure (sig : int);
 100    pragma Convention (C, isr_address);
 101
 102    function intr_attach (sig : int; handler : isr_address) return long;
 103    pragma Import (C, intr_attach, "signal");
 104
 105    Intr_Attach_Reset : constant Boolean := True;
 106    --  True if intr_attach is reset after an interrupt handler is called
 107
 108    procedure kill (sig : Signal);
 109    pragma Import (C, kill, "raise");
 110
 111    ------------
 112    -- Clock  --
 113    ------------
 114
 115    procedure QueryPerformanceFrequency
 116      (lpPerformanceFreq : access LARGE_INTEGER);
 117    pragma Import
 118      (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
 119
 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.
 122
 123    -------------
 124    -- Threads --
 125    -------------
 126
 127    type Thread_Body is access
 128      function (arg : System.Address) return System.Address;
 129    pragma Convention (C, Thread_Body);
 130
 131    function Thread_Body_Access is new
 132      Ada.Unchecked_Conversion (System.Address, Thread_Body);
 133
 134    procedure SwitchToThread;
 135    pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
 136
 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");
 144
 145    -----------------------
 146    -- Critical sections --
 147    -----------------------
 148
 149    subtype CRITICAL_SECTION is System.OS_Locks.CRITICAL_SECTION;
 150
 151    procedure InitializeCriticalSection
 152      (pCriticalSection : access CRITICAL_SECTION);
 153    pragma Import
 154      (Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
 155
 156    procedure EnterCriticalSection
 157      (pCriticalSection : access CRITICAL_SECTION);
 158    pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
 159
 160    procedure LeaveCriticalSection
 161      (pCriticalSection : access CRITICAL_SECTION);
 162    pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
 163
 164    procedure DeleteCriticalSection
 165      (pCriticalSection : access CRITICAL_SECTION);
 166    pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
 167
 168    -------------------------------------------------------------
 169    -- Thread Creation, Activation, Suspension And Termination --
 170    -------------------------------------------------------------
 171
 172    type PTHREAD_START_ROUTINE is access function
 173      (pThreadParameter : Win32.PVOID) return Win32.DWORD;
 174    pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
 175
 176    function To_PTHREAD_START_ROUTINE is new
 177      Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
 178
 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");
 187
 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");
 196
 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#;
 202
 203    Create_New_Process_Group          : constant := 16#00000200#;
 204
 205    Create_No_window                  : constant := 16#08000000#;
 206
 207    Profile_User                      : constant := 16#10000000#;
 208    Profile_Kernel                    : constant := 16#20000000#;
 209    Profile_Server                    : constant := 16#40000000#;
 210
 211    Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#;
 212
 213    function GetExitCodeThread
 214      (hThread   : Win32.HANDLE;
 215       pExitCode : not null access Win32.DWORD) return Win32.BOOL;
 216    pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
 217
 218    function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD;
 219    pragma Import (Stdcall, ResumeThread, "ResumeThread");
 220
 221    function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD;
 222    pragma Import (Stdcall, SuspendThread, "SuspendThread");
 223
 224    procedure ExitThread (dwExitCode : Win32.DWORD);
 225    pragma Import (Stdcall, ExitThread, "ExitThread");
 226
 227    procedure EndThreadEx (dwExitCode : Win32.DWORD);
 228    pragma Import (C, EndThreadEx, "_endthreadex");
 229
 230    function TerminateThread
 231      (hThread    : Win32.HANDLE;
 232       dwExitCode : Win32.DWORD) return Win32.BOOL;
 233    pragma Import (Stdcall, TerminateThread, "TerminateThread");
 234
 235    function GetCurrentThread return Win32.HANDLE;
 236    pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
 237
 238    function GetCurrentProcess return Win32.HANDLE;
 239    pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
 240
 241    function GetCurrentThreadId return Win32.DWORD;
 242    pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
 243
 244    function TlsAlloc return Win32.DWORD;
 245    pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
 246
 247    function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID;
 248    pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
 249
 250    function TlsSetValue
 251      (dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL;
 252    pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
 253
 254    function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL;
 255    pragma Import (Stdcall, TlsFree, "TlsFree");
 256
 257    TLS_Nothing : constant := Win32.DWORD'Last;
 258
 259    procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
 260    pragma Import (Stdcall, ExitProcess, "ExitProcess");
 261
 262    function WaitForSingleObject
 263      (hHandle        : Win32.HANDLE;
 264       dwMilliseconds : Win32.DWORD) return Win32.DWORD;
 265    pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
 266
 267    function WaitForSingleObjectEx
 268      (hHandle        : Win32.HANDLE;
 269       dwMilliseconds : Win32.DWORD;
 270       fAlertable     : Win32.BOOL) return Win32.DWORD;
 271    pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
 272
 273    Wait_Infinite : constant := Win32.DWORD'Last;
 274    WAIT_TIMEOUT  : constant := 16#0000_0102#;
 275    WAIT_FAILED   : constant := 16#FFFF_FFFF#;
 276
 277    ------------------------------------
 278    -- Semaphores, Events and Mutexes --
 279    ------------------------------------
 280
 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");
 287
 288    function OpenSemaphore
 289      (dwDesiredAccess : Win32.DWORD;
 290       bInheritHandle  : Win32.BOOL;
 291       pName           : PSZ) return Win32.HANDLE;
 292    pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
 293
 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");
 299
 300    function CreateEvent
 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");
 306
 307    function OpenEvent
 308      (dwDesiredAccess : Win32.DWORD;
 309       bInheritHandle  : Win32.BOOL;
 310       pName           : PSZ) return Win32.HANDLE;
 311    pragma Import (Stdcall, OpenEvent, "OpenEventA");
 312
 313    function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
 314    pragma Import (Stdcall, SetEvent, "SetEvent");
 315
 316    function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
 317    pragma Import (Stdcall, ResetEvent, "ResetEvent");
 318
 319    function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
 320    pragma Import (Stdcall, PulseEvent, "PulseEvent");
 321
 322    function CreateMutex
 323      (pMutexAttributes : access Win32.SECURITY_ATTRIBUTES;
 324       bInitialOwner    : Win32.BOOL;
 325       pName            : PSZ) return Win32.HANDLE;
 326    pragma Import (Stdcall, CreateMutex, "CreateMutexA");
 327
 328    function OpenMutex
 329      (dwDesiredAccess : Win32.DWORD;
 330       bInheritHandle  : Win32.BOOL;
 331       pName           : PSZ) return Win32.HANDLE;
 332    pragma Import (Stdcall, OpenMutex, "OpenMutexA");
 333
 334    function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL;
 335    pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
 336
 337    ---------------------------------------------------
 338    -- Accessing properties of Threads and Processes --
 339    ---------------------------------------------------
 340
 341    -----------------
 342    --  Priorities --
 343    -----------------
 344
 345    function SetThreadPriority
 346      (hThread   : Win32.HANDLE;
 347       nPriority : Interfaces.C.int) return Win32.BOOL;
 348    pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
 349
 350    function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int;
 351    pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
 352
 353    function SetPriorityClass
 354      (hProcess        : Win32.HANDLE;
 355       dwPriorityClass : Win32.DWORD) return Win32.BOOL;
 356    pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
 357
 358    procedure SetThreadPriorityBoost
 359      (hThread              : Win32.HANDLE;
 360       DisablePriorityBoost : Win32.BOOL);
 361    pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
 362
 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#;
 367
 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;
 376
 377 private
 378
 379    type sigset_t is new Interfaces.C.unsigned_long;
 380
 381 end System.OS_Interface;