diff options
Diffstat (limited to 'gcc/ada/i-c.adb')
| -rw-r--r-- | gcc/ada/i-c.adb | 826 |
1 files changed, 0 insertions, 826 deletions
diff --git a/gcc/ada/i-c.adb b/gcc/ada/i-c.adb deleted file mode 100644 index 01d6912..0000000 --- a/gcc/ada/i-c.adb +++ /dev/null @@ -1,826 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; |