gcc/ada/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-1994, Florida State University            --
  10 --          Copyright (C) 1995-2008, 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 the tasking run-time (libgnarl). For non tasking
  39 --  oriented services consider declaring them into system-win32.
  40
  41 --  PLEASE DO NOT add any with-clauses to this package or remove the pragma
  42 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
  43
  44 with Ada.Unchecked_Conversion;
  45
  46 with Interfaces.C;
  47 with Interfaces.C.Strings;
  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    -------------------
  59    -- General Types --
  60    -------------------
  61
  62    subtype PSZ   is Interfaces.C.Strings.chars_ptr;
  63
  64    Null_Void : constant Win32.PVOID := System.Null_Address;
  65
  66    -------------------------
  67    -- Handles for objects --
  68    -------------------------
  69
  70    subtype Thread_Id is Win32.HANDLE;
  71
  72    -----------
  73    -- Errno --
  74    -----------
  75
  76    NO_ERROR : constant := 0;
  77    FUNC_ERR : constant := -1;
  78
  79    -------------
  80    -- Signals --
  81    -------------
  82
  83    Max_Interrupt : constant := 31;
  84    type Signal is new int range 0 .. Max_Interrupt;
  85    for Signal'Size use int'Size;
  86
  87    SIGINT     : constant := 2; --  interrupt (Ctrl-C)
  88    SIGILL     : constant := 4; --  illegal instruction (not reset)
  89    SIGFPE     : constant := 8; --  floating point exception
  90    SIGSEGV    : constant := 11; -- segmentation violation
  91    SIGTERM    : constant := 15; -- software termination signal from kill
  92    SIGBREAK   : constant := 21; -- break (Ctrl-Break)
  93    SIGABRT    : constant := 22; -- used by abort, replace SIGIOT in the future
  94
  95    type sigset_t is private;
  96
  97    type isr_address is access procedure (sig : int);
  98    pragma Convention (C, isr_address);
  99
 100    function intr_attach (sig : int; handler : isr_address) return long;
 101    pragma Import (C, intr_attach, "signal");
 102
 103    Intr_Attach_Reset : constant Boolean := True;
 104    --  True if intr_attach is reset after an interrupt handler is called
 105
 106    procedure kill (sig : Signal);
 107    pragma Import (C, kill, "raise");
 108
 109    -------------
 110    -- Threads --
 111    -------------
 112
 113    type Thread_Body is access
 114      function (arg : System.Address) return System.Address;
 115    pragma Convention (C, Thread_Body);
 116
 117    function Thread_Body_Access is new
 118      Ada.Unchecked_Conversion (System.Address, Thread_Body);
 119
 120    procedure SwitchToThread;
 121    pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
 122
 123    function GetThreadTimes
 124      (hThread        : Win32.HANDLE;
 125       lpCreationTime : access Long_Long_Integer;
 126       lpExitTime     : access Long_Long_Integer;
 127       lpKernelTime   : access Long_Long_Integer;
 128       lpUserTime     : access Long_Long_Integer) return Win32.BOOL;
 129    pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes");
 130
 131    -----------------------
 132    -- Critical sections --
 133    -----------------------
 134
 135    type CRITICAL_SECTION is private;
 136
 137    -------------------------------------------------------------
 138    -- Thread Creation, Activation, Suspension And Termination --
 139    -------------------------------------------------------------
 140
 141    type PTHREAD_START_ROUTINE is access function
 142      (pThreadParameter : Win32.PVOID) return Win32.DWORD;
 143    pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
 144
 145    function To_PTHREAD_START_ROUTINE is new
 146      Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
 147
 148    function CreateThread
 149      (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES;
 150       dwStackSize       : Win32.DWORD;
 151       pStartAddress     : PTHREAD_START_ROUTINE;
 152       pParameter        : Win32.PVOID;
 153       dwCreationFlags   : Win32.DWORD;
 154       pThreadId         : access Win32.DWORD) return Win32.HANDLE;
 155    pragma Import (Stdcall, CreateThread, "CreateThread");
 156
 157    function BeginThreadEx
 158      (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES;
 159       dwStackSize       : Win32.DWORD;
 160       pStartAddress     : PTHREAD_START_ROUTINE;
 161       pParameter        : Win32.PVOID;
 162       dwCreationFlags   : Win32.DWORD;
 163       pThreadId         : not null access Win32.DWORD) return Win32.HANDLE;
 164    pragma Import (C, BeginThreadEx, "_beginthreadex");
 165
 166    Debug_Process                     : constant := 16#00000001#;
 167    Debug_Only_This_Process           : constant := 16#00000002#;
 168    Create_Suspended                  : constant := 16#00000004#;
 169    Detached_Process                  : constant := 16#00000008#;
 170    Create_New_Console                : constant := 16#00000010#;
 171
 172    Create_New_Process_Group          : constant := 16#00000200#;
 173
 174    Create_No_window                  : constant := 16#08000000#;
 175
 176    Profile_User                      : constant := 16#10000000#;
 177    Profile_Kernel                    : constant := 16#20000000#;
 178    Profile_Server                    : constant := 16#40000000#;
 179
 180    Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#;
 181
 182    function GetExitCodeThread
 183      (hThread   : Win32.HANDLE;
 184       pExitCode : not null access Win32.DWORD) return Win32.BOOL;
 185    pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
 186
 187    function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD;
 188    pragma Import (Stdcall, ResumeThread, "ResumeThread");
 189
 190    function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD;
 191    pragma Import (Stdcall, SuspendThread, "SuspendThread");
 192
 193    procedure ExitThread (dwExitCode : Win32.DWORD);
 194    pragma Import (Stdcall, ExitThread, "ExitThread");
 195
 196    procedure EndThreadEx (dwExitCode : Win32.DWORD);
 197    pragma Import (C, EndThreadEx, "_endthreadex");
 198
 199    function TerminateThread
 200      (hThread    : Win32.HANDLE;
 201       dwExitCode : Win32.DWORD) return Win32.BOOL;
 202    pragma Import (Stdcall, TerminateThread, "TerminateThread");
 203
 204    function GetCurrentThread return Win32.HANDLE;
 205    pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
 206
 207    function GetCurrentProcess return Win32.HANDLE;
 208    pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
 209
 210    function GetCurrentThreadId return Win32.DWORD;
 211    pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
 212
 213    function TlsAlloc return Win32.DWORD;
 214    pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
 215
 216    function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID;
 217    pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
 218
 219    function TlsSetValue
 220      (dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL;
 221    pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
 222
 223    function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL;
 224    pragma Import (Stdcall, TlsFree, "TlsFree");
 225
 226    TLS_Nothing : constant := Win32.DWORD'Last;
 227
 228    procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
 229    pragma Import (Stdcall, ExitProcess, "ExitProcess");
 230
 231    function WaitForSingleObject
 232      (hHandle        : Win32.HANDLE;
 233       dwMilliseconds : Win32.DWORD) return Win32.DWORD;
 234    pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
 235
 236    function WaitForSingleObjectEx
 237      (hHandle        : Win32.HANDLE;
 238       dwMilliseconds : Win32.DWORD;
 239       fAlertable     : Win32.BOOL) return Win32.DWORD;
 240    pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
 241
 242    Wait_Infinite : constant := Win32.DWORD'Last;
 243    WAIT_TIMEOUT  : constant := 16#0000_0102#;
 244    WAIT_FAILED   : constant := 16#FFFF_FFFF#;
 245
 246    ------------------------------------
 247    -- Semaphores, Events and Mutexes --
 248    ------------------------------------
 249
 250    function CreateSemaphore
 251      (pSemaphoreAttributes : access Win32.SECURITY_ATTRIBUTES;
 252       lInitialCount        : Interfaces.C.long;
 253       lMaximumCount        : Interfaces.C.long;
 254       pName                : PSZ) return Win32.HANDLE;
 255    pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
 256
 257    function OpenSemaphore
 258      (dwDesiredAccess : Win32.DWORD;
 259       bInheritHandle  : Win32.BOOL;
 260       pName           : PSZ) return Win32.HANDLE;
 261    pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
 262
 263    function ReleaseSemaphore
 264      (hSemaphore     : Win32.HANDLE;
 265       lReleaseCount  : Interfaces.C.long;
 266       pPreviousCount : access Win32.LONG) return Win32.BOOL;
 267    pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
 268
 269    function CreateEvent
 270      (pEventAttributes : access Win32.SECURITY_ATTRIBUTES;
 271       bManualReset     : Win32.BOOL;
 272       bInitialState    : Win32.BOOL;
 273       pName            : PSZ) return Win32.HANDLE;
 274    pragma Import (Stdcall, CreateEvent, "CreateEventA");
 275
 276    function OpenEvent
 277      (dwDesiredAccess : Win32.DWORD;
 278       bInheritHandle  : Win32.BOOL;
 279       pName           : PSZ) return Win32.HANDLE;
 280    pragma Import (Stdcall, OpenEvent, "OpenEventA");
 281
 282    function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
 283    pragma Import (Stdcall, SetEvent, "SetEvent");
 284
 285    function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
 286    pragma Import (Stdcall, ResetEvent, "ResetEvent");
 287
 288    function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL;
 289    pragma Import (Stdcall, PulseEvent, "PulseEvent");
 290
 291    function CreateMutex
 292      (pMutexAttributes : access Win32.SECURITY_ATTRIBUTES;
 293       bInitialOwner    : Win32.BOOL;
 294       pName            : PSZ) return Win32.HANDLE;
 295    pragma Import (Stdcall, CreateMutex, "CreateMutexA");
 296
 297    function OpenMutex
 298      (dwDesiredAccess : Win32.DWORD;
 299       bInheritHandle  : Win32.BOOL;
 300       pName           : PSZ) return Win32.HANDLE;
 301    pragma Import (Stdcall, OpenMutex, "OpenMutexA");
 302
 303    function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL;
 304    pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
 305
 306    ---------------------------------------------------
 307    -- Accessing properties of Threads and Processes --
 308    ---------------------------------------------------
 309
 310    -----------------
 311    --  Priorities --
 312    -----------------
 313
 314    function SetThreadPriority
 315      (hThread   : Win32.HANDLE;
 316       nPriority : Interfaces.C.int) return Win32.BOOL;
 317    pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
 318
 319    function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int;
 320    pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
 321
 322    function SetPriorityClass
 323      (hProcess        : Win32.HANDLE;
 324       dwPriorityClass : Win32.DWORD) return Win32.BOOL;
 325    pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
 326
 327    procedure SetThreadPriorityBoost
 328      (hThread              : Win32.HANDLE;
 329       DisablePriorityBoost : Win32.BOOL);
 330    pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
 331
 332    Normal_Priority_Class   : constant := 16#00000020#;
 333    Idle_Priority_Class     : constant := 16#00000040#;
 334    High_Priority_Class     : constant := 16#00000080#;
 335    Realtime_Priority_Class : constant := 16#00000100#;
 336
 337    Thread_Priority_Idle          : constant := -15;
 338    Thread_Priority_Lowest        : constant := -2;
 339    Thread_Priority_Below_Normal  : constant := -1;
 340    Thread_Priority_Normal        : constant := 0;
 341    Thread_Priority_Above_Normal  : constant := 1;
 342    Thread_Priority_Highest       : constant := 2;
 343    Thread_Priority_Time_Critical : constant := 15;
 344    Thread_Priority_Error_Return  : constant := Interfaces.C.long'Last;
 345
 346 private
 347
 348    type sigset_t is new Interfaces.C.unsigned_long;
 349
 350    type CRITICAL_SECTION is record
 351       DebugInfo : System.Address;
 352
 353       LockCount      : Long_Integer;
 354       RecursionCount : Long_Integer;
 355       OwningThread   : Win32.HANDLE;
 356       --  The above three fields control entering and exiting the critical
 357       --  section for the resource.
 358
 359       LockSemaphore : Win32.HANDLE;
 360       Reserved      : Win32.DWORD;
 361    end record;
 362
 363 end System.OS_Interface;