OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [s-wwdenu.adb] - Blame information for rev 20

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
------------------------------------------------------------------------------
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-2005, 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 2,  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.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20
-- Boston, MA 02110-1301, USA.                                              --
21
--                                                                          --
22
-- As a special exception,  if other files  instantiate  generics from this --
23
-- unit, or you link  this unit with other files  to produce an executable, --
24
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
25
-- covered  by the  GNU  General  Public  License.  This exception does not --
26
-- however invalidate  any other reasons why  the executable file  might be --
27
-- covered by the  GNU Public License.                                      --
28
--                                                                          --
29
-- GNAT was originally developed  by the GNAT team at  New York University. --
30
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
31
--                                                                          --
32
------------------------------------------------------------------------------
33
 
34
with System.WCh_StW; use System.WCh_StW;
35
with System.WCh_Con; use System.WCh_Con;
36
 
37
with Unchecked_Conversion;
38
 
39
package body System.WWd_Enum is
40
 
41
   -----------------------------------
42
   -- Wide_Wide_Width_Enumeration_8 --
43
   -----------------------------------
44
 
45
   function Wide_Wide_Width_Enumeration_8
46
     (Names   : String;
47
      Indexes : System.Address;
48
      Lo, Hi  : Natural;
49
      EM      : WC_Encoding_Method) return Natural
50
   is
51
      W : Natural;
52
 
53
      type Natural_8 is range 0 .. 2 ** 7 - 1;
54
      type Index_Table is array (Natural) of Natural_8;
55
      type Index_Table_Ptr is access Index_Table;
56
 
57
      function To_Index_Table_Ptr is
58
        new Unchecked_Conversion (System.Address, Index_Table_Ptr);
59
 
60
      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
61
 
62
   begin
63
      W := 0;
64
      for J in Lo .. Hi loop
65
         declare
66
            WS : constant Wide_Wide_String :=
67
                   String_To_Wide_Wide_String
68
                     (Names (Natural (IndexesT (J)) ..
69
                             Natural (IndexesT (J + 1)) - 1), EM);
70
         begin
71
            W := Natural'Max (W, WS'Length);
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 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
            WS : constant Wide_Wide_String :=
104
                   String_To_Wide_Wide_String
105
                     (Names (Natural (IndexesT (J)) ..
106
                             Natural (IndexesT (J + 1)) - 1), EM);
107
         begin
108
            W := Natural'Max (W, WS'Length);
109
         end;
110
      end loop;
111
 
112
      return W;
113
   end Wide_Wide_Width_Enumeration_16;
114
 
115
   ------------------------------------
116
   -- Wide_Wide_Width_Enumeration_32 --
117
   ------------------------------------
118
 
119
   function Wide_Wide_Width_Enumeration_32
120
     (Names   : String;
121
      Indexes : System.Address;
122
      Lo, Hi  : Natural;
123
      EM      : WC_Encoding_Method) return Natural
124
   is
125
      W : Natural;
126
 
127
      type Natural_32 is range 0 .. 2 ** 31 - 1;
128
      type Index_Table is array (Natural) of Natural_32;
129
      type Index_Table_Ptr is access Index_Table;
130
 
131
      function To_Index_Table_Ptr is
132
        new Unchecked_Conversion (System.Address, Index_Table_Ptr);
133
 
134
      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
135
 
136
   begin
137
      W := 0;
138
      for J in Lo .. Hi loop
139
         declare
140
            WS : constant Wide_Wide_String :=
141
                   String_To_Wide_Wide_String
142
                     (Names (Natural (IndexesT (J)) ..
143
                             Natural (IndexesT (J + 1)) - 1), EM);
144
         begin
145
            W := Natural'Max (W, WS'Length);
146
         end;
147
      end loop;
148
 
149
      return W;
150
   end Wide_Wide_Width_Enumeration_32;
151
 
152
   ------------------------------
153
   -- Wide_Width_Enumeration_8 --
154
   ------------------------------
155
 
156
   function Wide_Width_Enumeration_8
157
     (Names   : String;
158
      Indexes : System.Address;
159
      Lo, Hi  : Natural;
160
      EM      : WC_Encoding_Method) return Natural
161
   is
162
      W : Natural;
163
 
164
      type Natural_8 is range 0 .. 2 ** 7 - 1;
165
      type Index_Table is array (Natural) of Natural_8;
166
      type Index_Table_Ptr is access Index_Table;
167
 
168
      function To_Index_Table_Ptr is
169
        new Unchecked_Conversion (System.Address, Index_Table_Ptr);
170
 
171
      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
172
 
173
   begin
174
      W := 0;
175
      for J in Lo .. Hi loop
176
         declare
177
            WS : constant Wide_String :=
178
                   String_To_Wide_String
179
                     (Names (Natural (IndexesT (J)) ..
180
                             Natural (IndexesT (J + 1)) - 1), EM);
181
         begin
182
            W := Natural'Max (W, WS'Length);
183
         end;
184
      end loop;
185
 
186
      return W;
187
   end Wide_Width_Enumeration_8;
188
 
189
   -------------------------------
190
   -- Wide_Width_Enumeration_16 --
191
   -------------------------------
192
 
193
   function Wide_Width_Enumeration_16
194
     (Names   : String;
195
      Indexes : System.Address;
196
      Lo, Hi  : Natural;
197
      EM      : WC_Encoding_Method) return Natural
198
   is
199
      W : Natural;
200
 
201
      type Natural_16 is range 0 .. 2 ** 15 - 1;
202
      type Index_Table is array (Natural) of Natural_16;
203
      type Index_Table_Ptr is access Index_Table;
204
 
205
      function To_Index_Table_Ptr is
206
        new Unchecked_Conversion (System.Address, Index_Table_Ptr);
207
 
208
      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
209
 
210
   begin
211
      W := 0;
212
      for J in Lo .. Hi loop
213
         declare
214
            WS : constant Wide_String :=
215
                   String_To_Wide_String
216
                     (Names (Natural (IndexesT (J)) ..
217
                             Natural (IndexesT (J + 1)) - 1), EM);
218
         begin
219
            W := Natural'Max (W, WS'Length);
220
         end;
221
      end loop;
222
 
223
      return W;
224
   end Wide_Width_Enumeration_16;
225
 
226
   -------------------------------
227
   -- Wide_Width_Enumeration_32 --
228
   -------------------------------
229
 
230
   function Wide_Width_Enumeration_32
231
     (Names   : String;
232
      Indexes : System.Address;
233
      Lo, Hi  : Natural;
234
      EM      : WC_Encoding_Method) return Natural
235
   is
236
      W : Natural;
237
 
238
      type Natural_32 is range 0 .. 2 ** 31 - 1;
239
      type Index_Table is array (Natural) of Natural_32;
240
      type Index_Table_Ptr is access Index_Table;
241
 
242
      function To_Index_Table_Ptr is
243
        new Unchecked_Conversion (System.Address, Index_Table_Ptr);
244
 
245
      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
246
 
247
   begin
248
      W := 0;
249
      for J in Lo .. Hi loop
250
         declare
251
            WS : constant Wide_String :=
252
                   String_To_Wide_String
253
                     (Names (Natural (IndexesT (J)) ..
254
                             Natural (IndexesT (J + 1)) - 1), EM);
255
         begin
256
            W := Natural'Max (W, WS'Length);
257
         end;
258
      end loop;
259
 
260
      return W;
261
   end Wide_Width_Enumeration_32;
262
 
263
end System.WWd_Enum;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.