HAOUAS Elyes has uploaded this change for review. ( https://review.coreboot.org/c/coreboot/+/37574 )
Change subject: lib/gnat: (test)Update files to latest version ......................................................................
lib/gnat: (test)Update files to latest version
Change-Id: I6436beea84cd301d5c992ee1c7720260019add87 Signed-off-by: Elyes HAOUAS ehaouas@noos.fr --- M src/lib/gnat/a-unccon.ads M src/lib/gnat/ada.ads M src/lib/gnat/g-souinf.ads M src/lib/gnat/gnat.ads M src/lib/gnat/i-c.adb M src/lib/gnat/i-c.ads M src/lib/gnat/interfac.ads M src/lib/gnat/s-atacco.ads M src/lib/gnat/s-imenne.adb M src/lib/gnat/s-imenne.ads M src/lib/gnat/s-maccod.ads M src/lib/gnat/s-parame.ads M src/lib/gnat/s-stoele.adb M src/lib/gnat/s-stoele.ads M src/lib/gnat/s-unstyp.ads M src/lib/gnat/system.ads 16 files changed, 1,125 insertions(+), 21 deletions(-)
git pull ssh://review.coreboot.org:29418/coreboot refs/changes/74/37574/1
diff --git a/src/lib/gnat/a-unccon.ads b/src/lib/gnat/a-unccon.ads index ffa84d9..a8429c1 100644 --- a/src/lib/gnat/a-unccon.ads +++ b/src/lib/gnat/a-unccon.ads @@ -19,5 +19,6 @@
function Ada.Unchecked_Conversion (S : Source) return Target;
-pragma Pure (Unchecked_Conversion); -pragma Import (Intrinsic, Unchecked_Conversion); +pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion); +pragma Pure (Ada.Unchecked_Conversion); +pragma Import (Intrinsic, Ada.Unchecked_Conversion); diff --git a/src/lib/gnat/ada.ads b/src/lib/gnat/ada.ads index 8c86011..4c2a3d0 100644 --- a/src/lib/gnat/ada.ads +++ b/src/lib/gnat/ada.ads @@ -14,6 +14,7 @@ ------------------------------------------------------------------------------
package Ada is + pragma No_Elaboration_Code_All; pragma Pure;
end Ada; diff --git a/src/lib/gnat/g-souinf.ads b/src/lib/gnat/g-souinf.ads index 610db23..bdd27a5 100644 --- a/src/lib/gnat/g-souinf.ads +++ b/src/lib/gnat/g-souinf.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2019, 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- -- @@ -79,6 +79,10 @@ -- package itself. This is useful in identifying and logging information -- from within generic templates.
+ function Compilation_ISO_Date return String with + Import, Convention => Intrinsic; + -- Returns date of compilation as a static string "yyyy-mm-dd". + function Compilation_Date return String with Import, Convention => Intrinsic; -- Returns date of compilation as a static string "mmm dd yyyy". This is diff --git a/src/lib/gnat/gnat.ads b/src/lib/gnat/gnat.ads index a0807b6..ffcb725 100644 --- a/src/lib/gnat/gnat.ads +++ b/src/lib/gnat/gnat.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, AdaCore -- +-- Copyright (C) 1992-2019, AdaCore -- -- -- -- 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- -- @@ -34,4 +34,24 @@ package GNAT is pragma Pure;
+ -- The following type denotes the range of buckets for various hashed + -- data structures in the GNAT unit hierarchy. + + type Bucket_Range_Type is mod 2 ** 32; + + -- The following exception is raised whenever an attempt is made to mutate + -- the state of a data structure that is being iterated on. + + Iterated : exception; + + -- The following exception is raised when an iterator is exhausted and + -- further attempts are made to advance it. + + Iterator_Exhausted : exception; + + -- The following exception is raised whenever an attempt is made to mutate + -- the state of a data structure that has not been created yet. + + Not_Created : exception; + end GNAT; diff --git a/src/lib/gnat/i-c.adb b/src/lib/gnat/i-c.adb index 6926a9e..2e651b6 100644 --- a/src/lib/gnat/i-c.adb +++ b/src/lib/gnat/i-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -48,6 +48,45 @@ 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 -- ------------ @@ -59,6 +98,372 @@ 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 -- ---------- @@ -70,4 +475,352 @@ 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; diff --git a/src/lib/gnat/i-c.ads b/src/lib/gnat/i-c.ads index 1403fce..1088836 100644 --- a/src/lib/gnat/i-c.ads +++ b/src/lib/gnat/i-c.ads @@ -59,6 +59,12 @@
type size_t is mod 2 ** System.Parameters.ptr_bits;
+ -- Floating-Point + + type C_float is new Float; + type double is new Standard.Long_Float; + type long_double is new Standard.Long_Long_Float; + ---------------------------- -- Characters and Strings -- ---------------------------- @@ -75,4 +81,150 @@
function Is_Nul_Terminated (Item : char_array) return Boolean;
+ function To_C + (Item : String; + Append_Nul : Boolean := True) return char_array; + + function To_Ada + (Item : char_array; + Trim_Nul : Boolean := True) return String; + + procedure To_C + (Item : String; + Target : out char_array; + Count : out size_t; + Append_Nul : Boolean := True); + + procedure To_Ada + (Item : char_array; + Target : out String; + Count : out Natural; + Trim_Nul : Boolean := True); + + ------------------------------------ + -- Wide Character and Wide String -- + ------------------------------------ + + type wchar_t is new Wide_Character; + for wchar_t'Size use Standard'Wchar_T_Size; + + wide_nul : constant wchar_t := wchar_t'First; + + function To_C (Item : Wide_Character) return wchar_t; + function To_Ada (Item : wchar_t) return Wide_Character; + + type wchar_array is array (size_t range <>) of aliased wchar_t; + + function Is_Nul_Terminated (Item : wchar_array) return Boolean; + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return wchar_array; + + function To_Ada + (Item : wchar_array; + Trim_Nul : Boolean := True) return Wide_String; + + procedure To_C + (Item : Wide_String; + Target : out wchar_array; + Count : out size_t; + Append_Nul : Boolean := True); + + procedure To_Ada + (Item : wchar_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True); + + Terminator_Error : exception; + + -- The remaining declarations are for Ada 2005 (AI-285) + + -- ISO/IEC 10646:2003 compatible types defined by SC22/WG14 document N1010 + + type char16_t is new Wide_Character; + pragma Ada_05 (char16_t); + + char16_nul : constant char16_t := char16_t'Val (0); + pragma Ada_05 (char16_nul); + + function To_C (Item : Wide_Character) return char16_t; + pragma Ada_05 (To_C); + + function To_Ada (Item : char16_t) return Wide_Character; + pragma Ada_05 (To_Ada); + + type char16_array is array (size_t range <>) of aliased char16_t; + pragma Ada_05 (char16_array); + + function Is_Nul_Terminated (Item : char16_array) return Boolean; + pragma Ada_05 (Is_Nul_Terminated); + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return char16_array; + pragma Ada_05 (To_C); + + function To_Ada + (Item : char16_array; + Trim_Nul : Boolean := True) return Wide_String; + pragma Ada_05 (To_Ada); + + procedure To_C + (Item : Wide_String; + Target : out char16_array; + Count : out size_t; + Append_Nul : Boolean := True); + pragma Ada_05 (To_C); + + procedure To_Ada + (Item : char16_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True); + pragma Ada_05 (To_Ada); + + type char32_t is new Wide_Wide_Character; + pragma Ada_05 (char32_t); + + char32_nul : constant char32_t := char32_t'Val (0); + pragma Ada_05 (char32_nul); + + function To_C (Item : Wide_Wide_Character) return char32_t; + pragma Ada_05 (To_C); + + function To_Ada (Item : char32_t) return Wide_Wide_Character; + pragma Ada_05 (To_Ada); + + type char32_array is array (size_t range <>) of aliased char32_t; + pragma Ada_05 (char32_array); + + function Is_Nul_Terminated (Item : char32_array) return Boolean; + pragma Ada_05 (Is_Nul_Terminated); + + function To_C + (Item : Wide_Wide_String; + Append_Nul : Boolean := True) return char32_array; + pragma Ada_05 (To_C); + + function To_Ada + (Item : char32_array; + Trim_Nul : Boolean := True) return Wide_Wide_String; + pragma Ada_05 (To_Ada); + + procedure To_C + (Item : Wide_Wide_String; + Target : out char32_array; + Count : out size_t; + Append_Nul : Boolean := True); + pragma Ada_05 (To_C); + + procedure To_Ada + (Item : char32_array; + Target : out Wide_Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True); + pragma Ada_05 (To_Ada); + end Interfaces.C; diff --git a/src/lib/gnat/interfac.ads b/src/lib/gnat/interfac.ads index e7e196c..829cd8e 100644 --- a/src/lib/gnat/interfac.ads +++ b/src/lib/gnat/interfac.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2019, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -36,6 +36,7 @@ pragma Compiler_Unit_Warning;
package Interfaces is + pragma No_Elaboration_Code_All; pragma Pure;
-- All identifiers in this unit are implementation defined @@ -65,6 +66,11 @@ type Unsigned_16 is mod 2 ** 16; for Unsigned_16'Size use 16;
+ type Unsigned_24 is mod 2 ** 24; + for Unsigned_24'Size use 24; + -- Declare this type for compatibility with legacy Ada compilers. + -- This is particularly useful in the context of CodePeer analysis. + type Unsigned_32 is mod 2 ** 32; for Unsigned_32'Size use 32;
@@ -158,4 +164,21 @@ pragma Import (Intrinsic, Rotate_Left); pragma Import (Intrinsic, Rotate_Right);
+ -- IEEE Floating point types + + type IEEE_Float_32 is digits 6; + for IEEE_Float_32'Size use 32; + + type IEEE_Float_64 is digits 15; + for IEEE_Float_64'Size use 64; + + -- If there is an IEEE extended float available on the machine, we assume + -- that it is available as Long_Long_Float. + + -- Note: it is harmless, and explicitly permitted, to include additional + -- types in interfaces, so it is not wrong to have IEEE_Extended_Float + -- defined even if the extended format is not available. + + type IEEE_Extended_Float is new Long_Long_Float; + end Interfaces; diff --git a/src/lib/gnat/s-atacco.ads b/src/lib/gnat/s-atacco.ads index fb6232d..2609998 100644 --- a/src/lib/gnat/s-atacco.ads +++ b/src/lib/gnat/s-atacco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- diff --git a/src/lib/gnat/s-imenne.adb b/src/lib/gnat/s-imenne.adb index 0c82dfd..bc77cd0 100644 --- a/src/lib/gnat/s-imenne.adb +++ b/src/lib/gnat/s-imenne.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2019, 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- -- @@ -50,7 +50,8 @@ pragma Assert (S'First = 1);
type Natural_8 is range 0 .. 2 ** 7 - 1; - type Index_Table is array (Natural) of Natural_8; + subtype Index is Natural range Natural'First .. Names'Length; + type Index_Table is array (Index) of Natural_8; type Index_Table_Ptr is access Index_Table;
function To_Index_Table_Ptr is @@ -80,7 +81,8 @@ pragma Assert (S'First = 1);
type Natural_16 is range 0 .. 2 ** 15 - 1; - type Index_Table is array (Natural) of Natural_16; + subtype Index is Natural range Natural'First .. Names'Length; + type Index_Table is array (Index) of Natural_16; type Index_Table_Ptr is access Index_Table;
function To_Index_Table_Ptr is @@ -110,7 +112,8 @@ pragma Assert (S'First = 1);
type Natural_32 is range 0 .. 2 ** 31 - 1; - type Index_Table is array (Natural) of Natural_32; + subtype Index is Natural range Natural'First .. Names'Length; + type Index_Table is array (Index) of Natural_32; type Index_Table_Ptr is access Index_Table;
function To_Index_Table_Ptr is diff --git a/src/lib/gnat/s-imenne.ads b/src/lib/gnat/s-imenne.ads index 3726720..0e661bf 100644 --- a/src/lib/gnat/s-imenne.ads +++ b/src/lib/gnat/s-imenne.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2019, 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- -- diff --git a/src/lib/gnat/s-maccod.ads b/src/lib/gnat/s-maccod.ads index a95e319..9f0dc46 100644 --- a/src/lib/gnat/s-maccod.ads +++ b/src/lib/gnat/s-maccod.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -34,6 +34,7 @@ -- for full details.
package System.Machine_Code is + pragma No_Elaboration_Code_All; pragma Pure;
-- All identifiers in this unit are implementation defined diff --git a/src/lib/gnat/s-parame.ads b/src/lib/gnat/s-parame.ads index 3bb8b10..92ea885 100644 --- a/src/lib/gnat/s-parame.ads +++ b/src/lib/gnat/s-parame.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -51,6 +51,55 @@ package System.Parameters is pragma Pure;
+ --------------------------------------- + -- Task And Stack Allocation Control -- + --------------------------------------- + + type Size_Type is range + -(2 ** (Integer'(Standard'Address_Size) - 1)) .. + +(2 ** (Integer'(Standard'Address_Size) - 1)) - 1; + -- Type used to provide task stack sizes to the runtime. Sized to permit + -- stack sizes of up to half the total addressable memory space. This may + -- seem excessively large (even for 32-bit systems), however there are many + -- instances of users requiring large stack sizes (for example string + -- processing). + + Unspecified_Size : constant Size_Type := Size_Type'First; + -- Value used to indicate that no size type is set + + function Default_Stack_Size return Size_Type; + -- Default task stack size used if none is specified + + function Minimum_Stack_Size return Size_Type; + -- Minimum task stack size permitted + + function Adjust_Storage_Size (Size : Size_Type) return Size_Type; + -- Given the storage size stored in the TCB, return the Storage_Size + -- value required by the RM for the Storage_Size attribute. The + -- required adjustment is as follows: + -- + -- when Size = Unspecified_Size, return Default_Stack_Size + -- when Size < Minimum_Stack_Size, return Minimum_Stack_Size + -- otherwise return given Size + + Default_Env_Stack_Size : constant Size_Type := 8_192_000; + -- Assumed size of the environment task, if no other information is + -- available. This value is used when stack checking is enabled and + -- no GNAT_STACK_LIMIT environment variable is set. + + Stack_Grows_Down : constant Boolean := True; + -- This constant indicates whether the stack grows up (False) or + -- down (True) in memory as functions are called. It is used for + -- proper implementation of the stack overflow check. + + Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; + -- The run-time chosen default size for secondary stacks that may be + -- overriden by the user with the use of binder -D switch. + + Sec_Stack_Dynamic : constant Boolean := True; + -- Indicates if secondary stacks can grow and shrink at run-time. If False, + -- the size of a secondary stack is fixed at the point of its creation. + ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- @@ -61,6 +110,89 @@ -- of all targets.
ptr_bits : constant := Standard'Address_Size; + subtype C_Address is System.Address; -- Number of bits in Interfaces.C pointers, normally a standard address
+ C_Malloc_Linkname : constant String := "__gnat_malloc"; + -- Name of runtime function used to allocate such a pointer + + ---------------------------------------------- + -- Behavior of Pragma Finalize_Storage_Only -- + ---------------------------------------------- + + -- Garbage_Collected is a Boolean constant whose value indicates the + -- effect of the pragma Finalize_Storage_Entry on a controlled type. + + -- Garbage_Collected = False + + -- The system releases all storage on program termination only, + -- but not other garbage collection occurs, so finalization calls + -- are omitted only for outer level objects can be omitted if + -- pragma Finalize_Storage_Only is used. + + -- Garbage_Collected = True + + -- The system provides full garbage collection, so it is never + -- necessary to release storage for controlled objects for which + -- a pragma Finalize_Storage_Only is used. + + Garbage_Collected : constant Boolean := False; + -- The storage mode for this system (release on program exit) + + --------------------- + -- Tasking Profile -- + --------------------- + + -- In the following sections, constant parameters are defined to + -- allow some optimizations and fine tuning within the tasking run time + -- based on restrictions on the tasking features. + + ---------------------- + -- Locking Strategy -- + ---------------------- + + Single_Lock : constant Boolean := False; + -- Indicates whether a single lock should be used within the tasking + -- run-time to protect internal structures. If True, a single lock + -- will be used, meaning less locking/unlocking operations, but also + -- more global contention. In general, Single_Lock should be set to + -- True on single processor machines, and to False to multi-processor + -- systems, but this can vary from application to application and also + -- depends on the scheduling policy. + + ------------------- + -- Task Abortion -- + ------------------- + + No_Abort : constant Boolean := False; + -- This constant indicates whether abort statements and asynchronous + -- transfer of control (ATC) are disallowed. If set to True, it is + -- assumed that neither construct is used, and the run time does not + -- need to defer/undefer abort and check for pending actions at + -- completion points. A value of True for No_Abort corresponds to: + -- pragma Restrictions (No_Abort_Statements); + -- pragma Restrictions (Max_Asynchronous_Select_Nesting => 0); + + --------------------- + -- Task Attributes -- + --------------------- + + Max_Attribute_Count : constant := 32; + -- Number of task attributes stored in the task control block + + ----------------------- + -- Task Image Length -- + ----------------------- + + Max_Task_Image_Length : constant := 256; + -- This constant specifies the maximum length of a task's image + + ------------------------------ + -- Exception Message Length -- + ------------------------------ + + Default_Exception_Msg_Max_Length : constant := 200; + -- This constant specifies the default number of characters to allow + -- in an exception message (200 is minimum required by RM 11.4.1(18)). + end System.Parameters; diff --git a/src/lib/gnat/s-stoele.adb b/src/lib/gnat/s-stoele.adb index 1cb5f92..8a00f7f 100644 --- a/src/lib/gnat/s-stoele.adb +++ b/src/lib/gnat/s-stoele.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- diff --git a/src/lib/gnat/s-stoele.ads b/src/lib/gnat/s-stoele.ads index bf773cb..cf9a826 100644 --- a/src/lib/gnat/s-stoele.ads +++ b/src/lib/gnat/s-stoele.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2019, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- diff --git a/src/lib/gnat/s-unstyp.ads b/src/lib/gnat/s-unstyp.ads index 9eefc15..08480b4 100644 --- a/src/lib/gnat/s-unstyp.ads +++ b/src/lib/gnat/s-unstyp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -39,6 +39,7 @@
package System.Unsigned_Types is pragma Pure; + pragma No_Elaboration_Code_All;
type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size; type Short_Unsigned is mod 2 ** Short_Integer'Size; @@ -59,6 +60,7 @@ type Packed_Bytes1 is array (Natural range <>) of aliased Packed_Byte; for Packed_Bytes1'Alignment use 1; for Packed_Bytes1'Component_Size use Packed_Byte'Size; + pragma Suppress_Initialization (Packed_Bytes1); -- This is the type used to implement packed arrays where no alignment -- is required. This includes the cases of 1,2,4 (where we use direct -- masking operations), and all odd component sizes (where the clusters @@ -67,6 +69,7 @@
type Packed_Bytes2 is new Packed_Bytes1; for Packed_Bytes2'Alignment use Integer'Min (2, Standard'Maximum_Alignment); + pragma Suppress_Initialization (Packed_Bytes2); -- This is the type used to implement packed arrays where an alignment -- of 2 (is possible) is helpful for maximum efficiency of the get and -- set routines in the corresponding library unit. This is true of all @@ -77,6 +80,7 @@
type Packed_Bytes4 is new Packed_Bytes1; for Packed_Bytes4'Alignment use Integer'Min (4, Standard'Maximum_Alignment); + pragma Suppress_Initialization (Packed_Bytes4); -- This is the type used to implement packed arrays where an alignment -- of 4 (if possible) is helpful for maximum efficiency of the get and -- set routines in the corresponding library unit. This is true of all diff --git a/src/lib/gnat/system.ads b/src/lib/gnat/system.ads index 74ced54..841ec34 100644 --- a/src/lib/gnat/system.ads +++ b/src/lib/gnat/system.ads @@ -5,9 +5,9 @@ -- S Y S T E M -- -- -- -- S p e c -- --- (LSH Version) -- +-- (Compiler Version) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -34,11 +34,21 @@ -- -- ------------------------------------------------------------------------------
-pragma Restrictions (No_Exception_Registration); +-- This version of System is a generic version that is used in building the +-- compiler. Right now, we have a host/target problem if we try to use the +-- "proper" System, and since the compiler itself does not care about most +-- System parameters, this generic version works fine.
pragma Restrictions (No_Implicit_Dynamic_Code); +-- We want to avoid trampolines in the compiler, so it can be used in systems +-- which prevent execution of code on the stack, e.g. in windows environments +-- with DEP (Data Execution Protection) enabled. + pragma Restrictions (No_Finalization); -pragma Restrictions (No_Tasking); +-- Use restriction No_Finalization to avoid pulling finalization (not allowed +-- in GNAT) inside sem_spark.adb, when defining type Perm_Tree_Access as an +-- access type on incomplete type Perm_Tree_Wrapper (which is required for +-- defining a recursive type).
package System is pragma Pure;
build bot (Jenkins) has posted comments on this change. ( https://review.coreboot.org/c/coreboot/+/37574 )
Change subject: lib/gnat: (test)Update files to latest version ......................................................................
Patch Set 1:
(1 comment)
https://review.coreboot.org/c/coreboot/+/37574/1/src/lib/gnat/s-parame.ads File src/lib/gnat/s-parame.ads:
https://review.coreboot.org/c/coreboot/+/37574/1/src/lib/gnat/s-parame.ads@9... PS1, Line 97: -- overriden by the user with the use of binder -D switch. 'overriden' may be misspelled - perhaps 'overridden'?
Hello build bot (Jenkins), Nico Huber,
I'd like you to reexamine a change. Please visit
https://review.coreboot.org/c/coreboot/+/37574
to look at the new patch set (#2).
Change subject: lib/gnat: (test)Update files to latest version ......................................................................
lib/gnat: (test)Update files to latest version
Change-Id: I6436beea84cd301d5c992ee1c7720260019add87 Signed-off-by: Elyes HAOUAS ehaouas@noos.fr --- M src/lib/gnat/a-unccon.ads M src/lib/gnat/ada.ads M src/lib/gnat/g-souinf.ads M src/lib/gnat/gnat.ads M src/lib/gnat/i-c.adb M src/lib/gnat/i-c.ads M src/lib/gnat/interfac.ads M src/lib/gnat/s-atacco.ads M src/lib/gnat/s-imenne.adb M src/lib/gnat/s-imenne.ads M src/lib/gnat/s-maccod.ads M src/lib/gnat/s-parame.ads M src/lib/gnat/s-stoele.adb M src/lib/gnat/s-stoele.ads M src/lib/gnat/s-unstyp.ads M src/lib/gnat/system.ads 16 files changed, 1,125 insertions(+), 21 deletions(-)
git pull ssh://review.coreboot.org:29418/coreboot refs/changes/74/37574/2
HAOUAS Elyes has abandoned this change. ( https://review.coreboot.org/c/coreboot/+/37574 )
Change subject: lib/gnat: (test)Update files to latest version ......................................................................
Abandoned
-
build bot (Jenkins) (Code Review) -
HAOUAS Elyes (Code Review)