File : s-imgcha.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . I M G _ C H A R --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2013, 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 -- --
19 -- --
20 -- --
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
32 package body System.Img_Char is
33
34 ---------------------
35 -- Image_Character --
36 ---------------------
37
38 procedure Image_Character
39 (V : Character;
40 S : in out String;
41 P : out Natural)
42 is
43 pragma Assert (S'First = 1);
44
45 subtype Cname is String (1 .. 3);
46
47 subtype C0_Range is Character
48 range Character'Val (16#00#) .. Character'Val (16#1F#);
49
50 C0 : constant array (C0_Range) of Cname :=
51 (Character'Val (16#00#) => "NUL",
52 Character'Val (16#01#) => "SOH",
53 Character'Val (16#02#) => "STX",
54 Character'Val (16#03#) => "ETX",
55 Character'Val (16#04#) => "EOT",
56 Character'Val (16#05#) => "ENQ",
57 Character'Val (16#06#) => "ACK",
58 Character'Val (16#07#) => "BEL",
59 Character'Val (16#08#) => "BS ",
60 Character'Val (16#09#) => "HT ",
61 Character'Val (16#0A#) => "LF ",
62 Character'Val (16#0B#) => "VT ",
63 Character'Val (16#0C#) => "FF ",
64 Character'Val (16#0D#) => "CR ",
65 Character'Val (16#0E#) => "SO ",
66 Character'Val (16#0F#) => "SI ",
67 Character'Val (16#10#) => "DLE",
68 Character'Val (16#11#) => "DC1",
69 Character'Val (16#12#) => "DC2",
70 Character'Val (16#13#) => "DC3",
71 Character'Val (16#14#) => "DC4",
72 Character'Val (16#15#) => "NAK",
73 Character'Val (16#16#) => "SYN",
74 Character'Val (16#17#) => "ETB",
75 Character'Val (16#18#) => "CAN",
76 Character'Val (16#19#) => "EM ",
77 Character'Val (16#1A#) => "SUB",
78 Character'Val (16#1B#) => "ESC",
79 Character'Val (16#1C#) => "FS ",
80 Character'Val (16#1D#) => "GS ",
81 Character'Val (16#1E#) => "RS ",
82 Character'Val (16#1F#) => "US ");
83
84 subtype C1_Range is Character
85 range Character'Val (16#7F#) .. Character'Val (16#9F#);
86
87 C1 : constant array (C1_Range) of Cname :=
88 (Character'Val (16#7F#) => "DEL",
89 Character'Val (16#80#) => "res",
90 Character'Val (16#81#) => "res",
91 Character'Val (16#82#) => "BPH",
92 Character'Val (16#83#) => "NBH",
93 Character'Val (16#84#) => "res",
94 Character'Val (16#85#) => "NEL",
95 Character'Val (16#86#) => "SSA",
96 Character'Val (16#87#) => "ESA",
97 Character'Val (16#88#) => "HTS",
98 Character'Val (16#89#) => "HTJ",
99 Character'Val (16#8A#) => "VTS",
100 Character'Val (16#8B#) => "PLD",
101 Character'Val (16#8C#) => "PLU",
102 Character'Val (16#8D#) => "RI ",
103 Character'Val (16#8E#) => "SS2",
104 Character'Val (16#8F#) => "SS3",
105 Character'Val (16#90#) => "DCS",
106 Character'Val (16#91#) => "PU1",
107 Character'Val (16#92#) => "PU2",
108 Character'Val (16#93#) => "STS",
109 Character'Val (16#94#) => "CCH",
110 Character'Val (16#95#) => "MW ",
111 Character'Val (16#96#) => "SPA",
112 Character'Val (16#97#) => "EPA",
113 Character'Val (16#98#) => "SOS",
114 Character'Val (16#99#) => "res",
115 Character'Val (16#9A#) => "SCI",
116 Character'Val (16#9B#) => "CSI",
117 Character'Val (16#9C#) => "ST ",
118 Character'Val (16#9D#) => "OSC",
119 Character'Val (16#9E#) => "PM ",
120 Character'Val (16#9F#) => "APC");
121
122 begin
123 -- Control characters are represented by their names (RM 3.5(32))
124
125 if V in C0_Range then
126 S (1 .. 3) := C0 (V);
127 P := (if S (3) = ' ' then 2 else 3);
128
129 elsif V in C1_Range then
130 S (1 .. 3) := C1 (V);
131
132 if S (1) /= 'r' then
133 P := (if S (3) = ' ' then 2 else 3);
134
135 -- Special case, res means RESERVED_nnn where nnn is the three digit
136 -- decimal value corresponding to the code position (more efficient
137 -- to compute than to store).
138
139 else
140 declare
141 VP : constant Natural := Character'Pos (V);
142 begin
143 S (1 .. 9) := "RESERVED_";
144 S (10) := Character'Val (48 + VP / 100);
145 S (11) := Character'Val (48 + (VP / 10) mod 10);
146 S (12) := Character'Val (48 + VP mod 10);
147 P := 12;
148 end;
149 end if;
150
151 -- Normal characters yield the character enclosed in quotes (RM 3.5(32))
152
153 else
154 S (1) := ''';
155 S (2) := V;
156 S (3) := ''';
157 P := 3;
158 end if;
159 end Image_Character;
160
161 ------------------------
162 -- Image_Character_05 --
163 ------------------------
164
165 procedure Image_Character_05
166 (V : Character;
167 S : in out String;
168 P : out Natural)
169 is
170 pragma Assert (S'First = 1);
171 begin
172 if V = Character'Val (16#00AD#) then
173 P := 11;
174 S (1 .. P) := "SOFT_HYPHEN";
175 else
176 Image_Character (V, S, P);
177 end if;
178 end Image_Character_05;
179
180 end System.Img_Char;