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-2014, 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 subtype LARGE_INTEGER is System.Win32.LARGE_INTEGER; 57 58 ------------------- 59 -- General Types -- 60 ------------------- 61 62 subtype PSZ is Interfaces.C.Strings.chars_ptr; 63 64 Null_Void : constant Win32.PVOID := System.Null_Address; 65 66 ------------------------- 67 -- Handles for objects -- 68 ------------------------- 69 70 subtype Thread_Id is Win32.HANDLE; 71 72 ----------- 73 -- Errno -- 74 ----------- 75 76 NO_ERROR : constant := 0; 77 FUNC_ERR : constant := -1; 78 79 ------------- 80 -- Signals -- 81 ------------- 82 83 Max_Interrupt : constant := 31; 84 type Signal is new int range 0 .. Max_Interrupt; 85 for Signal'Size use int'Size; 86 87 SIGINT : constant := 2; -- interrupt (Ctrl-C) 88 SIGILL : constant := 4; -- illegal instruction (not reset) 89 SIGFPE : constant := 8; -- floating point exception 90 SIGSEGV : constant := 11; -- segmentation violation 91 SIGTERM : constant := 15; -- software termination signal from kill 92 SIGBREAK : constant := 21; -- break (Ctrl-Break) 93 SIGABRT : constant := 22; -- used by abort, replace SIGIOT in the future 94 95 type sigset_t is private; 96 97 type isr_address is access procedure (sig : int); 98 pragma Convention (C, isr_address); 99 100 function intr_attach (sig : int; handler : isr_address) return long; 101 pragma Import (C, intr_attach, "signal"); 102 103 Intr_Attach_Reset : constant Boolean := True; 104 -- True if intr_attach is reset after an interrupt handler is called 105 106 procedure kill (sig : Signal); 107 pragma Import (C, kill, "raise"); 108 109 ------------ 110 -- Clock -- 111 ------------ 112 113 procedure QueryPerformanceFrequency 114 (lpPerformanceFreq : access LARGE_INTEGER); 115 pragma Import 116 (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency"); 117 118 -- According to the spec, on XP and later than function cannot fail, 119 -- so we ignore the return value and import it as a procedure. 120 121 ------------- 122 -- Threads -- 123 ------------- 124 125 type Thread_Body is access 126 function (arg : System.Address) return System.Address; 127 pragma Convention (C, Thread_Body); 128 129 function Thread_Body_Access is new 130 Ada.Unchecked_Conversion (System.Address, Thread_Body); 131 132 procedure SwitchToThread; 133 pragma Import (Stdcall, SwitchToThread, "SwitchToThread"); 134 135 function GetThreadTimes 136 (hThread : Win32.HANDLE; 137 lpCreationTime : access Long_Long_Integer; 138 lpExitTime : access Long_Long_Integer; 139 lpKernelTime : access Long_Long_Integer; 140 lpUserTime : access Long_Long_Integer) return Win32.BOOL; 141 pragma Import (Stdcall, GetThreadTimes, "GetThreadTimes"); 142 143 ----------------------- 144 -- Critical sections -- 145 ----------------------- 146 147 type CRITICAL_SECTION is private; 148 149 ------------------------------------------------------------- 150 -- Thread Creation, Activation, Suspension And Termination -- 151 ------------------------------------------------------------- 152 153 type PTHREAD_START_ROUTINE is access function 154 (pThreadParameter : Win32.PVOID) return Win32.DWORD; 155 pragma Convention (Stdcall, PTHREAD_START_ROUTINE); 156 157 function To_PTHREAD_START_ROUTINE is new 158 Ada.Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE); 159 160 function CreateThread 161 (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES; 162 dwStackSize : Win32.DWORD; 163 pStartAddress : PTHREAD_START_ROUTINE; 164 pParameter : Win32.PVOID; 165 dwCreationFlags : Win32.DWORD; 166 pThreadId : access Win32.DWORD) return Win32.HANDLE; 167 pragma Import (Stdcall, CreateThread, "CreateThread"); 168 169 function BeginThreadEx 170 (pThreadAttributes : access Win32.SECURITY_ATTRIBUTES; 171 dwStackSize : Win32.DWORD; 172 pStartAddress : PTHREAD_START_ROUTINE; 173 pParameter : Win32.PVOID; 174 dwCreationFlags : Win32.DWORD; 175 pThreadId : not null access Win32.DWORD) return Win32.HANDLE; 176 pragma Import (C, BeginThreadEx, "_beginthreadex"); 177 178 Debug_Process : constant := 16#00000001#; 179 Debug_Only_This_Process : constant := 16#00000002#; 180 Create_Suspended : constant := 16#00000004#; 181 Detached_Process : constant := 16#00000008#; 182 Create_New_Console : constant := 16#00000010#; 183 184 Create_New_Process_Group : constant := 16#00000200#; 185 186 Create_No_window : constant := 16#08000000#; 187 188 Profile_User : constant := 16#10000000#; 189 Profile_Kernel : constant := 16#20000000#; 190 Profile_Server : constant := 16#40000000#; 191 192 Stack_Size_Param_Is_A_Reservation : constant := 16#00010000#; 193 194 function GetExitCodeThread 195 (hThread : Win32.HANDLE; 196 pExitCode : not null access Win32.DWORD) return Win32.BOOL; 197 pragma Import (Stdcall, GetExitCodeThread, "GetExitCodeThread"); 198 199 function ResumeThread (hThread : Win32.HANDLE) return Win32.DWORD; 200 pragma Import (Stdcall, ResumeThread, "ResumeThread"); 201 202 function SuspendThread (hThread : Win32.HANDLE) return Win32.DWORD; 203 pragma Import (Stdcall, SuspendThread, "SuspendThread"); 204 205 procedure ExitThread (dwExitCode : Win32.DWORD); 206 pragma Import (Stdcall, ExitThread, "ExitThread"); 207 208 procedure EndThreadEx (dwExitCode : Win32.DWORD); 209 pragma Import (C, EndThreadEx, "_endthreadex"); 210 211 function TerminateThread 212 (hThread : Win32.HANDLE; 213 dwExitCode : Win32.DWORD) return Win32.BOOL; 214 pragma Import (Stdcall, TerminateThread, "TerminateThread"); 215 216 function GetCurrentThread return Win32.HANDLE; 217 pragma Import (Stdcall, GetCurrentThread, "GetCurrentThread"); 218 219 function GetCurrentProcess return Win32.HANDLE; 220 pragma Import (Stdcall, GetCurrentProcess, "GetCurrentProcess"); 221 222 function GetCurrentThreadId return Win32.DWORD; 223 pragma Import (Stdcall, GetCurrentThreadId, "GetCurrentThreadId"); 224 225 function TlsAlloc return Win32.DWORD; 226 pragma Import (Stdcall, TlsAlloc, "TlsAlloc"); 227 228 function TlsGetValue (dwTlsIndex : Win32.DWORD) return Win32.PVOID; 229 pragma Import (Stdcall, TlsGetValue, "TlsGetValue"); 230 231 function TlsSetValue 232 (dwTlsIndex : Win32.DWORD; pTlsValue : Win32.PVOID) return Win32.BOOL; 233 pragma Import (Stdcall, TlsSetValue, "TlsSetValue"); 234 235 function TlsFree (dwTlsIndex : Win32.DWORD) return Win32.BOOL; 236 pragma Import (Stdcall, TlsFree, "TlsFree"); 237 238 TLS_Nothing : constant := Win32.DWORD'Last; 239 240 procedure ExitProcess (uExitCode : Interfaces.C.unsigned); 241 pragma Import (Stdcall, ExitProcess, "ExitProcess"); 242 243 function WaitForSingleObject 244 (hHandle : Win32.HANDLE; 245 dwMilliseconds : Win32.DWORD) return Win32.DWORD; 246 pragma Import (Stdcall, WaitForSingleObject, "WaitForSingleObject"); 247 248 function WaitForSingleObjectEx 249 (hHandle : Win32.HANDLE; 250 dwMilliseconds : Win32.DWORD; 251 fAlertable : Win32.BOOL) return Win32.DWORD; 252 pragma Import (Stdcall, WaitForSingleObjectEx, "WaitForSingleObjectEx"); 253 254 Wait_Infinite : constant := Win32.DWORD'Last; 255 WAIT_TIMEOUT : constant := 16#0000_0102#; 256 WAIT_FAILED : constant := 16#FFFF_FFFF#; 257 258 ------------------------------------ 259 -- Semaphores, Events and Mutexes -- 260 ------------------------------------ 261 262 function CreateSemaphore 263 (pSemaphoreAttributes : access Win32.SECURITY_ATTRIBUTES; 264 lInitialCount : Interfaces.C.long; 265 lMaximumCount : Interfaces.C.long; 266 pName : PSZ) return Win32.HANDLE; 267 pragma Import (Stdcall, CreateSemaphore, "CreateSemaphoreA"); 268 269 function OpenSemaphore 270 (dwDesiredAccess : Win32.DWORD; 271 bInheritHandle : Win32.BOOL; 272 pName : PSZ) return Win32.HANDLE; 273 pragma Import (Stdcall, OpenSemaphore, "OpenSemaphoreA"); 274 275 function ReleaseSemaphore 276 (hSemaphore : Win32.HANDLE; 277 lReleaseCount : Interfaces.C.long; 278 pPreviousCount : access Win32.LONG) return Win32.BOOL; 279 pragma Import (Stdcall, ReleaseSemaphore, "ReleaseSemaphore"); 280 281 function CreateEvent 282 (pEventAttributes : access Win32.SECURITY_ATTRIBUTES; 283 bManualReset : Win32.BOOL; 284 bInitialState : Win32.BOOL; 285 pName : PSZ) return Win32.HANDLE; 286 pragma Import (Stdcall, CreateEvent, "CreateEventA"); 287 288 function OpenEvent 289 (dwDesiredAccess : Win32.DWORD; 290 bInheritHandle : Win32.BOOL; 291 pName : PSZ) return Win32.HANDLE; 292 pragma Import (Stdcall, OpenEvent, "OpenEventA"); 293 294 function SetEvent (hEvent : Win32.HANDLE) return Win32.BOOL; 295 pragma Import (Stdcall, SetEvent, "SetEvent"); 296 297 function ResetEvent (hEvent : Win32.HANDLE) return Win32.BOOL; 298 pragma Import (Stdcall, ResetEvent, "ResetEvent"); 299 300 function PulseEvent (hEvent : Win32.HANDLE) return Win32.BOOL; 301 pragma Import (Stdcall, PulseEvent, "PulseEvent"); 302 303 function CreateMutex 304 (pMutexAttributes : access Win32.SECURITY_ATTRIBUTES; 305 bInitialOwner : Win32.BOOL; 306 pName : PSZ) return Win32.HANDLE; 307 pragma Import (Stdcall, CreateMutex, "CreateMutexA"); 308 309 function OpenMutex 310 (dwDesiredAccess : Win32.DWORD; 311 bInheritHandle : Win32.BOOL; 312 pName : PSZ) return Win32.HANDLE; 313 pragma Import (Stdcall, OpenMutex, "OpenMutexA"); 314 315 function ReleaseMutex (hMutex : Win32.HANDLE) return Win32.BOOL; 316 pragma Import (Stdcall, ReleaseMutex, "ReleaseMutex"); 317 318 --------------------------------------------------- 319 -- Accessing properties of Threads and Processes -- 320 --------------------------------------------------- 321 322 ----------------- 323 -- Priorities -- 324 ----------------- 325 326 function SetThreadPriority 327 (hThread : Win32.HANDLE; 328 nPriority : Interfaces.C.int) return Win32.BOOL; 329 pragma Import (Stdcall, SetThreadPriority, "SetThreadPriority"); 330 331 function GetThreadPriority (hThread : Win32.HANDLE) return Interfaces.C.int; 332 pragma Import (Stdcall, GetThreadPriority, "GetThreadPriority"); 333 334 function SetPriorityClass 335 (hProcess : Win32.HANDLE; 336 dwPriorityClass : Win32.DWORD) return Win32.BOOL; 337 pragma Import (Stdcall, SetPriorityClass, "SetPriorityClass"); 338 339 procedure SetThreadPriorityBoost 340 (hThread : Win32.HANDLE; 341 DisablePriorityBoost : Win32.BOOL); 342 pragma Import (Stdcall, SetThreadPriorityBoost, "SetThreadPriorityBoost"); 343 344 Normal_Priority_Class : constant := 16#00000020#; 345 Idle_Priority_Class : constant := 16#00000040#; 346 High_Priority_Class : constant := 16#00000080#; 347 Realtime_Priority_Class : constant := 16#00000100#; 348 349 Thread_Priority_Idle : constant := -15; 350 Thread_Priority_Lowest : constant := -2; 351 Thread_Priority_Below_Normal : constant := -1; 352 Thread_Priority_Normal : constant := 0; 353 Thread_Priority_Above_Normal : constant := 1; 354 Thread_Priority_Highest : constant := 2; 355 Thread_Priority_Time_Critical : constant := 15; 356 Thread_Priority_Error_Return : constant := Interfaces.C.long'Last; 357 358private 359 360 type sigset_t is new Interfaces.C.unsigned_long; 361 362 type CRITICAL_SECTION is record 363 DebugInfo : System.Address; 364 365 LockCount : Long_Integer; 366 RecursionCount : Long_Integer; 367 OwningThread : Win32.HANDLE; 368 -- The above three fields control entering and exiting the critical 369 -- section for the resource. 370 371 LockSemaphore : Win32.HANDLE; 372 SpinCount : Win32.DWORD; 373 end record; 374 375end System.OS_Interface; 376