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
This commit is contained in:
parent
62883e6b17
commit
ea0c8cfb98
|
@ -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,
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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 |
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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>>
|
||||
|
|
|
@ -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;
|
||||
|
||||
---------------------------------------
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -257,5 +257,4 @@ begin
|
|||
end loop;
|
||||
|
||||
return;
|
||||
|
||||
end Krunch;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -498,6 +498,7 @@ package body MLib.Prj is
|
|||
|
||||
begin
|
||||
if Libgnarl_Needed /= Yes then
|
||||
|
||||
-- Scan the ALI file
|
||||
|
||||
Name_Len := ALI_File'Length;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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));
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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 --
|
||||
------------------------
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 + $;
|
||||
|
|
Loading…
Reference in New Issue