| 87e3f630 |
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) 1991-2015, 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. It is -- |
| 28 | -- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- |
| 29 | -- State University (http://www.gnat.com). -- |
| 30 | -- -- |
| 31 | ------------------------------------------------------------------------------ |
| 32 | |
| 33 | -- This is the DragonFly THREADS version of this package |
| 34 | |
| 35 | with Interfaces.C; use Interfaces.C; |
| 36 | |
| 37 | package body System.OS_Interface is |
| 38 | |
| 39 | ----------- |
| 40 | -- Errno -- |
| 41 | ----------- |
| 42 | |
| 43 | function Errno return int is |
| 44 | type int_ptr is access all int; |
| 45 | |
| 46 | function internal_errno return int_ptr; |
| 47 | pragma Import (C, internal_errno, "__get_errno"); |
| 48 | |
| 49 | begin |
| 50 | return (internal_errno.all); |
| 51 | end Errno; |
| 52 | |
| 53 | -------------------- |
| 54 | -- Get_Stack_Base -- |
| 55 | -------------------- |
| 56 | |
| 57 | function Get_Stack_Base (thread : pthread_t) return Address is |
| 58 | pragma Unreferenced (thread); |
| 59 | begin |
| 60 | return Null_Address; |
| 61 | end Get_Stack_Base; |
| 62 | |
| 63 | ------------------ |
| 64 | -- pthread_init -- |
| 65 | ------------------ |
| 66 | |
| 67 | procedure pthread_init is |
| 68 | begin |
| 69 | null; |
| 70 | end pthread_init; |
| 71 | |
| 72 | ----------------- |
| 73 | -- To_Duration -- |
| 74 | ----------------- |
| 75 | |
| 76 | function To_Duration (TS : timespec) return Duration is |
| 77 | begin |
| 78 | return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; |
| 79 | end To_Duration; |
| 80 | |
| 81 | ------------------------ |
| 82 | -- To_Target_Priority -- |
| 83 | ------------------------ |
| 84 | |
| 85 | function To_Target_Priority |
| 86 | (Prio : System.Any_Priority) return Interfaces.C.int |
| 87 | is |
| 88 | begin |
| 89 | return Interfaces.C.int (Prio); |
| 90 | end To_Target_Priority; |
| 91 | |
| 92 | ----------------- |
| 93 | -- To_Timespec -- |
| 94 | ----------------- |
| 95 | |
| 96 | function To_Timespec (D : Duration) return timespec is |
| 97 | S : time_t; |
| 98 | F : Duration; |
| 99 | |
| 100 | begin |
| 101 | S := time_t (Long_Long_Integer (D)); |
| 102 | F := D - Duration (S); |
| 103 | |
| 104 | -- If F has negative value due to a round-up, adjust for positive F |
| 105 | -- value. |
| 106 | |
| 107 | if F < 0.0 then |
| 108 | S := S - 1; |
| 109 | F := F + 1.0; |
| 110 | end if; |
| 111 | |
| 112 | return timespec'(ts_sec => S, |
| 113 | ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); |
| 114 | end To_Timespec; |
| 115 | |
| 116 | end System.OS_Interface; |
projects / thirdparty / gcc.git / blame