|
111
|
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 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1991-2017, Florida State University --
|
|
145
|
10 -- Copyright (C) 1995-2019, Free Software Foundation, Inc. --
|
|
111
|
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. It is --
|
|
|
29 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
|
|
|
30 -- State University (http://www.gnat.com). --
|
|
|
31 -- --
|
|
|
32 -- The GNARL files that were developed for RTEMS are maintained by On-Line --
|
|
|
33 -- Applications Research Corporation (http://www.oarcorp.com) in coopera- --
|
|
|
34 -- tion with Ada Core Technologies Inc. and Florida State University. --
|
|
|
35 -- --
|
|
|
36 ------------------------------------------------------------------------------
|
|
|
37
|
|
|
38 -- This is the RTEMS version of this package
|
|
|
39
|
|
|
40 -- This package encapsulates all direct interfaces to OS services
|
|
|
41 -- that are needed by children of System.
|
|
|
42
|
|
|
43 pragma Polling (Off);
|
|
|
44 -- Turn off polling, we do not want ATC polling to take place during
|
|
|
45 -- tasking operations. It causes infinite loops and other problems.
|
|
|
46
|
|
|
47 with Interfaces.C; use Interfaces.C;
|
|
|
48 package body System.OS_Interface is
|
|
|
49
|
|
|
50 -----------------
|
|
|
51 -- To_Duration --
|
|
|
52 -----------------
|
|
|
53
|
|
|
54 function To_Duration (TS : timespec) return Duration is
|
|
|
55 begin
|
|
|
56 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
|
|
|
57 end To_Duration;
|
|
|
58
|
|
|
59 ------------------------
|
|
|
60 -- To_Target_Priority --
|
|
|
61 ------------------------
|
|
|
62
|
|
|
63 function To_Target_Priority
|
|
|
64 (Prio : System.Any_Priority) return Interfaces.C.int
|
|
|
65 is
|
|
|
66 begin
|
|
|
67 return Interfaces.C.int (Prio);
|
|
|
68 end To_Target_Priority;
|
|
|
69
|
|
|
70 -----------------
|
|
|
71 -- To_Timespec --
|
|
|
72 -----------------
|
|
|
73
|
|
|
74 function To_Timespec (D : Duration) return timespec is
|
|
|
75 S : time_t;
|
|
|
76 F : Duration;
|
|
|
77 begin
|
|
|
78 S := time_t (Long_Long_Integer (D));
|
|
|
79 F := D - Duration (S);
|
|
|
80
|
|
|
81 -- If F has negative value due to round-up, adjust for positive F value
|
|
|
82
|
|
|
83 if F < 0.0 then
|
|
|
84 S := S - 1;
|
|
|
85 F := F + 1.0;
|
|
|
86 end if;
|
|
|
87 return timespec'(tv_sec => S,
|
|
|
88 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
|
|
|
89 end To_Timespec;
|
|
|
90
|
|
|
91 ------------------
|
|
|
92 -- pthread_init --
|
|
|
93 ------------------
|
|
|
94
|
|
|
95 procedure pthread_init is
|
|
|
96 begin
|
|
|
97 null;
|
|
|
98 end pthread_init;
|
|
|
99
|
|
|
100 --------------------
|
|
|
101 -- Get_Stack_Base --
|
|
|
102 --------------------
|
|
|
103
|
|
|
104 function Get_Stack_Base (thread : pthread_t) return Address is
|
|
|
105 pragma Warnings (Off, thread);
|
|
|
106
|
|
|
107 begin
|
|
|
108 return Null_Address;
|
|
|
109 end Get_Stack_Base;
|
|
|
110
|
|
|
111 -----------------
|
|
|
112 -- sigaltstack --
|
|
|
113 -----------------
|
|
|
114
|
|
|
115 function sigaltstack
|
|
|
116 (ss : not null access stack_t;
|
|
|
117 oss : access stack_t) return int is
|
|
|
118 pragma Unreferenced (ss);
|
|
|
119 pragma Unreferenced (oss);
|
|
|
120 begin
|
|
|
121 return 0;
|
|
|
122 end sigaltstack;
|
|
|
123
|
|
|
124 -----------------------------------
|
|
|
125 -- pthread_rwlockattr_setkind_np --
|
|
|
126 -----------------------------------
|
|
|
127
|
|
|
128 function pthread_rwlockattr_setkind_np
|
|
|
129 (attr : access pthread_rwlockattr_t;
|
|
|
130 pref : int) return int is
|
|
|
131 pragma Unreferenced (attr);
|
|
|
132 pragma Unreferenced (pref);
|
|
|
133 begin
|
|
|
134 return 0;
|
|
|
135 end pthread_rwlockattr_setkind_np;
|
|
|
136
|
|
|
137 end System.OS_Interface;
|
