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