URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [i-c.adb] - Blame information for rev 753

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


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                         I N T E R F A C E S . C                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2009, 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.      --
--                                                                          --
------------------------------------------------------------------------------
 
package body Interfaces.C is
 
   -----------------------
   -- Is_Nul_Terminated --
   -----------------------
 
   --  Case of char_array
 
   function Is_Nul_Terminated (Item : char_array) return Boolean is
   begin
      for J in Item'Range loop
         if Item (J) = nul then
            return True;
         end if;
      end loop;
 
      return False;
   end Is_Nul_Terminated;
 
   --  Case of wchar_array
 
   function Is_Nul_Terminated (Item : wchar_array) return Boolean is
   begin
      for J in Item'Range loop
         if Item (J) = wide_nul then
            return True;
         end if;
      end loop;
 
      return False;
   end Is_Nul_Terminated;
 
   --  Case of char16_array
 
   function Is_Nul_Terminated (Item : char16_array) return Boolean is
   begin
      for J in Item'Range loop
         if Item (J) = char16_nul then
            return True;
         end if;
      end loop;
 
      return False;
   end Is_Nul_Terminated;
 
   --  Case of char32_array
 
   function Is_Nul_Terminated (Item : char32_array) return Boolean is
   begin
      for J in Item'Range loop
         if Item (J) = char32_nul then
            return True;
         end if;
      end loop;
 
      return False;
   end Is_Nul_Terminated;
 
   ------------
   -- To_Ada --
   ------------
 
   --  Convert char to Character
 
   function To_Ada (Item : char) return Character is
   begin
      return Character'Val (char'Pos (Item));
   end To_Ada;
 
   --  Convert char_array to String (function form)
 
   function To_Ada
     (Item     : char_array;
      Trim_Nul : Boolean := True) return String
   is
      Count : Natural;
      From  : size_t;
 
   begin
      if Trim_Nul then
         From := Item'First;
 
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = nul then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      declare
         R : String (1 .. Count);
 
      begin
         for J in R'Range loop
            R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
         end loop;
 
         return R;
      end;
   end To_Ada;
 
   --  Convert char_array to String (procedure form)
 
   procedure To_Ada
     (Item     : char_array;
      Target   : out String;
      Count    : out Natural;
      Trim_Nul : Boolean := True)
   is
      From : size_t;
      To   : Positive;
 
   begin
      if Trim_Nul then
         From := Item'First;
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = nul then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      if Count > Target'Length then
         raise Constraint_Error;
 
      else
         From := Item'First;
         To   := Target'First;
 
         for J in 1 .. Count loop
            Target (To) := Character (Item (From));
            From := From + 1;
            To   := To + 1;
         end loop;
      end if;
 
   end To_Ada;
 
   --  Convert wchar_t to Wide_Character
 
   function To_Ada (Item : wchar_t) return Wide_Character is
   begin
      return Wide_Character (Item);
   end To_Ada;
 
   --  Convert wchar_array to Wide_String (function form)
 
   function To_Ada
     (Item     : wchar_array;
      Trim_Nul : Boolean := True) return Wide_String
   is
      Count : Natural;
      From  : size_t;
 
   begin
      if Trim_Nul then
         From := Item'First;
 
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = wide_nul then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      declare
         R : Wide_String (1 .. Count);
 
      begin
         for J in R'Range loop
            R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
         end loop;
 
         return R;
      end;
   end To_Ada;
 
   --  Convert wchar_array to Wide_String (procedure form)
 
   procedure To_Ada
     (Item     : wchar_array;
      Target   : out Wide_String;
      Count    : out Natural;
      Trim_Nul : Boolean := True)
   is
      From : size_t;
      To   : Positive;
 
   begin
      if Trim_Nul then
         From := Item'First;
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = wide_nul then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      if Count > Target'Length then
         raise Constraint_Error;
 
      else
         From := Item'First;
         To   := Target'First;
 
         for J in 1 .. Count loop
            Target (To) := To_Ada (Item (From));
            From := From + 1;
            To   := To + 1;
         end loop;
      end if;
   end To_Ada;
 
   --  Convert char16_t to Wide_Character
 
   function To_Ada (Item : char16_t) return Wide_Character is
   begin
      return Wide_Character'Val (char16_t'Pos (Item));
   end To_Ada;
 
   --  Convert char16_array to Wide_String (function form)
 
   function To_Ada
     (Item     : char16_array;
      Trim_Nul : Boolean := True) return Wide_String
   is
      Count : Natural;
      From  : size_t;
 
   begin
      if Trim_Nul then
         From := Item'First;
 
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = char16_t'Val (0) then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      declare
         R : Wide_String (1 .. Count);
 
      begin
         for J in R'Range loop
            R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
         end loop;
 
         return R;
      end;
   end To_Ada;
 
   --  Convert char16_array to Wide_String (procedure form)
 
   procedure To_Ada
     (Item     : char16_array;
      Target   : out Wide_String;
      Count    : out Natural;
      Trim_Nul : Boolean := True)
   is
      From : size_t;
      To   : Positive;
 
   begin
      if Trim_Nul then
         From := Item'First;
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = char16_t'Val (0) then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      if Count > Target'Length then
         raise Constraint_Error;
 
      else
         From := Item'First;
         To   := Target'First;
 
         for J in 1 .. Count loop
            Target (To) := To_Ada (Item (From));
            From := From + 1;
            To   := To + 1;
         end loop;
      end if;
   end To_Ada;
 
   --  Convert char32_t to Wide_Wide_Character
 
   function To_Ada (Item : char32_t) return Wide_Wide_Character is
   begin
      return Wide_Wide_Character'Val (char32_t'Pos (Item));
   end To_Ada;
 
   --  Convert char32_array to Wide_Wide_String (function form)
 
   function To_Ada
     (Item     : char32_array;
      Trim_Nul : Boolean := True) return Wide_Wide_String
   is
      Count : Natural;
      From  : size_t;
 
   begin
      if Trim_Nul then
         From := Item'First;
 
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = char32_t'Val (0) then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      declare
         R : Wide_Wide_String (1 .. Count);
 
      begin
         for J in R'Range loop
            R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));
         end loop;
 
         return R;
      end;
   end To_Ada;
 
   --  Convert char32_array to Wide_Wide_String (procedure form)
 
   procedure To_Ada
     (Item     : char32_array;
      Target   : out Wide_Wide_String;
      Count    : out Natural;
      Trim_Nul : Boolean := True)
   is
      From : size_t;
      To   : Positive;
 
   begin
      if Trim_Nul then
         From := Item'First;
         loop
            if From > Item'Last then
               raise Terminator_Error;
            elsif Item (From) = char32_t'Val (0) then
               exit;
            else
               From := From + 1;
            end if;
         end loop;
 
         Count := Natural (From - Item'First);
 
      else
         Count := Item'Length;
      end if;
 
      if Count > Target'Length then
         raise Constraint_Error;
 
      else
         From := Item'First;
         To   := Target'First;
 
         for J in 1 .. Count loop
            Target (To) := To_Ada (Item (From));
            From := From + 1;
            To   := To + 1;
         end loop;
      end if;
   end To_Ada;
 
   ----------
   -- To_C --
   ----------
 
   --  Convert Character to char
 
   function To_C (Item : Character) return char is
   begin
      return char'Val (Character'Pos (Item));
   end To_C;
 
   --  Convert String to char_array (function form)
 
   function To_C
     (Item       : String;
      Append_Nul : Boolean := True) return char_array
   is
   begin
      if Append_Nul then
         declare
            R : char_array (0 .. Item'Length);
 
         begin
            for J in Item'Range loop
               R (size_t (J - Item'First)) := To_C (Item (J));
            end loop;
 
            R (R'Last) := nul;
            return R;
         end;
 
      --  Append_Nul False
 
      else
         --  A nasty case, if the string is null, we must return a null
         --  char_array. The lower bound of this array is required to be zero
         --  (RM B.3(50)) but that is of course impossible given that size_t
         --  is unsigned. According to Ada 2005 AI-258, the result is to raise
         --  Constraint_Error. This is also the appropriate behavior in Ada 95,
         --  since nothing else makes sense.
 
         if Item'Length = 0 then
            raise Constraint_Error;
 
         --  Normal case
 
         else
            declare
               R : char_array (0 .. Item'Length - 1);
 
            begin
               for J in Item'Range loop
                  R (size_t (J - Item'First)) := To_C (Item (J));
               end loop;
 
               return R;
            end;
         end if;
      end if;
   end To_C;
 
   --  Convert String to char_array (procedure form)
 
   procedure To_C
     (Item       : String;
      Target     : out char_array;
      Count      : out size_t;
      Append_Nul : Boolean := True)
   is
      To : size_t;
 
   begin
      if Target'Length < Item'Length then
         raise Constraint_Error;
 
      else
         To := Target'First;
         for From in Item'Range loop
            Target (To) := char (Item (From));
            To := To + 1;
         end loop;
 
         if Append_Nul then
            if To > Target'Last then
               raise Constraint_Error;
            else
               Target (To) := nul;
               Count := Item'Length + 1;
            end if;
 
         else
            Count := Item'Length;
         end if;
      end if;
   end To_C;
 
   --  Convert Wide_Character to wchar_t
 
   function To_C (Item : Wide_Character) return wchar_t is
   begin
      return wchar_t (Item);
   end To_C;
 
   --  Convert Wide_String to wchar_array (function form)
 
   function To_C
     (Item       : Wide_String;
      Append_Nul : Boolean := True) return wchar_array
   is
   begin
      if Append_Nul then
         declare
            R : wchar_array (0 .. Item'Length);
 
         begin
            for J in Item'Range loop
               R (size_t (J - Item'First)) := To_C (Item (J));
            end loop;
 
            R (R'Last) := wide_nul;
            return R;
         end;
 
      else
         --  A nasty case, if the string is null, we must return a null
         --  wchar_array. The lower bound of this array is required to be zero
         --  (RM B.3(50)) but that is of course impossible given that size_t
         --  is unsigned. According to Ada 2005 AI-258, the result is to raise
         --  Constraint_Error. This is also the appropriate behavior in Ada 95,
         --  since nothing else makes sense.
 
         if Item'Length = 0 then
            raise Constraint_Error;
 
         else
            declare
               R : wchar_array (0 .. Item'Length - 1);
 
            begin
               for J in size_t range 0 .. Item'Length - 1 loop
                  R (J) := To_C (Item (Integer (J) + Item'First));
               end loop;
 
               return R;
            end;
         end if;
      end if;
   end To_C;
 
   --  Convert Wide_String to wchar_array (procedure form)
 
   procedure To_C
     (Item       : Wide_String;
      Target     : out wchar_array;
      Count      : out size_t;
      Append_Nul : Boolean := True)
   is
      To : size_t;
 
   begin
      if Target'Length < Item'Length then
         raise Constraint_Error;
 
      else
         To := Target'First;
         for From in Item'Range loop
            Target (To) := To_C (Item (From));
            To := To + 1;
         end loop;
 
         if Append_Nul then
            if To > Target'Last then
               raise Constraint_Error;
            else
               Target (To) := wide_nul;
               Count := Item'Length + 1;
            end if;
 
         else
            Count := Item'Length;
         end if;
      end if;
   end To_C;
 
   --  Convert Wide_Character to char16_t
 
   function To_C (Item : Wide_Character) return char16_t is
   begin
      return char16_t'Val (Wide_Character'Pos (Item));
   end To_C;
 
   --  Convert Wide_String to char16_array (function form)
 
   function To_C
     (Item       : Wide_String;
      Append_Nul : Boolean := True) return char16_array
   is
   begin
      if Append_Nul then
         declare
            R : char16_array (0 .. Item'Length);
 
         begin
            for J in Item'Range loop
               R (size_t (J - Item'First)) := To_C (Item (J));
            end loop;
 
            R (R'Last) := char16_t'Val (0);
            return R;
         end;
 
      else
         --  A nasty case, if the string is null, we must return a null
         --  char16_array. The lower bound of this array is required to be zero
         --  (RM B.3(50)) but that is of course impossible given that size_t
         --  is unsigned. According to Ada 2005 AI-258, the result is to raise
         --  Constraint_Error. This is also the appropriate behavior in Ada 95,
         --  since nothing else makes sense.
 
         if Item'Length = 0 then
            raise Constraint_Error;
 
         else
            declare
               R : char16_array (0 .. Item'Length - 1);
 
            begin
               for J in size_t range 0 .. Item'Length - 1 loop
                  R (J) := To_C (Item (Integer (J) + Item'First));
               end loop;
 
               return R;
            end;
         end if;
      end if;
   end To_C;
 
   --  Convert Wide_String to char16_array (procedure form)
 
   procedure To_C
     (Item       : Wide_String;
      Target     : out char16_array;
      Count      : out size_t;
      Append_Nul : Boolean := True)
   is
      To : size_t;
 
   begin
      if Target'Length < Item'Length then
         raise Constraint_Error;
 
      else
         To := Target'First;
         for From in Item'Range loop
            Target (To) := To_C (Item (From));
            To := To + 1;
         end loop;
 
         if Append_Nul then
            if To > Target'Last then
               raise Constraint_Error;
            else
               Target (To) := char16_t'Val (0);
               Count := Item'Length + 1;
            end if;
 
         else
            Count := Item'Length;
         end if;
      end if;
   end To_C;
 
   --  Convert Wide_Character to char32_t
 
   function To_C (Item : Wide_Wide_Character) return char32_t is
   begin
      return char32_t'Val (Wide_Wide_Character'Pos (Item));
   end To_C;
 
   --  Convert Wide_Wide_String to char32_array (function form)
 
   function To_C
     (Item       : Wide_Wide_String;
      Append_Nul : Boolean := True) return char32_array
   is
   begin
      if Append_Nul then
         declare
            R : char32_array (0 .. Item'Length);
 
         begin
            for J in Item'Range loop
               R (size_t (J - Item'First)) := To_C (Item (J));
            end loop;
 
            R (R'Last) := char32_t'Val (0);
            return R;
         end;
 
      else
         --  A nasty case, if the string is null, we must return a null
         --  char32_array. The lower bound of this array is required to be zero
         --  (RM B.3(50)) but that is of course impossible given that size_t
         --  is unsigned. According to Ada 2005 AI-258, the result is to raise
         --  Constraint_Error.
 
         if Item'Length = 0 then
            raise Constraint_Error;
 
         else
            declare
               R : char32_array (0 .. Item'Length - 1);
 
            begin
               for J in size_t range 0 .. Item'Length - 1 loop
                  R (J) := To_C (Item (Integer (J) + Item'First));
               end loop;
 
               return R;
            end;
         end if;
      end if;
   end To_C;
 
   --  Convert Wide_Wide_String to char32_array (procedure form)
 
   procedure To_C
     (Item       : Wide_Wide_String;
      Target     : out char32_array;
      Count      : out size_t;
      Append_Nul : Boolean := True)
   is
      To : size_t;
 
   begin
      if Target'Length < Item'Length then
         raise Constraint_Error;
 
      else
         To := Target'First;
         for From in Item'Range loop
            Target (To) := To_C (Item (From));
            To := To + 1;
         end loop;
 
         if Append_Nul then
            if To > Target'Last then
               raise Constraint_Error;
            else
               Target (To) := char32_t'Val (0);
               Count := Item'Length + 1;
            end if;
 
         else
            Count := Item'Length;
         end if;
      end if;
   end To_C;
 
end Interfaces.C;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [i-c.adb] - Blame information for rev 753

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT COMPILER COMPONENTS --`
4			`-- --`
5			`-- I N T E R F A C E S . C --`
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			`package body Interfaces.C is`
33
34			`-----------------------`
35			`-- Is_Nul_Terminated --`
36			`-----------------------`
37
38			`-- Case of char_array`
39
40			`function Is_Nul_Terminated (Item : char_array) return Boolean is`
41			`begin`
42			`for J in Item'Range loop`
43			`if Item (J) = nul then`
44			`return True;`
45			`end if;`
46			`end loop;`
47
48			`return False;`
49			`end Is_Nul_Terminated;`
50
51			`-- Case of wchar_array`
52
53			`function Is_Nul_Terminated (Item : wchar_array) return Boolean is`
54			`begin`
55			`for J in Item'Range loop`
56			`if Item (J) = wide_nul then`
57			`return True;`
58			`end if;`
59			`end loop;`
60
61			`return False;`
62			`end Is_Nul_Terminated;`
63
64			`-- Case of char16_array`
65
66			`function Is_Nul_Terminated (Item : char16_array) return Boolean is`
67			`begin`
68			`for J in Item'Range loop`
69			`if Item (J) = char16_nul then`
70			`return True;`
71			`end if;`
72			`end loop;`
73
74			`return False;`
75			`end Is_Nul_Terminated;`
76
77			`-- Case of char32_array`
78
79			`function Is_Nul_Terminated (Item : char32_array) return Boolean is`
80			`begin`
81			`for J in Item'Range loop`
82			`if Item (J) = char32_nul then`
83			`return True;`
84			`end if;`
85			`end loop;`
86
87			`return False;`
88			`end Is_Nul_Terminated;`
89
90			`------------`
91			`-- To_Ada --`
92			`------------`
93
94			`-- Convert char to Character`
95
96			`function To_Ada (Item : char) return Character is`
97			`begin`
98			`return Character'Val (char'Pos (Item));`
99			`end To_Ada;`
100
101			`-- Convert char_array to String (function form)`
102
103			`function To_Ada`
104			`(Item : char_array;`
105			`Trim_Nul : Boolean := True) return String`
106			`is`
107			`Count : Natural;`
108			`From : size_t;`
109
110			`begin`
111			`if Trim_Nul then`
112			`From := Item'First;`
113
114			`loop`
115			`if From > Item'Last then`
116			`raise Terminator_Error;`
117			`elsif Item (From) = nul then`
118			`exit;`
119			`else`
120			`From := From + 1;`
121			`end if;`
122			`end loop;`
123
124			`Count := Natural (From - Item'First);`
125
126			`else`
127			`Count := Item'Length;`
128			`end if;`
129
130			`declare`
131			`R : String (1 .. Count);`
132
133			`begin`
134			`for J in R'Range loop`
135			`R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));`
136			`end loop;`
137
138			`return R;`
139			`end;`
140			`end To_Ada;`
141
142			`-- Convert char_array to String (procedure form)`
143
144			`procedure To_Ada`
145			`(Item : char_array;`
146			`Target : out String;`
147			`Count : out Natural;`
148			`Trim_Nul : Boolean := True)`
149			`is`
150			`From : size_t;`
151			`To : Positive;`
152
153			`begin`
154			`if Trim_Nul then`
155			`From := Item'First;`
156			`loop`
157			`if From > Item'Last then`
158			`raise Terminator_Error;`
159			`elsif Item (From) = nul then`
160			`exit;`
161			`else`
162			`From := From + 1;`
163			`end if;`
164			`end loop;`
165
166			`Count := Natural (From - Item'First);`
167
168			`else`
169			`Count := Item'Length;`
170			`end if;`
171
172			`if Count > Target'Length then`
173			`raise Constraint_Error;`
174
175			`else`
176			`From := Item'First;`
177			`To := Target'First;`
178
179			`for J in 1 .. Count loop`
180			`Target (To) := Character (Item (From));`
181			`From := From + 1;`
182			`To := To + 1;`
183			`end loop;`
184			`end if;`
185
186			`end To_Ada;`
187
188			`-- Convert wchar_t to Wide_Character`
189
190			`function To_Ada (Item : wchar_t) return Wide_Character is`
191			`begin`
192			`return Wide_Character (Item);`
193			`end To_Ada;`
194
195			`-- Convert wchar_array to Wide_String (function form)`
196
197			`function To_Ada`
198			`(Item : wchar_array;`
199			`Trim_Nul : Boolean := True) return Wide_String`
200			`is`
201			`Count : Natural;`
202			`From : size_t;`
203
204			`begin`
205			`if Trim_Nul then`
206			`From := Item'First;`
207
208			`loop`
209			`if From > Item'Last then`
210			`raise Terminator_Error;`
211			`elsif Item (From) = wide_nul then`
212			`exit;`
213			`else`
214			`From := From + 1;`
215			`end if;`
216			`end loop;`
217
218			`Count := Natural (From - Item'First);`
219
220			`else`
221			`Count := Item'Length;`
222			`end if;`
223
224			`declare`
225			`R : Wide_String (1 .. Count);`
226
227			`begin`
228			`for J in R'Range loop`
229			`R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));`
230			`end loop;`
231
232			`return R;`
233			`end;`
234			`end To_Ada;`
235
236			`-- Convert wchar_array to Wide_String (procedure form)`
237
238			`procedure To_Ada`
239			`(Item : wchar_array;`
240			`Target : out Wide_String;`
241			`Count : out Natural;`
242			`Trim_Nul : Boolean := True)`
243			`is`
244			`From : size_t;`
245			`To : Positive;`
246
247			`begin`
248			`if Trim_Nul then`
249			`From := Item'First;`
250			`loop`
251			`if From > Item'Last then`
252			`raise Terminator_Error;`
253			`elsif Item (From) = wide_nul then`
254			`exit;`
255			`else`
256			`From := From + 1;`
257			`end if;`
258			`end loop;`
259
260			`Count := Natural (From - Item'First);`
261
262			`else`
263			`Count := Item'Length;`
264			`end if;`
265
266			`if Count > Target'Length then`
267			`raise Constraint_Error;`
268
269			`else`
270			`From := Item'First;`
271			`To := Target'First;`
272
273			`for J in 1 .. Count loop`
274			`Target (To) := To_Ada (Item (From));`
275			`From := From + 1;`
276			`To := To + 1;`
277			`end loop;`
278			`end if;`
279			`end To_Ada;`
280
281			`-- Convert char16_t to Wide_Character`
282
283			`function To_Ada (Item : char16_t) return Wide_Character is`
284			`begin`
285			`return Wide_Character'Val (char16_t'Pos (Item));`
286			`end To_Ada;`
287
288			`-- Convert char16_array to Wide_String (function form)`
289
290			`function To_Ada`
291			`(Item : char16_array;`
292			`Trim_Nul : Boolean := True) return Wide_String`
293			`is`
294			`Count : Natural;`
295			`From : size_t;`
296
297			`begin`
298			`if Trim_Nul then`
299			`From := Item'First;`
300
301			`loop`
302			`if From > Item'Last then`
303			`raise Terminator_Error;`
304			`elsif Item (From) = char16_t'Val (0) then`
305			`exit;`
306			`else`
307			`From := From + 1;`
308			`end if;`
309			`end loop;`
310
311			`Count := Natural (From - Item'First);`
312
313			`else`
314			`Count := Item'Length;`
315			`end if;`
316
317			`declare`
318			`R : Wide_String (1 .. Count);`
319
320			`begin`
321			`for J in R'Range loop`
322			`R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));`
323			`end loop;`
324
325			`return R;`
326			`end;`
327			`end To_Ada;`
328
329			`-- Convert char16_array to Wide_String (procedure form)`
330
331			`procedure To_Ada`
332			`(Item : char16_array;`
333			`Target : out Wide_String;`
334			`Count : out Natural;`
335			`Trim_Nul : Boolean := True)`
336			`is`
337			`From : size_t;`
338			`To : Positive;`
339
340			`begin`
341			`if Trim_Nul then`
342			`From := Item'First;`
343			`loop`
344			`if From > Item'Last then`
345			`raise Terminator_Error;`
346			`elsif Item (From) = char16_t'Val (0) then`
347			`exit;`
348			`else`
349			`From := From + 1;`
350			`end if;`
351			`end loop;`
352
353			`Count := Natural (From - Item'First);`
354
355			`else`
356			`Count := Item'Length;`
357			`end if;`
358
359			`if Count > Target'Length then`
360			`raise Constraint_Error;`
361
362			`else`
363			`From := Item'First;`
364			`To := Target'First;`
365
366			`for J in 1 .. Count loop`
367			`Target (To) := To_Ada (Item (From));`
368			`From := From + 1;`
369			`To := To + 1;`
370			`end loop;`
371			`end if;`
372			`end To_Ada;`
373
374			`-- Convert char32_t to Wide_Wide_Character`
375
376			`function To_Ada (Item : char32_t) return Wide_Wide_Character is`
377			`begin`
378			`return Wide_Wide_Character'Val (char32_t'Pos (Item));`
379			`end To_Ada;`
380
381			`-- Convert char32_array to Wide_Wide_String (function form)`
382
383			`function To_Ada`
384			`(Item : char32_array;`
385			`Trim_Nul : Boolean := True) return Wide_Wide_String`
386			`is`
387			`Count : Natural;`
388			`From : size_t;`
389
390			`begin`
391			`if Trim_Nul then`
392			`From := Item'First;`
393
394			`loop`
395			`if From > Item'Last then`
396			`raise Terminator_Error;`
397			`elsif Item (From) = char32_t'Val (0) then`
398			`exit;`
399			`else`
400			`From := From + 1;`
401			`end if;`
402			`end loop;`
403
404			`Count := Natural (From - Item'First);`
405
406			`else`
407			`Count := Item'Length;`
408			`end if;`
409
410			`declare`
411			`R : Wide_Wide_String (1 .. Count);`
412
413			`begin`
414			`for J in R'Range loop`
415			`R (J) := To_Ada (Item (size_t (J) + (Item'First - 1)));`
416			`end loop;`
417
418			`return R;`
419			`end;`
420			`end To_Ada;`
421
422			`-- Convert char32_array to Wide_Wide_String (procedure form)`
423
424			`procedure To_Ada`
425			`(Item : char32_array;`
426			`Target : out Wide_Wide_String;`
427			`Count : out Natural;`
428			`Trim_Nul : Boolean := True)`
429			`is`
430			`From : size_t;`
431			`To : Positive;`
432
433			`begin`
434			`if Trim_Nul then`
435			`From := Item'First;`
436			`loop`
437			`if From > Item'Last then`
438			`raise Terminator_Error;`
439			`elsif Item (From) = char32_t'Val (0) then`
440			`exit;`
441			`else`
442			`From := From + 1;`
443			`end if;`
444			`end loop;`
445
446			`Count := Natural (From - Item'First);`
447
448			`else`
449			`Count := Item'Length;`
450			`end if;`
451
452			`if Count > Target'Length then`
453			`raise Constraint_Error;`
454
455			`else`
456			`From := Item'First;`
457			`To := Target'First;`
458
459			`for J in 1 .. Count loop`
460			`Target (To) := To_Ada (Item (From));`
461			`From := From + 1;`
462			`To := To + 1;`
463			`end loop;`
464			`end if;`
465			`end To_Ada;`
466
467			`----------`
468			`-- To_C --`
469			`----------`
470
471			`-- Convert Character to char`
472
473			`function To_C (Item : Character) return char is`
474			`begin`
475			`return char'Val (Character'Pos (Item));`
476			`end To_C;`
477
478			`-- Convert String to char_array (function form)`
479
480			`function To_C`
481			`(Item : String;`
482			`Append_Nul : Boolean := True) return char_array`
483			`is`
484			`begin`
485			`if Append_Nul then`
486			`declare`
487			`R : char_array (0 .. Item'Length);`
488
489			`begin`
490			`for J in Item'Range loop`
491			`R (size_t (J - Item'First)) := To_C (Item (J));`
492			`end loop;`
493
494			`R (R'Last) := nul;`
495			`return R;`
496			`end;`
497
498			`-- Append_Nul False`
499
500			`else`
501			`-- A nasty case, if the string is null, we must return a null`
502			`-- char_array. The lower bound of this array is required to be zero`
503			`-- (RM B.3(50)) but that is of course impossible given that size_t`
504			`-- is unsigned. According to Ada 2005 AI-258, the result is to raise`
505			`-- Constraint_Error. This is also the appropriate behavior in Ada 95,`
506			`-- since nothing else makes sense.`
507
508			`if Item'Length = 0 then`
509			`raise Constraint_Error;`
510
511			`-- Normal case`
512
513			`else`
514			`declare`
515			`R : char_array (0 .. Item'Length - 1);`
516
517			`begin`
518			`for J in Item'Range loop`
519			`R (size_t (J - Item'First)) := To_C (Item (J));`
520			`end loop;`
521
522			`return R;`
523			`end;`
524			`end if;`
525			`end if;`
526			`end To_C;`
527
528			`-- Convert String to char_array (procedure form)`
529
530			`procedure To_C`
531			`(Item : String;`
532			`Target : out char_array;`
533			`Count : out size_t;`
534			`Append_Nul : Boolean := True)`
535			`is`
536			`To : size_t;`
537
538			`begin`
539			`if Target'Length < Item'Length then`
540			`raise Constraint_Error;`
541
542			`else`
543			`To := Target'First;`
544			`for From in Item'Range loop`
545			`Target (To) := char (Item (From));`
546			`To := To + 1;`
547			`end loop;`
548
549			`if Append_Nul then`
550			`if To > Target'Last then`
551			`raise Constraint_Error;`
552			`else`
553			`Target (To) := nul;`
554			`Count := Item'Length + 1;`
555			`end if;`
556
557			`else`
558			`Count := Item'Length;`
559			`end if;`
560			`end if;`
561			`end To_C;`
562
563			`-- Convert Wide_Character to wchar_t`
564
565			`function To_C (Item : Wide_Character) return wchar_t is`
566			`begin`
567			`return wchar_t (Item);`
568			`end To_C;`
569
570			`-- Convert Wide_String to wchar_array (function form)`
571
572			`function To_C`
573			`(Item : Wide_String;`
574			`Append_Nul : Boolean := True) return wchar_array`
575			`is`
576			`begin`
577			`if Append_Nul then`
578			`declare`
579			`R : wchar_array (0 .. Item'Length);`
580
581			`begin`
582			`for J in Item'Range loop`
583			`R (size_t (J - Item'First)) := To_C (Item (J));`
584			`end loop;`
585
586			`R (R'Last) := wide_nul;`
587			`return R;`
588			`end;`
589
590			`else`
591			`-- A nasty case, if the string is null, we must return a null`
592			`-- wchar_array. The lower bound of this array is required to be zero`
593			`-- (RM B.3(50)) but that is of course impossible given that size_t`
594			`-- is unsigned. According to Ada 2005 AI-258, the result is to raise`
595			`-- Constraint_Error. This is also the appropriate behavior in Ada 95,`
596			`-- since nothing else makes sense.`
597
598			`if Item'Length = 0 then`
599			`raise Constraint_Error;`
600
601			`else`
602			`declare`
603			`R : wchar_array (0 .. Item'Length - 1);`
604
605			`begin`
606			`for J in size_t range 0 .. Item'Length - 1 loop`
607			`R (J) := To_C (Item (Integer (J) + Item'First));`
608			`end loop;`
609
610			`return R;`
611			`end;`
612			`end if;`
613			`end if;`
614			`end To_C;`
615
616			`-- Convert Wide_String to wchar_array (procedure form)`
617
618			`procedure To_C`
619			`(Item : Wide_String;`
620			`Target : out wchar_array;`
621			`Count : out size_t;`
622			`Append_Nul : Boolean := True)`
623			`is`
624			`To : size_t;`
625
626			`begin`
627			`if Target'Length < Item'Length then`
628			`raise Constraint_Error;`
629
630			`else`
631			`To := Target'First;`
632			`for From in Item'Range loop`
633			`Target (To) := To_C (Item (From));`
634			`To := To + 1;`
635			`end loop;`
636
637			`if Append_Nul then`
638			`if To > Target'Last then`
639			`raise Constraint_Error;`
640			`else`
641			`Target (To) := wide_nul;`
642			`Count := Item'Length + 1;`
643			`end if;`
644
645			`else`
646			`Count := Item'Length;`
647			`end if;`
648			`end if;`
649			`end To_C;`
650
651			`-- Convert Wide_Character to char16_t`
652
653			`function To_C (Item : Wide_Character) return char16_t is`
654			`begin`
655			`return char16_t'Val (Wide_Character'Pos (Item));`
656			`end To_C;`
657
658			`-- Convert Wide_String to char16_array (function form)`
659
660			`function To_C`
661			`(Item : Wide_String;`
662			`Append_Nul : Boolean := True) return char16_array`
663			`is`
664			`begin`
665			`if Append_Nul then`
666			`declare`
667			`R : char16_array (0 .. Item'Length);`
668
669			`begin`
670			`for J in Item'Range loop`
671			`R (size_t (J - Item'First)) := To_C (Item (J));`
672			`end loop;`
673
674			`R (R'Last) := char16_t'Val (0);`
675			`return R;`
676			`end;`
677
678			`else`
679			`-- A nasty case, if the string is null, we must return a null`
680			`-- char16_array. The lower bound of this array is required to be zero`
681			`-- (RM B.3(50)) but that is of course impossible given that size_t`
682			`-- is unsigned. According to Ada 2005 AI-258, the result is to raise`
683			`-- Constraint_Error. This is also the appropriate behavior in Ada 95,`
684			`-- since nothing else makes sense.`
685
686			`if Item'Length = 0 then`
687			`raise Constraint_Error;`
688
689			`else`
690			`declare`
691			`R : char16_array (0 .. Item'Length - 1);`
692
693			`begin`
694			`for J in size_t range 0 .. Item'Length - 1 loop`
695			`R (J) := To_C (Item (Integer (J) + Item'First));`
696			`end loop;`
697
698			`return R;`
699			`end;`
700			`end if;`
701			`end if;`
702			`end To_C;`
703
704			`-- Convert Wide_String to char16_array (procedure form)`
705
706			`procedure To_C`
707			`(Item : Wide_String;`
708			`Target : out char16_array;`
709			`Count : out size_t;`
710			`Append_Nul : Boolean := True)`
711			`is`
712			`To : size_t;`
713
714			`begin`
715			`if Target'Length < Item'Length then`
716			`raise Constraint_Error;`
717
718			`else`
719			`To := Target'First;`
720			`for From in Item'Range loop`
721			`Target (To) := To_C (Item (From));`
722			`To := To + 1;`
723			`end loop;`
724
725			`if Append_Nul then`
726			`if To > Target'Last then`
727			`raise Constraint_Error;`
728			`else`
729			`Target (To) := char16_t'Val (0);`
730			`Count := Item'Length + 1;`
731			`end if;`
732
733			`else`
734			`Count := Item'Length;`
735			`end if;`
736			`end if;`
737			`end To_C;`
738
739			`-- Convert Wide_Character to char32_t`
740
741			`function To_C (Item : Wide_Wide_Character) return char32_t is`
742			`begin`
743			`return char32_t'Val (Wide_Wide_Character'Pos (Item));`
744			`end To_C;`
745
746			`-- Convert Wide_Wide_String to char32_array (function form)`
747
748			`function To_C`
749			`(Item : Wide_Wide_String;`
750			`Append_Nul : Boolean := True) return char32_array`
751			`is`
752			`begin`
753			`if Append_Nul then`
754			`declare`
755			`R : char32_array (0 .. Item'Length);`
756
757			`begin`
758			`for J in Item'Range loop`
759			`R (size_t (J - Item'First)) := To_C (Item (J));`
760			`end loop;`
761
762			`R (R'Last) := char32_t'Val (0);`
763			`return R;`
764			`end;`
765
766			`else`
767			`-- A nasty case, if the string is null, we must return a null`
768			`-- char32_array. The lower bound of this array is required to be zero`
769			`-- (RM B.3(50)) but that is of course impossible given that size_t`
770			`-- is unsigned. According to Ada 2005 AI-258, the result is to raise`
771			`-- Constraint_Error.`
772
773			`if Item'Length = 0 then`
774			`raise Constraint_Error;`
775
776			`else`
777			`declare`
778			`R : char32_array (0 .. Item'Length - 1);`
779
780			`begin`
781			`for J in size_t range 0 .. Item'Length - 1 loop`
782			`R (J) := To_C (Item (Integer (J) + Item'First));`
783			`end loop;`
784
785			`return R;`
786			`end;`
787			`end if;`
788			`end if;`
789			`end To_C;`
790
791			`-- Convert Wide_Wide_String to char32_array (procedure form)`
792
793			`procedure To_C`
794			`(Item : Wide_Wide_String;`
795			`Target : out char32_array;`
796			`Count : out size_t;`
797			`Append_Nul : Boolean := True)`
798			`is`
799			`To : size_t;`
800
801			`begin`
802			`if Target'Length < Item'Length then`
803			`raise Constraint_Error;`
804
805			`else`
806			`To := Target'First;`
807			`for From in Item'Range loop`
808			`Target (To) := To_C (Item (From));`
809			`To := To + 1;`
810			`end loop;`
811
812			`if Append_Nul then`
813			`if To > Target'Last then`
814			`raise Constraint_Error;`
815			`else`
816			`Target (To) := char32_t'Val (0);`
817			`Count := Item'Length + 1;`
818			`end if;`
819
820			`else`
821			`Count := Item'Length;`
822			`end if;`
823			`end if;`
824			`end To_C;`
825
826			`end Interfaces.C;`