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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [i-c.adb] - Blame information for rev 16

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-2005 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 2,  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.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- 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 scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [i-c.adb] - Blame information for rev 16

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