1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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 2, 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. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
41 function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat;
42 -- Extract two decimal digit value from time stamp
48 function "<" (Left, Right : Time_Stamp_Type) return Boolean is
50 return not (Left = Right) and then String (Left) < String (Right);
57 function "<=" (Left, Right : Time_Stamp_Type) return Boolean is
59 return not (Left > Right);
66 function "=" (Left, Right : Time_Stamp_Type) return Boolean is
71 if String (Left) = String (Right) then
74 elsif Left (1) = ' ' or else Right (1) = ' ' then
78 -- In the following code we check for a difference of 2 seconds or less
80 -- Recall that the time stamp format is:
82 -- Y Y Y Y M M D D H H M M S S
83 -- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
85 -- Note that we do not bother to worry about shifts in the day.
86 -- It seems unlikely that such shifts could ever occur in practice
87 -- and even if they do we err on the safe side, ie we say that the time
88 -- stamps are different.
90 Sright := V (Right, 13) + 60 * (V (Right, 11) + 60 * V (Right, 09));
91 Sleft := V (Left, 13) + 60 * (V (Left, 11) + 60 * V (Left, 09));
93 -- So the check is: dates must be the same, times differ 2 sec at most
95 return abs (Sleft - Sright) <= 2
96 and then String (Left (1 .. 8)) = String (Right (1 .. 8));
103 function ">" (Left, Right : Time_Stamp_Type) return Boolean is
105 return not (Left = Right) and then String (Left) > String (Right);
112 function ">=" (Left, Right : Time_Stamp_Type) return Boolean is
114 return not (Left < Right);
121 function Get_Char_Code (C : Character) return Char_Code is
123 return Char_Code'Val (Character'Pos (C));
130 function Get_Character (C : Char_Code) return Character is
132 pragma Assert (C <= 255);
133 return Character'Val (C);
140 subtype Wordh is Word range 0 .. 15;
141 Hex : constant array (Wordh) of Character := "0123456789abcdef";
143 function Get_Hex_String (W : Word) return Word_Hex_String is
145 WS : Word_Hex_String;
148 for J in reverse 1 .. 8 loop
149 WS (J) := Hex (X mod 16);
156 ------------------------
157 -- In_Character_Range --
158 ------------------------
160 function In_Character_Range (C : Char_Code) return Boolean is
163 end In_Character_Range;
165 ---------------------
166 -- Make_Time_Stamp --
167 ---------------------
169 procedure Make_Time_Stamp
176 TS : out Time_Stamp_Type)
178 Z : constant := Character'Pos ('0');
181 TS (01) := Character'Val (Z + Year / 1000);
182 TS (02) := Character'Val (Z + (Year / 100) mod 10);
183 TS (03) := Character'Val (Z + (Year / 10) mod 10);
184 TS (04) := Character'Val (Z + Year mod 10);
185 TS (05) := Character'Val (Z + Month / 10);
186 TS (06) := Character'Val (Z + Month mod 10);
187 TS (07) := Character'Val (Z + Day / 10);
188 TS (08) := Character'Val (Z + Day mod 10);
189 TS (09) := Character'Val (Z + Hour / 10);
190 TS (10) := Character'Val (Z + Hour mod 10);
191 TS (11) := Character'Val (Z + Minutes / 10);
192 TS (12) := Character'Val (Z + Minutes mod 10);
193 TS (13) := Character'Val (Z + Seconds / 10);
194 TS (14) := Character'Val (Z + Seconds mod 10);
197 ----------------------
198 -- Split_Time_Stamp --
199 ----------------------
201 procedure Split_Time_Stamp
202 (TS : Time_Stamp_Type;
212 -- Y Y Y Y M M D D H H M M S S
213 -- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
215 Year := 100 * V (TS, 01) + V (TS, 03);
219 Minutes := V (TS, 11);
220 Seconds := V (TS, 13);
221 end Split_Time_Stamp;
227 function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat is
229 return 10 * (Character'Pos (T (X)) - Character'Pos ('0')) +
230 Character'Pos (T (X + 1)) - Character'Pos ('0');