1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                      S Y S T E M . W W D _ E N U M                       --
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
32with System.WCh_StW; use System.WCh_StW;
33with System.WCh_Con; use System.WCh_Con;
34
35with Ada.Unchecked_Conversion;
36
37package body System.WWd_Enum is
38
39   -----------------------------------
40   -- Wide_Wide_Width_Enumeration_8 --
41   -----------------------------------
42
43   function Wide_Wide_Width_Enumeration_8
44     (Names   : String;
45      Indexes : System.Address;
46      Lo, Hi  : Natural;
47      EM      : WC_Encoding_Method) return Natural
48   is
49      W : Natural;
50
51      type Natural_8 is range 0 .. 2 ** 7 - 1;
52      type Index_Table is array (Natural) of Natural_8;
53      type Index_Table_Ptr is access Index_Table;
54
55      function To_Index_Table_Ptr is
56        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
57
58      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
59
60   begin
61      W := 0;
62      for J in Lo .. Hi loop
63         declare
64            S  : constant String :=
65                   Names (Natural (IndexesT (J)) ..
66                          Natural (IndexesT (J + 1)) - 1);
67            WS : Wide_Wide_String (1 .. S'Length);
68            L  : Natural;
69         begin
70            String_To_Wide_Wide_String (S, WS, L, EM);
71            W := Natural'Max (W, L);
72         end;
73      end loop;
74
75      return W;
76   end Wide_Wide_Width_Enumeration_8;
77
78   ------------------------------------
79   -- Wide_Wide_Width_Enumeration_16 --
80   ------------------------------------
81
82   function Wide_Wide_Width_Enumeration_16
83     (Names   : String;
84      Indexes : System.Address;
85      Lo, Hi  : Natural;
86      EM      : WC_Encoding_Method) return Natural
87   is
88      W : Natural;
89
90      type Natural_16 is range 0 .. 2 ** 15 - 1;
91      type Index_Table is array (Natural) of Natural_16;
92      type Index_Table_Ptr is access Index_Table;
93
94      function To_Index_Table_Ptr is
95        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
96
97      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
98
99   begin
100      W := 0;
101      for J in Lo .. Hi loop
102         declare
103            S  : constant String :=
104                   Names (Natural (IndexesT (J)) ..
105                          Natural (IndexesT (J + 1)) - 1);
106            WS : Wide_Wide_String (1 .. S'Length);
107            L  : Natural;
108         begin
109            String_To_Wide_Wide_String (S, WS, L, EM);
110            W := Natural'Max (W, L);
111         end;
112      end loop;
113
114      return W;
115   end Wide_Wide_Width_Enumeration_16;
116
117   ------------------------------------
118   -- Wide_Wide_Width_Enumeration_32 --
119   ------------------------------------
120
121   function Wide_Wide_Width_Enumeration_32
122     (Names   : String;
123      Indexes : System.Address;
124      Lo, Hi  : Natural;
125      EM      : WC_Encoding_Method) return Natural
126   is
127      W : Natural;
128
129      type Natural_32 is range 0 .. 2 ** 31 - 1;
130      type Index_Table is array (Natural) of Natural_32;
131      type Index_Table_Ptr is access Index_Table;
132
133      function To_Index_Table_Ptr is
134        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
135
136      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
137
138   begin
139      W := 0;
140      for J in Lo .. Hi loop
141         declare
142            S  : constant String :=
143                   Names (Natural (IndexesT (J)) ..
144                          Natural (IndexesT (J + 1)) - 1);
145            WS : Wide_Wide_String (1 .. S'Length);
146            L  : Natural;
147         begin
148            String_To_Wide_Wide_String (S, WS, L, EM);
149            W := Natural'Max (W, L);
150         end;
151      end loop;
152
153      return W;
154   end Wide_Wide_Width_Enumeration_32;
155
156   ------------------------------
157   -- Wide_Width_Enumeration_8 --
158   ------------------------------
159
160   function Wide_Width_Enumeration_8
161     (Names   : String;
162      Indexes : System.Address;
163      Lo, Hi  : Natural;
164      EM      : WC_Encoding_Method) return Natural
165   is
166      W : Natural;
167
168      type Natural_8 is range 0 .. 2 ** 7 - 1;
169      type Index_Table is array (Natural) of Natural_8;
170      type Index_Table_Ptr is access Index_Table;
171
172      function To_Index_Table_Ptr is
173        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
174
175      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
176
177   begin
178      W := 0;
179      for J in Lo .. Hi loop
180         declare
181            S  : constant String :=
182                   Names (Natural (IndexesT (J)) ..
183                          Natural (IndexesT (J + 1)) - 1);
184            WS : Wide_String (1 .. S'Length);
185            L  : Natural;
186         begin
187            String_To_Wide_String (S, WS, L, EM);
188            W := Natural'Max (W, L);
189         end;
190      end loop;
191
192      return W;
193   end Wide_Width_Enumeration_8;
194
195   -------------------------------
196   -- Wide_Width_Enumeration_16 --
197   -------------------------------
198
199   function Wide_Width_Enumeration_16
200     (Names   : String;
201      Indexes : System.Address;
202      Lo, Hi  : Natural;
203      EM      : WC_Encoding_Method) return Natural
204   is
205      W : Natural;
206
207      type Natural_16 is range 0 .. 2 ** 15 - 1;
208      type Index_Table is array (Natural) of Natural_16;
209      type Index_Table_Ptr is access Index_Table;
210
211      function To_Index_Table_Ptr is
212        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
213
214      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
215
216   begin
217      W := 0;
218      for J in Lo .. Hi loop
219         declare
220            S  : constant String :=
221                   Names (Natural (IndexesT (J)) ..
222                          Natural (IndexesT (J + 1)) - 1);
223            WS : Wide_String (1 .. S'Length);
224            L  : Natural;
225         begin
226            String_To_Wide_String (S, WS, L, EM);
227            W := Natural'Max (W, L);
228         end;
229      end loop;
230
231      return W;
232   end Wide_Width_Enumeration_16;
233
234   -------------------------------
235   -- Wide_Width_Enumeration_32 --
236   -------------------------------
237
238   function Wide_Width_Enumeration_32
239     (Names   : String;
240      Indexes : System.Address;
241      Lo, Hi  : Natural;
242      EM      : WC_Encoding_Method) return Natural
243   is
244      W : Natural;
245
246      type Natural_32 is range 0 .. 2 ** 31 - 1;
247      type Index_Table is array (Natural) of Natural_32;
248      type Index_Table_Ptr is access Index_Table;
249
250      function To_Index_Table_Ptr is
251        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
252
253      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
254
255   begin
256      W := 0;
257      for J in Lo .. Hi loop
258         declare
259            S  : constant String :=
260                   Names (Natural (IndexesT (J)) ..
261                          Natural (IndexesT (J + 1)) - 1);
262            WS : Wide_String (1 .. S'Length);
263            L  : Natural;
264         begin
265            String_To_Wide_String (S, WS, L, EM);
266            W := Natural'Max (W, L);
267         end;
268      end loop;
269
270      return W;
271   end Wide_Width_Enumeration_32;
272
273end System.WWd_Enum;
274