|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M . O S _ P R I M I T I V E S --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1998-2018, Free Software Foundation, Inc. --
|
|
111
|
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 version is for POSIX.1-2008-like operating systems
|
|
|
33
|
|
|
34 with System.CRTL;
|
|
131
|
35 with System.OS_Constants;
|
|
111
|
36 package body System.OS_Primitives is
|
|
|
37
|
|
131
|
38 subtype int is System.CRTL.int;
|
|
|
39
|
|
111
|
40 -- ??? These definitions are duplicated from System.OS_Interface because
|
|
|
41 -- we don't want to depend on any package. Consider removing these
|
|
|
42 -- declarations in System.OS_Interface and move these ones to the spec.
|
|
|
43
|
|
|
44 type time_t is new System.CRTL.int64;
|
|
|
45
|
|
|
46 type timespec is record
|
|
|
47 tv_sec : time_t;
|
|
|
48 tv_nsec : Long_Integer;
|
|
|
49 end record;
|
|
|
50 pragma Convention (C, timespec);
|
|
|
51
|
|
|
52 function nanosleep (rqtp, rmtp : not null access timespec) return Integer;
|
|
|
53 pragma Import (C, nanosleep, "nanosleep");
|
|
|
54
|
|
|
55 -----------
|
|
|
56 -- Clock --
|
|
|
57 -----------
|
|
|
58
|
|
|
59 function Clock return Duration is
|
|
131
|
60 TS : aliased timespec;
|
|
|
61 Result : int;
|
|
111
|
62
|
|
131
|
63 type clockid_t is new int;
|
|
|
64 CLOCK_REALTIME : constant clockid_t :=
|
|
|
65 System.OS_Constants.CLOCK_REALTIME;
|
|
111
|
66
|
|
131
|
67 function clock_gettime
|
|
|
68 (clock_id : clockid_t;
|
|
|
69 tp : access timespec) return int;
|
|
|
70 pragma Import (C, clock_gettime, "clock_gettime");
|
|
111
|
71
|
|
|
72 begin
|
|
131
|
73 Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
|
|
|
74 pragma Assert (Result = 0);
|
|
|
75 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
|
|
111
|
76 end Clock;
|
|
|
77
|
|
|
78 -----------------
|
|
|
79 -- To_Timespec --
|
|
|
80 -----------------
|
|
|
81
|
|
|
82 function To_Timespec (D : Duration) return timespec;
|
|
|
83
|
|
|
84 function To_Timespec (D : Duration) return timespec is
|
|
|
85 S : time_t;
|
|
|
86 F : Duration;
|
|
|
87
|
|
|
88 begin
|
|
|
89 S := time_t (Long_Long_Integer (D));
|
|
|
90 F := D - Duration (S);
|
|
|
91
|
|
|
92 -- If F has negative value due to a round-up, adjust for positive F
|
|
|
93 -- value.
|
|
|
94
|
|
|
95 if F < 0.0 then
|
|
|
96 S := S - 1;
|
|
|
97 F := F + 1.0;
|
|
|
98 end if;
|
|
|
99
|
|
|
100 return
|
|
|
101 timespec'(tv_sec => S,
|
|
|
102 tv_nsec => Long_Integer (Long_Long_Integer (F * 10#1#E9)));
|
|
|
103 end To_Timespec;
|
|
|
104
|
|
|
105 -----------------
|
|
|
106 -- Timed_Delay --
|
|
|
107 -----------------
|
|
|
108
|
|
|
109 procedure Timed_Delay
|
|
|
110 (Time : Duration;
|
|
|
111 Mode : Integer)
|
|
131
|
112 is separate;
|
|
111
|
113
|
|
|
114 ----------------
|
|
|
115 -- Initialize --
|
|
|
116 ----------------
|
|
|
117
|
|
|
118 procedure Initialize is
|
|
|
119 begin
|
|
|
120 null;
|
|
|
121 end Initialize;
|
|
|
122
|
|
|
123 end System.OS_Primitives;
|
