?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* arm.md (reload_mulsi3, reload_mulsi_compare0, reload_muladdsi)
[official-gcc.git] / gcc / ada / a-chahan.adb
blob28cfdffff417ccb340249120d359668fc4819574
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . C H A R A C T E R S . H A N D L I N G --
6 -- --
7 -- B o d y --
8 -- --
9 -- --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
11 -- --
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. --
22 -- --
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. --
29 -- --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
32 -- --
33 ------------------------------------------------------------------------------
34
35 with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
36 with Ada.Strings.Maps; use Ada.Strings.Maps;
37 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
38
39 package body Ada.Characters.Handling is
40
41 ------------------------------------
42 -- Character Classification Table --
43 ------------------------------------
44
45 type Character_Flags is mod 256;
46 for Character_Flags'Size use 8;
47
48 Control : constant Character_Flags := 1;
49 Lower : constant Character_Flags := 2;
50 Upper : constant Character_Flags := 4;
51 Basic : constant Character_Flags := 8;
52 Hex_Digit : constant Character_Flags := 16;
53 Digit : constant Character_Flags := 32;
54 Special : constant Character_Flags := 64;
55
56 Letter : constant Character_Flags := Lower or Upper;
57 Alphanum : constant Character_Flags := Letter or Digit;
58 Graphic : constant Character_Flags := Alphanum or Special;
59
60 Char_Map : constant array (Character) of Character_Flags :=
61 (
62 NUL => Control,
63 SOH => Control,
64 STX => Control,
65 ETX => Control,
66 EOT => Control,
67 ENQ => Control,
68 ACK => Control,
69 BEL => Control,
70 BS => Control,
71 HT => Control,
72 LF => Control,
73 VT => Control,
74 FF => Control,
75 CR => Control,
76 SO => Control,
77 SI => Control,
78
79 DLE => Control,
80 DC1 => Control,
81 DC2 => Control,
82 DC3 => Control,
83 DC4 => Control,
84 NAK => Control,
85 SYN => Control,
86 ETB => Control,
87 CAN => Control,
88 EM => Control,
89 SUB => Control,
90 ESC => Control,
91 FS => Control,
92 GS => Control,
93 RS => Control,
94 US => Control,
95
96 Space => Special,
97 Exclamation => Special,
98 Quotation => Special,
99 Number_Sign => Special,
100 Dollar_Sign => Special,
101 Percent_Sign => Special,
102 Ampersand => Special,
103 Apostrophe => Special,
104 Left_Parenthesis => Special,
105 Right_Parenthesis => Special,
106 Asterisk => Special,
107 Plus_Sign => Special,
108 Comma => Special,
109 Hyphen => Special,
110 Full_Stop => Special,
111 Solidus => Special,
112
113 '0' .. '9' => Digit + Hex_Digit,
114
115 Colon => Special,
116 Semicolon => Special,
117 Less_Than_Sign => Special,
118 Equals_Sign => Special,
119 Greater_Than_Sign => Special,
120 Question => Special,
121 Commercial_At => Special,
122
123 'A' .. 'F' => Upper + Basic + Hex_Digit,
124 'G' .. 'Z' => Upper + Basic,
125
126 Left_Square_Bracket => Special,
127 Reverse_Solidus => Special,
128 Right_Square_Bracket => Special,
129 Circumflex => Special,
130 Low_Line => Special,
131 Grave => Special,
132
133 'a' .. 'f' => Lower + Basic + Hex_Digit,
134 'g' .. 'z' => Lower + Basic,
135
136 Left_Curly_Bracket => Special,
137 Vertical_Line => Special,
138 Right_Curly_Bracket => Special,
139 Tilde => Special,
140
141 DEL => Control,
142 Reserved_128 => Control,
143 Reserved_129 => Control,
144 BPH => Control,
145 NBH => Control,
146 Reserved_132 => Control,
147 NEL => Control,
148 SSA => Control,
149 ESA => Control,
150 HTS => Control,
151 HTJ => Control,
152 VTS => Control,
153 PLD => Control,
154 PLU => Control,
155 RI => Control,
156 SS2 => Control,
157 SS3 => Control,
158
159 DCS => Control,
160 PU1 => Control,
161 PU2 => Control,
162 STS => Control,
163 CCH => Control,
164 MW => Control,
165 SPA => Control,
166 EPA => Control,
167
168 SOS => Control,
169 Reserved_153 => Control,
170 SCI => Control,
171 CSI => Control,
172 ST => Control,
173 OSC => Control,
174 PM => Control,
175 APC => Control,
176
177 No_Break_Space => Special,
178 Inverted_Exclamation => Special,
179 Cent_Sign => Special,
180 Pound_Sign => Special,
181 Currency_Sign => Special,
182 Yen_Sign => Special,
183 Broken_Bar => Special,
184 Section_Sign => Special,
185 Diaeresis => Special,
186 Copyright_Sign => Special,
187 Feminine_Ordinal_Indicator => Special,
188 Left_Angle_Quotation => Special,
189 Not_Sign => Special,
190 Soft_Hyphen => Special,
191 Registered_Trade_Mark_Sign => Special,
192 Macron => Special,
193 Degree_Sign => Special,
194 Plus_Minus_Sign => Special,
195 Superscript_Two => Special,
196 Superscript_Three => Special,
197 Acute => Special,
198 Micro_Sign => Special,
199 Pilcrow_Sign => Special,
200 Middle_Dot => Special,
201 Cedilla => Special,
202 Superscript_One => Special,
203 Masculine_Ordinal_Indicator => Special,
204 Right_Angle_Quotation => Special,
205 Fraction_One_Quarter => Special,
206 Fraction_One_Half => Special,
207 Fraction_Three_Quarters => Special,
208 Inverted_Question => Special,
209
210 UC_A_Grave => Upper,
211 UC_A_Acute => Upper,
212 UC_A_Circumflex => Upper,
213 UC_A_Tilde => Upper,
214 UC_A_Diaeresis => Upper,
215 UC_A_Ring => Upper,
216 UC_AE_Diphthong => Upper + Basic,
217 UC_C_Cedilla => Upper,
218 UC_E_Grave => Upper,
219 UC_E_Acute => Upper,
220 UC_E_Circumflex => Upper,
221 UC_E_Diaeresis => Upper,
222 UC_I_Grave => Upper,
223 UC_I_Acute => Upper,
224 UC_I_Circumflex => Upper,
225 UC_I_Diaeresis => Upper,
226 UC_Icelandic_Eth => Upper + Basic,
227 UC_N_Tilde => Upper,
228 UC_O_Grave => Upper,
229 UC_O_Acute => Upper,
230 UC_O_Circumflex => Upper,
231 UC_O_Tilde => Upper,
232 UC_O_Diaeresis => Upper,
233
234 Multiplication_Sign => Special,
235
236 UC_O_Oblique_Stroke => Upper,
237 UC_U_Grave => Upper,
238 UC_U_Acute => Upper,
239 UC_U_Circumflex => Upper,
240 UC_U_Diaeresis => Upper,
241 UC_Y_Acute => Upper,
242 UC_Icelandic_Thorn => Upper + Basic,
243
244 LC_German_Sharp_S => Lower + Basic,
245 LC_A_Grave => Lower,
246 LC_A_Acute => Lower,
247 LC_A_Circumflex => Lower,
248 LC_A_Tilde => Lower,
249 LC_A_Diaeresis => Lower,
250 LC_A_Ring => Lower,
251 LC_AE_Diphthong => Lower + Basic,
252 LC_C_Cedilla => Lower,
253 LC_E_Grave => Lower,
254 LC_E_Acute => Lower,
255 LC_E_Circumflex => Lower,
256 LC_E_Diaeresis => Lower,
257 LC_I_Grave => Lower,
258 LC_I_Acute => Lower,
259 LC_I_Circumflex => Lower,
260 LC_I_Diaeresis => Lower,
261 LC_Icelandic_Eth => Lower + Basic,
262 LC_N_Tilde => Lower,
263 LC_O_Grave => Lower,
264 LC_O_Acute => Lower,
265 LC_O_Circumflex => Lower,
266 LC_O_Tilde => Lower,
267 LC_O_Diaeresis => Lower,
268
269 Division_Sign => Special,
270
271 LC_O_Oblique_Stroke => Lower,
272 LC_U_Grave => Lower,
273 LC_U_Acute => Lower,
274 LC_U_Circumflex => Lower,
275 LC_U_Diaeresis => Lower,
276 LC_Y_Acute => Lower,
277 LC_Icelandic_Thorn => Lower + Basic,
278 LC_Y_Diaeresis => Lower
279 );
280
281 ---------------------
282 -- Is_Alphanumeric --
283 ---------------------
284
285 function Is_Alphanumeric (Item : in Character) return Boolean is
286 begin
287 return (Char_Map (Item) and Alphanum) /= 0;
288 end Is_Alphanumeric;
289
290 --------------
291 -- Is_Basic --
292 --------------
293
294 function Is_Basic (Item : in Character) return Boolean is
295 begin
296 return (Char_Map (Item) and Basic) /= 0;
297 end Is_Basic;
298
299 ------------------
300 -- Is_Character --
301 ------------------
302
303 function Is_Character (Item : in Wide_Character) return Boolean is
304 begin
305 return Wide_Character'Pos (Item) < 256;
306 end Is_Character;
307
308 ----------------
309 -- Is_Control --
310 ----------------
311
312 function Is_Control (Item : in Character) return Boolean is
313 begin
314 return (Char_Map (Item) and Control) /= 0;
315 end Is_Control;
316
317 --------------
318 -- Is_Digit --
319 --------------
320
321 function Is_Digit (Item : in Character) return Boolean is
322 begin
323 return Item in '0' .. '9';
324 end Is_Digit;
325
326 ----------------
327 -- Is_Graphic --
328 ----------------
329
330 function Is_Graphic (Item : in Character) return Boolean is
331 begin
332 return (Char_Map (Item) and Graphic) /= 0;
333 end Is_Graphic;
334
335 --------------------------
336 -- Is_Hexadecimal_Digit --
337 --------------------------
338
339 function Is_Hexadecimal_Digit (Item : in Character) return Boolean is
340 begin
341 return (Char_Map (Item) and Hex_Digit) /= 0;
342 end Is_Hexadecimal_Digit;
343
344 ----------------
345 -- Is_ISO_646 --
346 ----------------
347
348 function Is_ISO_646 (Item : in Character) return Boolean is
349 begin
350 return Item in ISO_646;
351 end Is_ISO_646;
352
353 -- Note: much more efficient coding of the following function is possible
354 -- by testing several 16#80# bits in a complete word in a single operation
355
356 function Is_ISO_646 (Item : in String) return Boolean is
357 begin
358 for J in Item'Range loop
359 if Item (J) not in ISO_646 then
360 return False;
361 end if;
362 end loop;
363
364 return True;
365 end Is_ISO_646;
366
367 ---------------
368 -- Is_Letter --
369 ---------------
370
371 function Is_Letter (Item : in Character) return Boolean is
372 begin
373 return (Char_Map (Item) and Letter) /= 0;
374 end Is_Letter;
375
376 --------------
377 -- Is_Lower --
378 --------------
379
380 function Is_Lower (Item : in Character) return Boolean is
381 begin
382 return (Char_Map (Item) and Lower) /= 0;
383 end Is_Lower;
384
385 ----------------
386 -- Is_Special --
387 ----------------
388
389 function Is_Special (Item : in Character) return Boolean is
390 begin
391 return (Char_Map (Item) and Special) /= 0;
392 end Is_Special;
393
394 ---------------
395 -- Is_String --
396 ---------------
397
398 function Is_String (Item : in Wide_String) return Boolean is
399 begin
400 for J in Item'Range loop
401 if Wide_Character'Pos (Item (J)) >= 256 then
402 return False;
403 end if;
404 end loop;
405
406 return True;
407 end Is_String;
408
409 --------------
410 -- Is_Upper --
411 --------------
412
413 function Is_Upper (Item : in Character) return Boolean is
414 begin
415 return (Char_Map (Item) and Upper) /= 0;
416 end Is_Upper;
417
418 --------------
419 -- To_Basic --
420 --------------
421
422 function To_Basic (Item : in Character) return Character is
423 begin
424 return Value (Basic_Map, Item);
425 end To_Basic;
426
427 function To_Basic (Item : in String) return String is
428 Result : String (1 .. Item'Length);
429
430 begin
431 for J in Item'Range loop
432 Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J));
433 end loop;
434
435 return Result;
436 end To_Basic;
437
438 ------------------
439 -- To_Character --
440 ------------------
441
442 function To_Character
443 (Item : in Wide_Character;
444 Substitute : in Character := ' ')
445 return Character
446 is
447 begin
448 if Is_Character (Item) then
449 return Character'Val (Wide_Character'Pos (Item));
450 else
451 return Substitute;
452 end if;
453 end To_Character;
454
455 ----------------
456 -- To_ISO_646 --
457 ----------------
458
459 function To_ISO_646
460 (Item : in Character;
461 Substitute : in ISO_646 := ' ')
462 return ISO_646
463 is
464 begin
465 if Item in ISO_646 then
466 return Item;
467 else
468 return Substitute;
469 end if;
470 end To_ISO_646;
471
472 function To_ISO_646
473 (Item : in String;
474 Substitute : in ISO_646 := ' ')
475 return String
476 is
477 Result : String (1 .. Item'Length);
478
479 begin
480 for J in Item'Range loop
481 if Item (J) in ISO_646 then
482 Result (J - (Item'First - 1)) := Item (J);
483 else
484 Result (J - (Item'First - 1)) := Substitute;
485 end if;
486 end loop;
487
488 return Result;
489 end To_ISO_646;
490
491 --------------
492 -- To_Lower --
493 --------------
494
495 function To_Lower (Item : in Character) return Character is
496 begin
497 return Value (Lower_Case_Map, Item);
498 end To_Lower;
499
500 function To_Lower (Item : in String) return String is
501 Result : String (1 .. Item'Length);
502
503 begin
504 for J in Item'Range loop
505 Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J));
506 end loop;
507
508 return Result;
509 end To_Lower;
510
511 ---------------
512 -- To_String --
513 ---------------
514
515 function To_String
516 (Item : in Wide_String;
517 Substitute : in Character := ' ')
518 return String
519 is
520 Result : String (1 .. Item'Length);
521
522 begin
523 for J in Item'Range loop
524 Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
525 end loop;
526 return Result;
527 end To_String;
528
529 --------------
530 -- To_Upper --
531 --------------
532
533 function To_Upper
534 (Item : in Character)
535 return Character
536 is
537 begin
538 return Value (Upper_Case_Map, Item);
539 end To_Upper;
540
541 function To_Upper
542 (Item : in String)
543 return String
544 is
545 Result : String (1 .. Item'Length);
546
547 begin
548 for J in Item'Range loop
549 Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J));
550 end loop;
551
552 return Result;
553 end To_Upper;
554
555 -----------------------
556 -- To_Wide_Character --
557 -----------------------
558
559 function To_Wide_Character
560 (Item : in Character)
561 return Wide_Character
562 is
563 begin
564 return Wide_Character'Val (Character'Pos (Item));
565 end To_Wide_Character;
566
567 --------------------
568 -- To_Wide_String --
569 --------------------
570
571 function To_Wide_String
572 (Item : in String)
573 return Wide_String
574 is
575 Result : Wide_String (1 .. Item'Length);
576
577 begin
578 for J in Item'Range loop
579 Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
580 end loop;
581
582 return Result;
583 end To_Wide_String;
584 end Ada.Characters.Handling;
Mirror of the offical gcc git repository hosted at gcc.gnu.org