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).
  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
  45 with Interfaces.C.Strings;
  46
  47 with Ada.Unchecked_Conversion;
  48
  49 package System.OS_Interface is
  50    pragma Preelaborate;
  51
  52    pragma Linker_Options ("-mthreads");
  53
  54    subtype int  is Interfaces.C.int;
  55    subtype long is Interfaces.C.long;
  56
  57    -------------------
  58    -- General Types --
  59    -------------------
  60
  61    type DWORD is new Interfaces.C.unsigned_long;
  62    type WORD  is new Interfaces.C.unsigned_short;
  63
  64    --  The LARGE_INTEGER type is actually a fixed point type
  65    --  that only can represent integers. The reason for this is
  66    --  easier conversion to Duration or other fixed point types.
  67    --  (See Operations.Clock)
  68
  69    type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
  70
  71    subtype PSZ   is Interfaces.C.Strings.chars_ptr;
  72    subtype PCHAR is Interfaces.C.Strings.chars_ptr;
  73
  74    subtype PVOID is System.Address;
  75
  76    Null_Void : constant PVOID := System.Null_Address;
  77
  78    type PLONG  is access all Interfaces.C.long;
  79    type PDWORD is access all DWORD;
  80    type BYTE is new Interfaces.C.unsigned_char;
  81    subtype CHAR is Interfaces.C.char;
  82
  83    type BOOL is new Boolean;
  84    for BOOL'Size use Interfaces.C.unsigned_long'Size;
  85
  86    -------------------------
  87    -- Handles for objects --
  88    -------------------------
  89
  90    type HANDLE is new Interfaces.C.long;
  91    type PHANDLE is access all HANDLE;
  92
  93    subtype Thread_Id is HANDLE;
  94
  95    -----------
  96    -- Errno --
  97    -----------
  98
  99    NO_ERROR : constant := 0;
 100    FUNC_ERR : constant := -1;
 101
 102    -----------
 103    -- Files --
 104    -----------
 105
 106    type SECURITY_ATTRIBUTES is record
 107       nLength             : DWORD;
 108       pSecurityDescriptor : PVOID;
 109       bInheritHandle      : BOOL;
 110    end record;
 111
 112    function CloseHandle (hObject : HANDLE) return BOOL;
 113    pragma Import (Stdcall, CloseHandle, "CloseHandle");
 114
 115    ------------------------
 116    -- System Information --
 117    ------------------------
 118
 119    type SYSTEM_INFO is record
 120       dwOemId                     : DWORD;
 121       dwPageSize                  : DWORD;
 122       lpMinimumApplicationAddress : PVOID;
 123       lpMaximumApplicationAddress : PVOID;
 124       dwActiveProcessorMask       : DWORD;
 125       dwNumberOfProcessors        : DWORD;
 126       dwProcessorType             : DWORD;
 127       dwAllocationGranularity     : DWORD;
 128       dwReserved                  : DWORD;
 129    end record;
 130
 131    procedure GetSystemInfo (SI : access SYSTEM_INFO);
 132    pragma Import (Stdcall, GetSystemInfo, "GetSystemInfo");
 133
 134    -------------
 135    -- Signals --
 136    -------------
 137
 138    Max_Interrupt : constant := 31;
 139    type Signal is new int range 0 .. Max_Interrupt;
 140    for Signal'Size use int'Size;
 141
 142    SIGINT     : constant := 2; --  interrupt (Ctrl-C)
 143    SIGILL     : constant := 4; --  illegal instruction (not reset)
 144    SIGFPE     : constant := 8; --  floating point exception
 145    SIGSEGV    : constant := 11; -- segmentation violation
 146    SIGTERM    : constant := 15; -- software termination signal from kill
 147    SIGBREAK   : constant := 21; -- break (Ctrl-Break)
 148    SIGABRT    : constant := 22; -- used by abort, replace SIGIOT in the future
 149
 150    type sigset_t is private;
 151
 152    type isr_address is access procedure (sig : int);
 153    pragma Convention (C, isr_address);
 154
 155    function intr_attach (sig : int; handler : isr_address) return long;
 156    pragma Import (C, intr_attach, "signal");
 157
 158    Intr_Attach_Reset : constant Boolean := True;
 159    --  True if intr_attach is reset after an interrupt handler is called
 160
 161    procedure kill (sig : Signal);
 162    pragma Import (C, kill, "raise");
 163
 164    ---------------------
 165    -- Time Management --
 166    ---------------------
 167
 168    procedure Sleep (dwMilliseconds : DWORD);
 169    pragma Import (Stdcall, Sleep, External_Name => "Sleep");
 170
 171    type SYSTEMTIME is record
 172       wYear         : WORD;
 173       wMonth        : WORD;
 174       wDayOfWeek    : WORD;
 175       wDay          : WORD;
 176       wHour         : WORD;
 177       wMinute       : WORD;
 178       wSecond       : WORD;
 179       wMilliseconds : WORD;
 180    end record;
 181
 182    procedure GetSystemTime (pSystemTime : access SYSTEMTIME);
 183    pragma Import (Stdcall, GetSystemTime, "GetSystemTime");
 184
 185    procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
 186    pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
 187
 188    function SetSystemTime (pSystemTime : access SYSTEMTIME) return BOOL;
 189    pragma Import (Stdcall, SetSystemTime, "SetSystemTime");
 190
 191    function FileTimeToSystemTime
 192      (lpFileTime   : access Long_Long_Integer;
 193       lpSystemTime : access SYSTEMTIME) return BOOL;
 194    pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime");
 195
 196    function SystemTimeToFileTime
 197      (lpSystemTime : access SYSTEMTIME;
 198       lpFileTime   : access Long_Long_Integer) return BOOL;
 199    pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime");
 200
 201    function FileTimeToLocalFileTime
 202      (lpFileTime      : access Long_Long_Integer;
 203       lpLocalFileTime : access Long_Long_Integer) return BOOL;
 204    pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime");
 205
 206    function LocalFileTimeToFileTime
 207      (lpFileTime      : access Long_Long_Integer;
 208       lpLocalFileTime : access Long_Long_Integer) return BOOL;
 209    pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime");
 210
 211    function QueryPerformanceCounter
 212      (lpPerformanceCount : access LARGE_INTEGER) return BOOL;
 213    pragma Import
 214      (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
 215
 216    function QueryPerformanceFrequency
 217      (lpFrequency : access LARGE_INTEGER) return BOOL;
 218    pragma Import
 219      (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
 220
 221    -------------
 222    -- Threads --
 223    -------------
 224
 225    type Thread_Body is access
 226      function (arg : System.Address) return System.Address;
 227    pragma Convention (C, Thread_Body);
 228
 229    function Thread_Body_Access is new
 230      Ada.Unchecked_Conversion (System.Address, Thread_Body);
 231
 232    procedure SwitchToThread;
 233    pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
 234
 235    function GetThreadTimes
 236      (hThread        : HANDLE;
 237       lpCreationTime : access Long_Long_Integer;
 238       lpExitTime     : access Long_Long_Integer;
 239       lpKernelTime   : access Long_Long_Integer;
 240       lpUserTime     : access Long_Long_Integer) return BOOL;
 241    pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes");
 242
 243    -----------------------
 244    -- Critical sections --
 245    -----------------------
 246
 247    type CRITICAL_SECTION is private;
 248
 249    procedure InitializeCriticalSection
 250      (pCriticalSection : access CRITICAL_SECTION);
 251    pragma Import
 252      (Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
 253
 254    procedure EnterCriticalSection
 255      (pCriticalSection : access CRITICAL_SECTION);
 256    pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
 257
 258    procedure LeaveCriticalSection
 259      (pCriticalSection : access CRITICAL_SECTION);
 260    pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
 261
 262    procedure DeleteCriticalSection
 263      (pCriticalSection : access CRITICAL_SECTION);
 264    pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
 265
 266    -------------------------------------------------------------
 267    -- Thread Creation, Activation, Suspension And Termination --
 268    -------------------------------------------------------------
 269
 270    subtype ProcessorId is DWORD;
 271
 272    type PTHREAD_START_ROUTINE is access function
 273      (pThreadParameter : PVOID) return DWORD;
 274    pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
 275
 276    function To_PTHREAD_START_ROUTINE is new
 277      Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
 278
 279    function CreateThread
 280      (pThreadAttributes : access SECURITY_ATTRIBUTES;
 281       dwStackSize       : DWORD;
 282       pStartAddress     : PTHREAD_START_ROUTINE;
 283       pParameter        : PVOID;
 284       dwCreationFlags   : DWORD;
 285       pThreadId         : PDWORD) return HANDLE;
 286    pragma Import (Stdcall, CreateThread, "CreateThread");
 287
 288    function BeginThreadEx
 289      (pThreadAttributes : access SECURITY_ATTRIBUTES;
 290       dwStackSize       : DWORD;
 291       pStartAddress     : PTHREAD_START_ROUTINE;
 292       pParameter        : PVOID;
 293       dwCreationFlags   : DWORD;
 294       pThreadId         : PDWORD) return HANDLE;
 295    pragma Import (C, BeginThreadEx, "_beginthreadex");
 296
 297    Debug_Process                     : constant := 16#00000001#;
 298    Debug_Only_This_Process           : constant := 16#00000002#;
 299    Create_Suspended                  : constant := 16#00000004#;
 300    Detached_Process                  : constant := 16#00000008#;
 301    Create_New_Console                : constant := 16#00000010#;
 302
 303    Create_New_Process_Group          : constant := 16#00000200#;
 304
 305    Create_No_window                  : constant := 16#08000000#;
 306
 307    Profile_User                      : constant := 16#10000000#;
 308    Profile_Kernel                    : constant := 16#20000000#;
 309    Profile_Server                    : constant := 16#40000000#;
 310
 311    Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#;
 312
 313    function GetExitCodeThread
 314      (hThread   : HANDLE;
 315       pExitCode : PDWORD) return BOOL;
 316    pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread");
 317
 318    function ResumeThread (hThread : HANDLE) return DWORD;
 319    pragma Import (Stdcall, ResumeThread, "ResumeThread");
 320
 321    function SuspendThread (hThread : HANDLE) return DWORD;
 322    pragma Import (Stdcall, SuspendThread, "SuspendThread");
 323
 324    procedure ExitThread (dwExitCode : DWORD);
 325    pragma Import (Stdcall, ExitThread, "ExitThread");
 326
 327    procedure EndThreadEx (dwExitCode : DWORD);
 328    pragma Import (C, EndThreadEx, "_endthreadex");
 329
 330    function TerminateThread
 331      (hThread    : HANDLE;
 332       dwExitCode : DWORD) return BOOL;
 333    pragma Import (Stdcall, TerminateThread, "TerminateThread");
 334
 335    function GetCurrentThread return HANDLE;
 336    pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread");
 337
 338    function GetCurrentProcess return HANDLE;
 339    pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess");
 340
 341    function GetCurrentThreadId return DWORD;
 342    pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId");
 343
 344    function TlsAlloc return DWORD;
 345    pragma Import (Stdcall, TlsAlloc, "TlsAlloc");
 346
 347    function TlsGetValue (dwTlsIndex : DWORD) return PVOID;
 348    pragma Import (Stdcall, TlsGetValue, "TlsGetValue");
 349
 350    function TlsSetValue (dwTlsIndex : DWORD; pTlsValue : PVOID) return BOOL;
 351    pragma Import (Stdcall, TlsSetValue, "TlsSetValue");
 352
 353    function TlsFree (dwTlsIndex : DWORD) return BOOL;
 354    pragma Import (Stdcall, TlsFree, "TlsFree");
 355
 356    TLS_Nothing : constant := DWORD'Last;
 357
 358    procedure ExitProcess (uExitCode : Interfaces.C.unsigned);
 359    pragma Import (Stdcall, ExitProcess, "ExitProcess");
 360
 361    function WaitForSingleObject
 362      (hHandle        : HANDLE;
 363       dwMilliseconds : DWORD) return DWORD;
 364    pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject");
 365
 366    function WaitForSingleObjectEx
 367      (hHandle        : HANDLE;
 368       dwMilliseconds : DWORD;
 369       fAlertable     : BOOL) return DWORD;
 370    pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx");
 371
 372    function SetThreadIdealProcessor
 373      (hThread          : HANDLE;
 374       dwIdealProcessor : ProcessorId) return DWORD;
 375    pragma Import (Stdcall, SetThreadIdealProcessor, "SetThreadIdealProcessor");
 376
 377    Wait_Infinite : constant := DWORD'Last;
 378    WAIT_TIMEOUT  : constant := 16#0000_0102#;
 379    WAIT_FAILED   : constant := 16#FFFF_FFFF#;
 380
 381    ------------------------------------
 382    -- Semaphores, Events and Mutexes --
 383    ------------------------------------
 384
 385    function CreateSemaphore
 386      (pSemaphoreAttributes : access SECURITY_ATTRIBUTES;
 387       lInitialCount        : Interfaces.C.long;
 388       lMaximumCount        : Interfaces.C.long;
 389       pName                : PSZ) return HANDLE;
 390    pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA");
 391
 392    function OpenSemaphore
 393      (dwDesiredAccess : DWORD;
 394       bInheritHandle  : BOOL;
 395       pName           : PSZ) return HANDLE;
 396    pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA");
 397
 398    function ReleaseSemaphore
 399      (hSemaphore     : HANDLE;
 400       lReleaseCount  : Interfaces.C.long;
 401       pPreviousCount : PLONG) return BOOL;
 402    pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore");
 403
 404    function CreateEvent
 405      (pEventAttributes : access SECURITY_ATTRIBUTES;
 406       bManualReset     : BOOL;
 407       bInitialState    : BOOL;
 408       pName            : PSZ) return HANDLE;
 409    pragma Import (Stdcall, CreateEvent, "CreateEventA");
 410
 411    function OpenEvent
 412      (dwDesiredAccess : DWORD;
 413       bInheritHandle  : BOOL;
 414       pName           : PSZ) return HANDLE;
 415    pragma Import (Stdcall, OpenEvent, "OpenEventA");
 416
 417    function SetEvent (hEvent : HANDLE) return BOOL;
 418    pragma Import (Stdcall, SetEvent, "SetEvent");
 419
 420    function ResetEvent (hEvent : HANDLE) return BOOL;
 421    pragma Import (Stdcall, ResetEvent, "ResetEvent");
 422
 423    function PulseEvent (hEvent : HANDLE) return BOOL;
 424    pragma Import (Stdcall, PulseEvent, "PulseEvent");
 425
 426    function CreateMutex
 427      (pMutexAttributes : access SECURITY_ATTRIBUTES;
 428       bInitialOwner    : BOOL;
 429       pName            : PSZ) return HANDLE;
 430    pragma Import (Stdcall, CreateMutex, "CreateMutexA");
 431
 432    function OpenMutex
 433      (dwDesiredAccess : DWORD;
 434       bInheritHandle  : BOOL;
 435       pName           : PSZ) return HANDLE;
 436    pragma Import (Stdcall, OpenMutex, "OpenMutexA");
 437
 438    function ReleaseMutex (hMutex : HANDLE) return BOOL;
 439    pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex");
 440
 441    ---------------------------------------------------
 442    -- Accessing properties of Threads and Processes --
 443    ---------------------------------------------------
 444
 445    -----------------
 446    --  Priorities --
 447    -----------------
 448
 449    function SetThreadPriority
 450      (hThread   : HANDLE;
 451       nPriority : Interfaces.C.int) return BOOL;
 452    pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority");
 453
 454    function GetThreadPriority (hThread : HANDLE) return Interfaces.C.int;
 455    pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority");
 456
 457    function SetPriorityClass
 458      (hProcess        : HANDLE;
 459       dwPriorityClass : DWORD) return BOOL;
 460    pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass");
 461
 462    procedure SetThreadPriorityBoost
 463      (hThread              : HANDLE;
 464       DisablePriorityBoost : BOOL);
 465    pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost");
 466
 467    Normal_Priority_Class   : constant := 16#00000020#;
 468    Idle_Priority_Class     : constant := 16#00000040#;
 469    High_Priority_Class     : constant := 16#00000080#;
 470    Realtime_Priority_Class : constant := 16#00000100#;
 471
 472    Thread_Priority_Idle          : constant := -15;
 473    Thread_Priority_Lowest        : constant := -2;
 474    Thread_Priority_Below_Normal  : constant := -1;
 475    Thread_Priority_Normal        : constant := 0;
 476    Thread_Priority_Above_Normal  : constant := 1;
 477    Thread_Priority_Highest       : constant := 2;
 478    Thread_Priority_Time_Critical : constant := 15;
 479    Thread_Priority_Error_Return  : constant := Interfaces.C.long'Last;
 480
 481    function GetLastError return DWORD;
 482    pragma Import (Stdcall, GetLastError, "GetLastError");
 483
 484 private
 485
 486    type sigset_t is new Interfaces.C.unsigned_long;
 487
 488    type CRITICAL_SECTION is record
 489       DebugInfo      : System.Address;
 490       --  The following three fields control entering and
 491       --  exiting the critical section for the resource
 492       LockCount      : Long_Integer;
 493       RecursionCount : Long_Integer;
 494       OwningThread   : HANDLE;
 495       LockSemaphore  : HANDLE;
 496       Reserved       : DWORD;
 497    end record;
 498
 499 end System.OS_Interface;