]> gcc.gnu.org Git - gcc.git/commitdiff
gnatchop.adb, [...]: Minor reformatting.
authorRobert Dewar <dewar@adacore.com>
Fri, 1 Aug 2014 08:17:20 +0000 (08:17 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 1 Aug 2014 08:17:20 +0000 (10:17 +0200)
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

30 files changed:
gcc/ada/ChangeLog
gcc/ada/binde.adb
gcc/ada/bindgen.adb
gcc/ada/butil.adb
gcc/ada/clean.adb
gcc/ada/cstand.adb
gcc/ada/einfo.adb
gcc/ada/einfo.ads
gcc/ada/exp_ch11.adb
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch6.adb
gcc/ada/fe.h
gcc/ada/gnatchop.adb
gcc/ada/gnatcmd.adb
gcc/ada/gnatls.adb
gcc/ada/gnatname.adb
gcc/ada/inline.adb
gcc/ada/inline.ads
gcc/ada/krunch.adb
gcc/ada/make.adb
gcc/ada/mlib-prj.adb
gcc/ada/mlib.ads
gcc/ada/osint.adb
gcc/ada/sem_ch11.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_mech.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads
gcc/ada/snames.ads-tmpl

index 28cde03e477aefa28a3768c7613cac5993cf6cdb..83ae8cd72a2c817836cf11388a5f435ceee076ab 100644 (file)
@@ -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,
index f22e53ba68a9ed00c6dbccf480919226acbf8c67..6c43ab8fdf9d71f21a1b84600a3b8d8a93dd1d4a 100644 (file)
@@ -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)
index 6363e1b498ae593d675368e5828d1333035e9b0e..553542ef5293272d996a27ef14815855584daecf 100644 (file)
@@ -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
index 8ca4994cb03feb0f47e1f005b87da00e52a98b7a..3ac112a07a54802ade19886888a19d82f4a9ae63 100644 (file)
@@ -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;
index a41729ad66606d41ab38435597f213e853c15883..999c735fe1250be13408cbad5949b1047b186888 100644 (file)
@@ -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);
index 8261a41b6a1e471fa5c3a2acd9e024720908acc3..2fe357666da40e417c452a783779274ea6e21c45 100644 (file)
@@ -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);
index a3e77a83fd995b63b1f5f01687affa47f2b8ece3..92fdff650e23ccc75300cb303249dd6b47db430a 100644 (file)
@@ -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                               |
index b29821bee6fb3725c138aa2ac43a8fe3aa7d5269..7bb4d9c7d22a2280b9258a9c885bf62602409c2c 100644 (file)
@@ -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);
index a1aadc2543c87cc54267e265dc2bf74393be1984..aafa2b4fdb60a4f8218e71310e0b20f5c3c4679d 100644 (file)
@@ -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:
index 92bde0d8e539ed04d1abfde168846325764fd8e3..dca3ec1877672a626312c7fa232644bdadd2d695 100644 (file)
@@ -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>>
index 561fdfc5629f422d31184aaba7ee3aa201945a58..c5a8b83a7b46778c56203044c5b2b1eecc08abee 100644 (file)
@@ -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;
 
    ---------------------------------------
index 905283fb958bb9fae0e3d9f5d685dc0ce269c03e..c76affaf29144eaa8af2a7b796ea0ac293045492 100644 (file)
@@ -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
index 6170f8858fcf39d6c36d4180118acad4c2d3a395..c638c4551b5253aae9c03b2025c0e1a9fc6601ae 100644 (file)
@@ -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;
index 9cca2d83ea845ce5082f00b7194c90041ef2a1fd..104d335afa70708285c852c4ef41c2e7c3919412 100644 (file)
@@ -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
index c270e6016322555944ed230d6c5f06d650f996e0..07815d0d5b5c3c5325da1b5c304f3390c00f3488 100644 (file)
@@ -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 --
index dd485a6b8b3ac19ceab4915fbd16659cc7264881..82f32747948b71ca36d2ef93a2f3bcf6dcd6451b 100644 (file)
@@ -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);
index a2d41b220056518af3f8900ebdcf3806d4c53a49..b133cc4100dabf8382a8fd2d5e12af1ac5873716 100644 (file)
@@ -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;
index d07a261c2fd617ad0594b8a7cdbd898495380a82..edab7833f4a41211ab98546b7f2d086447f5c9f1 100644 (file)
@@ -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
index b98f3538bd47f48e610d91b0adede8174f2fcac3..a56acc06ed3bbacbeeb694e4465150e4a09b3bbf 100644 (file)
@@ -257,5 +257,4 @@ begin
    end loop;
 
    return;
-
 end Krunch;
index b71c28a2b1f1f9e6f5e46c6a08e941d21436ea2f..c194bc760b0a84d403742f21d9bdca4f284a80ce 100644 (file)
@@ -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;
index 3686be317fa8a9c6d065648034b2f2ec1e32656c..a4799bb99f63d3ccbdc9bc6d94e9552a9d25085e 100644 (file)
@@ -498,6 +498,7 @@ package body MLib.Prj is
 
       begin
          if Libgnarl_Needed /= Yes then
+
             --  Scan the ALI file
 
             Name_Len := ALI_File'Length;
index c8f32287657d228f21356220e2de36833cca8601..e370fa48de9962efd8f48d7ca5263b8b67ff999e 100644 (file)
@@ -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;
index 159501de777b3fe604d30f93ed0a196d0755a8f1..c0b25cc47f75b70b71c46b6743f179644ae39c86 100644 (file)
@@ -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;
 
index c4a148f0cd5e2cf3961a372ce77ad60737eb1cc6..21c94bddb9bfebc613913f544784f0842f926365 100644 (file)
@@ -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);
index b97616b6ec7d3ac7675216dff76dd44c2a600191..498aafade58b78536ce29eb575519deb3cca18e0 100644 (file)
@@ -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;
index cb0facadf60cdb6d2ccc7676d7fd8d945d14d4cf..f2c79d29296e8f2f8d957bc8f0e60559a6e0902c 100644 (file)
@@ -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));
 
index 44a3da91c09e216b403a1d8044b8bfb675128af1..be7eff31cb1ad9907dc2aa1f259660980e50c3dd 100644 (file)
@@ -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;
 
index e0f979bd209cea8fdd0af4d53fdfb08f2ade849d..204ae5fc6a43e8f1123091665a25b6817d6d81fe 100644 (file)
@@ -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 --
    ------------------------
index da0a538febc06eab9d97ff90342a04d6f90e40a2..e59cc892e25bf588ccdb3d8b879f0e515a3676c3 100644 (file)
@@ -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;
index 1488ce56d13844cf0dcc85c0e72cd54a9ff16f89..0b9220d381c9ebfb16fdf100e03e4fb7badfb482 100644 (file)
@@ -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 + $;
This page took 0.166816 seconds and 5 git commands to generate.