annotate gcc/ada/libgnat/s-wwdenu.adb @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT RUN-TIME COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- S Y S T E M . W W D _ E N U M --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
kono
parents:
diff changeset
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 with System.WCh_StW; use System.WCh_StW;
kono
parents:
diff changeset
33 with System.WCh_Con; use System.WCh_Con;
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 with Ada.Unchecked_Conversion;
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 package body System.WWd_Enum is
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 -----------------------------------
kono
parents:
diff changeset
40 -- Wide_Wide_Width_Enumeration_8 --
kono
parents:
diff changeset
41 -----------------------------------
kono
parents:
diff changeset
42
kono
parents:
diff changeset
43 function Wide_Wide_Width_Enumeration_8
kono
parents:
diff changeset
44 (Names : String;
kono
parents:
diff changeset
45 Indexes : System.Address;
kono
parents:
diff changeset
46 Lo, Hi : Natural;
kono
parents:
diff changeset
47 EM : WC_Encoding_Method) return Natural
kono
parents:
diff changeset
48 is
kono
parents:
diff changeset
49 W : Natural;
kono
parents:
diff changeset
50
kono
parents:
diff changeset
51 type Natural_8 is range 0 .. 2 ** 7 - 1;
kono
parents:
diff changeset
52 type Index_Table is array (Natural) of Natural_8;
kono
parents:
diff changeset
53 type Index_Table_Ptr is access Index_Table;
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55 function To_Index_Table_Ptr is
kono
parents:
diff changeset
56 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
kono
parents:
diff changeset
57
kono
parents:
diff changeset
58 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 begin
kono
parents:
diff changeset
61 W := 0;
kono
parents:
diff changeset
62 for J in Lo .. Hi loop
kono
parents:
diff changeset
63 declare
kono
parents:
diff changeset
64 S : constant String :=
kono
parents:
diff changeset
65 Names (Natural (IndexesT (J)) ..
kono
parents:
diff changeset
66 Natural (IndexesT (J + 1)) - 1);
kono
parents:
diff changeset
67 WS : Wide_Wide_String (1 .. S'Length);
kono
parents:
diff changeset
68 L : Natural;
kono
parents:
diff changeset
69 begin
kono
parents:
diff changeset
70 String_To_Wide_Wide_String (S, WS, L, EM);
kono
parents:
diff changeset
71 W := Natural'Max (W, L);
kono
parents:
diff changeset
72 end;
kono
parents:
diff changeset
73 end loop;
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 return W;
kono
parents:
diff changeset
76 end Wide_Wide_Width_Enumeration_8;
kono
parents:
diff changeset
77
kono
parents:
diff changeset
78 ------------------------------------
kono
parents:
diff changeset
79 -- Wide_Wide_Width_Enumeration_16 --
kono
parents:
diff changeset
80 ------------------------------------
kono
parents:
diff changeset
81
kono
parents:
diff changeset
82 function Wide_Wide_Width_Enumeration_16
kono
parents:
diff changeset
83 (Names : String;
kono
parents:
diff changeset
84 Indexes : System.Address;
kono
parents:
diff changeset
85 Lo, Hi : Natural;
kono
parents:
diff changeset
86 EM : WC_Encoding_Method) return Natural
kono
parents:
diff changeset
87 is
kono
parents:
diff changeset
88 W : Natural;
kono
parents:
diff changeset
89
kono
parents:
diff changeset
90 type Natural_16 is range 0 .. 2 ** 15 - 1;
kono
parents:
diff changeset
91 type Index_Table is array (Natural) of Natural_16;
kono
parents:
diff changeset
92 type Index_Table_Ptr is access Index_Table;
kono
parents:
diff changeset
93
kono
parents:
diff changeset
94 function To_Index_Table_Ptr is
kono
parents:
diff changeset
95 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
kono
parents:
diff changeset
96
kono
parents:
diff changeset
97 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
kono
parents:
diff changeset
98
kono
parents:
diff changeset
99 begin
kono
parents:
diff changeset
100 W := 0;
kono
parents:
diff changeset
101 for J in Lo .. Hi loop
kono
parents:
diff changeset
102 declare
kono
parents:
diff changeset
103 S : constant String :=
kono
parents:
diff changeset
104 Names (Natural (IndexesT (J)) ..
kono
parents:
diff changeset
105 Natural (IndexesT (J + 1)) - 1);
kono
parents:
diff changeset
106 WS : Wide_Wide_String (1 .. S'Length);
kono
parents:
diff changeset
107 L : Natural;
kono
parents:
diff changeset
108 begin
kono
parents:
diff changeset
109 String_To_Wide_Wide_String (S, WS, L, EM);
kono
parents:
diff changeset
110 W := Natural'Max (W, L);
kono
parents:
diff changeset
111 end;
kono
parents:
diff changeset
112 end loop;
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 return W;
kono
parents:
diff changeset
115 end Wide_Wide_Width_Enumeration_16;
kono
parents:
diff changeset
116
kono
parents:
diff changeset
117 ------------------------------------
kono
parents:
diff changeset
118 -- Wide_Wide_Width_Enumeration_32 --
kono
parents:
diff changeset
119 ------------------------------------
kono
parents:
diff changeset
120
kono
parents:
diff changeset
121 function Wide_Wide_Width_Enumeration_32
kono
parents:
diff changeset
122 (Names : String;
kono
parents:
diff changeset
123 Indexes : System.Address;
kono
parents:
diff changeset
124 Lo, Hi : Natural;
kono
parents:
diff changeset
125 EM : WC_Encoding_Method) return Natural
kono
parents:
diff changeset
126 is
kono
parents:
diff changeset
127 W : Natural;
kono
parents:
diff changeset
128
kono
parents:
diff changeset
129 type Natural_32 is range 0 .. 2 ** 31 - 1;
kono
parents:
diff changeset
130 type Index_Table is array (Natural) of Natural_32;
kono
parents:
diff changeset
131 type Index_Table_Ptr is access Index_Table;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 function To_Index_Table_Ptr is
kono
parents:
diff changeset
134 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
kono
parents:
diff changeset
135
kono
parents:
diff changeset
136 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 begin
kono
parents:
diff changeset
139 W := 0;
kono
parents:
diff changeset
140 for J in Lo .. Hi loop
kono
parents:
diff changeset
141 declare
kono
parents:
diff changeset
142 S : constant String :=
kono
parents:
diff changeset
143 Names (Natural (IndexesT (J)) ..
kono
parents:
diff changeset
144 Natural (IndexesT (J + 1)) - 1);
kono
parents:
diff changeset
145 WS : Wide_Wide_String (1 .. S'Length);
kono
parents:
diff changeset
146 L : Natural;
kono
parents:
diff changeset
147 begin
kono
parents:
diff changeset
148 String_To_Wide_Wide_String (S, WS, L, EM);
kono
parents:
diff changeset
149 W := Natural'Max (W, L);
kono
parents:
diff changeset
150 end;
kono
parents:
diff changeset
151 end loop;
kono
parents:
diff changeset
152
kono
parents:
diff changeset
153 return W;
kono
parents:
diff changeset
154 end Wide_Wide_Width_Enumeration_32;
kono
parents:
diff changeset
155
kono
parents:
diff changeset
156 ------------------------------
kono
parents:
diff changeset
157 -- Wide_Width_Enumeration_8 --
kono
parents:
diff changeset
158 ------------------------------
kono
parents:
diff changeset
159
kono
parents:
diff changeset
160 function Wide_Width_Enumeration_8
kono
parents:
diff changeset
161 (Names : String;
kono
parents:
diff changeset
162 Indexes : System.Address;
kono
parents:
diff changeset
163 Lo, Hi : Natural;
kono
parents:
diff changeset
164 EM : WC_Encoding_Method) return Natural
kono
parents:
diff changeset
165 is
kono
parents:
diff changeset
166 W : Natural;
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 type Natural_8 is range 0 .. 2 ** 7 - 1;
kono
parents:
diff changeset
169 type Index_Table is array (Natural) of Natural_8;
kono
parents:
diff changeset
170 type Index_Table_Ptr is access Index_Table;
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 function To_Index_Table_Ptr is
kono
parents:
diff changeset
173 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
kono
parents:
diff changeset
174
kono
parents:
diff changeset
175 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 begin
kono
parents:
diff changeset
178 W := 0;
kono
parents:
diff changeset
179 for J in Lo .. Hi loop
kono
parents:
diff changeset
180 declare
kono
parents:
diff changeset
181 S : constant String :=
kono
parents:
diff changeset
182 Names (Natural (IndexesT (J)) ..
kono
parents:
diff changeset
183 Natural (IndexesT (J + 1)) - 1);
kono
parents:
diff changeset
184 WS : Wide_String (1 .. S'Length);
kono
parents:
diff changeset
185 L : Natural;
kono
parents:
diff changeset
186 begin
kono
parents:
diff changeset
187 String_To_Wide_String (S, WS, L, EM);
kono
parents:
diff changeset
188 W := Natural'Max (W, L);
kono
parents:
diff changeset
189 end;
kono
parents:
diff changeset
190 end loop;
kono
parents:
diff changeset
191
kono
parents:
diff changeset
192 return W;
kono
parents:
diff changeset
193 end Wide_Width_Enumeration_8;
kono
parents:
diff changeset
194
kono
parents:
diff changeset
195 -------------------------------
kono
parents:
diff changeset
196 -- Wide_Width_Enumeration_16 --
kono
parents:
diff changeset
197 -------------------------------
kono
parents:
diff changeset
198
kono
parents:
diff changeset
199 function Wide_Width_Enumeration_16
kono
parents:
diff changeset
200 (Names : String;
kono
parents:
diff changeset
201 Indexes : System.Address;
kono
parents:
diff changeset
202 Lo, Hi : Natural;
kono
parents:
diff changeset
203 EM : WC_Encoding_Method) return Natural
kono
parents:
diff changeset
204 is
kono
parents:
diff changeset
205 W : Natural;
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 type Natural_16 is range 0 .. 2 ** 15 - 1;
kono
parents:
diff changeset
208 type Index_Table is array (Natural) of Natural_16;
kono
parents:
diff changeset
209 type Index_Table_Ptr is access Index_Table;
kono
parents:
diff changeset
210
kono
parents:
diff changeset
211 function To_Index_Table_Ptr is
kono
parents:
diff changeset
212 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
kono
parents:
diff changeset
213
kono
parents:
diff changeset
214 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
kono
parents:
diff changeset
215
kono
parents:
diff changeset
216 begin
kono
parents:
diff changeset
217 W := 0;
kono
parents:
diff changeset
218 for J in Lo .. Hi loop
kono
parents:
diff changeset
219 declare
kono
parents:
diff changeset
220 S : constant String :=
kono
parents:
diff changeset
221 Names (Natural (IndexesT (J)) ..
kono
parents:
diff changeset
222 Natural (IndexesT (J + 1)) - 1);
kono
parents:
diff changeset
223 WS : Wide_String (1 .. S'Length);
kono
parents:
diff changeset
224 L : Natural;
kono
parents:
diff changeset
225 begin
kono
parents:
diff changeset
226 String_To_Wide_String (S, WS, L, EM);
kono
parents:
diff changeset
227 W := Natural'Max (W, L);
kono
parents:
diff changeset
228 end;
kono
parents:
diff changeset
229 end loop;
kono
parents:
diff changeset
230
kono
parents:
diff changeset
231 return W;
kono
parents:
diff changeset
232 end Wide_Width_Enumeration_16;
kono
parents:
diff changeset
233
kono
parents:
diff changeset
234 -------------------------------
kono
parents:
diff changeset
235 -- Wide_Width_Enumeration_32 --
kono
parents:
diff changeset
236 -------------------------------
kono
parents:
diff changeset
237
kono
parents:
diff changeset
238 function Wide_Width_Enumeration_32
kono
parents:
diff changeset
239 (Names : String;
kono
parents:
diff changeset
240 Indexes : System.Address;
kono
parents:
diff changeset
241 Lo, Hi : Natural;
kono
parents:
diff changeset
242 EM : WC_Encoding_Method) return Natural
kono
parents:
diff changeset
243 is
kono
parents:
diff changeset
244 W : Natural;
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 type Natural_32 is range 0 .. 2 ** 31 - 1;
kono
parents:
diff changeset
247 type Index_Table is array (Natural) of Natural_32;
kono
parents:
diff changeset
248 type Index_Table_Ptr is access Index_Table;
kono
parents:
diff changeset
249
kono
parents:
diff changeset
250 function To_Index_Table_Ptr is
kono
parents:
diff changeset
251 new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
kono
parents:
diff changeset
252
kono
parents:
diff changeset
253 IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255 begin
kono
parents:
diff changeset
256 W := 0;
kono
parents:
diff changeset
257 for J in Lo .. Hi loop
kono
parents:
diff changeset
258 declare
kono
parents:
diff changeset
259 S : constant String :=
kono
parents:
diff changeset
260 Names (Natural (IndexesT (J)) ..
kono
parents:
diff changeset
261 Natural (IndexesT (J + 1)) - 1);
kono
parents:
diff changeset
262 WS : Wide_String (1 .. S'Length);
kono
parents:
diff changeset
263 L : Natural;
kono
parents:
diff changeset
264 begin
kono
parents:
diff changeset
265 String_To_Wide_String (S, WS, L, EM);
kono
parents:
diff changeset
266 W := Natural'Max (W, L);
kono
parents:
diff changeset
267 end;
kono
parents:
diff changeset
268 end loop;
kono
parents:
diff changeset
269
kono
parents:
diff changeset
270 return W;
kono
parents:
diff changeset
271 end Wide_Width_Enumeration_32;
kono
parents:
diff changeset
272
kono
parents:
diff changeset
273 end System.WWd_Enum;