[thirdparty/gcc.git] / gcc / ada / libgnat / s-wwdenu.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUN-TIME COMPONENTS                         --
--                                                                          --
--                      S Y S T E M . W W D _ E N U M                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2020, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with System.WCh_StW; use System.WCh_StW;
with System.WCh_Con; use System.WCh_Con;

with Ada.Unchecked_Conversion;

package body System.WWd_Enum is

   -----------------------------------
   -- Wide_Wide_Width_Enumeration_8 --
   -----------------------------------

   function Wide_Wide_Width_Enumeration_8
     (Names   : String;
      Indexes : System.Address;
      Lo, Hi  : Natural;
      EM      : WC_Encoding_Method) return Natural
   is
      W : Natural;

      type Natural_8 is range 0 .. 2 ** 7 - 1;
      type Index_Table is array (Natural) of Natural_8;
      type Index_Table_Ptr is access Index_Table;

      function To_Index_Table_Ptr is
        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);

      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);

   begin
      W := 0;
      for J in Lo .. Hi loop
         declare
            S  : constant String :=
                   Names (Natural (IndexesT (J)) ..
                          Natural (IndexesT (J + 1)) - 1);
            WS : Wide_Wide_String (1 .. S'Length);
            L  : Natural;
         begin
            String_To_Wide_Wide_String (S, WS, L, EM);
            W := Natural'Max (W, L);
         end;
      end loop;

      return W;
   end Wide_Wide_Width_Enumeration_8;

   ------------------------------------
   -- Wide_Wide_Width_Enumeration_16 --
   ------------------------------------

   function Wide_Wide_Width_Enumeration_16
     (Names   : String;
      Indexes : System.Address;
      Lo, Hi  : Natural;
      EM      : WC_Encoding_Method) return Natural
   is
      W : Natural;

      type Natural_16 is range 0 .. 2 ** 15 - 1;
      type Index_Table is array (Natural) of Natural_16;
      type Index_Table_Ptr is access Index_Table;

      function To_Index_Table_Ptr is
        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);

      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);

   begin
      W := 0;
      for J in Lo .. Hi loop
         declare
            S  : constant String :=
                   Names (Natural (IndexesT (J)) ..
                          Natural (IndexesT (J + 1)) - 1);
            WS : Wide_Wide_String (1 .. S'Length);
            L  : Natural;
         begin
            String_To_Wide_Wide_String (S, WS, L, EM);
            W := Natural'Max (W, L);
         end;
      end loop;

      return W;
   end Wide_Wide_Width_Enumeration_16;

   ------------------------------------
   -- Wide_Wide_Width_Enumeration_32 --
   ------------------------------------

   function Wide_Wide_Width_Enumeration_32
     (Names   : String;
      Indexes : System.Address;
      Lo, Hi  : Natural;
      EM      : WC_Encoding_Method) return Natural
   is
      W : Natural;

      type Natural_32 is range 0 .. 2 ** 31 - 1;
      type Index_Table is array (Natural) of Natural_32;
      type Index_Table_Ptr is access Index_Table;

      function To_Index_Table_Ptr is
        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);

      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);

   begin
      W := 0;
      for J in Lo .. Hi loop
         declare
            S  : constant String :=
                   Names (Natural (IndexesT (J)) ..
                          Natural (IndexesT (J + 1)) - 1);
            WS : Wide_Wide_String (1 .. S'Length);
            L  : Natural;
         begin
            String_To_Wide_Wide_String (S, WS, L, EM);
            W := Natural'Max (W, L);
         end;
      end loop;

      return W;
   end Wide_Wide_Width_Enumeration_32;

   ------------------------------
   -- Wide_Width_Enumeration_8 --
   ------------------------------

   function Wide_Width_Enumeration_8
     (Names   : String;
      Indexes : System.Address;
      Lo, Hi  : Natural;
      EM      : WC_Encoding_Method) return Natural
   is
      W : Natural;

      type Natural_8 is range 0 .. 2 ** 7 - 1;
      type Index_Table is array (Natural) of Natural_8;
      type Index_Table_Ptr is access Index_Table;

      function To_Index_Table_Ptr is
        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);

      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);

   begin
      W := 0;
      for J in Lo .. Hi loop
         declare
            S  : constant String :=
                   Names (Natural (IndexesT (J)) ..
                          Natural (IndexesT (J + 1)) - 1);
            WS : Wide_String (1 .. S'Length);
            L  : Natural;
         begin
            String_To_Wide_String (S, WS, L, EM);
            W := Natural'Max (W, L);
         end;
      end loop;

      return W;
   end Wide_Width_Enumeration_8;

   -------------------------------
   -- Wide_Width_Enumeration_16 --
   -------------------------------

   function Wide_Width_Enumeration_16
     (Names   : String;
      Indexes : System.Address;
      Lo, Hi  : Natural;
      EM      : WC_Encoding_Method) return Natural
   is
      W : Natural;

      type Natural_16 is range 0 .. 2 ** 15 - 1;
      type Index_Table is array (Natural) of Natural_16;
      type Index_Table_Ptr is access Index_Table;

      function To_Index_Table_Ptr is
        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);

      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);

   begin
      W := 0;
      for J in Lo .. Hi loop
         declare
            S  : constant String :=
                   Names (Natural (IndexesT (J)) ..
                          Natural (IndexesT (J + 1)) - 1);
            WS : Wide_String (1 .. S'Length);
            L  : Natural;
         begin
            String_To_Wide_String (S, WS, L, EM);
            W := Natural'Max (W, L);
         end;
      end loop;

      return W;
   end Wide_Width_Enumeration_16;

   -------------------------------
   -- Wide_Width_Enumeration_32 --
   -------------------------------

   function Wide_Width_Enumeration_32
     (Names   : String;
      Indexes : System.Address;
      Lo, Hi  : Natural;
      EM      : WC_Encoding_Method) return Natural
   is
      W : Natural;

      type Natural_32 is range 0 .. 2 ** 31 - 1;
      type Index_Table is array (Natural) of Natural_32;
      type Index_Table_Ptr is access Index_Table;

      function To_Index_Table_Ptr is
        new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);

      IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);

   begin
      W := 0;
      for J in Lo .. Hi loop
         declare
            S  : constant String :=
                   Names (Natural (IndexesT (J)) ..
                          Natural (IndexesT (J + 1)) - 1);
            WS : Wide_String (1 .. S'Length);
            L  : Natural;
         begin
            String_To_Wide_String (S, WS, L, EM);
            W := Natural'Max (W, L);
         end;
      end loop;

      return W;
   end Wide_Width_Enumeration_32;

end System.WWd_Enum;
Commit	Line	Data
cacbc350 RK	1	------------------------------------------------------------------------------
cacbc350 RK	2	-- --
3084fecd	3	-- GNAT RUN-TIME COMPONENTS --
cacbc350 RK	4	-- --
	5	-- S Y S T E M . W W D _ E N U M --
	6	-- --
	7	-- B o d y --
	8	-- --
4b490c1e	9	-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
cacbc350 RK	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- --
748086b7	13	-- ware Foundation; either version 3, or (at your option) any later ver- --
cacbc350 RK	14	-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
cacbc350 RK	15	-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
748086b7 JJ	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/>. --
cacbc350 RK	26	-- --
cacbc350 RK	27	-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc	28	-- Extensive contributions were provided by Ada Core Technologies Inc. --
cacbc350 RK	29	-- --
	30	------------------------------------------------------------------------------
	31
	32	with System.WCh_StW; use System.WCh_StW;
	33	with System.WCh_Con; use System.WCh_Con;
	34
cecaf88a	35	with Ada.Unchecked_Conversion;
cacbc350 RK	36
	37	package body System.WWd_Enum is
	38
82c80734 RD	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
cecaf88a	56	new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
82c80734 RD	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
470cd9e9 RD	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;
82c80734	69	begin
470cd9e9 RD	70	String_To_Wide_Wide_String (S, WS, L, EM);
470cd9e9 RD	71	W := Natural'Max (W, L);
82c80734 RD	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
cecaf88a	95	new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
82c80734 RD	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
470cd9e9 RD	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;
82c80734	108	begin
470cd9e9 RD	109	String_To_Wide_Wide_String (S, WS, L, EM);
470cd9e9 RD	110	W := Natural'Max (W, L);
82c80734 RD	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
cecaf88a	134	new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
82c80734 RD	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
470cd9e9 RD	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;
82c80734	147	begin
470cd9e9 RD	148	String_To_Wide_Wide_String (S, WS, L, EM);
470cd9e9 RD	149	W := Natural'Max (W, L);
82c80734 RD	150	end;
	151	end loop;
	152
	153	return W;
	154	end Wide_Wide_Width_Enumeration_32;
	155
cacbc350 RK	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;
82c80734	164	EM : WC_Encoding_Method) return Natural
cacbc350 RK	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
cecaf88a	173	new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
cacbc350 RK	174
	175	IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
	176
	177	begin
	178	W := 0;
