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