projects / thirdparty / gcc.git / blame
| Commit | Line | Data |
|---|---|---|
| 415dddc8 RK |
1 | ------------------------------------------------------------------------------ |
| 2 | -- -- | |
| 3 | -- GNAT COMPILER COMPONENTS -- | |
| 4 | -- -- | |
| 5 | -- T Y P E S -- | |
| 6 | -- -- | |
| 7 | -- B o d y -- | |
| 8 | -- -- | |
| 1d005acc | 9 | -- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- |
| 415dddc8 RK |
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- -- | |
| 748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| 415dddc8 RK |
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 -- | |
| 748086b7 | 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| 415dddc8 | 17 | -- -- |
| 748086b7 JJ |
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/>. -- | |
| 415dddc8 RK |
26 | -- -- |
| 27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
| 71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| 415dddc8 RK |
29 | -- -- |
| 30 | ------------------------------------------------------------------------------ | |
| 31 | ||
| 32 | package 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 | |
| 3354f96d RW |
84 | -- and even if they do we err on the safe side, i.e., we say that the |
| 85 | -- time stamps are different. | |
| 415dddc8 RK |
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 | ||
| 415dddc8 RK |
127 | function Get_Character (C : Char_Code) return Character is |
| 128 | begin | |
| 07fc65c4 | 129 | pragma Assert (C <= 255); |
| 415dddc8 RK |
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; | |
| cfac6e9f | 138 | Hex : constant array (Wordh) of Character := "0123456789abcdef"; |
| 415dddc8 RK |
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 | ||
| 82c80734 RD |
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 | ||
| 415dddc8 RK |
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 | ||
| 82c80734 RD |
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 | ||
| 415dddc8 RK |
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 | ||
| 0f96fd14 BD |
213 | ---------------------------- |
| 214 | -- Null_Source_Buffer_Ptr -- | |
| 215 | ---------------------------- | |
| 216 | ||
| 217 | function Null_Source_Buffer_Ptr (X : Source_Buffer_Ptr) return Boolean is | |
| 218 | begin | |
| 219 | return Source_Buffer_Ptr_Equal (X, null); | |
| 220 | end Null_Source_Buffer_Ptr; | |
| 221 | ||
| 415dddc8 RK |
222 | ---------------------- |
| 223 | -- Split_Time_Stamp -- | |
| 224 | ---------------------- | |
| 225 | ||
| 226 | procedure Split_Time_Stamp | |
| 227 | (TS : Time_Stamp_Type; | |
| 228 | Year : out Nat; | |
| 229 | Month : out Nat; | |
| 230 | Day : out Nat; | |
| 231 | Hour : out Nat; | |
| 232 | Minutes : out Nat; | |
| 233 | Seconds : out Nat) | |
| 234 | is | |
| 235 | ||
| 236 | begin | |
| 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 | |
| 239 | ||
| 240 | Year := 100 * V (TS, 01) + V (TS, 03); | |
| 241 | Month := V (TS, 05); | |
| 242 | Day := V (TS, 07); | |
| 243 | Hour := V (TS, 09); | |
| 244 | Minutes := V (TS, 11); | |
| 245 | Seconds := V (TS, 13); | |
| 246 | end Split_Time_Stamp; | |
| 247 | ||
| 248 | ------- | |
| 249 | -- V -- | |
| 250 | ------- | |
| 251 | ||
| 252 | function V (T : Time_Stamp_Type; X : Time_Stamp_Index) return Nat is | |
| 253 | begin | |
| 254 | return 10 * (Character'Pos (T (X)) - Character'Pos ('0')) + | |
| 255 | Character'Pos (T (X + 1)) - Character'Pos ('0'); | |
| 256 | end V; | |
| 257 | ||
| 258 | end Types; |