+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,
-- 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");
-- 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;
-- 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)
-- 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
-- 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
-- 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);
-- 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
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;
------------------------
-- 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;
----------------
declare
U1_Name : constant String (1 .. Name_Len) :=
- Name_Buffer (1 .. Name_Len);
+ Name_Buffer (1 .. Name_Len);
Min_Length : Natural;
begin
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;
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
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);
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,
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));
-- 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);
-- Component_Size Uint22
-- Corresponding_Remote_Type Node22
-- Enumeration_Rep_Expr Node22
- -- Exception_Code Uint22
-- Original_Record_Component Node22
-- Private_View Node22
-- Protected_Formal Node22
-- 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
-- (unused) Flag2
-- (unused) Flag3
+ -- (unused) Flag132
+ -- (unused) Flag133
+
-- (unused) Flag275
-- (unused) Flag276
-- (unused) Flag277
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
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));
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);
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
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
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);
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));
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));
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 |
-- 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
-- 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.
-- 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
-- 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)
-- 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)
-- 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
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;
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;
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;
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);
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);
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);
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);
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);
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);
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);
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);
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);
------------------------------------------------------------------------------
with Atree; use Atree;
-with Casing; use Casing;
with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
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:
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;
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;
---------------------
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;
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;
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;
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;
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;
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;
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;
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;
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;
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
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;
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>>
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;
-- 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);
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;
---------------------------------------
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
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;
-- 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;
-- 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
declare
Command : constant String := Command_Name;
+
begin
for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then
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
-- 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.
-- 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 --
declare
Command : constant String := Command_Name;
+
begin
for Index in reverse Command'Range loop
if Command (Index) = Directory_Separator then
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);
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
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 --
-- 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);
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;
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
-- Number_Of_Statements --
--------------------------
+ -- Why not List_Length???
+
function Number_Of_Statements (Stats : List_Id) return Natural is
Stat_Count : Integer := 0;
Stmt : Node_Id;
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
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
end loop;
return;
-
end Krunch;
Args : Argument_List)
is
pragma Unreferenced (Is_Main_Source);
+
begin
Arguments_Project := No_Project;
Last_Argument := 0;
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;
begin
if Libgnarl_Needed /= Yes then
+
-- Scan the ALI file
Name_Len := ALI_File'Length;
-- for each directory in the rpath.
private
-
Preserve : Attribute := Time_Stamps;
- -- Used by Copy_ALI_Files.
+ -- Used by Copy_ALI_Files
end MLib;
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;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Stand; use Stand;
-with Uintp; use Uintp;
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);
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;
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));
-- --
-- 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- --
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;
-------------------------
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
("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);
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;
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 --
------------------------
-- 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;
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 + $;
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 + $;