gcc/ada/s-wwdenu.adb

   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
  32 with System.WCh_StW; use System.WCh_StW;
  33 with System.WCh_Con; use System.WCh_Con;
  34
  35 with Ada.Unchecked_Conversion;
  36
  37 package 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
 273 end System.WWd_Enum;