aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobert Dewar <dewar@adacore.com>2014-08-01 08:17:20 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2014-08-01 10:17:20 +0200
commitea0c8cfb98bc575325f35f4798b2c657f4497e5e (patch)
treef67b75102f9fc406e9089148d3ba4caef87238c7
parent62883e6b17b85341fbc9b35c51bc076d39dcec23 (diff)
downloadgcc-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/ChangeLog13
-rw-r--r--gcc/ada/binde.adb7
-rw-r--r--gcc/ada/bindgen.adb26
-rw-r--r--gcc/ada/butil.adb80
-rw-r--r--gcc/ada/clean.adb8
-rw-r--r--gcc/ada/cstand.adb19
-rw-r--r--gcc/ada/einfo.adb46
-rw-r--r--gcc/ada/einfo.ads36
-rw-r--r--gcc/ada/exp_ch11.adb63
-rw-r--r--gcc/ada/exp_ch4.adb86
-rw-r--r--gcc/ada/exp_ch6.adb32
-rw-r--r--gcc/ada/fe.h5
-rw-r--r--gcc/ada/gnatchop.adb25
-rw-r--r--gcc/ada/gnatcmd.adb3
-rw-r--r--gcc/ada/gnatls.adb16
-rw-r--r--gcc/ada/gnatname.adb7
-rw-r--r--gcc/ada/inline.adb24
-rw-r--r--gcc/ada/inline.ads10
-rw-r--r--gcc/ada/krunch.adb1
-rw-r--r--gcc/ada/make.adb5
-rw-r--r--gcc/ada/mlib-prj.adb1
-rw-r--r--gcc/ada/mlib.ads3
-rw-r--r--gcc/ada/osint.adb2
-rw-r--r--gcc/ada/sem_ch11.adb2
-rw-r--r--gcc/ada/sem_ch6.adb2
-rw-r--r--gcc/ada/sem_ch8.adb1
-rw-r--r--gcc/ada/sem_mech.adb158
-rw-r--r--gcc/ada/sem_util.adb12
-rw-r--r--gcc/ada/sem_util.ads6
-rw-r--r--gcc/ada/snames.ads-tmpl2
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 + $;