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