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-2019, 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 the HP-UX 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). 37 38-- PLEASE DO NOT add any with-clauses to this package or remove the pragma 39-- Preelaborate. This package is designed to be a bottom-level (leaf) package. 40 41with Ada.Unchecked_Conversion; 42 43with Interfaces.C; 44 45package System.OS_Interface is 46 pragma Preelaborate; 47 48 pragma Linker_Options ("-lcma"); 49 50 subtype int is Interfaces.C.int; 51 subtype short is Interfaces.C.short; 52 subtype long is Interfaces.C.long; 53 subtype unsigned is Interfaces.C.unsigned; 54 subtype unsigned_short is Interfaces.C.unsigned_short; 55 subtype unsigned_long is Interfaces.C.unsigned_long; 56 subtype unsigned_char is Interfaces.C.unsigned_char; 57 subtype plain_char is Interfaces.C.plain_char; 58 subtype size_t is Interfaces.C.size_t; 59 60 ----------- 61 -- Errno -- 62 ----------- 63 64 function errno return int; 65 pragma Import (C, errno, "__get_errno"); 66 67 EAGAIN : constant := 11; 68 EINTR : constant := 4; 69 EINVAL : constant := 22; 70 ENOMEM : constant := 12; 71 ETIME : constant := 52; 72 ETIMEDOUT : constant := 238; 73 74 FUNC_ERR : constant := -1; 75 76 ------------- 77 -- Signals -- 78 ------------- 79 80 Max_Interrupt : constant := 44; 81 type Signal is new int range 0 .. Max_Interrupt; 82 for Signal'Size use int'Size; 83 84 SIGHUP : constant := 1; -- hangup 85 SIGINT : constant := 2; -- interrupt (rubout) 86 SIGQUIT : constant := 3; -- quit (ASCD FS) 87 SIGILL : constant := 4; -- illegal instruction (not reset) 88 SIGTRAP : constant := 5; -- trace trap (not reset) 89 SIGIOT : constant := 6; -- IOT instruction 90 SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future 91 SIGEMT : constant := 7; -- EMT instruction 92 SIGFPE : constant := 8; -- floating point exception 93 SIGKILL : constant := 9; -- kill (cannot be caught or ignored) 94 SIGBUS : constant := 10; -- bus error 95 SIGSEGV : constant := 11; -- segmentation violation 96 SIGSYS : constant := 12; -- bad argument to system call 97 SIGPIPE : constant := 13; -- write on a pipe with no one to read it 98 SIGALRM : constant := 14; -- alarm clock 99 SIGTERM : constant := 15; -- software termination signal from kill 100 SIGUSR1 : constant := 16; -- user defined signal 1 101 SIGUSR2 : constant := 17; -- user defined signal 2 102 SIGCLD : constant := 18; -- alias for SIGCHLD 103 SIGCHLD : constant := 18; -- child status change 104 SIGPWR : constant := 19; -- power-fail restart 105 SIGVTALRM : constant := 20; -- virtual timer alarm 106 SIGPROF : constant := 21; -- profiling timer alarm 107 SIGIO : constant := 22; -- asynchronous I/O 108 SIGPOLL : constant := 22; -- pollable event occurred 109 SIGWINCH : constant := 23; -- window size change 110 SIGSTOP : constant := 24; -- stop (cannot be caught or ignored) 111 SIGTSTP : constant := 25; -- user stop requested from tty 112 SIGCONT : constant := 26; -- stopped process has been continued 113 SIGTTIN : constant := 27; -- background tty read attempted 114 SIGTTOU : constant := 28; -- background tty write attempted 115 SIGURG : constant := 29; -- urgent condition on IO channel 116 SIGLOST : constant := 30; -- remote lock lost (NFS) 117 SIGDIL : constant := 32; -- DIL signal 118 SIGXCPU : constant := 33; -- CPU time limit exceeded (setrlimit) 119 SIGXFSZ : constant := 34; -- file size limit exceeded (setrlimit) 120 121 SIGADAABORT : constant := SIGABRT; 122 -- Note: on other targets, we usually use SIGABRT, but on HP/UX, it 123 -- appears that SIGABRT can't be used in sigwait(), so we use SIGTERM. 124 125 type Signal_Set is array (Natural range <>) of Signal; 126 127 Unmasked : constant Signal_Set := 128 (SIGBUS, SIGTRAP, SIGTTIN, SIGTTOU, SIGTSTP); 129 130 Reserved : constant Signal_Set := (SIGKILL, SIGSTOP); 131 132 type sigset_t is private; 133 134 type isr_address is access procedure (sig : int); 135 pragma Convention (C, isr_address); 136 137 function intr_attach (sig : int; handler : isr_address) return long; 138 139 Intr_Attach_Reset : constant Boolean := True; 140 -- True if intr_attach is reset after an interrupt handler is called 141 142 function sigaddset (set : access sigset_t; sig : Signal) return int; 143 pragma Import (C, sigaddset, "sigaddset"); 144 145 function sigdelset (set : access sigset_t; sig : Signal) return int; 146 pragma Import (C, sigdelset, "sigdelset"); 147 148 function sigfillset (set : access sigset_t) return int; 149 pragma Import (C, sigfillset, "sigfillset"); 150 151 function sigismember (set : access sigset_t; sig : Signal) return int; 152 pragma Import (C, sigismember, "sigismember"); 153 154 function sigemptyset (set : access sigset_t) return int; 155 pragma Import (C, sigemptyset, "sigemptyset"); 156 157 type Signal_Handler is access procedure (signo : Signal); 158 159 type struct_sigaction is record 160 sa_handler : System.Address; 161 sa_mask : sigset_t; 162 sa_flags : int; 163 end record; 164 pragma Convention (C, struct_sigaction); 165 type struct_sigaction_ptr is access all struct_sigaction; 166 167 SA_RESTART : constant := 16#40#; 168 SA_SIGINFO : constant := 16#10#; 169 SA_ONSTACK : constant := 16#01#; 170 171 SIG_BLOCK : constant := 0; 172 SIG_UNBLOCK : constant := 1; 173 SIG_SETMASK : constant := 2; 174 175 SIG_DFL : constant := 0; 176 SIG_IGN : constant := 1; 177 SIG_ERR : constant := -1; 178 179 function sigaction 180 (sig : Signal; 181 act : struct_sigaction_ptr; 182 oact : struct_sigaction_ptr) return int; 183 pragma Import (C, sigaction, "sigaction"); 184 185 ---------- 186 -- Time -- 187 ---------- 188 189 type timespec is private; 190 191 function nanosleep (rqtp, rmtp : access timespec) return int; 192 pragma Import (C, nanosleep); 193 194 type clockid_t is new int; 195 196 function Clock_Gettime 197 (Clock_Id : clockid_t; Tp : access timespec) return int; 198 pragma Import (C, Clock_Gettime); 199 200 function To_Duration (TS : timespec) return Duration; 201 pragma Inline (To_Duration); 202 203 function To_Timespec (D : Duration) return timespec; 204 pragma Inline (To_Timespec); 205 206 ------------------------- 207 -- Priority Scheduling -- 208 ------------------------- 209 210 SCHED_FIFO : constant := 0; 211 SCHED_RR : constant := 1; 212 SCHED_OTHER : constant := 2; 213 214 ------------- 215 -- Process -- 216 ------------- 217 218 type pid_t is private; 219 220 function kill (pid : pid_t; sig : Signal) return int; 221 pragma Import (C, kill, "kill"); 222 223 function getpid return pid_t; 224 pragma Import (C, getpid, "getpid"); 225 226 ------------- 227 -- Threads -- 228 ------------- 229 230 type Thread_Body is access 231 function (arg : System.Address) return System.Address; 232 pragma Convention (C, Thread_Body); 233 234 function Thread_Body_Access is new 235 Ada.Unchecked_Conversion (System.Address, Thread_Body); 236 237 type pthread_t is private; 238 subtype Thread_Id is pthread_t; 239 240 type pthread_mutex_t is limited private; 241 type pthread_cond_t is limited private; 242 type pthread_attr_t is limited private; 243 type pthread_mutexattr_t is limited private; 244 type pthread_condattr_t is limited private; 245 type pthread_key_t is private; 246 247 -- Read/Write lock not supported on HPUX. To add support both types 248 -- pthread_rwlock_t and pthread_rwlockattr_t must properly be defined 249 -- with the associated routines pthread_rwlock_[init/destroy] and 250 -- pthread_rwlock_[rdlock/wrlock/unlock]. 251 252 subtype pthread_rwlock_t is pthread_mutex_t; 253 subtype pthread_rwlockattr_t is pthread_mutexattr_t; 254 255 ----------- 256 -- Stack -- 257 ----------- 258 259 function Get_Stack_Base (thread : pthread_t) return Address; 260 pragma Inline (Get_Stack_Base); 261 -- This is a dummy procedure to share some GNULLI files 262 263 --------------------------------------- 264 -- Nonstandard Thread Initialization -- 265 --------------------------------------- 266 267 procedure pthread_init; 268 pragma Inline (pthread_init); 269 -- This is a dummy procedure to share some GNULLI files 270 271 ------------------------- 272 -- POSIX.1c Section 3 -- 273 ------------------------- 274 275 function sigwait (set : access sigset_t) return int; 276 pragma Import (C, sigwait, "cma_sigwait"); 277 278 function sigwait 279 (set : access sigset_t; 280 sig : access Signal) return int; 281 pragma Inline (sigwait); 282 -- DCE_THREADS has a nonstandard sigwait 283 284 function pthread_kill 285 (thread : pthread_t; 286 sig : Signal) return int; 287 pragma Inline (pthread_kill); 288 -- DCE_THREADS doesn't have pthread_kill 289 290 function pthread_sigmask 291 (how : int; 292 set : access sigset_t; 293 oset : access sigset_t) return int; 294 -- DCE THREADS does not have pthread_sigmask. Instead, it uses sigprocmask 295 -- to do the signal handling when the thread library is sucked in. 296 pragma Import (C, pthread_sigmask, "sigprocmask"); 297 298 -------------------------- 299 -- POSIX.1c Section 11 -- 300 -------------------------- 301 302 function pthread_mutexattr_init 303 (attr : access pthread_mutexattr_t) return int; 304 -- DCE_THREADS has a nonstandard pthread_mutexattr_init 305 306 function pthread_mutexattr_destroy 307 (attr : access pthread_mutexattr_t) return int; 308 -- DCE_THREADS has a nonstandard pthread_mutexattr_destroy 309 310 function pthread_mutex_init 311 (mutex : access pthread_mutex_t; 312 attr : access pthread_mutexattr_t) return int; 313 -- DCE_THREADS has a nonstandard pthread_mutex_init 314 315 function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; 316 -- DCE_THREADS has a nonstandard pthread_mutex_destroy 317 318 function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; 319 pragma Inline (pthread_mutex_lock); 320 -- DCE_THREADS has nonstandard pthread_mutex_lock 321 322 function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; 323 pragma Inline (pthread_mutex_unlock); 324 -- DCE_THREADS has nonstandard pthread_mutex_lock 325 326 function pthread_condattr_init 327 (attr : access pthread_condattr_t) return int; 328 -- DCE_THREADS has nonstandard pthread_condattr_init 329 330 function pthread_condattr_destroy 331 (attr : access pthread_condattr_t) return int; 332 -- DCE_THREADS has nonstandard pthread_condattr_destroy 333 334 function pthread_cond_init 335 (cond : access pthread_cond_t; 336 attr : access pthread_condattr_t) return int; 337 -- DCE_THREADS has nonstandard pthread_cond_init 338 339 function pthread_cond_destroy (cond : access pthread_cond_t) return int; 340 -- DCE_THREADS has nonstandard pthread_cond_destroy 341 342 function pthread_cond_signal (cond : access pthread_cond_t) return int; 343 pragma Inline (pthread_cond_signal); 344 -- DCE_THREADS has nonstandard pthread_cond_signal 345 346 function pthread_cond_wait 347 (cond : access pthread_cond_t; 348 mutex : access pthread_mutex_t) return int; 349 pragma Inline (pthread_cond_wait); 350 -- DCE_THREADS has a nonstandard pthread_cond_wait 351 352 function pthread_cond_timedwait 353 (cond : access pthread_cond_t; 354 mutex : access pthread_mutex_t; 355 abstime : access timespec) return int; 356 pragma Inline (pthread_cond_timedwait); 357 -- DCE_THREADS has a nonstandard pthread_cond_timedwait 358 359 -------------------------- 360 -- POSIX.1c Section 13 -- 361 -------------------------- 362 363 type struct_sched_param is record 364 sched_priority : int; -- scheduling priority 365 end record; 366 367 function pthread_setschedparam 368 (thread : pthread_t; 369 policy : int; 370 param : access struct_sched_param) return int; 371 pragma Inline (pthread_setschedparam); 372 -- DCE_THREADS has a nonstandard pthread_setschedparam 373 374 function sched_yield return int; 375 pragma Inline (sched_yield); 376 -- DCE_THREADS has a nonstandard sched_yield 377 378 --------------------------- 379 -- P1003.1c - Section 16 -- 380 --------------------------- 381 382 function pthread_attr_init (attributes : access pthread_attr_t) return int; 383 pragma Inline (pthread_attr_init); 384 -- DCE_THREADS has a nonstandard pthread_attr_init 385 386 function pthread_attr_destroy 387 (attributes : access pthread_attr_t) return int; 388 pragma Inline (pthread_attr_destroy); 389 -- DCE_THREADS has a nonstandard pthread_attr_destroy 390 391 function pthread_attr_setstacksize 392 (attr : access pthread_attr_t; 393 stacksize : size_t) return int; 394 pragma Inline (pthread_attr_setstacksize); 395 -- DCE_THREADS has a nonstandard pthread_attr_setstacksize 396 397 function pthread_create 398 (thread : access pthread_t; 399 attributes : access pthread_attr_t; 400 start_routine : Thread_Body; 401 arg : System.Address) return int; 402 pragma Inline (pthread_create); 403 -- DCE_THREADS has a nonstandard pthread_create 404 405 procedure pthread_detach (thread : access pthread_t); 406 pragma Import (C, pthread_detach); 407 408 procedure pthread_exit (status : System.Address); 409 pragma Import (C, pthread_exit, "pthread_exit"); 410 411 function pthread_self return pthread_t; 412 pragma Import (C, pthread_self, "pthread_self"); 413 414 -------------------------- 415 -- POSIX.1c Section 17 -- 416 -------------------------- 417 418 function pthread_setspecific 419 (key : pthread_key_t; 420 value : System.Address) return int; 421 pragma Inline (pthread_setspecific); 422 -- DCE_THREADS has a nonstandard pthread_setspecific 423 424 function pthread_getspecific (key : pthread_key_t) return System.Address; 425 pragma Inline (pthread_getspecific); 426 -- DCE_THREADS has a nonstandard pthread_getspecific 427 428 type destructor_pointer is access procedure (arg : System.Address); 429 pragma Convention (C, destructor_pointer); 430 431 function pthread_key_create 432 (key : access pthread_key_t; 433 destructor : destructor_pointer) return int; 434 pragma Inline (pthread_key_create); 435 -- DCE_THREADS has a nonstandard pthread_key_create 436 437private 438 439 type array_type_1 is array (Integer range 0 .. 7) of unsigned_long; 440 type sigset_t is record 441 X_X_sigbits : array_type_1; 442 end record; 443 pragma Convention (C, sigset_t); 444 445 type pid_t is new int; 446 447 type time_t is new long; 448 449 type timespec is record 450 tv_sec : time_t; 451 tv_nsec : long; 452 end record; 453 pragma Convention (C, timespec); 454 455 CLOCK_REALTIME : constant clockid_t := 1; 456 457 type cma_t_address is new System.Address; 458 459 type cma_t_handle is record 460 field1 : cma_t_address; 461 field2 : Short_Integer; 462 field3 : Short_Integer; 463 end record; 464 for cma_t_handle'Size use 64; 465 466 type pthread_attr_t is new cma_t_handle; 467 pragma Convention (C_Pass_By_Copy, pthread_attr_t); 468 469 type pthread_condattr_t is new cma_t_handle; 470 pragma Convention (C_Pass_By_Copy, pthread_condattr_t); 471 472 type pthread_mutexattr_t is new cma_t_handle; 473 pragma Convention (C_Pass_By_Copy, pthread_mutexattr_t); 474 475 type pthread_t is new cma_t_handle; 476 pragma Convention (C_Pass_By_Copy, pthread_t); 477 478 type pthread_mutex_t is new cma_t_handle; 479 pragma Convention (C_Pass_By_Copy, pthread_mutex_t); 480 481 type pthread_cond_t is new cma_t_handle; 482 pragma Convention (C_Pass_By_Copy, pthread_cond_t); 483 484 type pthread_key_t is new int; 485 486end System.OS_Interface; 487