]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
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 | -- -- | |
07fc65c4 | 9 | -- Copyright (C) 1997-2002 Free Software Foundation -- |
84481f76 RK |
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 | -- -- | |
71ff80dc | 29 | -- GNARL was developed by the GNARL team at Florida State University. -- |
fbf5a39b | 30 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- |
84481f76 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This is the VxWorks version. | |
35 | ||
36 | -- This package encapsulates all direct interfaces to OS services | |
37 | -- that are needed by children of System. | |
38 | ||
39 | pragma Polling (Off); | |
40 | -- Turn off polling, we do not want ATC polling to take place during | |
41 | -- tasking operations. It causes infinite loops and other problems. | |
42 | ||
84481f76 RK |
43 | package body System.OS_Interface is |
44 | ||
07fc65c4 | 45 | use type Interfaces.C.int; |
84481f76 | 46 | |
07fc65c4 GB |
47 | Low_Priority : constant := 255; |
48 | -- VxWorks native (default) lowest scheduling priority. | |
84481f76 | 49 | |
07fc65c4 GB |
50 | ------------- |
51 | -- sigwait -- | |
52 | ------------- | |
84481f76 RK |
53 | |
54 | function sigwait | |
55 | (set : access sigset_t; | |
56 | sig : access Signal) return int | |
57 | is | |
07fc65c4 | 58 | Result : int; |
84481f76 RK |
59 | |
60 | function sigwaitinfo | |
61 | (set : access sigset_t; sigvalue : System.Address) return int; | |
62 | pragma Import (C, sigwaitinfo, "sigwaitinfo"); | |
63 | ||
64 | begin | |
65 | Result := sigwaitinfo (set, System.Null_Address); | |
66 | ||
67 | if Result /= -1 then | |
68 | sig.all := Signal (Result); | |
69 | return 0; | |
70 | else | |
71 | sig.all := 0; | |
72 | return errno; | |
73 | end if; | |
74 | end sigwait; | |
75 | ||
84481f76 RK |
76 | ----------------- |
77 | -- To_Duration -- | |
78 | ----------------- | |
79 | ||
80 | function To_Duration (TS : timespec) return Duration is | |
81 | begin | |
82 | return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; | |
83 | end To_Duration; | |
84 | ||
85 | ----------------- | |
86 | -- To_Timespec -- | |
87 | ----------------- | |
88 | ||
89 | function To_Timespec (D : Duration) return timespec is | |
90 | S : time_t; | |
91 | F : Duration; | |
92 | begin | |
93 | S := time_t (Long_Long_Integer (D)); | |
94 | F := D - Duration (S); | |
95 | ||
96 | -- If F has negative value due to a round-up, adjust for positive F | |
97 | -- value. | |
98 | if F < 0.0 then | |
99 | S := S - 1; | |
100 | F := F + 1.0; | |
101 | end if; | |
07fc65c4 | 102 | |
fbf5a39b AC |
103 | return timespec'(ts_sec => S, |
104 | ts_nsec => long (Long_Long_Integer (F * 10#1#E9))); | |
84481f76 RK |
105 | end To_Timespec; |
106 | ||
07fc65c4 GB |
107 | ------------------------- |
108 | -- To_VxWorks_Priority -- | |
109 | ------------------------- | |
110 | ||
111 | function To_VxWorks_Priority (Priority : in int) return int is | |
112 | begin | |
113 | return Low_Priority - Priority; | |
114 | end To_VxWorks_Priority; | |
115 | ||
84481f76 RK |
116 | -------------------- |
117 | -- To_Clock_Ticks -- | |
118 | -------------------- | |
119 | ||
120 | -- ??? - For now, we'll always get the system clock rate | |
121 | -- since it is allowed to be changed during run-time in | |
07fc65c4 | 122 | -- VxWorks. A better method would be to provide an operation |
84481f76 RK |
123 | -- to set it that so we can always know its value. |
124 | -- | |
125 | -- Another thing we should probably allow for is a resultant | |
07fc65c4 | 126 | -- tick count greater than int'Last. This should probably |
84481f76 RK |
127 | -- be a procedure with two output parameters, one in the |
128 | -- range 0 .. int'Last, and another representing the overflow | |
129 | -- count. | |
130 | ||
131 | function To_Clock_Ticks (D : Duration) return int is | |
132 | Ticks : Long_Long_Integer; | |
133 | Rate_Duration : Duration; | |
134 | Ticks_Duration : Duration; | |
07fc65c4 | 135 | |
84481f76 | 136 | begin |
07fc65c4 GB |
137 | if D < 0.0 then |
138 | return -1; | |
139 | end if; | |
84481f76 RK |
140 | |
141 | -- Ensure that the duration can be converted to ticks | |
142 | -- at the current clock tick rate without overflowing. | |
143 | ||
144 | Rate_Duration := Duration (sysClkRateGet); | |
145 | ||
146 | if D > (Duration'Last / Rate_Duration) then | |
147 | Ticks := Long_Long_Integer (int'Last); | |
84481f76 | 148 | else |
84481f76 RK |
149 | Ticks_Duration := D * Rate_Duration; |
150 | Ticks := Long_Long_Integer (Ticks_Duration); | |
151 | ||
152 | if Ticks_Duration > Duration (Ticks) then | |
153 | Ticks := Ticks + 1; | |
154 | end if; | |
155 | ||
156 | if Ticks > Long_Long_Integer (int'Last) then | |
157 | Ticks := Long_Long_Integer (int'Last); | |
158 | end if; | |
159 | end if; | |
160 | ||
161 | return int (Ticks); | |
162 | end To_Clock_Ticks; | |
163 | ||
164 | end System.OS_Interface; |