-- Get_Postcond_Enabled --
--------------------------
- function Get_Postcond_Enabled (Subp : Entity_Id) return Node_Id is
+ function Get_Postcond_Enabled (Subp : Entity_Id) return Entity_Id is
Decl : Node_Id;
begin
Decl :=
------------------------------------
function Get_Result_Object_For_Postcond
- (Subp : Entity_Id) return Node_Id
+ (Subp : Entity_Id) return Entity_Id
is
Decl : Node_Id;
begin
-- Get_Return_Success_For_Postcond --
-------------------------------------
- function Get_Return_Success_For_Postcond (Subp : Entity_Id) return Node_Id
+ function Get_Return_Success_For_Postcond (Subp : Entity_Id) return Entity_Id
is
Decl : Node_Id;
begin
-- Entry_Index_Type --
----------------------
- function Entry_Index_Type (Id : E) return N is
+ function Entry_Index_Type (Id : E) return E is
begin
pragma Assert (Ekind (Id) = E_Entry_Family);
return Etype (Discrete_Subtype_Definition (Parent (Id)));
-- Link_Entities --
-------------------
- procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
+ procedure Link_Entities (First, Second : Entity_Id) is
begin
if Present (Second) then
Set_Prev_Entity (Second, First); -- First <-- Second
-- WARNING: There is a matching C declaration of this subprogram in fe.h
- procedure Link_Entities (First : Entity_Id; Second : Entity_Id);
+ procedure Link_Entities (First, Second : Entity_Id);
-- Link entities First and Second in one entity chain.
--
-- NOTE: No updates are done to the First_Entity and Last_Entity fields
-- of the following global variables to appropriate values before making a
-- call to one of the error message routines with a string containing the
-- insertion character to get the value inserted in an appropriate format.
+ --
+ -- Some of these are initialized below, because they are read before being
+ -- set by clients.
Error_Msg_Col : Column_Number;
-- Column for @ insertion character in message
Error_Msg_Uint_1 : Uint;
- Error_Msg_Uint_2 : Uint;
+ Error_Msg_Uint_2 : Uint := No_Uint;
-- Uint values for ^ insertion characters in message
-- WARNING: There is a matching C declaration of these variables in fe.h
-- Source location for # insertion character in message
Error_Msg_Name_1 : Name_Id;
- Error_Msg_Name_2 : Name_Id;
- Error_Msg_Name_3 : Name_Id;
+ Error_Msg_Name_2 : Name_Id := No_Name;
+ Error_Msg_Name_3 : Name_Id := No_Name;
-- Name_Id values for % insertion characters in message
Error_Msg_File_1 : File_Name_Type;
- Error_Msg_File_2 : File_Name_Type;
- Error_Msg_File_3 : File_Name_Type;
+ Error_Msg_File_2 : File_Name_Type := No_File;
+ Error_Msg_File_3 : File_Name_Type := No_File;
-- File_Name_Type values for { insertion characters in message
Error_Msg_Unit_1 : Unit_Name_Type;
- Error_Msg_Unit_2 : Unit_Name_Type;
+ Error_Msg_Unit_2 : Unit_Name_Type := No_Unit_Name;
-- Unit_Name_Type values for $ insertion characters in message
Error_Msg_Node_1 : Node_Id;
- Error_Msg_Node_2 : Node_Id;
+ Error_Msg_Node_2 : Node_Id := Empty;
-- Node_Id values for & insertion characters in message
Error_Msg_Warn : Boolean;
end if;
-- The following assignment ensures that a second ampersand insertion
- -- character will correspond to the Error_Msg_Node_2 parameter. We
- -- suppress possible validity checks in case operating in -gnatVa mode,
- -- and Error_Msg_Node_2 is not needed and has not been set.
+ -- character will correspond to the Error_Msg_Node_2 parameter.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Node_1 := Error_Msg_Node_2;
- end;
+ Error_Msg_Node_1 := Error_Msg_Node_2;
end Set_Msg_Insertion_Node;
--------------------------------------
end if;
-- The following assignment ensures that a second percent insertion
- -- character will correspond to the Error_Msg_Unit_2 parameter. We
- -- suppress possible validity checks in case operating in -gnatVa mode,
- -- and Error_Msg_Unit_2 is not needed and has not been set.
+ -- character will correspond to the Error_Msg_Unit_2 parameter.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Unit_1 := Error_Msg_Unit_2;
- end;
+ Error_Msg_Unit_1 := Error_Msg_Unit_2;
end Set_Msg_Insertion_Unit_Name;
------------------
end if;
-- The following assignments ensure that the second and third {
- -- insertion characters will correspond to the Error_Msg_File_2 and
- -- Error_Msg_File_3 values and We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_File_2 or
- -- Error_Msg_File_3 is not needed and has not been set.
+ -- insertion characters will correspond to the Error_Msg_File_2
+ -- and Error_Msg_File_3 values.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_File_1 := Error_Msg_File_2;
- Error_Msg_File_2 := Error_Msg_File_3;
- end;
+ Error_Msg_File_1 := Error_Msg_File_2;
+ Error_Msg_File_2 := Error_Msg_File_3;
end Set_Msg_Insertion_File_Name;
-----------------------------------
-- The following assignments ensure that the second and third percent
-- insertion characters will correspond to the Error_Msg_Name_2 and
- -- Error_Msg_Name_3 as required. We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_Name_1/2 is not needed
- -- and has not been set.
+ -- Error_Msg_Name_3 as required.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Name_1 := Error_Msg_Name_2;
- Error_Msg_Name_2 := Error_Msg_Name_3;
- end;
+ Error_Msg_Name_1 := Error_Msg_Name_2;
+ Error_Msg_Name_2 := Error_Msg_Name_3;
end Set_Msg_Insertion_Name;
------------------------------------
-- The following assignments ensure that the second and third % or %%
-- insertion characters will correspond to the Error_Msg_Name_2 and
- -- Error_Msg_Name_3 values and We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_Name_2 or
- -- Error_Msg_Name_3 is not needed and has not been set.
+ -- Error_Msg_Name_3 values.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Name_1 := Error_Msg_Name_2;
- Error_Msg_Name_2 := Error_Msg_Name_3;
- end;
+ Error_Msg_Name_1 := Error_Msg_Name_2;
+ Error_Msg_Name_2 := Error_Msg_Name_3;
end Set_Msg_Insertion_Name_Literal;
-------------------------------------
end loop;
-- The following assignment ensures that a second caret insertion
- -- character will correspond to the Error_Msg_Uint_2 parameter. We
- -- suppress possible validity checks in case operating in -gnatVa mode,
- -- and Error_Msg_Uint_2 is not needed and has not been set.
+ -- character will correspond to the Error_Msg_Uint_2 parameter.
- declare
- pragma Suppress (Range_Check);
- begin
- Error_Msg_Uint_1 := Error_Msg_Uint_2;
- end;
+ Error_Msg_Uint_1 := Error_Msg_Uint_2;
end Set_Msg_Insertion_Uint;
-----------------
function Make_Deep_Proc
(Prim : Final_Primitives;
Typ : Entity_Id;
- Stmts : List_Id) return Node_Id;
+ Stmts : List_Id) return Entity_Id;
-- This function generates the tree for Deep_Initialize, Deep_Adjust or
- -- Deep_Finalize procedures according to the first parameter, these
- -- procedures operate on the type Typ. The Stmts parameter gives the body
- -- of the procedure.
+ -- Deep_Finalize procedures according to the first parameter. These
+ -- procedures operate on the type Typ. The Stmts parameter gives the
+ -- body of the procedure.
function Make_Deep_Array_Body
(Prim : Final_Primitives;
function Build_Corresponding_Record
(N : Node_Id;
- Ctyp : Node_Id;
+ Ctyp : Entity_Id;
Loc : Source_Ptr) return Node_Id;
-- Common to tasks and protected types. Copy discriminant specifications,
-- build record declaration. N is the type declaration, Ctyp is the
--------------------------------
function Build_Corresponding_Record
- (N : Node_Id;
- Ctyp : Entity_Id;
- Loc : Source_Ptr) return Node_Id
+ (N : Node_Id;
+ Ctyp : Entity_Id;
+ Loc : Source_Ptr) return Node_Id
is
Rec_Ent : constant Entity_Id :=
Make_Defining_Identifier
Actuals : List_Id;
Formals : List_Id;
Decls : List_Id;
- Stmts : List_Id) return Node_Id
+ Stmts : List_Id) return Entity_Id
is
Actual : Entity_Id;
Expr : Node_Id := Empty;
-- Build_Static_Dispatch_Tables --
----------------------------------
- procedure Build_Static_Dispatch_Tables (N : Entity_Id) is
+ procedure Build_Static_Dispatch_Tables (N : Node_Id) is
Target_List : List_Id;
procedure Build_Dispatch_Tables (List : List_Id);
-- value of which is Init_Val if present or null if not.
function Build_Simple_Declaration_With_Default
- (Decl_Id : Entity_Id;
- Init_Val : Entity_Id;
- Typ : Entity_Id;
- Default_Val : Entity_Id) return Node_Id;
+ (Decl_Id : Entity_Id;
+ Init_Val : Node_Id;
+ Typ : Node_Id;
+ Default_Val : Node_Id) return Node_Id;
-- Build a declaration the Defining_Identifier of which is Decl_Id, the
-- Object_Definition of which is Typ, the value of which is Init_Val if
-- present or Default otherwise.
function Build_Simple_Declaration_With_Default
(Decl_Id : Entity_Id;
Init_Val : Node_Id;
- Typ : Entity_Id;
+ Typ : Node_Id;
Default_Val : Node_Id) return Node_Id
is
Value : Node_Id := Init_Val;
procedure Expand_Pragma_Subprogram_Variant
(Prag : Node_Id;
- Subp_Id : Node_Id;
+ Subp_Id : Entity_Id;
Body_Decls : List_Id)
is
Curr_Decls : List_Id;
function Build_Shared_Var_Proc_Call
(Loc : Source_Ptr;
- E : Node_Id;
+ E : Entity_Id;
N : Name_Id) return Node_Id;
-- Build a call to support procedure N for shared object E (provided by the
-- instance of System.Shared_Storage.Shared_Var_Procs associated to E).
-- Convert_To_Actual_Subtype --
-------------------------------
- procedure Convert_To_Actual_Subtype (Exp : Entity_Id) is
+ procedure Convert_To_Actual_Subtype (Exp : Node_Id) is
Act_ST : Entity_Id;
begin
-- Get_Index_Subtype --
-----------------------
- function Get_Index_Subtype (N : Node_Id) return Node_Id is
+ function Get_Index_Subtype (N : Node_Id) return Entity_Id is
P_Type : Entity_Id := Etype (Prefix (N));
Indx : Node_Id;
J : Int;
-- Full_View or Corresponding_Record_Type.
procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id);
- -- Expr is the expression for an address clause for entity Nam whose type
- -- is Typ. If Typ has a default initialization, and there is no explicit
- -- initialization in the source declaration, check whether the address
- -- clause might cause overlaying of an entity, and emit a warning on the
- -- side effect that the initialization will cause.
+ -- Expr is the expression for an address clause for the entity denoted by
+ -- Nam whose type is Typ. If Typ has a default initialization, and there is
+ -- no explicit initialization in the source declaration, check whether the
+ -- address clause might cause overlaying of an entity, and emit a warning
+ -- on the side effect that the initialization will cause.
-------------------------------
-- Adjust_Esize_For_Alignment --
-- Warn_Overlay --
------------------
- procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Entity_Id) is
+ procedure Warn_Overlay (Expr : Node_Id; Typ : Entity_Id; Nam : Node_Id) is
Ent : constant Entity_Id := Entity (Nam);
-- The object to which the address clause applies
-- to the expansion phase. As an optimization, if the discrete choice
-- specifies a single value we do not delay resolution.
- function Array_Aggr_Subtype (N : Node_Id; Typ : Node_Id) return Entity_Id;
+ function Array_Aggr_Subtype (N : Node_Id; Typ : Entity_Id) return Entity_Id;
-- This routine returns the type or subtype of an array aggregate.
--
-- N is the array aggregate node whose type we return.
function Stream_Attribute_Available
(Typ : Entity_Id;
Nam : TSS_Name_Type;
- Partial_View : Node_Id := Empty) return Boolean
+ Partial_View : Entity_Id := Empty) return Boolean
is
Etyp : Entity_Id := Typ;
-- body at the point of freezing will not work. Subp is the subprogram
-- for which N provides the Renaming_As_Body.
- procedure Check_In_Previous_With_Clause
- (N : Node_Id;
- Nam : Node_Id);
+ procedure Check_In_Previous_With_Clause (N, Nam : Node_Id);
-- N is a use_package clause and Nam the package name, or N is a use_type
-- clause and Nam is the prefix of the type name. In either case, verify
- -- that the package is visible at that point in the context: either it
+ -- that the package is visible at that point in the context: either it
-- appears in a previous with_clause, or because it is a fully qualified
-- name and the root ancestor appears in a previous with_clause.
-- Check_In_Previous_With_Clause --
-----------------------------------
- procedure Check_In_Previous_With_Clause
- (N : Node_Id;
- Nam : Entity_Id)
- is
+ procedure Check_In_Previous_With_Clause (N, Nam : Node_Id) is
Pack : constant Entity_Id := Entity (Original_Node (Nam));
Item : Node_Id;
Par : Node_Id;
function Get_Argument
(Prag : Node_Id;
- Context_Id : Node_Id := Empty) return Node_Id;
+ Context_Id : Entity_Id := Empty) return Node_Id;
-- Obtain the argument of pragma Prag depending on context and the nature
-- of the pragma. The argument is extracted in the following manner:
--
-- Visit_Node --
----------------
- procedure Visit_Node (N : Node_Or_Entity_Id) is
+ procedure Visit_Node (N : Node_Id) is
begin
pragma Assert (Nkind (N) not in N_Entity);
-- carries the name of the reference discriminant.
function Build_Overriding_Spec
- (Op : Node_Id;
+ (Op : Entity_Id;
Typ : Entity_Id) return Node_Id;
-- Build a subprogram specification for the wrapper of an inherited
-- operation with a modified pre- or postcondition (See AI12-0113).
projects / thirdparty / gcc.git / commitdiff
