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-- B o d y -- 8-- -- 9-- Copyright (C) 1999-2009, 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 3, or (at your option) any later ver- -- 14-- sion. GNAT 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. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNARL was developed by the GNARL team at Florida State University. -- 28-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This is a LynxOS (Native) version of this package 33 34pragma Polling (Off); 35-- Turn off polling, we do not want ATC polling to take place during 36-- tasking operations. It causes infinite loops and other problems. 37 38package body System.OS_Interface is 39 40 use Interfaces.C; 41 42 ------------------- 43 -- clock_gettime -- 44 ------------------- 45 46 function clock_gettime 47 (clock_id : clockid_t; 48 tp : access timespec) 49 return int 50 is 51 function clock_gettime_base 52 (clock_id : clockid_t; 53 tp : access timespec) 54 return int; 55 pragma Import (C, clock_gettime_base, "clock_gettime"); 56 57 begin 58 if clock_gettime_base (clock_id, tp) /= 0 then 59 return errno; 60 end if; 61 62 return 0; 63 end clock_gettime; 64 65 ----------------- 66 -- To_Duration -- 67 ----------------- 68 69 function To_Duration (TS : timespec) return Duration is 70 begin 71 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9; 72 end To_Duration; 73 74 ------------------------ 75 -- To_Target_Priority -- 76 ------------------------ 77 78 function To_Target_Priority 79 (Prio : System.Any_Priority) return Interfaces.C.int 80 is 81 begin 82 return Interfaces.C.int (Prio); 83 end To_Target_Priority; 84 85 ----------------- 86 -- To_Timespec -- 87 ----------------- 88 89 function To_Timespec (D : Duration) return timespec is 90 S : time_t; 91 F : Duration; 92 93 begin 94 S := time_t (Long_Long_Integer (D)); 95 F := D - Duration (S); 96 97 -- If F has negative value due to a round-up, adjust for positive F 98 -- value. 99 100 if F < 0.0 then 101 S := S - 1; 102 F := F + 1.0; 103 end if; 104 105 return timespec'(tv_sec => S, 106 tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); 107 end To_Timespec; 108 109 ------------------------- 110 -- POSIX.1c Section 3 -- 111 ------------------------- 112 113 function sigwait 114 (set : access sigset_t; 115 sig : access Signal) 116 return int 117 is 118 function sigwait_base 119 (set : access sigset_t; 120 value : System.Address) 121 return Signal; 122 pragma Import (C, sigwait_base, "sigwait"); 123 124 begin 125 sig.all := sigwait_base (set, Null_Address); 126 127 if sig.all = -1 then 128 return errno; 129 end if; 130 131 return 0; 132 end sigwait; 133 134 -------------------------- 135 -- POSIX.1c Section 11 -- 136 -------------------------- 137 138 -- For all the following functions, LynxOS threads has the POSIX Draft 4 139 -- behavior; it sets errno but the standard Posix requires it to be 140 -- returned. 141 142 function pthread_mutexattr_init 143 (attr : access pthread_mutexattr_t) 144 return int 145 is 146 function pthread_mutexattr_create 147 (attr : access pthread_mutexattr_t) 148 return int; 149 pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create"); 150 151 begin 152 if pthread_mutexattr_create (attr) /= 0 then 153 return errno; 154 end if; 155 156 return 0; 157 end pthread_mutexattr_init; 158 159 function pthread_mutexattr_destroy 160 (attr : access pthread_mutexattr_t) 161 return int 162 is 163 function pthread_mutexattr_delete 164 (attr : access pthread_mutexattr_t) 165 return int; 166 pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete"); 167 168 begin 169 if pthread_mutexattr_delete (attr) /= 0 then 170 return errno; 171 end if; 172 173 return 0; 174 end pthread_mutexattr_destroy; 175 176 function pthread_mutex_init 177 (mutex : access pthread_mutex_t; 178 attr : access pthread_mutexattr_t) 179 return int 180 is 181 function pthread_mutex_init_base 182 (mutex : access pthread_mutex_t; 183 attr : pthread_mutexattr_t) 184 return int; 185 pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init"); 186 187 begin 188 if pthread_mutex_init_base (mutex, attr.all) /= 0 then 189 return errno; 190 end if; 191 192 return 0; 193 end pthread_mutex_init; 194 195 function pthread_mutex_destroy 196 (mutex : access pthread_mutex_t) 197 return int 198 is 199 function pthread_mutex_destroy_base 200 (mutex : access pthread_mutex_t) 201 return int; 202 pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy"); 203 204 begin 205 if pthread_mutex_destroy_base (mutex) /= 0 then 206 return errno; 207 end if; 208 209 return 0; 210 end pthread_mutex_destroy; 211 212 function pthread_mutex_lock 213 (mutex : access pthread_mutex_t) 214 return int 215 is 216 function pthread_mutex_lock_base 217 (mutex : access pthread_mutex_t) 218 return int; 219 pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock"); 220 221 begin 222 if pthread_mutex_lock_base (mutex) /= 0 then 223 return errno; 224 end if; 225 226 return 0; 227 end pthread_mutex_lock; 228 229 function pthread_mutex_unlock 230 (mutex : access pthread_mutex_t) 231 return int 232 is 233 function pthread_mutex_unlock_base 234 (mutex : access pthread_mutex_t) 235 return int; 236 pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock"); 237 238 begin 239 if pthread_mutex_unlock_base (mutex) /= 0 then 240 return errno; 241 end if; 242 243 return 0; 244 end pthread_mutex_unlock; 245 246 function pthread_condattr_init 247 (attr : access pthread_condattr_t) 248 return int 249 is 250 function pthread_condattr_create 251 (attr : access pthread_condattr_t) 252 return int; 253 pragma Import (C, pthread_condattr_create, "pthread_condattr_create"); 254 255 begin 256 if pthread_condattr_create (attr) /= 0 then 257 return errno; 258 end if; 259 260 return 0; 261 end pthread_condattr_init; 262 263 function pthread_condattr_destroy 264 (attr : access pthread_condattr_t) 265 return int 266 is 267 function pthread_condattr_delete 268 (attr : access pthread_condattr_t) 269 return int; 270 pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete"); 271 272 begin 273 if pthread_condattr_delete (attr) /= 0 then 274 return errno; 275 end if; 276 277 return 0; 278 end pthread_condattr_destroy; 279 280 function pthread_cond_init 281 (cond : access pthread_cond_t; 282 attr : access pthread_condattr_t) 283 return int 284 is 285 function pthread_cond_init_base 286 (cond : access pthread_cond_t; 287 attr : pthread_condattr_t) 288 return int; 289 pragma Import (C, pthread_cond_init_base, "pthread_cond_init"); 290 291 begin 292 if pthread_cond_init_base (cond, attr.all) /= 0 then 293 return errno; 294 end if; 295 296 return 0; 297 end pthread_cond_init; 298 299 function pthread_cond_destroy 300 (cond : access pthread_cond_t) 301 return int 302 is 303 function pthread_cond_destroy_base 304 (cond : access pthread_cond_t) 305 return int; 306 pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy"); 307 308 begin 309 if pthread_cond_destroy_base (cond) /= 0 then 310 return errno; 311 end if; 312 313 return 0; 314 end pthread_cond_destroy; 315 316 function pthread_cond_signal 317 (cond : access pthread_cond_t) 318 return int 319 is 320 function pthread_cond_signal_base 321 (cond : access pthread_cond_t) 322 return int; 323 pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal"); 324 325 begin 326 if pthread_cond_signal_base (cond) /= 0 then 327 return errno; 328 end if; 329 330 return 0; 331 end pthread_cond_signal; 332 333 function pthread_cond_wait 334 (cond : access pthread_cond_t; 335 mutex : access pthread_mutex_t) 336 return int 337 is 338 function pthread_cond_wait_base 339 (cond : access pthread_cond_t; 340 mutex : access pthread_mutex_t) 341 return int; 342 pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait"); 343 344 begin 345 if pthread_cond_wait_base (cond, mutex) /= 0 then 346 return errno; 347 end if; 348 349 return 0; 350 end pthread_cond_wait; 351 352 function pthread_cond_timedwait 353 (cond : access pthread_cond_t; 354 mutex : access pthread_mutex_t; 355 reltime : access timespec) return int 356 is 357 function pthread_cond_timedwait_base 358 (cond : access pthread_cond_t; 359 mutex : access pthread_mutex_t; 360 reltime : access timespec) return int; 361 pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait"); 362 363 begin 364 if pthread_cond_timedwait_base (cond, mutex, reltime) /= 0 then 365 if errno = EAGAIN then 366 return ETIMEDOUT; 367 end if; 368 369 return errno; 370 end if; 371 372 return 0; 373 end pthread_cond_timedwait; 374 375 -------------------------- 376 -- POSIX.1c Section 13 -- 377 -------------------------- 378 379 function pthread_setschedparam 380 (thread : pthread_t; 381 policy : int; 382 param : access struct_sched_param) 383 return int 384 is 385 function pthread_setscheduler 386 (thread : pthread_t; 387 policy : int; 388 prio : int) 389 return int; 390 pragma Import (C, pthread_setscheduler, "pthread_setscheduler"); 391 392 begin 393 if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then 394 return errno; 395 end if; 396 397 return 0; 398 end pthread_setschedparam; 399 400 function pthread_mutexattr_setprotocol 401 (attr : access pthread_mutexattr_t; 402 protocol : int) 403 return int 404 is 405 pragma Unreferenced (attr, protocol); 406 begin 407 return 0; 408 end pthread_mutexattr_setprotocol; 409 410 function pthread_mutexattr_setprioceiling 411 (attr : access pthread_mutexattr_t; 412 prioceiling : int) 413 return int 414 is 415 pragma Unreferenced (attr, prioceiling); 416 begin 417 return 0; 418 end pthread_mutexattr_setprioceiling; 419 420 function pthread_attr_setscope 421 (attr : access pthread_attr_t; 422 contentionscope : int) 423 return int 424 is 425 pragma Unreferenced (attr, contentionscope); 426 begin 427 return 0; 428 end pthread_attr_setscope; 429 430 function sched_yield return int is 431 procedure pthread_yield; 432 pragma Import (C, pthread_yield, "pthread_yield"); 433 434 begin 435 pthread_yield; 436 return 0; 437 end sched_yield; 438 439 ----------------------------- 440 -- P1003.1c - Section 16 -- 441 ----------------------------- 442 443 function pthread_attr_setdetachstate 444 (attr : access pthread_attr_t; 445 detachstate : int) 446 return int 447 is 448 pragma Unreferenced (attr, detachstate); 449 begin 450 return 0; 451 end pthread_attr_setdetachstate; 452 453 function pthread_create 454 (thread : access pthread_t; 455 attributes : access pthread_attr_t; 456 start_routine : Thread_Body; 457 arg : System.Address) 458 return int 459 is 460 -- The LynxOS pthread_create doesn't seems to work. 461 -- Workaround : We're using st_new instead. 462 -- 463 -- function pthread_create_base 464 -- (thread : access pthread_t; 465 -- attributes : pthread_attr_t; 466 -- start_routine : Thread_Body; 467 -- arg : System.Address) 468 -- return int; 469 -- pragma Import (C, pthread_create_base, "pthread_create"); 470 471 St : aliased st_t := attributes.st; 472 473 function st_new 474 (start_routine : Thread_Body; 475 arg : System.Address; 476 attributes : access st_t; 477 thread : access pthread_t) 478 return int; 479 pragma Import (C, st_new, "st_new"); 480 481 begin 482 -- Following code would be used if above commented function worked 483 484 -- if pthread_create_base 485 -- (thread, attributes.all, start_routine, arg) /= 0 then 486 487 if st_new (start_routine, arg, St'Access, thread) /= 0 then 488 return errno; 489 end if; 490 491 return 0; 492 end pthread_create; 493 494 function pthread_detach (thread : pthread_t) return int is 495 aliased_thread : aliased pthread_t := thread; 496 497 function pthread_detach_base (thread : access pthread_t) return int; 498 pragma Import (C, pthread_detach_base, "pthread_detach"); 499 500 begin 501 if pthread_detach_base (aliased_thread'Access) /= 0 then 502 return errno; 503 end if; 504 505 return 0; 506 end pthread_detach; 507 508 -------------------------- 509 -- POSIX.1c Section 17 -- 510 -------------------------- 511 512 function pthread_setspecific 513 (key : pthread_key_t; 514 value : System.Address) 515 return int 516 is 517 function pthread_setspecific_base 518 (key : pthread_key_t; 519 value : System.Address) 520 return int; 521 pragma Import (C, pthread_setspecific_base, "pthread_setspecific"); 522 523 begin 524 if pthread_setspecific_base (key, value) /= 0 then 525 return errno; 526 end if; 527 528 return 0; 529 end pthread_setspecific; 530 531 function pthread_getspecific (key : pthread_key_t) return System.Address is 532 procedure pthread_getspecific_base 533 (key : pthread_key_t; 534 value : access System.Address); 535 pragma Import (C, pthread_getspecific_base, "pthread_getspecific"); 536 537 value : aliased System.Address := System.Null_Address; 538 539 begin 540 pthread_getspecific_base (key, value'Unchecked_Access); 541 return value; 542 end pthread_getspecific; 543 544 function Get_Stack_Base (thread : pthread_t) return Address is 545 pragma Warnings (Off, thread); 546 547 begin 548 return Null_Address; 549 end Get_Stack_Base; 550 551 function pthread_key_create 552 (key : access pthread_key_t; 553 destructor : destructor_pointer) 554 return int 555 is 556 function pthread_keycreate 557 (key : access pthread_key_t; 558 destructor : destructor_pointer) 559 return int; 560 pragma Import (C, pthread_keycreate, "pthread_keycreate"); 561 562 begin 563 if pthread_keycreate (key, destructor) /= 0 then 564 return errno; 565 end if; 566 567 return 0; 568 end pthread_key_create; 569 570 procedure pthread_init is 571 begin 572 null; 573 end pthread_init; 574 575end System.OS_Interface; 576