1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
38 -----------------------
39 -- Local Subprograms --
40 -----------------------
42 function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat;
43 -- Extract two decimal digit value from time stamp
49 function "<" (Left, Right : Time_Stamp_Type) return Boolean is
51 return not (Left = Right) and then String (Left) < String (Right);
58 function "<=" (Left, Right : Time_Stamp_Type) return Boolean is
60 return not (Left > Right);
67 function "=" (Left, Right : Time_Stamp_Type) return Boolean is
72 if String (Left) = String (Right) then
75 elsif Left (1) = ' ' or else Right (1) = ' ' then
79 -- In the following code we check for a difference of 2 seconds or less
81 -- Recall that the time stamp format is:
83 -- Y Y Y Y M M D D H H M M S S
84 -- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
86 -- Note that we do not bother to worry about shifts in the day.
87 -- It seems unlikely that such shifts could ever occur in practice
88 -- and even if they do we err on the safe side, ie we say that the time
89 -- stamps are different.
91 Sright := V (Right, 13) + 60 * (V (Right, 11) + 60 * V (Right, 09));
92 Sleft := V (Left, 13) + 60 * (V (Left, 11) + 60 * V (Left, 09));
94 -- So the check is: dates must be the same, times differ 2 sec at most
96 return abs (Sleft - Sright) <= 2
97 and then String (Left (1 .. 8)) = String (Right (1 .. 8));
104 function ">" (Left, Right : Time_Stamp_Type) return Boolean is
106 return not (Left = Right) and then String (Left) > String (Right);
113 function ">=" (Left, Right : Time_Stamp_Type) return Boolean is
115 return not (Left < Right);
122 function Get_Char_Code (C : Character) return Char_Code is
124 return Char_Code'Val (Character'Pos (C));
131 -- Note: raises Constraint_Error if checks on and C out of range
133 function Get_Character (C : Char_Code) return Character is
135 return Character'Val (C);
142 subtype Wordh is Word range 0 .. 15;
143 Hex : constant array (Wordh) of Character := "0123456789abcdef";
145 function Get_Hex_String (W : Word) return Word_Hex_String is
147 WS : Word_Hex_String;
150 for J in reverse 1 .. 8 loop
151 WS (J) := Hex (X mod 16);
158 ------------------------
159 -- In_Character_Range --
160 ------------------------
162 function In_Character_Range (C : Char_Code) return Boolean is
165 end In_Character_Range;
167 ---------------------
168 -- Make_Time_Stamp --
169 ---------------------
171 procedure Make_Time_Stamp
178 TS : out Time_Stamp_Type)
180 Z : constant := Character'Pos ('0');
183 TS (01) := Character'Val (Z + Year / 1000);
184 TS (02) := Character'Val (Z + (Year / 100) mod 10);
185 TS (03) := Character'Val (Z + (Year / 10) mod 10);
186 TS (04) := Character'Val (Z + Year mod 10);
187 TS (05) := Character'Val (Z + Month / 10);
188 TS (06) := Character'Val (Z + Month mod 10);
189 TS (07) := Character'Val (Z + Day / 10);
190 TS (08) := Character'Val (Z + Day mod 10);
191 TS (09) := Character'Val (Z + Hour / 10);
192 TS (10) := Character'Val (Z + Hour mod 10);
193 TS (11) := Character'Val (Z + Minutes / 10);
194 TS (12) := Character'Val (Z + Minutes mod 10);
195 TS (13) := Character'Val (Z + Seconds / 10);
196 TS (14) := Character'Val (Z + Seconds mod 10);
199 ----------------------
200 -- Split_Time_Stamp --
201 ----------------------
203 procedure Split_Time_Stamp
204 (TS : Time_Stamp_Type;
214 -- Y Y Y Y M M D D H H M M S S
215 -- 01 02 03 04 05 06 07 08 09 10 11 12 13 14
217 Year := 100 * V (TS, 01) + V (TS, 03);
221 Minutes := V (TS, 11);
222 Seconds := V (TS, 13);
223 end Split_Time_Stamp;
229 function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat is
231 return 10 * (Character'Pos (T (X)) - Character'Pos ('0')) +
232 Character'Pos (T (X + 1)) - Character'Pos ('0');