* exp_ch6.adb (Expand_N_Subprogram_Declaration): Do not create
protected operations if original subprogram is flagged as eliminated.
(Expand_N_Subprogram_Body): For a protected operation, create
discriminals for next operation before checking whether the operation
is eliminated.
* exp_ch9.adb (Expand_N_Protected_Body,
Expand_N_Protected_Type_Declaration): Do not generate specs and bodies
for internal protected operations if the original subprogram is
eliminated.
* sem_elim.adb (Check_Eliminated): Handle properly protected operations
declared in a single protected object.
2004-02-23 Vincent Celier <celier@gnat.com>
* prj-attr.adb: Make attribute Builder'Executable an associative array,
case insensitive if file names are case insensitive, instead of a
standard associative array.
* prj-attr.adb (Initialize): For 'b' associative arrays, do not set
them as case insensitive on platforms where the file names are case
sensitive.
* prj-part.adb (Parse_Single_Project): Make sure, when checking if
project file has already been parsed that canonical path are compared.
2004-02-23 Robert Dewar <dewar@gnat.com>
* sinput-c.ads: Correct bad unit title in header
* freeze.adb: Minor reformatting
2004-02-23 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* trans.c (tree_transform, case N_Procedure_Call_Statement): For
nonaddressable COMPONENT_REF that is removing padding that we are
taking the address of, take the address of the padded record instead
if item is variable size.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@78292
138bc75d-0d04-0410-961f-
82ee72b054a4
+2004-02-23 Ed Schonberg <schonberg@gnat.com>
+
+ * exp_ch6.adb (Expand_N_Subprogram_Declaration): Do not create
+ protected operations if original subprogram is flagged as eliminated.
+ (Expand_N_Subprogram_Body): For a protected operation, create
+ discriminals for next operation before checking whether the operation
+ is eliminated.
+
+ * exp_ch9.adb (Expand_N_Protected_Body,
+ Expand_N_Protected_Type_Declaration): Do not generate specs and bodies
+ for internal protected operations if the original subprogram is
+ eliminated.
+
+ * sem_elim.adb (Check_Eliminated): Handle properly protected operations
+ declared in a single protected object.
+
+2004-02-23 Vincent Celier <celier@gnat.com>
+
+ * prj-attr.adb: Make attribute Builder'Executable an associative array,
+ case insensitive if file names are case insensitive, instead of a
+ standard associative array.
+
+ * prj-attr.adb (Initialize): For 'b' associative arrays, do not set
+ them as case insensitive on platforms where the file names are case
+ sensitive.
+
+ * prj-part.adb (Parse_Single_Project): Make sure, when checking if
+ project file has already been parsed that canonical path are compared.
+
+2004-02-23 Robert Dewar <dewar@gnat.com>
+
+ * sinput-c.ads: Correct bad unit title in header
+
+ * freeze.adb: Minor reformatting
+
+2004-02-23 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+ * trans.c (tree_transform, case N_Procedure_Call_Statement): For
+ nonaddressable COMPONENT_REF that is removing padding that we are
+ taking the address of, take the address of the padded record instead
+ if item is variable size.
+
2004-02-20 Robert Dewar <dewar@gnat.com>
* bld.adb, exp_util.adb, gprcmd.adb: Minor reformatting
end;
end if;
+ Scop := Scope (Spec_Id);
+
+ -- Add discriminal renamings to protected subprograms.
+ -- Install new discriminals for expansion of the next
+ -- subprogram of this protected type, if any.
+
+ if Is_List_Member (N)
+ and then Present (Parent (List_Containing (N)))
+ and then Nkind (Parent (List_Containing (N))) = N_Protected_Body
+ then
+ Add_Discriminal_Declarations
+ (Declarations (N), Scop, Name_uObject, Loc);
+ Add_Private_Declarations (Declarations (N), Scop, Name_uObject, Loc);
+
+ -- Associate privals and discriminals with the next protected
+ -- operation body to be expanded. These are used to expand
+ -- references to private data objects and discriminants,
+ -- respectively.
+
+ Next_Op := Next_Protected_Operation (N);
+
+ if Present (Next_Op) then
+ Dec := Parent (Base_Type (Scop));
+ Set_Privals (Dec, Next_Op, Loc);
+ Set_Discriminals (Dec);
+ end if;
+ end if;
+
-- Clear out statement list for stubbed procedure
if Present (Corresponding_Spec (N)) then
end if;
end if;
- Scop := Scope (Spec_Id);
-
-- Returns_By_Ref flag is normally set when the subprogram is frozen
-- but subprograms with no specs are not frozen
end;
end if;
- -- Add discriminal renamings to protected subprograms.
- -- Install new discriminals for expansion of the next
- -- subprogram of this protected type, if any.
-
- if Is_List_Member (N)
- and then Present (Parent (List_Containing (N)))
- and then Nkind (Parent (List_Containing (N))) = N_Protected_Body
- then
- Add_Discriminal_Declarations
- (Declarations (N), Scop, Name_uObject, Loc);
- Add_Private_Declarations (Declarations (N), Scop, Name_uObject, Loc);
-
- -- Associate privals and discriminals with the next protected
- -- operation body to be expanded. These are used to expand
- -- references to private data objects and discriminants,
- -- respectively.
-
- Next_Op := Next_Protected_Operation (N);
-
- if Present (Next_Op) then
- Dec := Parent (Base_Type (Scop));
- Set_Privals (Dec, Next_Op, Loc);
- Set_Discriminals (Dec);
- end if;
- end if;
-
-- If subprogram contains a parameterless recursive call, then we may
-- have an infinite recursion, so see if we can generate code to check
-- for this possibility if storage checks are not suppressed.
Prot_Id : Entity_Id;
begin
- -- Deal with case of protected subprogram
+ -- Deal with case of protected subprogram. Do not generate
+ -- protected operation if operation is flagged as eliminated.
if Is_List_Member (N)
and then Present (Parent (List_Containing (N)))
and then Nkind (Parent (List_Containing (N))) = N_Protected_Body
and then Is_Protected_Type (Scop)
then
- if No (Protected_Body_Subprogram (Subp)) then
+ if No (Protected_Body_Subprogram (Subp))
+ and then not Is_Eliminated (Subp)
+ then
Prot_Decl :=
Make_Subprogram_Declaration (Loc,
Specification =>
-- Exclude functions created to analyze defaults.
- if not Is_Eliminated (Defining_Entity (Op_Body)) then
+ if not Is_Eliminated (Defining_Entity (Op_Body))
+ and then not Is_Eliminated (Corresponding_Spec (Op_Body))
+ then
New_Op_Body :=
Build_Unprotected_Subprogram_Body (Op_Body, Pid);
-- subprogram; one to call from outside the object and one to
-- call from inside. Build a barrier function and an entry
-- body action procedure specification for each protected entry.
- -- Initialize the entry body array.
+ -- Initialize the entry body array. If subprogram is flagged as
+ -- eliminated, do not generate any internal operations.
E_Count := 0;
Comp := First (Visible_Declarations (Pdef));
while Present (Comp) loop
- if Nkind (Comp) = N_Subprogram_Declaration then
+ if Nkind (Comp) = N_Subprogram_Declaration
+ and then not Is_Eliminated (Defining_Entity (Comp))
+ then
Sub :=
Make_Subprogram_Declaration (Loc,
Specification =>
-- might otherwise be frozen in the wrong scope, and a freeze node
-- on subtype has no effect.
+ -----------------
+ -- Check_Itype --
+ -----------------
+
procedure Check_Itype (Desig : Entity_Id) is
begin
if not Is_Frozen (Desig)
then
Set_First_Entity (Rec, First_Entity (Base_Type (Rec)));
- -- If this is an internal type without a declaration, as for
- -- a record component, the base type may not yet be frozen,
- -- and its controller has not been created. Add an explicit
- -- freeze node for the itype, so it will be frozen after the
- -- base type.
+ -- If this is an internal type without a declaration, as for a
+ -- record component, the base type may not yet be frozen, and its
+ -- controller has not been created. Add an explicit freeze node
+ -- for the itype, so it will be frozen after the base type.
elsif Is_Itype (Rec)
and then Has_Delayed_Freeze (Base_Type (Rec))
-- Loop through formals
Formal := First_Formal (E);
-
while Present (Formal) loop
F_Type := Etype (Formal);
Freeze_And_Append (F_Type, Loc, Result);
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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- --
"Pbuilder#" &
"Ladefault_switches#" &
"Lbswitches#" &
- "SAexecutable#" &
+ "Sbexecutable#" &
"SVexecutable_suffix#" &
"SVglobal_configuration_pragmas#" &
when 'b' =>
if File_Names_Case_Sensitive then
- Kind_2 := Case_Insensitive_Associative_Array;
+ Kind_2 := Associative_Array;
else
Kind_2 := Case_Insensitive_Associative_Array;
end if;
-- projects. These imported projects will be effectively parsed after the
-- name of the current project has been extablished.
- type Name_And_Id is record
- Name : Name_Id;
+ type Names_And_Id is record
+ Path_Name : Name_Id;
+ Canonical_Path_Name : Name_Id;
Id : Project_Node_Id;
end record;
package Project_Stack is new Table.Table
- (Table_Component_Type => Name_And_Id,
+ (Table_Component_Type => Names_And_Id,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 10,
if Project_Stack.Last > 1 then
for Index in reverse 1 .. Project_Stack.Last loop
- Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
+ Error_Msg_Name_1 := Project_Stack.Table (Index).Path_Name;
Error_Msg ("\imported by {", Current_With.Location);
end loop;
end if;
Canonical_Path_Name := Name_Find;
for Index in 1 .. Project_Stack.Last loop
- if Project_Stack.Table (Index).Name =
+ if Project_Stack.Table (Index).Canonical_Path_Name =
Canonical_Path_Name
then
-- We have found the limited imported project,
-- Check for a circular dependency
for Index in 1 .. Project_Stack.Last loop
- if Canonical_Path_Name = Project_Stack.Table (Index).Name then
+ if Canonical_Path_Name =
+ Project_Stack.Table (Index).Canonical_Path_Name
+ then
Error_Msg ("circular dependency detected", Token_Ptr);
Error_Msg_Name_1 := Normed_Path_Name;
Error_Msg ("\ { is imported by", Token_Ptr);
for Current in reverse 1 .. Project_Stack.Last loop
- Error_Msg_Name_1 := Project_Stack.Table (Current).Name;
+ Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name;
if Error_Msg_Name_1 /= Canonical_Path_Name then
Error_Msg
-- Put the new path name on the stack
Project_Stack.Increment_Last;
- Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
+ Project_Stack.Table (Project_Stack.Last).Path_Name := Normed_Path_Name;
+ Project_Stack.Table (Project_Stack.Last).Canonical_Path_Name :=
+ Canonical_Path_Name;
-- Check if the project file has already been parsed.
while
A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
loop
- if
- Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
- then
- if Extended then
+ declare
+ Path_Id : Name_Id := Path_Name_Of (A_Project_Name_And_Node.Node);
+ begin
+ if Path_Id /= No_Name then
+ Get_Name_String (Path_Id);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Path_Id := Name_Find;
+ end if;
- if A_Project_Name_And_Node.Extended then
- Error_Msg
- ("cannot extend the same project file several times",
- Token_Ptr);
+ if Path_Id = Canonical_Path_Name then
+ if Extended then
- else
- Error_Msg
- ("cannot extend an already imported project file",
- Token_Ptr);
- end if;
+ if A_Project_Name_And_Node.Extended then
+ Error_Msg
+ ("cannot extend the same project file several times",
+ Token_Ptr);
- elsif A_Project_Name_And_Node.Extended then
- Extends_All := Is_Extending_All (A_Project_Name_And_Node.Node);
-
- -- If the imported project is an extended project A, and we are
- -- in an extended project, replace A with the ultimate project
- -- extending A.
+ else
+ Error_Msg
+ ("cannot extend an already imported project file",
+ Token_Ptr);
+ end if;
- if From_Extended /= None then
- declare
- Decl : Project_Node_Id :=
- Project_Declaration_Of
- (A_Project_Name_And_Node.Node);
- Prj : Project_Node_Id :=
- Extending_Project_Of (Decl);
- begin
- loop
- Decl := Project_Declaration_Of (Prj);
- exit when Extending_Project_Of (Decl) = Empty_Node;
- Prj := Extending_Project_Of (Decl);
- end loop;
+ elsif A_Project_Name_And_Node.Extended then
+ Extends_All :=
+ Is_Extending_All (A_Project_Name_And_Node.Node);
+
+ -- If the imported project is an extended project A,
+ -- and we are in an extended project, replace A with the
+ -- ultimate project extending A.
+
+ if From_Extended /= None then
+ declare
+ Decl : Project_Node_Id :=
+ Project_Declaration_Of
+ (A_Project_Name_And_Node.Node);
+ Prj : Project_Node_Id :=
+ Extending_Project_Of (Decl);
+ begin
+ loop
+ Decl := Project_Declaration_Of (Prj);
+ exit when Extending_Project_Of (Decl) = Empty_Node;
+ Prj := Extending_Project_Of (Decl);
+ end loop;
- A_Project_Name_And_Node.Node := Prj;
- end;
- else
- Error_Msg
- ("cannot import an already extended project file",
- Token_Ptr);
+ A_Project_Name_And_Node.Node := Prj;
+ end;
+ else
+ Error_Msg
+ ("cannot import an already extended project file",
+ Token_Ptr);
+ end if;
end if;
- end if;
- Project := A_Project_Name_And_Node.Node;
- Project_Stack.Decrement_Last;
- return;
- end if;
+ Project := A_Project_Name_And_Node.Node;
+ Project_Stack.Decrement_Last;
+ return;
+ end if;
+ end;
A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
end loop;
if Project_Stack.Last > 1 then
Error_Msg_Name_1 :=
- Project_Stack.Table (Project_Stack.Last).Name;
+ Project_Stack.Table (Project_Stack.Last).Path_Name;
Error_Msg ("\extended by {", Token_Ptr);
for Index in reverse 1 .. Project_Stack.Last - 1 loop
- Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
+ Error_Msg_Name_1 :=
+ Project_Stack.Table (Index).Path_Name;
Error_Msg ("\imported by {", Token_Ptr);
end loop;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2004 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- --
Ctr : Nat;
Ent : Entity_Id;
+ function Original_Chars (S : Entity_Id) return Name_Id;
+ -- If the candidate subprogram is a protected operation of a single
+ -- protected object, the scope of the operation is the created
+ -- protected type, and we have to retrieve the original name of
+ -- the object.
+
+ --------------------
+ -- Original_Chars --
+ --------------------
+
+ function Original_Chars (S : Entity_Id) return Name_Id is
+ begin
+ if Ekind (S) /= E_Protected_Type
+ or else Comes_From_Source (S)
+ then
+ return Chars (S);
+ else
+ return Chars (Defining_Identifier (Original_Node (Parent (S))));
+ end if;
+ end Original_Chars;
+
+ -- Start of processing for Check_Eliminated
+
begin
if No_Elimination then
return;
Scop := Scope (E);
if Elmt.Entity_Scope /= null then
for J in reverse Elmt.Entity_Scope'Range loop
- if Elmt.Entity_Scope (J) /= Chars (Scop) then
+ if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
goto Continue;
end if;
-- --
-- GNAT COMPILER COMPONENTS --
-- --
--- S I N P U T . P --
+-- S I N P U T . C --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
gnu_actual);
}
+ /* Otherwise, if we have a non-addressable COMPONENT_REF of a
+ variable-size type see if it's doing a unpadding operation.
+ If so, remove that operation since we have no way of
+ allocating the required temporary. */
+ if (TREE_CODE (gnu_actual) == COMPONENT_REF
+ && ! TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
+ && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_actual, 0)))
+ == RECORD_TYPE)
+ && TYPE_IS_PADDING_P (TREE_TYPE
+ (TREE_OPERAND (gnu_actual, 0)))
+ && !addressable_p (gnu_actual))
+ gnu_actual = TREE_OPERAND (gnu_actual, 0);
+
/* The symmetry of the paths to the type of an entity is
broken here since arguments don't know that they will
be passed by ref. */
OSDN Git Service
