gcc/ada/5wosinte.ads

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