cacbc350 RK	179	for J in Lo .. Hi loop
cacbc350 RK	180	declare
470cd9e9 RD	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;
cacbc350	186	begin
470cd9e9 RD	187	String_To_Wide_String (S, WS, L, EM);
470cd9e9 RD	188	W := Natural'Max (W, L);
cacbc350 RK	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;
82c80734	203	EM : WC_Encoding_Method) return Natural
cacbc350 RK	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
cecaf88a	212	new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
cacbc350 RK	213
	214	IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
	215
	216	begin
	217	W := 0;
cacbc350 RK	218	for J in Lo .. Hi loop
cacbc350 RK	219	declare
470cd9e9 RD	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;
cacbc350	225	begin
470cd9e9 RD	226	String_To_Wide_String (S, WS, L, EM);
470cd9e9 RD	227	W := Natural'Max (W, L);
cacbc350 RK	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;
82c80734	242	EM : WC_Encoding_Method) return Natural
cacbc350 RK	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
cecaf88a	251	new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr);
cacbc350 RK	252
	253	IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes);
	254
	255	begin
	256	W := 0;
cacbc350 RK	257	for J in Lo .. Hi loop
cacbc350 RK	258	declare
470cd9e9 RD	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;
cacbc350	264	begin
470cd9e9 RD	265	String_To_Wide_String (S, WS, L, EM);
470cd9e9 RD	266	W := Natural'Max (W, L);
cacbc350 RK	267	end;
	268	end loop;
	269
	270	return W;
	271	end Wide_Width_Enumeration_32;
	272
	273	end System.WWd_Enum;