1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                                T Y P E S                                 --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2009  Free Software Foundation, Inc.         --
10--                                                                          --
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.                                     --
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-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32package body Types is
33
34   -----------------------
35   -- Local Subprograms --
36   -----------------------
37
38   function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat;
39   --  Extract two decimal digit value from time stamp
40
41   ---------
42   -- "<" --
43   ---------
44
45   function "<" (Left, Right : Time_Stamp_Type) return Boolean is
46   begin
47      return not (Left = Right) and then String (Left) < String (Right);
48   end "<";
49
50   ----------
51   -- "<=" --
52   ----------
53
54   function "<=" (Left, Right : Time_Stamp_Type) return Boolean is
55   begin
56      return not (Left > Right);
57   end "<=";
58
59   ---------
60   -- "=" --
61   ---------
62
63   function "=" (Left, Right : Time_Stamp_Type) return Boolean is
64      Sleft  : Nat;
65      Sright : Nat;
66
67   begin
68      if String (Left) = String (Right) then
69         return True;
70
71      elsif Left (1) = ' ' or else Right (1) = ' ' then
72         return False;
73      end if;
74
75      --  In the following code we check for a difference of 2 seconds or less
76
77      --  Recall that the time stamp format is:
78
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
81
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.
86
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));
89
90      --  So the check is: dates must be the same, times differ 2 sec at most
91
92      return abs (Sleft - Sright) <= 2
93         and then String (Left (1 .. 8)) = String (Right (1 .. 8));
94   end "=";
95
96   ---------
97   -- ">" --
98   ---------
99
100   function ">" (Left, Right : Time_Stamp_Type) return Boolean is
101   begin
102      return not (Left = Right) and then String (Left) > String (Right);
103   end ">";
104
105   ----------
106   -- ">=" --
107   ----------
108
109   function ">=" (Left, Right : Time_Stamp_Type) return Boolean is
110   begin
111      return not (Left < Right);
112   end ">=";
113
114   -------------------
115   -- Get_Char_Code --
116   -------------------
117
118   function Get_Char_Code (C : Character) return Char_Code is
119   begin
120      return Char_Code'Val (Character'Pos (C));
121   end Get_Char_Code;
122
123   -------------------
124   -- Get_Character --
125   -------------------
126
127   function Get_Character (C : Char_Code) return Character is
128   begin
129      pragma Assert (C <= 255);
130      return Character'Val (C);
131   end Get_Character;
132
133   --------------------
134   -- Get_Hex_String --
135   --------------------
136
137   subtype Wordh is Word range 0 .. 15;
138   Hex : constant array (Wordh) of Character := "0123456789abcdef";
139
140   function Get_Hex_String (W : Word) return Word_Hex_String is
141      X  : Word := W;
142      WS : Word_Hex_String;
143
144   begin
145      for J in reverse 1 .. 8 loop
146         WS (J) := Hex (X mod 16);
147         X := X / 16;
148      end loop;
149
150      return WS;
151   end Get_Hex_String;
152
153   ------------------------
154   -- Get_Wide_Character --
155   ------------------------
156
157   function Get_Wide_Character (C : Char_Code) return Wide_Character is
158   begin
159      pragma Assert (C <= 65535);
160      return Wide_Character'Val (C);
161   end Get_Wide_Character;
162
163   ------------------------
164   -- In_Character_Range --
165   ------------------------
166
167   function In_Character_Range (C : Char_Code) return Boolean is
168   begin
169      return (C <= 255);
170   end In_Character_Range;
171
172   -----------------------------
173   -- In_Wide_Character_Range --
174   -----------------------------
175
176   function In_Wide_Character_Range (C : Char_Code) return Boolean is
177   begin
178      return (C <= 65535);
179   end In_Wide_Character_Range;
180
181   ---------------------
182   -- Make_Time_Stamp --
183   ---------------------
184
185   procedure Make_Time_Stamp
186     (Year    : Nat;
187      Month   : Nat;
188      Day     : Nat;
189      Hour    : Nat;
190      Minutes : Nat;
191      Seconds : Nat;
192      TS      : out Time_Stamp_Type)
193   is
194      Z : constant := Character'Pos ('0');
195
196   begin
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);
211   end Make_Time_Stamp;
212
213   ----------------------
214   -- Split_Time_Stamp --
215   ----------------------
216
217   procedure Split_Time_Stamp
218     (TS      : Time_Stamp_Type;
219      Year    : out Nat;
220      Month   : out Nat;
221      Day     : out Nat;
222      Hour    : out Nat;
223      Minutes : out Nat;
224      Seconds : out Nat)
225   is
226
227   begin
228      --     Y  Y  Y  Y  M  M  D  D  H  H  M  M  S  S
229      --    01 02 03 04 05 06 07 08 09 10 11 12 13 14
230
231      Year    := 100 * V (TS, 01) + V (TS, 03);
232      Month   := V (TS, 05);
233      Day     := V (TS, 07);
234      Hour    := V (TS, 09);
235      Minutes := V (TS, 11);
236      Seconds := V (TS, 13);
237   end Split_Time_Stamp;
238
239   -------
240   -- V --
241   -------
242
243   function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat is
244   begin
245      return 10 * (Character'Pos (T (X))     - Character'Pos ('0')) +
246                   Character'Pos (T (X + 1)) - Character'Pos ('0');
247   end V;
248
249end Types;
250