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