1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
11 -- GNAT 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
34 -----------------------
35 -- Local Subprograms --
36 -----------------------
38 function V
(T
: Time_Stamp_Type
; X
: Time_Stamp_Index
) return Nat
;
39 -- Extract two decimal digit value from time stamp
45 function "<" (Left
, Right
: Time_Stamp_Type
) return Boolean is
47 return not (Left
= Right
) and then String (Left
) < String (Right
);
54 function "<=" (Left
, Right
: Time_Stamp_Type
) return Boolean is
56 return not (Left
> Right
);
63 function "=" (Left
, Right
: Time_Stamp_Type
) return Boolean is
68 if String (Left
) = String (Right
) then
71 elsif Left
(1) = ' ' or else Right
(1) = ' ' then
75 -- In the following code we check for a difference of 2 seconds or less
77 -- Recall that the time stamp format is:
79 -- Y Y Y Y M M D D H H M M S S
80 -- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
82 -- Note that we do not bother to worry about shifts in the day.
83 -- It seems unlikely that such shifts could ever occur in practice
84 -- and even if they do we err on the safe side, i.e., we say that the
85 -- time stamps are different.
87 Sright
:= V
(Right
, 13) + 60 * (V
(Right
, 11) + 60 * V
(Right
, 09));
88 Sleft
:= V
(Left
, 13) + 60 * (V
(Left
, 11) + 60 * V
(Left
, 09));
90 -- So the check is: dates must be the same, times differ 2 sec at most
92 return abs (Sleft
- Sright
) <= 2
93 and then String (Left
(1 .. 8)) = String (Right
(1 .. 8));
100 function ">" (Left
, Right
: Time_Stamp_Type
) return Boolean is
102 return not (Left
= Right
) and then String (Left
) > String (Right
);
109 function ">=" (Left
, Right
: Time_Stamp_Type
) return Boolean is
111 return not (Left
< Right
);
118 function Get_Char_Code
(C
: Character) return Char_Code
is
120 return Char_Code
'Val (Character'Pos (C
));
127 function Get_Character
(C
: Char_Code
) return Character is
129 pragma Assert
(C
<= 255);
130 return Character'Val (C
);
137 subtype Wordh
is Word
range 0 .. 15;
138 Hex
: constant array (Wordh
) of Character := "0123456789abcdef";
140 function Get_Hex_String
(W
: Word
) return Word_Hex_String
is
142 WS
: Word_Hex_String
;
145 for J
in reverse 1 .. 8 loop
146 WS
(J
) := Hex
(X
mod 16);
153 ------------------------
154 -- Get_Wide_Character --
155 ------------------------
157 function Get_Wide_Character
(C
: Char_Code
) return Wide_Character is
159 pragma Assert
(C
<= 65535);
160 return Wide_Character'Val (C
);
161 end Get_Wide_Character
;
163 ------------------------
164 -- In_Character_Range --
165 ------------------------
167 function In_Character_Range
(C
: Char_Code
) return Boolean is
170 end In_Character_Range
;
172 -----------------------------
173 -- In_Wide_Character_Range --
174 -----------------------------
176 function In_Wide_Character_Range
(C
: Char_Code
) return Boolean is
179 end In_Wide_Character_Range
;
181 ---------------------
182 -- Make_Time_Stamp --
183 ---------------------
185 procedure Make_Time_Stamp
192 TS
: out Time_Stamp_Type
)
194 Z
: constant := Character'Pos ('0');
197 TS
(01) := Character'Val (Z
+ Year
/ 1000);
198 TS
(02) := Character'Val (Z
+ (Year
/ 100) mod 10);
199 TS
(03) := Character'Val (Z
+ (Year
/ 10) mod 10);
200 TS
(04) := Character'Val (Z
+ Year
mod 10);
201 TS
(05) := Character'Val (Z
+ Month
/ 10);
202 TS
(06) := Character'Val (Z
+ Month
mod 10);
203 TS
(07) := Character'Val (Z
+ Day
/ 10);
204 TS
(08) := Character'Val (Z
+ Day
mod 10);
205 TS
(09) := Character'Val (Z
+ Hour
/ 10);
206 TS
(10) := Character'Val (Z
+ Hour
mod 10);
207 TS
(11) := Character'Val (Z
+ Minutes
/ 10);
208 TS
(12) := Character'Val (Z
+ Minutes
mod 10);
209 TS
(13) := Character'Val (Z
+ Seconds
/ 10);
210 TS
(14) := Character'Val (Z
+ Seconds
mod 10);
213 ----------------------------
214 -- Null_Source_Buffer_Ptr --
215 ----------------------------
217 function Null_Source_Buffer_Ptr
(X
: Source_Buffer_Ptr
) return Boolean is
219 return Source_Buffer_Ptr_Equal
(X
, null);
220 end Null_Source_Buffer_Ptr
;
222 ----------------------
223 -- Split_Time_Stamp --
224 ----------------------
226 procedure Split_Time_Stamp
227 (TS
: Time_Stamp_Type
;
237 -- Y Y Y Y M M D D H H M M S S
238 -- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
240 Year
:= 100 * V
(TS
, 01) + V
(TS
, 03);
244 Minutes
:= V
(TS
, 11);
245 Seconds
:= V
(TS
, 13);
246 end Split_Time_Stamp
;
252 function V
(T
: Time_Stamp_Type
; X
: Time_Stamp_Index
) return Nat
is
254 return 10 * (Character'Pos (T
(X
)) - Character'Pos ('0')) +
255 Character'Pos (T
(X
+ 1)) - Character'Pos ('0');