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-2019, 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