diff options
author | Robert Dewar <dewar@adacore.com> | 2014-08-01 08:17:20 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-01 10:17:20 +0200 |
commit | ea0c8cfb98bc575325f35f4798b2c657f4497e5e (patch) | |
tree | f67b75102f9fc406e9089148d3ba4caef87238c7 | |
parent | 62883e6b17b85341fbc9b35c51bc076d39dcec23 (diff) | |
download | gcc-ea0c8cfb98bc575325f35f4798b2c657f4497e5e.zip gcc-ea0c8cfb98bc575325f35f4798b2c657f4497e5e.tar.gz gcc-ea0c8cfb98bc575325f35f4798b2c657f4497e5e.tar.bz2 |
gnatchop.adb, [...]: Minor reformatting.
2014-08-01 Robert Dewar <dewar@adacore.com>
* gnatchop.adb, gnatcmd.adb, make.adb, mlib-prj.adb, bindgen.adb,
mlib.ads, butil.adb, clean.adb, binde.adb, gnatls.adb, gnatname.adb,
osint.adb, krunch.adb: Minor reformatting.
2014-08-01 Robert Dewar <dewar@adacore.com>
* inline.adb, inline.ads, fe.h, einfo.adb, einfo.ads, sem_util.adb,
sem_util.ads, exp_ch4.adb, exp_ch11.adb, exp_ch6.adb, cstand.adb,
sem_mech.adb, sem_ch6.adb, sem_ch8.adb, sem_ch11.adb, snames.ads-tmpl:
Remove VMS-specific code.
From-SVN: r213414
-rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
-rw-r--r-- | gcc/ada/binde.adb | 7 | ||||
-rw-r--r-- | gcc/ada/bindgen.adb | 26 | ||||
-rw-r--r-- | gcc/ada/butil.adb | 80 | ||||
-rw-r--r-- | gcc/ada/clean.adb | 8 | ||||
-rw-r--r-- | gcc/ada/cstand.adb | 19 | ||||
-rw-r--r-- | gcc/ada/einfo.adb | 46 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 36 | ||||
-rw-r--r-- | gcc/ada/exp_ch11.adb | 63 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 86 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 32 | ||||
-rw-r--r-- | gcc/ada/fe.h | 5 | ||||
-rw-r--r-- | gcc/ada/gnatchop.adb | 25 | ||||
-rw-r--r-- | gcc/ada/gnatcmd.adb | 3 | ||||
-rw-r--r-- | gcc/ada/gnatls.adb | 16 | ||||
-rw-r--r-- | gcc/ada/gnatname.adb | 7 | ||||
-rw-r--r-- | gcc/ada/inline.adb | 24 | ||||
-rw-r--r-- | gcc/ada/inline.ads | 10 | ||||
-rw-r--r-- | gcc/ada/krunch.adb | 1 | ||||
-rw-r--r-- | gcc/ada/make.adb | 5 | ||||
-rw-r--r-- | gcc/ada/mlib-prj.adb | 1 | ||||
-rw-r--r-- | gcc/ada/mlib.ads | 3 | ||||
-rw-r--r-- | gcc/ada/osint.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch11.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_mech.adb | 158 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 12 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 6 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 |
30 files changed, 144 insertions, 557 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 28cde03..83ae8cd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2014-08-01 Robert Dewar <dewar@adacore.com> + + * gnatchop.adb, gnatcmd.adb, make.adb, mlib-prj.adb, bindgen.adb, + mlib.ads, butil.adb, clean.adb, binde.adb, gnatls.adb, gnatname.adb, + osint.adb, krunch.adb: Minor reformatting. + +2014-08-01 Robert Dewar <dewar@adacore.com> + + * inline.adb, inline.ads, fe.h, einfo.adb, einfo.ads, sem_util.adb, + sem_util.ads, exp_ch4.adb, exp_ch11.adb, exp_ch6.adb, cstand.adb, + sem_mech.adb, sem_ch6.adb, sem_ch8.adb, sem_ch11.adb, snames.ads-tmpl: + Remove VMS-specific code. + 2014-08-01 Arnaud Charlet <charlet@adacore.com> * binde.adb, bindgen.adb, butil.adb, clean.adb, gnatbind.adb, diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index f22e53b..6c43ab8 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -1085,8 +1085,7 @@ package body Binde is -- Output warning if -p used with no -gnatE units - if Pessimistic_Elab_Order - and not Dynamic_Elaboration_Checks_Specified + if Pessimistic_Elab_Order and not Dynamic_Elaboration_Checks_Specified then Error_Msg ("?use of -p switch questionable"); Error_Msg ("?since all units compiled with static elaboration model"); @@ -1105,7 +1104,6 @@ package body Binde is -- Initialize the no predecessor list No_Pred := No_Unit_Id; - for U in UNR.First .. UNR.Last loop if UNR.Table (U).Num_Pred = 0 then UNR.Table (U).Nextnp := No_Pred; @@ -1216,8 +1214,7 @@ package body Binde is -- interfaces to stand-alone libraries. if not Units.Table (U).SAL_Interface then - for - W in Units.Table (U).First_With .. Units.Table (U).Last_With + for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop if Withs.Table (W).Sfile /= No_File and then (not Withs.Table (W).SAL_Interface) diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 6363e1b..553542e 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -321,16 +321,16 @@ package body Bindgen is -- Move routine for sorting linker options procedure Resolve_Binder_Options; - -- Set the value of With_GNARL. + -- Set the value of With_GNARL procedure Set_Char (C : Character); -- Set given character in Statement_Buffer at the Last + 1 position -- and increment Last by one to reflect the stored character. procedure Set_Int (N : Int); - -- Set given value in decimal in Statement_Buffer with no spaces - -- starting at the Last + 1 position, and updating Last past the value. - -- A minus sign is output for a negative value. + -- Set given value in decimal in Statement_Buffer with no spaces starting + -- at the Last + 1 position, and updating Last past the value. A minus sign + -- is output for a negative value. procedure Set_Boolean (B : Boolean); -- Set given boolean value in Statement_Buffer at the Last + 1 position @@ -340,9 +340,9 @@ package body Bindgen is -- Initializes contents of IS_Pragma_Settings table from ALI table procedure Set_Main_Program_Name; - -- Given the main program name in Name_Buffer (length in Name_Len) - -- generate the name of the routine to be used in the call. The name - -- is generated starting at Last + 1, and Last is updated past it. + -- Given the main program name in Name_Buffer (length in Name_Len) generate + -- the name of the routine to be used in the call. The name is generated + -- starting at Last + 1, and Last is updated past it. procedure Set_Name_Buffer; -- Set the value stored in positions 1 .. Name_Len of the Name_Buffer @@ -355,9 +355,9 @@ package body Bindgen is -- Last + 1 position, and updating last past the string value. procedure Set_String_Replace (S : String); - -- Replaces the last S'Length characters in the Statement_Buffer with - -- the characters of S. The caller must ensure that these characters do - -- in fact exist in the Statement_Buffer. + -- Replaces the last S'Length characters in the Statement_Buffer with the + -- characters of S. The caller must ensure that these characters do in fact + -- exist in the Statement_Buffer. type Qualification_Mode is (Dollar_Sign, Dot, Double_Underscores); @@ -368,9 +368,9 @@ package body Bindgen is -- underscores (__), a dollar sign ($) or left as is. procedure Set_Unit_Number (U : Unit_Id); - -- Sets unit number (first unit is 1, leading zeroes output to line - -- up all output unit numbers nicely as required by the value, and - -- by the total number of units. + -- Sets unit number (first unit is 1, leading zeroes output to line up all + -- output unit numbers nicely as required by the value, and by the total + -- number of units. procedure Write_Statement_Buffer; -- Write out contents of statement buffer up to Last, and reset Last to 0 diff --git a/gcc/ada/butil.adb b/gcc/ada/butil.adb index 8ca4994..3ac112a 100644 --- a/gcc/ada/butil.adb +++ b/gcc/ada/butil.adb @@ -37,10 +37,9 @@ package body Butil is function Is_Internal_Unit return Boolean is begin return Is_Predefined_Unit - or else (Name_Len > 4 - and then (Name_Buffer (1 .. 5) = "gnat%" - or else - Name_Buffer (1 .. 5) = "gnat.")); + or else (Name_Len > 4 and then (Name_Buffer (1 .. 5) = "gnat%" + or else + Name_Buffer (1 .. 5) = "gnat.")); end Is_Internal_Unit; ------------------------ @@ -51,54 +50,25 @@ package body Butil is -- is that it would drag too much junk into the binder. function Is_Predefined_Unit return Boolean is + L : Natural renames Name_Len; + B : String renames Name_Buffer; begin - return (Name_Len > 3 - and then Name_Buffer (1 .. 4) = "ada.") - - or else (Name_Len > 6 - and then Name_Buffer (1 .. 7) = "system.") - - or else (Name_Len > 10 - and then Name_Buffer (1 .. 11) = "interfaces.") - - or else (Name_Len > 3 - and then Name_Buffer (1 .. 4) = "ada%") - - or else (Name_Len > 8 - and then Name_Buffer (1 .. 9) = "calendar%") - - or else (Name_Len > 9 - and then Name_Buffer (1 .. 10) = "direct_io%") - - or else (Name_Len > 10 - and then Name_Buffer (1 .. 11) = "interfaces%") - - or else (Name_Len > 13 - and then Name_Buffer (1 .. 14) = "io_exceptions%") - - or else (Name_Len > 12 - and then Name_Buffer (1 .. 13) = "machine_code%") - - or else (Name_Len > 13 - and then Name_Buffer (1 .. 14) = "sequential_io%") - - or else (Name_Len > 6 - and then Name_Buffer (1 .. 7) = "system%") - - or else (Name_Len > 7 - and then Name_Buffer (1 .. 8) = "text_io%") - - or else (Name_Len > 20 - and then Name_Buffer (1 .. 21) = "unchecked_conversion%") - - or else (Name_Len > 22 - and then Name_Buffer (1 .. 23) = "unchecked_deallocation%") - - or else (Name_Len > 4 - and then Name_Buffer (1 .. 5) = "gnat%") - - or else (Name_Len > 4 - and then Name_Buffer (1 .. 5) = "gnat."); + return (L > 3 and then B (1 .. 4) = "ada.") + or else (L > 6 and then B (1 .. 7) = "system.") + or else (L > 10 and then B (1 .. 11) = "interfaces.") + or else (L > 3 and then B (1 .. 4) = "ada%") + or else (L > 8 and then B (1 .. 9) = "calendar%") + or else (L > 9 and then B (1 .. 10) = "direct_io%") + or else (L > 10 and then B (1 .. 11) = "interfaces%") + or else (L > 13 and then B (1 .. 14) = "io_exceptions%") + or else (L > 12 and then B (1 .. 13) = "machine_code%") + or else (L > 13 and then B (1 .. 14) = "sequential_io%") + or else (L > 6 and then B (1 .. 7) = "system%") + or else (L > 7 and then B (1 .. 8) = "text_io%") + or else (L > 20 and then B (1 .. 21) = "unchecked_conversion%") + or else (L > 22 and then B (1 .. 23) = "unchecked_deallocation%") + or else (L > 4 and then B (1 .. 5) = "gnat%") + or else (L > 4 and then B (1 .. 5) = "gnat."); end Is_Predefined_Unit; ---------------- @@ -111,7 +81,7 @@ package body Butil is declare U1_Name : constant String (1 .. Name_Len) := - Name_Buffer (1 .. Name_Len); + Name_Buffer (1 .. Name_Len); Min_Length : Natural; begin @@ -123,10 +93,10 @@ package body Butil is Min_Length := U1_Name'Last; end if; - for I in 1 .. Min_Length loop - if U1_Name (I) > Name_Buffer (I) then + for J in 1 .. Min_Length loop + if U1_Name (J) > Name_Buffer (J) then return False; - elsif U1_Name (I) < Name_Buffer (I) then + elsif U1_Name (J) < Name_Buffer (J) then return True; end if; end loop; diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index a41729a..999c735 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -55,8 +55,8 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body Clean is Initialized : Boolean := False; - -- Set to True by the first call to Initialize. - -- To avoid reinitialization of some packages. + -- Set to True by the first call to Initialize to avoid reinitialization + -- of some packages. -- Suffixes of various files @@ -66,10 +66,10 @@ package body Clean is Object_Suffix : constant String := Get_Target_Object_Suffix.all; Debug_Suffix : constant String := ".dg"; Repinfo_Suffix : constant String := ".rep"; - -- Suffix of representation info files. + -- Suffix of representation info files B_Start : constant String := "b~"; - -- Prefix of binder generated file, and number of actual characters used. + -- Prefix of binder generated file, and number of actual characters used Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data (Is_Root_Tree => True); diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 8261a41..2fe3576 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -467,10 +467,9 @@ package body CStand is procedure Build_Exception (S : Standard_Entity_Type) is begin - Set_Ekind (Standard_Entity (S), E_Exception); - Set_Etype (Standard_Entity (S), Standard_Exception_Type); - Set_Exception_Code (Standard_Entity (S), Uint_0); - Set_Is_Public (Standard_Entity (S), True); + Set_Ekind (Standard_Entity (S), E_Exception); + Set_Etype (Standard_Entity (S), Standard_Exception_Type); + Set_Is_Public (Standard_Entity (S), True); Decl := Make_Exception_Declaration (Stloc, @@ -1590,7 +1589,6 @@ package body CStand is E_Id := Standard_Entity (S_Numeric_Error); Set_Ekind (E_Id, E_Exception); - Set_Exception_Code (E_Id, Uint_0); Set_Etype (E_Id, Standard_Exception_Type); Set_Is_Public (E_Id); Set_Renamed_Entity (E_Id, Standard_Entity (S_Constraint_Error)); @@ -1607,12 +1605,11 @@ package body CStand is -- Abort_Signal is an entity that does not get made visible Abort_Signal := New_Standard_Entity; - Set_Chars (Abort_Signal, Name_uAbort_Signal); - Set_Ekind (Abort_Signal, E_Exception); - Set_Exception_Code (Abort_Signal, Uint_0); - Set_Etype (Abort_Signal, Standard_Exception_Type); - Set_Scope (Abort_Signal, Standard_Standard); - Set_Is_Public (Abort_Signal, True); + Set_Chars (Abort_Signal, Name_uAbort_Signal); + Set_Ekind (Abort_Signal, E_Exception); + Set_Etype (Abort_Signal, Standard_Exception_Type); + Set_Scope (Abort_Signal, Standard_Standard); + Set_Is_Public (Abort_Signal, True); Decl := Make_Exception_Declaration (Stloc, Defining_Identifier => Abort_Signal); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index a3e77a8..92fdff6 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -195,7 +195,6 @@ package body Einfo is -- Component_Size Uint22 -- Corresponding_Remote_Type Node22 -- Enumeration_Rep_Expr Node22 - -- Exception_Code Uint22 -- Original_Record_Component Node22 -- Private_View Node22 -- Protected_Formal Node22 @@ -412,8 +411,6 @@ package body Einfo is -- Is_Generic_Instance Flag130 -- No_Pool_Assigned Flag131 - -- Is_AST_Entry Flag132 - -- Is_VMS_Exception Flag133 -- Is_Optional_Parameter Flag134 -- Has_Aliased_Components Flag135 -- No_Strict_Aliasing Flag136 @@ -574,6 +571,9 @@ package body Einfo is -- (unused) Flag2 -- (unused) Flag3 + -- (unused) Flag132 + -- (unused) Flag133 + -- (unused) Flag275 -- (unused) Flag276 -- (unused) Flag277 @@ -1182,12 +1182,6 @@ package body Einfo is return Uint12 (Id); end Esize; - function Exception_Code (Id : E) return Uint is - begin - pragma Assert (Ekind (Id) = E_Exception); - return Uint22 (Id); - end Exception_Code; - function Extra_Accessibility (Id : E) return E is begin pragma Assert @@ -1901,12 +1895,6 @@ package body Einfo is return Flag15 (Id); end Is_Aliased; - function Is_AST_Entry (Id : E) return B is - begin - pragma Assert (Is_Entry (Id)); - return Flag132 (Id); - end Is_AST_Entry; - function Is_Asynchronous (Id : E) return B is begin pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id)); @@ -2420,11 +2408,6 @@ package body Einfo is return Flag116 (Id); end Is_Visible_Lib_Unit; - function Is_VMS_Exception (Id : E) return B is - begin - return Flag133 (Id); - end Is_VMS_Exception; - function Is_Volatile (Id : E) return B is begin pragma Assert (Nkind (Id) in N_Entity); @@ -3931,12 +3914,6 @@ package body Einfo is Set_Uint12 (Id, V); end Set_Esize; - procedure Set_Exception_Code (Id : E; V : U) is - begin - pragma Assert (Ekind (Id) = E_Exception); - Set_Uint22 (Id, V); - end Set_Exception_Code; - procedure Set_Extra_Accessibility (Id : E; V : E) is begin pragma Assert @@ -4677,12 +4654,6 @@ package body Einfo is Set_Flag15 (Id, V); end Set_Is_Aliased; - procedure Set_Is_AST_Entry (Id : E; V : B := True) is - begin - pragma Assert (Is_Entry (Id)); - Set_Flag132 (Id, V); - end Set_Is_AST_Entry; - procedure Set_Is_Asynchronous (Id : E; V : B := True) is begin pragma Assert @@ -5227,12 +5198,6 @@ package body Einfo is Set_Flag116 (Id, V); end Set_Is_Visible_Lib_Unit; - procedure Set_Is_VMS_Exception (Id : E; V : B := True) is - begin - pragma Assert (Ekind (Id) = E_Exception); - Set_Flag133 (Id, V); - end Set_Is_VMS_Exception; - procedure Set_Is_Volatile (Id : E; V : B := True) is begin pragma Assert (Nkind (Id) in N_Entity); @@ -8353,7 +8318,6 @@ package body Einfo is W ("In_Package_Body", Flag48 (Id)); W ("In_Private_Part", Flag45 (Id)); W ("In_Use", Flag8 (Id)); - W ("Is_AST_Entry", Flag132 (Id)); W ("Is_Abstract_Subprogram", Flag19 (Id)); W ("Is_Abstract_Type", Flag146 (Id)); W ("Is_Local_Anonymous_Access", Flag194 (Id)); @@ -8454,7 +8418,6 @@ package body Einfo is W ("Is_Unchecked_Union", Flag117 (Id)); W ("Is_Underlying_Record_View", Flag246 (Id)); W ("Is_Unsigned_Type", Flag144 (Id)); - W ("Is_VMS_Exception", Flag133 (Id)); W ("Is_Valued_Procedure", Flag127 (Id)); W ("Is_Visible_Formal", Flag206 (Id)); W ("Is_Visible_Lib_Unit", Flag116 (Id)); @@ -9307,9 +9270,6 @@ package body Einfo is when E_Enumeration_Literal => Write_Str ("Enumeration_Rep_Expr"); - when E_Exception => - Write_Str ("Exception_Code"); - when E_Record_Type_With_Private | E_Record_Subtype_With_Private | E_Private_Type | diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index b29821b..7bb4d9c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1148,13 +1148,6 @@ package Einfo is -- Note one obscure case: for pragma Default_Storage_Pool (null), the -- Etype of the N_Null node is Empty. --- Exception_Code (Uint22) --- Defined in exception entities. Set to zero unless either an --- Import_Exception or Export_Exception pragma applies to the --- pragma and specifies a Code value. See description of these --- pragmas for details. Note that this field is relevant only if --- Is_VMS_Exception is set. - -- Extra_Formal (Node15) -- Defined in formal parameters in the non-generic case. Certain -- parameters require extra implicit information to be passed (e.g. the @@ -2146,13 +2139,6 @@ package Einfo is -- carry the keyword aliased, and on record components that have the -- keyword. For Ada 2012, also applies to formal parameters. --- Is_AST_Entry (Flag132) --- Defined in entry entities. Set if a valid pragma AST_Entry applies --- to the entry. This flag can only be set in OpenVMS versions of GNAT. --- Note: we also allow the flag to appear in entry families, but given --- the current implementation of the pragma AST_Entry, this flag will --- always be False in entry families. - -- Is_Atomic (Flag85) -- Defined in all type entities, and also in constants, components and -- variables. Set if a pragma Atomic or Shared applies to the entity. @@ -3060,12 +3046,6 @@ package Einfo is -- a separate flag must be used to indicate whether the names are visible -- by selected notation, or not. --- Is_VMS_Exception (Flag133) --- Defined in all entities. Set only for exception entities where the --- exception was specified in an Import_Exception or Export_Exception --- pragma with the VMS option for Form. See description of these pragmas --- for details. This flag can only be set in OpenVMS versions of GNAT. - -- Is_Volatile (Flag16) -- Defined in all type entities, and also in constants, components and -- variables. Set if a pragma Volatile applies to the entity. Also set @@ -5193,7 +5173,6 @@ package Einfo is -- Is_Trivial_Subprogram (Flag235) -- Is_Unchecked_Union (Flag117) -- Is_Visible_Formal (Flag206) - -- Is_VMS_Exception (Flag133) -- Kill_Elaboration_Checks (Flag32) -- Kill_Range_Checks (Flag33) -- Low_Bound_Tested (Flag205) @@ -5552,7 +5531,6 @@ package Einfo is -- Contract (Node34) -- Default_Expressions_Processed (Flag108) -- Entry_Accepted (Flag152) - -- Is_AST_Entry (Flag132) (for entry only) -- Needs_No_Actuals (Flag22) -- Sec_Stack_Needed_For_Return (Flag167) -- Uses_Sec_Stack (Flag95) @@ -5598,9 +5576,7 @@ package Einfo is -- Renamed_Entity (Node18) -- Register_Exception_Call (Node20) -- Interface_Name (Node21) - -- Exception_Code (Uint22) -- Discard_Names (Flag88) - -- Is_VMS_Exception (Flag133) -- Is_Raised (Flag224) -- E_Exception_Type @@ -6532,7 +6508,6 @@ package Einfo is function Enumeration_Rep_Expr (Id : E) return N; function Equivalent_Type (Id : E) return E; function Esize (Id : E) return U; - function Exception_Code (Id : E) return U; function Extra_Accessibility (Id : E) return E; function Extra_Accessibility_Of_Result (Id : E) return E; function Extra_Constrained (Id : E) return E; @@ -6654,7 +6629,6 @@ package Einfo is function Interface_Alias (Id : E) return E; function Interface_Name (Id : E) return N; function Interfaces (Id : E) return L; - function Is_AST_Entry (Id : E) return B; function Is_Abstract_Subprogram (Id : E) return B; function Is_Abstract_Type (Id : E) return B; function Is_Access_Constant (Id : E) return B; @@ -6749,7 +6723,6 @@ package Einfo is function Is_Unchecked_Union (Id : E) return B; function Is_Underlying_Record_View (Id : E) return B; function Is_Unsigned_Type (Id : E) return B; - function Is_VMS_Exception (Id : E) return B; function Is_Valued_Procedure (Id : E) return B; function Is_Visible_Formal (Id : E) return B; function Is_Visible_Lib_Unit (Id : E) return B; @@ -7168,7 +7141,6 @@ package Einfo is procedure Set_Enumeration_Rep_Expr (Id : E; V : N); procedure Set_Equivalent_Type (Id : E; V : E); procedure Set_Esize (Id : E; V : U); - procedure Set_Exception_Code (Id : E; V : U); procedure Set_Extra_Accessibility (Id : E; V : E); procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E); procedure Set_Extra_Constrained (Id : E; V : E); @@ -7289,7 +7261,6 @@ package Einfo is procedure Set_Interface_Alias (Id : E; V : E); procedure Set_Interface_Name (Id : E; V : N); procedure Set_Interfaces (Id : E; V : L); - procedure Set_Is_AST_Entry (Id : E; V : B := True); procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True); procedure Set_Is_Abstract_Type (Id : E; V : B := True); procedure Set_Is_Access_Constant (Id : E; V : B := True); @@ -7390,7 +7361,6 @@ package Einfo is procedure Set_Is_Unchecked_Union (Id : E; V : B := True); procedure Set_Is_Underlying_Record_View (Id : E; V : B := True); procedure Set_Is_Unsigned_Type (Id : E; V : B := True); - procedure Set_Is_VMS_Exception (Id : E; V : B := True); procedure Set_Is_Valued_Procedure (Id : E; V : B := True); procedure Set_Is_Visible_Formal (Id : E; V : B := True); procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True); @@ -7918,7 +7888,6 @@ package Einfo is pragma Inline (Enumeration_Rep_Expr); pragma Inline (Equivalent_Type); pragma Inline (Esize); - pragma Inline (Exception_Code); pragma Inline (Extra_Accessibility); pragma Inline (Extra_Accessibility_Of_Result); pragma Inline (Extra_Constrained); @@ -8036,7 +8005,6 @@ package Einfo is pragma Inline (Interface_Alias); pragma Inline (Interface_Name); pragma Inline (Interfaces); - pragma Inline (Is_AST_Entry); pragma Inline (Is_Abstract_Subprogram); pragma Inline (Is_Abstract_Type); pragma Inline (Is_Access_Constant); @@ -8178,7 +8146,6 @@ package Einfo is pragma Inline (Is_Unchecked_Union); pragma Inline (Is_Underlying_Record_View); pragma Inline (Is_Unsigned_Type); - pragma Inline (Is_VMS_Exception); pragma Inline (Is_Valued_Procedure); pragma Inline (Is_Visible_Formal); pragma Inline (Is_Visible_Lib_Unit); @@ -8400,7 +8367,6 @@ package Einfo is pragma Inline (Set_Enumeration_Rep_Expr); pragma Inline (Set_Equivalent_Type); pragma Inline (Set_Esize); - pragma Inline (Set_Exception_Code); pragma Inline (Set_Extra_Accessibility); pragma Inline (Set_Extra_Accessibility_Of_Result); pragma Inline (Set_Extra_Constrained); @@ -8518,7 +8484,6 @@ package Einfo is pragma Inline (Set_Interface_Alias); pragma Inline (Set_Interface_Name); pragma Inline (Set_Interfaces); - pragma Inline (Set_Is_AST_Entry); pragma Inline (Set_Is_Abstract_Subprogram); pragma Inline (Set_Is_Abstract_Type); pragma Inline (Set_Is_Access_Constant); @@ -8619,7 +8584,6 @@ package Einfo is pragma Inline (Set_Is_Unchecked_Union); pragma Inline (Set_Is_Underlying_Record_View); pragma Inline (Set_Is_Unsigned_Type); - pragma Inline (Set_Is_VMS_Exception); pragma Inline (Set_Is_Valued_Procedure); pragma Inline (Set_Is_Visible_Formal); pragma Inline (Set_Is_Visible_Lib_Unit); diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index a1aadc2..aafa2b4 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -24,7 +24,6 @@ ------------------------------------------------------------------------------ with Atree; use Atree; -with Casing; use Casing; with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; @@ -1685,59 +1684,17 @@ package body Exp_Ch11 is Str := String_From_Name_Buffer; - -- For VMS exceptions, convert the raise into a call to - -- lib$stop so it will be handled by __gnat_error_handler. + -- Convert raise to call to the Raise_Exception routine - if Is_VMS_Exception (Id) then - declare - Excep_Image : String_Id; - Cond : Node_Id; - - begin - if Present (Interface_Name (Id)) then - Excep_Image := Strval (Interface_Name (Id)); - else - Get_Name_String (Chars (Id)); - Set_All_Upper_Case; - Excep_Image := String_From_Name_Buffer; - end if; - - if Exception_Code (Id) /= No_Uint then - Cond := - Make_Integer_Literal (Loc, Exception_Code (Id)); - else - Cond := - Unchecked_Convert_To (Standard_Integer, - Make_Function_Call (Loc, - Name => New_Occurrence_Of - (RTE (RE_Import_Value), Loc), - Parameter_Associations => New_List - (Make_String_Literal (Loc, - Strval => Excep_Image)))); - end if; - - Rewrite (N, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Lib_Stop), Loc), - Parameter_Associations => New_List (Cond))); - Analyze_And_Resolve (Cond, Standard_Integer); - end; - - -- Not VMS exception case, convert raise to call to the - -- Raise_Exception routine. - - else - Rewrite (N, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Name (N), - Attribute_Name => Name_Identity), - Make_String_Literal (Loc, - Strval => Str)))); - end if; + Rewrite (N, + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_Raise_Exception), Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => Name (N), + Attribute_Name => Name_Identity), + Make_String_Literal (Loc, Strval => Str)))); end; -- Case of no name present (reraise). We rewrite the raise to: diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 92bde0d..dca3ec1 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -42,7 +42,6 @@ with Exp_Intr; use Exp_Intr; with Exp_Pakd; use Exp_Pakd; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; -with Exp_VFpt; use Exp_VFpt; with Freeze; use Freeze; with Inline; use Inline; with Lib; use Lib; @@ -6446,12 +6445,6 @@ package body Exp_Ch4 is Attribute_Name => Name_First)), Reason => CE_Overflow_Check_Failed)); end if; - - -- Vax floating-point types case - - if Vax_Float (Etype (N)) then - Expand_Vax_Arith (N); - end if; end Expand_N_Op_Abs; --------------------- @@ -6493,11 +6486,6 @@ package body Exp_Ch4 is if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then Apply_Arithmetic_Overflow_Check (N); return; - - -- Vax floating-point types case - - elsif Vax_Float (Typ) then - Expand_Vax_Arith (N); end if; end Expand_N_Op_Add; @@ -6706,12 +6694,6 @@ package body Exp_Ch4 is elsif Is_Integer_Type (Typ) then Apply_Divide_Checks (N); - - -- Deal with Vax_Float - - elsif Vax_Float (Typ) then - Expand_Vax_Arith (N); - return; end if; end Expand_N_Op_Divide; @@ -7432,13 +7414,6 @@ package body Exp_Ch4 is Rewrite_Comparison (N); - -- If we still have comparison for Vax_Float, process it - - if Vax_Float (Typl) and then Nkind (N) in N_Op_Compare then - Expand_Vax_Comparison (N); - return; - end if; - Optimize_Length_Comparison (N); end Expand_N_Op_Eq; @@ -7843,13 +7818,6 @@ package body Exp_Ch4 is Rewrite_Comparison (N); - -- If we still have comparison, and Vax_Float type, process it - - if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then - Expand_Vax_Comparison (N); - return; - end if; - Optimize_Length_Comparison (N); end Expand_N_Op_Ge; @@ -7893,13 +7861,6 @@ package body Exp_Ch4 is Rewrite_Comparison (N); - -- If we still have comparison, and Vax_Float type, process it - - if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then - Expand_Vax_Comparison (N); - return; - end if; - Optimize_Length_Comparison (N); end Expand_N_Op_Gt; @@ -7943,13 +7904,6 @@ package body Exp_Ch4 is Rewrite_Comparison (N); - -- If we still have comparison, and Vax_Float type, process it - - if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then - Expand_Vax_Comparison (N); - return; - end if; - Optimize_Length_Comparison (N); end Expand_N_Op_Le; @@ -7993,13 +7947,6 @@ package body Exp_Ch4 is Rewrite_Comparison (N); - -- If we still have comparison, and Vax_Float type, process it - - if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then - Expand_Vax_Comparison (N); - return; - end if; - Optimize_Length_Comparison (N); end Expand_N_Op_Lt; @@ -8033,11 +7980,6 @@ package body Exp_Ch4 is Right_Opnd => Right_Opnd (N))); Analyze_And_Resolve (N, Typ); - - -- Vax floating-point types case - - elsif Vax_Float (Etype (N)) then - Expand_Vax_Arith (N); end if; end Expand_N_Op_Minus; @@ -8510,12 +8452,6 @@ package body Exp_Ch4 is elsif Is_Signed_Integer_Type (Etype (N)) then Apply_Arithmetic_Overflow_Check (N); - - -- Deal with VAX float case - - elsif Vax_Float (Typ) then - Expand_Vax_Arith (N); - return; end if; end Expand_N_Op_Multiply; @@ -8554,13 +8490,6 @@ package body Exp_Ch4 is Rewrite_Comparison (N); - -- If we still have comparison for Vax_Float, process it - - if Vax_Float (Typ) and then Nkind (N) in N_Op_Compare then - Expand_Vax_Comparison (N); - return; - end if; - -- For all cases other than elementary types, we rewrite node as the -- negation of an equality operation, and reanalyze. The equality to be -- used is defined in the same scope and has the same signature. This @@ -9290,11 +9219,6 @@ package body Exp_Ch4 is if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then Apply_Arithmetic_Overflow_Check (N); - - -- VAX floating-point types case - - elsif Vax_Float (Typ) then - Expand_Vax_Arith (N); end if; end Expand_N_Op_Subtract; @@ -11009,16 +10933,6 @@ package body Exp_Ch4 is end; end if; - -- Final step, if the result is a type conversion involving Vax_Float - -- types, then it is subject for further special processing. - - if Nkind (N) = N_Type_Conversion - and then (Vax_Float (Operand_Type) or else Vax_Float (Target_Type)) - then - Expand_Vax_Conversion (N); - goto Done; - end if; - -- Here at end of processing <<Done>> diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 561fdfc..c5a8b83 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -43,7 +43,6 @@ with Exp_Pakd; use Exp_Pakd; with Exp_Prag; use Exp_Prag; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; -with Exp_VFpt; use Exp_VFpt; with Fname; use Fname; with Freeze; use Freeze; with Inline; use Inline; @@ -3926,19 +3925,19 @@ package body Exp_Ch6 is -- Back end inlining: let the back end handle it elsif No (Unit_Declaration_Node (Subp)) - or else - Nkind (Unit_Declaration_Node (Subp)) /= N_Subprogram_Declaration - or else - No (Body_To_Inline (Unit_Declaration_Node (Subp))) + or else Nkind (Unit_Declaration_Node (Subp)) /= + N_Subprogram_Declaration + or else No (Body_To_Inline (Unit_Declaration_Node (Subp))) then Add_Inlined_Body (Subp); Register_Backend_Call (Call_Node); - -- Frontend expansion of supported functions returning unconstrained - -- types + -- Frontend expands supported functions returning unconstrained types + + else + pragma Assert (Ekind (Subp) = E_Function + and then Returns_Unconstrained_Type (Subp)); - else pragma Assert (Ekind (Subp) = E_Function - and then Returns_Unconstrained_Type (Subp)); declare Spec : constant Node_Id := Unit_Declaration_Node (Subp); @@ -5201,21 +5200,6 @@ package body Exp_Ch6 is procedure Expand_N_Function_Call (N : Node_Id) is begin Expand_Call (N); - - -- If the return value of a foreign compiled function is VAX Float, then - -- expand the return (adjusts the location of the return value on - -- Alpha/VMS, no-op everywhere else). - -- Comes_From_Source intercepts recursive expansion. - - if Nkind (N) = N_Function_Call - and then Vax_Float (Etype (N)) - and then Present (Name (N)) - and then Present (Entity (Name (N))) - and then Has_Foreign_Convention (Entity (Name (N))) - and then Comes_From_Source (Parent (N)) - then - Expand_Vax_Foreign_Return (N); - end if; end Expand_N_Function_Call; --------------------------------------- diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 905283f..c76affa 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -154,11 +154,6 @@ extern void Get_External_Name (Entity_Id, Boolean, String_Pointer); extern Boolean Is_Fully_Repped_Tagged_Type (Entity_Id); -/* exp_vfpt: */ - -#define Get_Vax_Real_Literal_As_Signed exp_vfpt__get_vax_real_literal_as_signed -extern Ureal Get_Vax_Real_Literal_As_Signed (Node_Id); - /* lib: */ #define Cunit lib__cunit diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 6170f88..c638c45 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -255,23 +255,22 @@ procedure Gnatchop is procedure Parse_Offset_Info (Chop_File : File_Num; Source : not null access String); - -- Parses the output of the compiler indicating the offsets - -- and names of the compilation units in Chop_File. + -- Parses the output of the compiler indicating the offsets and names of + -- the compilation units in Chop_File. procedure Parse_Token (Source : not null access String; Ptr : in out Positive; Token_Ptr : out Positive); -- Skips any separators and stores the start of the token in Token_Ptr. - -- Then stores the position of the next separator in Ptr. - -- On return Source (Token_Ptr .. Ptr - 1) is the token. + -- Then stores the position of the next separator in Ptr. On return + -- Source (Token_Ptr .. Ptr - 1) is the token. procedure Read_File (FD : File_Descriptor; Contents : out String_Access; Success : out Boolean); - -- Reads file associated with FS into the newly allocated - -- string Contents. + -- Reads file associated with FS into the newly allocated string Contents. -- Success is true iff the number of bytes read is equal to the file size. function Report_Duplicate_Units return Boolean; @@ -293,17 +292,17 @@ procedure Gnatchop is -- Write all units that result from chopping the Input file procedure Write_Config_File (Input : File_Num; U : Unit_Num); - -- Call to write configuration pragmas (append them to gnat.adc) - -- Input is the file number for the chop file and U identifies the - -- unit entry for the configuration pragmas. + -- Call to write configuration pragmas (append them to gnat.adc). Input is + -- the file number for the chop file and U identifies the unit entry for + -- the configuration pragmas. function Get_Config_Pragmas (Input : File_Num; U : Unit_Num) return String_Access; - -- Call to read configuration pragmas from given unit entry, and - -- return a buffer containing the pragmas to be appended to - -- following units. Input is the file number for the chop file and - -- U identifies the unit entry for the configuration pragmas. + -- Call to read configuration pragmas from given unit entry, and return a + -- buffer containing the pragmas to be appended to following units. Input + -- is the file number for the chop file and U identifies the unit entry for + -- the configuration pragmas. procedure Write_Source_Reference_Pragma (Info : Unit_Info; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 9cca2d8..104d335 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -191,7 +191,7 @@ procedure GNATCmd is -- The index of the command in the arguments of the GNAT driver My_Exit_Status : Exit_Status := Success; - -- The exit status of the spawned tool. + -- The exit status of the spawned tool Current_Work_Dir : constant String := Get_Current_Dir; -- The path of the working directory @@ -1429,6 +1429,7 @@ begin declare Command : constant String := Command_Name; + begin for Index in reverse Command'Range loop if Command (Index) = Directory_Separator then diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index c270e60..07815d0 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -150,9 +150,9 @@ procedure Gnatls is Stamp : Time_Stamp_Type; Checksum : Word; Status : out File_Status); - -- Determine the file status (Status) of the file represented by FS - -- with the expected Stamp and checksum given as argument. FS will be - -- updated to the full file name if available. + -- Determine the file status (Status) of the file represented by FS with + -- the expected Stamp and checksum given as argument. FS will be updated + -- to the full file name if available. function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id; -- Give the Sdep entry corresponding to the unit U in ali record A @@ -175,7 +175,7 @@ procedure Gnatls is -- Reset Print flags properly when selective output is chosen procedure Scan_Ls_Arg (Argv : String); - -- Scan and process lser specific arguments. Argv is a single argument + -- Scan and process user specific arguments (Argv is a single argument) procedure Search_RTS (Name : String); -- Find include and objects path for the RTS name. @@ -184,16 +184,14 @@ procedure Gnatls is -- Print usage message procedure Output_License_Information; - -- Output license statement, and if not found, output reference to - -- COPYING. + -- Output license statement, and if not found, output reference to COPYING function Image (Restriction : Restriction_Id) return String; -- Returns the capitalized image of Restriction function Normalize (Path : String) return String; - -- Returns a normalized path name. - -- On Windows, the directory separators are set to '\' in - -- Normalize_Pathname. + -- Returns a normalized path name. On Windows, the directory separators are + -- set to '\' in Normalize_Pathname. ------------------------------------------ -- GNATDIST specific output subprograms -- diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index dd485a6..82f3274 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -551,6 +551,7 @@ begin declare Command : constant String := Command_Name; + begin for Index in reverse Command'Range loop if Command (Index) = Directory_Separator then @@ -579,12 +580,12 @@ begin declare New_Arguments : Argument_Data; pragma Warnings (Off, New_Arguments); - -- Declaring this defaulted initialized object ensures - -- that the new allocated component of table Arguments - -- is correctly initialized. + -- Declaring this defaulted initialized object ensures that the new + -- allocated component of table Arguments is correctly initialized. begin Arguments.Append (New_Arguments); end; + Patterns.Init (Arguments.Table (1).Directories); Patterns.Set_Last (Arguments.Table (1).Directories, 0); Patterns.Init (Arguments.Table (1).Name_Patterns); diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index a2d41b2..b133cc4 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -165,10 +165,10 @@ package body Inline is function Has_Single_Return (N : Node_Id) return Boolean; -- In general we cannot inline functions that return unconstrained type. - -- However, we can handle such functions if all return statements return - -- a local variable that is the only declaration in the body of the - -- function. In that case the call can be replaced by that local - -- variable as is done for other inlined calls. + -- However, we can handle such functions if all return statements return a + -- local variable that is the only declaration in the body of the function. + -- In that case the call can be replaced by that local variable as is done + -- for other inlined calls. function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean; -- Return True if E is in the main unit or its spec or in a subunit @@ -429,7 +429,7 @@ package body Inline is procedure Register_Backend_Not_Inlined_Subprogram (Subp : Entity_Id); -- Append Subp to the list of subprograms that cannot be inlined by - -- the backend + -- the backend. ---------------------------- -- Back_End_Cannot_Inline -- @@ -3332,7 +3332,7 @@ package body Inline is -- expanded into a procedure call which must be added after the -- object declaration. - if Is_Unc_Decl and then Back_End_Inlining then + if Is_Unc_Decl and Back_End_Inlining then Insert_Action_After (Parent (N), Blk); else Set_Expression (Parent (N), Empty); @@ -4329,9 +4329,9 @@ package body Inline is return False; end Has_Initialized_Type; - ------------------------ - -- Has_Single_Return -- - ------------------------ + ----------------------- + -- Has_Single_Return -- + ----------------------- function Has_Single_Return (N : Node_Id) return Boolean is Return_Statement : Node_Id := Empty; @@ -4376,8 +4376,8 @@ package body Inline is return Abandon; end if; - -- We can only inline a build-in-place function if - -- it has a single extended return. + -- We can only inline a build-in-place function if it has a single + -- extended return. elsif Nkind (N) = N_Extended_Return_Statement then if No (Return_Statement) then @@ -4572,6 +4572,8 @@ package body Inline is -- Number_Of_Statements -- -------------------------- + -- Why not List_Length??? + function Number_Of_Statements (Stats : List_Id) return Natural is Stat_Count : Integer := 0; Stmt : Node_Id; diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index d07a261..edab783 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -131,6 +131,9 @@ package Inline is Table_Increment => Alloc.Pending_Instantiations_Increment, Table_Name => "Pending_Descriptor"); + -- The following should be initialized in an init call in Frontend, we + -- have thoughts of making the frontend reusable in future ??? + Inlined_Calls : Elist_Id := No_Elist; -- List of frontend inlined calls @@ -242,13 +245,14 @@ package Inline is function Has_Excluded_Declaration (Subp : Entity_Id; Decls : List_Id) return Boolean; - -- Check for declarations that make inlining not worthwhile inlining Subp + -- Check a list of declarations, Decls, that make the inlining of Subp not + -- worthwhile function Has_Excluded_Statement (Subp : Entity_Id; Stats : List_Id) return Boolean; - -- Check for statements that make inlining not worthwhile: any tasking - -- statement, nested at any level. + -- Check a list of statements, Stats, that make inlining of Subp not + -- worthwhile, including any tasking statement, nested at any level. procedure Register_Backend_Call (N : Node_Id); -- Append N to the list Backend_Calls diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index b98f353..a56acc0 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.adb @@ -257,5 +257,4 @@ begin end loop; return; - end Krunch; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index b71c28a..c194bc7 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2257,6 +2257,7 @@ package body Make is Args : Argument_List) is pragma Unreferenced (Is_Main_Source); + begin Arguments_Project := No_Project; Last_Argument := 0; @@ -6413,8 +6414,8 @@ package body Make is if Prefix'Length > 0 then declare PATH : constant String := - Prefix & Directory_Separator & "bin" & Path_Separator & - Getenv ("PATH").all; + Prefix & Directory_Separator & "bin" & Path_Separator + & Getenv ("PATH").all; begin Setenv ("PATH", PATH); end; diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 3686be3..a4799bb 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -498,6 +498,7 @@ package body MLib.Prj is begin if Libgnarl_Needed /= Yes then + -- Scan the ALI file Name_Len := ALI_File'Length; diff --git a/gcc/ada/mlib.ads b/gcc/ada/mlib.ads index c8f3228..e370fa4 100644 --- a/gcc/ada/mlib.ads +++ b/gcc/ada/mlib.ads @@ -89,8 +89,7 @@ package MLib is -- for each directory in the rpath. private - Preserve : Attribute := Time_Stamps; - -- Used by Copy_ALI_Files. + -- Used by Copy_ALI_Files end MLib; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 159501d..c0b25cc 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1078,10 +1078,12 @@ package body Osint is N : C_File_Name; A : System.Address) return size_t; pragma Import (C, Internal, "__gnat_file_length_attr"); + begin -- The conversion from size_t to Long_Integer is ok here as this -- routine is only to be used by the compiler and we do not expect -- a unit to be larger than a 32bit integer. + return Long_Integer (Internal (-1, Name, Attr.all'Address)); end File_Length; diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index c4a148f..21c94bd 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -46,7 +46,6 @@ with Sem_Util; use Sem_Util; with Sem_Warn; use Sem_Warn; with Sinfo; use Sinfo; with Stand; use Stand; -with Uintp; use Uintp; package body Sem_Ch11 is @@ -61,7 +60,6 @@ package body Sem_Ch11 is Generate_Definition (Id); Enter_Name (Id); Set_Ekind (Id, E_Exception); - Set_Exception_Code (Id, Uint_0); Set_Etype (Id, Standard_Exception_Type); Set_Is_Statically_Allocated (Id); Set_Is_Pure (Id, PF); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b97616b..498aafa 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3571,7 +3571,7 @@ package body Sem_Ch6 is if not Back_End_Inlining then if Has_Pragma_Inline_Always (Spec_Id) - or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining) + or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining) then Build_Body_To_Inline (N, Spec_Id); end if; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index cb0faca..f2c79d2 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -558,7 +558,6 @@ package body Sem_Ch8 is Analyze (Nam); Set_Ekind (Id, E_Exception); - Set_Exception_Code (Id, Uint_0); Set_Etype (Id, Standard_Exception_Type); Set_Is_Pure (Id, Is_Pure (Current_Scope)); diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 44a3da9..be7eff3 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2014, 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- -- @@ -27,10 +27,8 @@ with Atree; use Atree; with Einfo; use Einfo; with Errout; use Errout; with Namet; use Namet; -with Nlists; use Nlists; with Sem; use Sem; with Sem_Aux; use Sem_Aux; -with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; @@ -43,19 +41,13 @@ package body Sem_Mech is ------------------------- procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is - Class : Node_Id; - Param : Node_Id; - - procedure Bad_Class; - -- Signal bad descriptor class name procedure Bad_Mechanism; -- Signal bad mechanism name - procedure Bad_Class is - begin - Error_Msg_N ("unrecognized descriptor class name", Class); - end Bad_Class; + ------------------- + -- Bad_Mechanism -- + ------------------- procedure Bad_Mechanism is begin @@ -70,26 +62,14 @@ package body Sem_Mech is ("mechanism for & has already been set", Mech_Name, Ent); end if; - -- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor + -- MECHANISM_NAME ::= value | reference if Nkind (Mech_Name) = N_Identifier then if Chars (Mech_Name) = Name_Value then Set_Mechanism_With_Checks (Ent, By_Copy, Mech_Name); - return; elsif Chars (Mech_Name) = Name_Reference then Set_Mechanism_With_Checks (Ent, By_Reference, Mech_Name); - return; - - elsif Chars (Mech_Name) = Name_Descriptor then - Check_VMS (Mech_Name); - Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name); - return; - - elsif Chars (Mech_Name) = Name_Short_Descriptor then - Check_VMS (Mech_Name); - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name); - return; elsif Chars (Mech_Name) = Name_Copy then Error_Msg_N ("bad mechanism name, Value assumed", Mech_Name); @@ -97,138 +77,10 @@ package body Sem_Mech is else Bad_Mechanism; - return; - end if; - - -- MECHANISM_NAME ::= descriptor (CLASS_NAME) | - -- short_descriptor (CLASS_NAME) - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca - - -- Note: this form is parsed as an indexed component - - elsif Nkind (Mech_Name) = N_Indexed_Component then - Class := First (Expressions (Mech_Name)); - - if Nkind (Prefix (Mech_Name)) /= N_Identifier - or else - not Nam_In (Chars (Prefix (Mech_Name)), Name_Descriptor, - Name_Short_Descriptor) - or else Present (Next (Class)) - then - Bad_Mechanism; - return; - end if; - - -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) | - -- short_descriptor (Class => CLASS_NAME) - -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca - - -- Note: this form is parsed as a function call - - elsif Nkind (Mech_Name) = N_Function_Call then - - Param := First (Parameter_Associations (Mech_Name)); - - if Nkind (Name (Mech_Name)) /= N_Identifier - or else - not Nam_In (Chars (Name (Mech_Name)), Name_Descriptor, - Name_Short_Descriptor) - or else Present (Next (Param)) - or else No (Selector_Name (Param)) - or else Chars (Selector_Name (Param)) /= Name_Class - then - Bad_Mechanism; - return; - else - Class := Explicit_Actual_Parameter (Param); end if; else Bad_Mechanism; - return; - end if; - - -- Fall through here with Class set to descriptor class name - - Check_VMS (Mech_Name); - - if Nkind (Class) /= N_Identifier then - Bad_Class; - return; - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_UBS - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_UBSB - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_UBA - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_S - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_SB - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_SB, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_A - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Descriptor - and then Chars (Class) = Name_NCA - then - Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_UBS - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_UBSB - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_UBA - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_S - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_SB - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_A - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A, Mech_Name); - - elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor - and then Chars (Class) = Name_NCA - then - Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA, Mech_Name); - - else - Bad_Class; - return; end if; end Set_Mechanism_Value; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e0f979b..204ae5f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2986,18 +2986,6 @@ package body Sem_Util is end if; end Check_Unprotected_Access; - --------------- - -- Check_VMS -- - --------------- - - procedure Check_VMS (Construct : Node_Id) is - begin - if not OpenVMS_On_Target then - Error_Msg_N - ("this construct is allowed only in Open'V'M'S", Construct); - end if; - end Check_VMS; - ------------------------ -- Collect_Interfaces -- ------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index da0a538..e59cc89 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -319,12 +319,6 @@ package Sem_Util is -- and the context is external to the protected operation, to warn against -- a possible unlocked access to data. - procedure Check_VMS (Construct : Node_Id); - -- Check that this the target is OpenVMS, and if so, return with no effect, - -- otherwise post an error noting this can only be used with OpenVMS ports. - -- The argument is the construct in question and is used to post the error - -- message. - procedure Collect_Interfaces (T : Entity_Id; Ifaces_List : out Elist_Id; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 1488ce5..0b9220d 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -697,7 +697,6 @@ package Snames is Name_Copy : constant Name_Id := N + $; Name_D_Float : constant Name_Id := N + $; Name_Decreases : constant Name_Id := N + $; - Name_Descriptor : constant Name_Id := N + $; Name_Disable : constant Name_Id := N + $; Name_Dot_Replacement : constant Name_Id := N + $; Name_Dynamic : constant Name_Id := N + $; @@ -775,7 +774,6 @@ package Snames is Name_Secondary_Stack_Size : constant Name_Id := N + $; Name_Section : constant Name_Id := N + $; Name_Semaphore : constant Name_Id := N + $; - Name_Short_Descriptor : constant Name_Id := N + $; Name_Simple_Barriers : constant Name_Id := N + $; Name_SPARK : constant Name_Id := N + $; Name_SPARK_05 : constant Name_Id := N + $; |