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-2011, Free Software Foundation, Inc. -- 11-- -- 12-- GNAT 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 3, or (at your option) any later ver- -- 15-- sion. GNAT 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. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNARL was developed by the GNARL team at Florida State University. -- 29-- Extensive contributions were provided by Ada Core Technologies Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33-- This is a NT (native) version of this package 34 35-- This package encapsulates all direct interfaces to OS services 36-- that are needed by the tasking run-time (libgnarl). For non tasking 37-- oriented services consider declaring them into system-win32. 38 39-- PLEASE DO NOT add any with-clauses to this package or remove the pragma 40-- Preelaborate. This package is designed to be a bottom-level (leaf) package. 41 42with Ada.Unchecked_Conversion; 43 44with Interfaces.C; 45with Interfaces.C.Strings; 46with System.Win32; 47 48package System.OS_Interface is 49 pragma Preelaborate; 50 51 pragma Linker_Options ("-mthreads"); 52 53 subtype int is Interfaces.C.int; 54 subtype long is Interfaces.C.long; 55 56 ------------------- 57 -- General Types -- 58 ------------------- 59 60 subtype PSZ is Interfaces.C.Strings.chars_ptr; 61 62 Null_Void : constant Win32.PVOID := System.Null_Address; 63 64 ------------------------- 65 -- Handles for objects -- 66 ------------------------- 67 68 subtype Thread_Id is Win32.HANDLE; 69 70 ----------- 71 -- Errno -- 72 ----------- 73 74 NO_ERROR : constant := 0; 75 FUNC_ERR : constant := -1; 76 77 ------------- 78 -- Signals -- 79 ------------- 80 81 Max_Interrupt : constant := 31; 82 type Signal is new int range 0 .. Max_Interrupt; 83 for Signal'Size use int'Size; 84 85 SIGINT : constant := 2; -- interrupt (Ctrl-C) 86 SIGILL : constant := 4; -- illegal instruction (not reset) 87 SIGFPE : constant := 8; -- floating point exception 88 SIGSEGV : constant := 11; -- segmentation violation 89 SIGTERM : constant := 15; -- software termination signal from kill 90 SIGBREAK : constant := 21; -- break (Ctrl-Break) 91 SIGABRT : constant := 22; -- used by abort, replace SIGIOT in the future 92 93 type sigset_t is private; 94 95 type isr_address is access procedure (sig : int); 96 pragma Convention (C, isr_address); 97 98 function intr_attach (sig : int; handler : isr_address) return long; 99 pragma Import (C, intr_attach, "signal"); 100 101 Intr_Attach_Reset : constant Boolean := True; 102 -- True if intr_attach is reset after an interrupt handler is called 103 104 procedure kill (sig : Signal); 105 pragma Import (C, kill, "raise"); 106 107 ------------- 108 -- Threads -- 109 ------------- 110 111 type Thread_Body is access 112 function (arg : System.Address) return System.Address; 113 pragma Convention (C, Thread_Body); 114 115 function Thread_Body_Access is new 116 Ada.Unchecked_Conversion (System.Address, Thread_Body); 117 118 procedure SwitchToThread; 119 pragma Import (Stdcall, SwitchToThread, "SwitchToThread"); 120 121 function GetThreadTimes 122 (hThread : Win32.HANDLE; 123 lpCreationTime : access Long_Long_Integer; 124 lpExitTime : access Long_Long_Integer; 125 lpKernelTime : access Long_Long_Integer; 126 lpUserTime : access Long_Long_Integer) return Win32.BOOL; 127 pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes"); 128 129 ----------------------- 130 -- Critical sections -- 131 ----------------------- 132 133 type CRITICAL_SECTION is private; 134 135 ------------------------------------------------------------- 136 -- Thread Creation, Activation, Suspension And Termination -- 137 ------------------------------------------------------------- 138 139 type PTHREAD_START_ROUTINE is access function 140 (pThreadParameter : Win32.PVOID) return Win32.DWORD; 141 pragma Convention (Stdcall, PTHREAD_START_ROUTINE); 142 143 function To_PTHREAD_START_ROUTINE is new 144 Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE); 145 146 function CreateThread 147 (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES; 148 dwStackSize : Win32.DWORD; 149 pStartAddress : PTHREAD_START_ROUTINE; 150 pParameter : Win32.PVOID; 151 dwCreationFlags : Win32.DWORD; 152 pThreadId : access Win32.DWORD) return Win32.HANDLE; 153 pragma Import (Stdcall, CreateThread, "CreateThread"); 154 155 function BeginThreadEx 156 (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES; 157 dwStackSize : Win32.DWORD; 158 pStartAddress : PTHREAD_START_ROUTINE; 159 pParameter : Win32.PVOID; 160 dwCreationFlags : Win32.DWORD; 161 pThreadId : not null access Win32.DWORD) return Win32.HANDLE; 162 pragma Import (C, BeginThreadEx, "_beginthreadex"); 163 164 Debug_Process : constant := 16#00000001#; 165 Debug_Only_This_Process : constant := 16#00000002#; 166 Create_Suspended : constant := 16#00000004#; 167 Detached_Process : constant := 16#00000008#; 168 Create_New_Console : constant := 16#00000010#; 169 170 Create_New_Process_Group : constant := 16#00000200#; 171 172 Create_No_window : constant := 16#08000000#; 173 174 Profile_User : constant := 16#10000000#; 175 Profile_Kernel : constant := 16#20000000#; 176 Profile_Server : constant := 16#40000000#; 177 178 Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#; 179 180 function GetExitCodeThread 181 (hThread : Win32.HANDLE; 182 pExitCode : not null access Win32.DWORD) return Win32.BOOL; 183 pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread"); 184 185 function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD; 186 pragma Import (Stdcall, ResumeThread, "ResumeThread"); 187 188 function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD; 189 pragma Import (Stdcall, SuspendThread, "SuspendThread"); 190 191 procedure ExitThread (dwExitCode : Win32.DWORD); 192 pragma Import (Stdcall, ExitThread, "ExitThread"); 193 194 procedure EndThreadEx (dwExitCode : Win32.DWORD); 195 pragma Import (C, EndThreadEx, "_endthreadex"); 196 197 function TerminateThread 198 (hThread : Win32.HANDLE; 199 dwExitCode : Win32.DWORD) return Win32.BOOL; 200 pragma Import (Stdcall, TerminateThread, "TerminateThread"); 201 202 function GetCurrentThread return Win32.HANDLE; 203 pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread"); 204 205 function GetCurrentProcess return Win32.HANDLE; 206 pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess"); 207 208 function GetCurrentThreadId return Win32.DWORD; 209 pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId"); 210 211 function TlsAlloc return Win32.DWORD; 212 pragma Import (Stdcall, TlsAlloc, "TlsAlloc"); 213 214 function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID; 215 pragma Import (Stdcall, TlsGetValue, "TlsGetValue"); 216 217 function TlsSetValue 218 (dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL; 219 pragma Import (Stdcall, TlsSetValue, "TlsSetValue"); 220 221 function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL; 222 pragma Import (Stdcall, TlsFree, "TlsFree"); 223 224 TLS_Nothing : constant := Win32.DWORD'Last; 225 226 procedure ExitProcess (uExitCode : Interfaces.C.unsigned); 227 pragma Import (Stdcall, ExitProcess, "ExitProcess"); 228 229 function WaitForSingleObject 230 (hHandle : Win32.HANDLE; 231 dwMilliseconds : Win32.DWORD) return Win32.DWORD; 232 pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject"); 233 234 function WaitForSingleObjectEx 235 (hHandle : Win32.HANDLE; 236 dwMilliseconds : Win32.DWORD; 237 fAlertable : Win32.BOOL) return Win32.DWORD; 238 pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx"); 239 240 Wait_Infinite : constant := Win32.DWORD'Last; 241 WAIT_TIMEOUT : constant := 16#0000_0102#; 242 WAIT_FAILED : constant := 16#FFFF_FFFF#; 243 244 ------------------------------------ 245 -- Semaphores, Events and Mutexes -- 246 ------------------------------------ 247 248 function CreateSemaphore 249 (pSemaphoreAttributes : access Win32.SECURITY_ATTRIBUTES; 250 lInitialCount : Interfaces.C.long; 251 lMaximumCount : Interfaces.C.long; 252 pName : PSZ) return Win32.HANDLE; 253 pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA"); 254 255 function OpenSemaphore 256 (dwDesiredAccess : Win32.DWORD; 257 bInheritHandle : Win32.BOOL; 258 pName : PSZ) return Win32.HANDLE; 259 pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA"); 260 261 function ReleaseSemaphore 262 (hSemaphore : Win32.HANDLE; 263 lReleaseCount : Interfaces.C.long; 264 pPreviousCount : access Win32.LONG) return Win32.BOOL; 265 pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore"); 266 267 function CreateEvent 268 (pEventAttributes : access Win32.SECURITY_ATTRIBUTES; 269 bManualReset : Win32.BOOL; 270 bInitialState : Win32.BOOL; 271 pName : PSZ) return Win32.HANDLE; 272 pragma Import (Stdcall, CreateEvent, "CreateEventA"); 273 274 function OpenEvent 275 (dwDesiredAccess : Win32.DWORD; 276 bInheritHandle : Win32.BOOL; 277 pName : PSZ) return Win32.HANDLE; 278 pragma Import (Stdcall, OpenEvent, "OpenEventA"); 279 280 function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL; 281 pragma Import (Stdcall, SetEvent, "SetEvent"); 282 283 function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL; 284 pragma Import (Stdcall, ResetEvent, "ResetEvent"); 285 286 function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL; 287 pragma Import (Stdcall, PulseEvent, "PulseEvent"); 288 289 function CreateMutex 290 (pMutexAttributes : access Win32.SECURITY_ATTRIBUTES; 291 bInitialOwner : Win32.BOOL; 292 pName : PSZ) return Win32.HANDLE; 293 pragma Import (Stdcall, CreateMutex, "CreateMutexA"); 294 295 function OpenMutex 296 (dwDesiredAccess : Win32.DWORD; 297 bInheritHandle : Win32.BOOL; 298 pName : PSZ) return Win32.HANDLE; 299 pragma Import (Stdcall, OpenMutex, "OpenMutexA"); 300 301 function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL; 302 pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex"); 303 304 --------------------------------------------------- 305 -- Accessing properties of Threads and Processes -- 306 --------------------------------------------------- 307 308 ----------------- 309 -- Priorities -- 310 ----------------- 311 312 function SetThreadPriority 313 (hThread : Win32.HANDLE; 314 nPriority : Interfaces.C.int) return Win32.BOOL; 315 pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority"); 316 317 function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int; 318 pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority"); 319 320 function SetPriorityClass 321 (hProcess : Win32.HANDLE; 322 dwPriorityClass : Win32.DWORD) return Win32.BOOL; 323 pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass"); 324 325 procedure SetThreadPriorityBoost 326 (hThread : Win32.HANDLE; 327 DisablePriorityBoost : Win32.BOOL); 328 pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost"); 329 330 Normal_Priority_Class : constant := 16#00000020#; 331 Idle_Priority_Class : constant := 16#00000040#; 332 High_Priority_Class : constant := 16#00000080#; 333 Realtime_Priority_Class : constant := 16#00000100#; 334 335 Thread_Priority_Idle : constant := -15; 336 Thread_Priority_Lowest : constant := -2; 337 Thread_Priority_Below_Normal : constant := -1; 338 Thread_Priority_Normal : constant := 0; 339 Thread_Priority_Above_Normal : constant := 1; 340 Thread_Priority_Highest : constant := 2; 341 Thread_Priority_Time_Critical : constant := 15; 342 Thread_Priority_Error_Return : constant := Interfaces.C.long'Last; 343 344private 345 346 type sigset_t is new Interfaces.C.unsigned_long; 347 348 type CRITICAL_SECTION is record 349 DebugInfo : System.Address; 350 351 LockCount : Long_Integer; 352 RecursionCount : Long_Integer; 353 OwningThread : Win32.HANDLE; 354 -- The above three fields control entering and exiting the critical 355 -- section for the resource. 356 357 LockSemaphore : Win32.HANDLE; 358 SpinCount : Win32.DWORD; 359 end record; 360 361end System.OS_Interface; 362