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-2002 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 Solaris (native) version of this package 35 36-- This package includes 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 43with Interfaces.C; 44package System.OS_Interface is 45 pragma Preelaborate; 46 47 pragma Linker_Options ("-lposix4"); 48 pragma Linker_Options ("-lthread"); 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 := 62; 72 ETIMEDOUT : constant := 145; 73 74 ------------- 75 -- Signals -- 76 ------------- 77 78 Max_Interrupt : constant := 45; 79 type Signal is new int range 0 .. Max_Interrupt; 80 for Signal'Size use int'Size; 81 82 SIGHUP : constant := 1; -- hangup 83 SIGINT : constant := 2; -- interrupt (rubout) 84 SIGQUIT : constant := 3; -- quit (ASCD FS) 85 SIGILL : constant := 4; -- illegal instruction (not reset) 86 SIGTRAP : constant := 5; -- trace trap (not reset) 87 SIGIOT : constant := 6; -- IOT instruction 88 SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future 89 SIGEMT : constant := 7; -- EMT instruction 90 SIGFPE : constant := 8; -- floating point exception 91 SIGKILL : constant := 9; -- kill (cannot be caught or ignored) 92 SIGBUS : constant := 10; -- bus error 93 SIGSEGV : constant := 11; -- segmentation violation 94 SIGSYS : constant := 12; -- bad argument to system call 95 SIGPIPE : constant := 13; -- write on a pipe with no one to read it 96 SIGALRM : constant := 14; -- alarm clock 97 SIGTERM : constant := 15; -- software termination signal from kill 98 SIGUSR1 : constant := 16; -- user defined signal 1 99 SIGUSR2 : constant := 17; -- user defined signal 2 100 SIGCLD : constant := 18; -- alias for SIGCHLD 101 SIGCHLD : constant := 18; -- child status change 102 SIGPWR : constant := 19; -- power-fail restart 103 SIGWINCH : constant := 20; -- window size change 104 SIGURG : constant := 21; -- urgent condition on IO channel 105 SIGPOLL : constant := 22; -- pollable event occurred 106 SIGIO : constant := 22; -- I/O possible (Solaris SIGPOLL alias) 107 SIGSTOP : constant := 23; -- stop (cannot be caught or ignored) 108 SIGTSTP : constant := 24; -- user stop requested from tty 109 SIGCONT : constant := 25; -- stopped process has been continued 110 SIGTTIN : constant := 26; -- background tty read attempted 111 SIGTTOU : constant := 27; -- background tty write attempted 112 SIGVTALRM : constant := 28; -- virtual timer expired 113 SIGPROF : constant := 29; -- profiling timer expired 114 SIGXCPU : constant := 30; -- CPU time limit exceeded 115 SIGXFSZ : constant := 31; -- filesize limit exceeded 116 SIGWAITING : constant := 32; -- process's lwps blocked (Solaris) 117 SIGLWP : constant := 33; -- used by thread library (Solaris) 118 SIGFREEZE : constant := 34; -- used by CPR (Solaris) 119 SIGTHAW : constant := 35; -- used by CPR (Solaris) 120 SIGCANCEL : constant := 36; -- thread cancellation signal (libthread) 121 122 type Signal_Set is array (Natural range <>) of Signal; 123 124 Unmasked : constant Signal_Set := (SIGTRAP, SIGLWP, SIGPROF); 125 126 -- Following signals should not be disturbed. 127 -- See c-posix-signals.c in FLORIST 128 129 Reserved : constant Signal_Set := 130 (SIGKILL, SIGSTOP, SIGWAITING, SIGCANCEL, SIGTRAP, SIGSEGV); 131 132 type sigset_t is private; 133 134 function sigaddset (set : access sigset_t; sig : Signal) return int; 135 pragma Import (C, sigaddset, "sigaddset"); 136 137 function sigdelset (set : access sigset_t; sig : Signal) return int; 138 pragma Import (C, sigdelset, "sigdelset"); 139 140 function sigfillset (set : access sigset_t) return int; 141 pragma Import (C, sigfillset, "sigfillset"); 142 143 function sigismember (set : access sigset_t; sig : Signal) return int; 144 pragma Import (C, sigismember, "sigismember"); 145 146 function sigemptyset (set : access sigset_t) return int; 147 pragma Import (C, sigemptyset, "sigemptyset"); 148 149 type union_type_3 is new String (1 .. 116); 150 type siginfo_t is record 151 si_signo : int; 152 si_code : int; 153 si_errno : int; 154 X_data : union_type_3; 155 end record; 156 pragma Convention (C, siginfo_t); 157 158 -- The types mcontext_t and gregset_t are part of the ucontext_t 159 -- information, which is specific to Solaris2.4 for SPARC 160 -- The ucontext_t info seems to be used by the handler 161 -- for SIGSEGV to decide whether it is a Storage_Error (stack overflow) or 162 -- a Constraint_Error (bad pointer). The original code that did this 163 -- is suspect, so it is not clear whether we really need this part of 164 -- the signal context information, or perhaps something else. 165 -- More analysis is needed, after which these declarations may need to 166 -- be changed. 167 168 FPE_INTDIV : constant := 1; -- integer divide by zero 169 FPE_INTOVF : constant := 2; -- integer overflow 170 FPE_FLTDIV : constant := 3; -- floating point divide by zero 171 FPE_FLTOVF : constant := 4; -- floating point overflow 172 FPE_FLTUND : constant := 5; -- floating point underflow 173 FPE_FLTRES : constant := 6; -- floating point inexact result 174 FPE_FLTINV : constant := 7; -- invalid floating point operation 175 FPE_FLTSUB : constant := 8; -- subscript out of range 176 177 type greg_t is new int; 178 179 type gregset_t is array (0 .. 18) of greg_t; 180 181 type union_type_2 is new String (1 .. 128); 182 type record_type_1 is record 183 fpu_fr : union_type_2; 184 fpu_q : System.Address; 185 fpu_fsr : unsigned; 186 fpu_qcnt : unsigned_char; 187 fpu_q_entrysize : unsigned_char; 188 fpu_en : unsigned_char; 189 end record; 190 pragma Convention (C, record_type_1); 191 192 type array_type_7 is array (Integer range 0 .. 20) of long; 193 type mcontext_t is record 194 gregs : gregset_t; 195 gwins : System.Address; 196 fpregs : record_type_1; 197 filler : array_type_7; 198 end record; 199 pragma Convention (C, mcontext_t); 200 201 type record_type_2 is record 202 ss_sp : System.Address; 203 ss_size : int; 204 ss_flags : int; 205 end record; 206 pragma Convention (C, record_type_2); 207 208 type array_type_8 is array (Integer range 0 .. 22) of long; 209 type ucontext_t is record 210 uc_flags : unsigned_long; 211 uc_link : System.Address; 212 uc_sigmask : sigset_t; 213 uc_stack : record_type_2; 214 uc_mcontext : mcontext_t; 215 uc_filler : array_type_8; 216 end record; 217 pragma Convention (C, ucontext_t); 218 219 type Signal_Handler is access procedure 220 (signo : Signal; 221 info : access siginfo_t; 222 context : access ucontext_t); 223 224 type union_type_1 is new plain_char; 225 type array_type_2 is array (Integer range 0 .. 1) of int; 226 type struct_sigaction is record 227 sa_flags : int; 228 sa_handler : System.Address; 229 sa_mask : sigset_t; 230 sa_resv : array_type_2; 231 end record; 232 pragma Convention (C, struct_sigaction); 233 type struct_sigaction_ptr is access all struct_sigaction; 234 235 SIG_BLOCK : constant := 1; 236 SIG_UNBLOCK : constant := 2; 237 SIG_SETMASK : constant := 3; 238 239 SIG_DFL : constant := 0; 240 SIG_IGN : constant := 1; 241 242 function sigaction 243 (sig : Signal; 244 act : struct_sigaction_ptr; 245 oact : struct_sigaction_ptr) return int; 246 pragma Import (C, sigaction, "sigaction"); 247 248 ---------- 249 -- Time -- 250 ---------- 251 252 type timespec is private; 253 254 type clockid_t is private; 255 256 CLOCK_REALTIME : constant clockid_t; 257 258 function clock_gettime 259 (clock_id : clockid_t; tp : access timespec) return int; 260 pragma Import (C, clock_gettime, "clock_gettime"); 261 262 function clock_getres 263 (clock_id : clockid_t; res : access timespec) return int; 264 pragma Import (C, clock_getres, "clock_getres"); 265 266 function To_Duration (TS : timespec) return Duration; 267 pragma Inline (To_Duration); 268 269 function To_Timespec (D : Duration) return timespec; 270 pragma Inline (To_Timespec); 271 272 type struct_timeval is private; 273 -- This is needed on systems that do not have clock_gettime() 274 -- but do have gettimeofday(). 275 276 function To_Duration (TV : struct_timeval) return Duration; 277 pragma Inline (To_Duration); 278 279 function To_Timeval (D : Duration) return struct_timeval; 280 pragma Inline (To_Timeval); 281 282 ------------- 283 -- Process -- 284 ------------- 285 286 type pid_t is private; 287 288 function kill (pid : pid_t; sig : Signal) return int; 289 pragma Import (C, kill, "kill"); 290 291 function getpid return pid_t; 292 pragma Import (C, getpid, "getpid"); 293 294 ------------- 295 -- Threads -- 296 ------------- 297 298 type Thread_Body is access 299 function (arg : System.Address) return System.Address; 300 301 THR_DETACHED : constant := 64; 302 THR_BOUND : constant := 1; 303 THR_NEW_LWP : constant := 2; 304 USYNC_THREAD : constant := 0; 305 306 type thread_t is private; 307 subtype Thread_Id is thread_t; 308 309 type mutex_t is limited private; 310 311 type cond_t is limited private; 312 313 type thread_key_t is private; 314 315 function thr_create 316 (stack_base : System.Address; 317 stack_size : size_t; 318 start_routine : Thread_Body; 319 arg : System.Address; 320 flags : int; 321 new_thread : access thread_t) return int; 322 pragma Import (C, thr_create, "thr_create"); 323 324 function thr_min_stack return size_t; 325 pragma Import (C, thr_min_stack, "thr_min_stack"); 326 327 function thr_self return thread_t; 328 pragma Import (C, thr_self, "thr_self"); 329 330 function mutex_init 331 (mutex : access mutex_t; 332 mtype : int; 333 arg : System.Address) return int; 334 pragma Import (C, mutex_init, "mutex_init"); 335 336 function mutex_destroy (mutex : access mutex_t) return int; 337 pragma Import (C, mutex_destroy, "mutex_destroy"); 338 339 function mutex_lock (mutex : access mutex_t) return int; 340 pragma Import (C, mutex_lock, "mutex_lock"); 341 342 function mutex_unlock (mutex : access mutex_t) return int; 343 pragma Import (C, mutex_unlock, "mutex_unlock"); 344 345 function cond_init 346 (cond : access cond_t; 347 ctype : int; 348 arg : int) return int; 349 pragma Import (C, cond_init, "cond_init"); 350 351 function cond_wait 352 (cond : access cond_t; mutex : access mutex_t) return int; 353 pragma Import (C, cond_wait, "cond_wait"); 354 355 function cond_timedwait 356 (cond : access cond_t; 357 mutex : access mutex_t; 358 abstime : access timespec) return int; 359 pragma Import (C, cond_timedwait, "cond_timedwait"); 360 361 function cond_signal (cond : access cond_t) return int; 362 pragma Import (C, cond_signal, "cond_signal"); 363 364 function cond_destroy (cond : access cond_t) return int; 365 pragma Import (C, cond_destroy, "cond_destroy"); 366 367 function thr_setspecific 368 (key : thread_key_t; value : System.Address) return int; 369 pragma Import (C, thr_setspecific, "thr_setspecific"); 370 371 function thr_getspecific 372 (key : thread_key_t; 373 value : access System.Address) return int; 374 pragma Import (C, thr_getspecific, "thr_getspecific"); 375 376 function thr_keycreate 377 (key : access thread_key_t; destructor : System.Address) return int; 378 pragma Import (C, thr_keycreate, "thr_keycreate"); 379 380 function thr_setprio (thread : thread_t; priority : int) return int; 381 pragma Import (C, thr_setprio, "thr_setprio"); 382 383 procedure thr_exit (status : System.Address); 384 pragma Import (C, thr_exit, "thr_exit"); 385 386 function thr_setconcurrency (new_level : int) return int; 387 pragma Import (C, thr_setconcurrency, "thr_setconcurrency"); 388 389 function sigwait (set : access sigset_t; sig : access Signal) return int; 390 pragma Import (C, sigwait, "__posix_sigwait"); 391 392 function thr_kill (thread : thread_t; sig : Signal) return int; 393 pragma Import (C, thr_kill, "thr_kill"); 394 395 type sigset_t_ptr is access all sigset_t; 396 397 function thr_sigsetmask 398 (how : int; 399 set : sigset_t_ptr; 400 oset : sigset_t_ptr) return int; 401 pragma Import (C, thr_sigsetmask, "thr_sigsetmask"); 402 403 function pthread_sigmask 404 (how : int; 405 set : sigset_t_ptr; 406 oset : sigset_t_ptr) return int; 407 pragma Import (C, pthread_sigmask, "thr_sigsetmask"); 408 409 function thr_suspend (target_thread : thread_t) return int; 410 pragma Import (C, thr_suspend, "thr_suspend"); 411 412 function thr_continue (target_thread : thread_t) return int; 413 pragma Import (C, thr_continue, "thr_continue"); 414 415 procedure thr_yield; 416 pragma Import (C, thr_yield, "thr_yield"); 417 418 --------- 419 -- LWP -- 420 --------- 421 422 P_PID : constant := 0; 423 P_LWPID : constant := 8; 424 425 PC_GETCID : constant := 0; 426 PC_GETCLINFO : constant := 1; 427 PC_SETPARMS : constant := 2; 428 PC_GETPARMS : constant := 3; 429 PC_ADMIN : constant := 4; 430 431 PC_CLNULL : constant := -1; 432 433 RT_NOCHANGE : constant := -1; 434 RT_TQINF : constant := -2; 435 RT_TQDEF : constant := -3; 436 437 PC_CLNMSZ : constant := 16; 438 439 PC_VERSION : constant := 1; 440 441 type lwpid_t is new int; 442 443 type pri_t is new short; 444 445 type id_t is new long; 446 447 P_MYID : constant := -1; 448 -- the specified LWP or process is the current one. 449 450 type struct_pcinfo is record 451 pc_cid : id_t; 452 pc_clname : String (1 .. PC_CLNMSZ); 453 rt_maxpri : short; 454 end record; 455 pragma Convention (C, struct_pcinfo); 456 457 type struct_pcparms is record 458 pc_cid : id_t; 459 rt_pri : pri_t; 460 rt_tqsecs : long; 461 rt_tqnsecs : long; 462 end record; 463 pragma Convention (C, struct_pcparms); 464 465 function priocntl 466 (ver : int; 467 id_type : int; 468 id : lwpid_t; 469 cmd : int; 470 arg : System.Address) return Interfaces.C.long; 471 pragma Import (C, priocntl, "__priocntl"); 472 473 function lwp_self return lwpid_t; 474 pragma Import (C, lwp_self, "_lwp_self"); 475 476 type processorid_t is new int; 477 type processorid_t_ptr is access all processorid_t; 478 479 -- Constants for function processor_bind 480 481 PBIND_QUERY : constant processorid_t := -2; 482 -- the processor bindings are not changed. 483 484 PBIND_NONE : constant processorid_t := -1; 485 -- the processor bindings of the specified LWPs are cleared. 486 487 -- Flags for function p_online 488 489 PR_OFFLINE : constant int := 1; 490 -- processor is offline, as quiet as possible 491 492 PR_ONLINE : constant int := 2; 493 -- processor online 494 495 PR_STATUS : constant int := 3; 496 -- value passed to p_online to request status 497 498 function p_online (processorid : processorid_t; flag : int) return int; 499 pragma Import (C, p_online, "p_online"); 500 501 function processor_bind 502 (id_type : int; 503 id : id_t; 504 proc_id : processorid_t; 505 obind : processorid_t_ptr) return int; 506 pragma Import (C, processor_bind, "processor_bind"); 507 508 procedure pthread_init; 509 -- dummy procedure to share s-intman.adb with other Solaris targets. 510 511private 512 513 type array_type_1 is array (0 .. 3) of unsigned_long; 514 type sigset_t is record 515 X_X_sigbits : array_type_1; 516 end record; 517 pragma Convention (C, sigset_t); 518 519 type pid_t is new long; 520 521 type time_t is new long; 522 523 type timespec is record 524 tv_sec : time_t; 525 tv_nsec : long; 526 end record; 527 pragma Convention (C, timespec); 528 529 type clockid_t is new int; 530 CLOCK_REALTIME : constant clockid_t := 0; 531 532 type struct_timeval is record 533 tv_sec : long; 534 tv_usec : long; 535 end record; 536 pragma Convention (C, struct_timeval); 537 538 type thread_t is new unsigned; 539 540 type array_type_9 is array (0 .. 3) of unsigned_char; 541 type record_type_3 is record 542 flag : array_type_9; 543 Xtype : unsigned_long; 544 end record; 545 pragma Convention (C, record_type_3); 546 547 type mutex_t is record 548 flags : record_type_3; 549 lock : String (1 .. 8); 550 data : String (1 .. 8); 551 end record; 552 pragma Convention (C, mutex_t); 553 554 type cond_t is record 555 flag : array_type_9; 556 Xtype : unsigned_long; 557 data : String (1 .. 8); 558 end record; 559 pragma Convention (C, cond_t); 560 561 type thread_key_t is new unsigned; 562 563end System.OS_Interface; 564