From b2ab8c33ed0041184fe3747fbad246a619883600 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 4 Nov 2011 14:52:11 +0100 Subject: [PATCH] [multiple changes] 2011-11-04 Hristian Kirtchev * exp_alfa.adb: Add with and use clauses for Exp_Ch8 and Sem_Util. (Expand_Alfa): Alphabetize cases on first choice. Add processing for object renaming declarations, identifiers and expanded names. (Expand_Alfa_N_In): Remove useless return. (Expand_Alfa_N_Object_Renaming_Declaration): New routine. (Expand_Potential_Renaming): New routine. * exp_ch8.adb (Evaluate_Name): Moved to the top level. (Expand_N_Object_Declaration): Alphabetize local variables. Move Evaluate_Name out to the top level. * exp_ch8.ads (Evaluate_Name): Moved from body to package spec. * exp_util.adb (Remove_Side_Effects): Add processing for functions with side effects in Alfa mode. 2011-11-04 Hristian Kirtchev * gnat_rm.texi: Add entries for restrictions No_Relative_Delay, No_Requeue_Statements and No_Stream_Optimizations. 2011-11-04 Ed Schonberg * sem_ch4.adb: Set type of entity in prefixed call, for completeness in a generic context. From-SVN: r180951 --- gcc/ada/ChangeLog | 28 ++++++ gcc/ada/exp_alfa.adb | 64 ++++++++++--- gcc/ada/exp_ch8.adb | 209 +++++++++++++++++++++---------------------- gcc/ada/exp_ch8.ads | 7 +- gcc/ada/exp_util.adb | 61 +++++++++---- gcc/ada/gnat_rm.texi | 19 ++++ gcc/ada/sem_ch4.adb | 4 +- 7 files changed, 255 insertions(+), 137 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8742031a5ad..392c0b19f8c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2011-11-04 Hristian Kirtchev + + * exp_alfa.adb: Add with and use clauses for Exp_Ch8 and + Sem_Util. + (Expand_Alfa): Alphabetize cases on first choice. Add + processing for object renaming declarations, identifiers and + expanded names. + (Expand_Alfa_N_In): Remove useless return. + (Expand_Alfa_N_Object_Renaming_Declaration): New routine. + (Expand_Potential_Renaming): New routine. + * exp_ch8.adb (Evaluate_Name): Moved to the top level. + (Expand_N_Object_Declaration): Alphabetize local variables. Move + Evaluate_Name out to the top level. + * exp_ch8.ads (Evaluate_Name): Moved from body to package spec. + * exp_util.adb (Remove_Side_Effects): Add processing for + functions with side effects in Alfa mode. + +2011-11-04 Hristian Kirtchev + + * gnat_rm.texi: Add entries for + restrictions No_Relative_Delay, No_Requeue_Statements and + No_Stream_Optimizations. + +2011-11-04 Ed Schonberg + + * sem_ch4.adb: Set type of entity in prefixed call, for + completeness in a generic context. + 2011-11-04 Yannick Moy * sem_prag.adb: Minor refactoring (renaming of a parameter). diff --git a/gcc/ada/exp_alfa.adb b/gcc/ada/exp_alfa.adb index 988d16fba1f..7dcecfd9df7 100644 --- a/gcc/ada/exp_alfa.adb +++ b/gcc/ada/exp_alfa.adb @@ -28,11 +28,13 @@ with Einfo; use Einfo; with Exp_Attr; use Exp_Attr; with Exp_Ch4; use Exp_Ch4; with Exp_Ch6; use Exp_Ch6; +with Exp_Ch8; use Exp_Ch8; with Exp_Dbug; use Exp_Dbug; with Nlists; use Nlists; with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; with Sem_Res; use Sem_Res; +with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; @@ -56,12 +58,19 @@ package body Exp_Alfa is procedure Expand_Alfa_N_In (N : Node_Id); -- Expand set membership into individual ones + procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id); + -- Perform name evaluation for a renamed object + procedure Expand_Alfa_N_Simple_Return_Statement (N : Node_Id); -- Insert conversion on function return if necessary procedure Expand_Alfa_Simple_Function_Return (N : Node_Id); -- Expand simple return from function + procedure Expand_Potential_Renaming (N : Node_Id); + -- N denotes a N_Identifier or N_Expanded_Name. If N references a renaming, + -- replace N with the renamed object. + ----------------- -- Expand_Alfa -- ----------------- @@ -69,22 +78,22 @@ package body Exp_Alfa is procedure Expand_Alfa (N : Node_Id) is begin case Nkind (N) is + when N_Attribute_Reference => + Expand_Alfa_N_Attribute_Reference (N); - when N_Package_Body | + when N_Block_Statement | + N_Package_Body | N_Package_Declaration | - N_Subprogram_Body | - N_Block_Statement => + N_Subprogram_Body => Qualify_Entity_Names (N); - when N_Simple_Return_Statement => - Expand_Alfa_N_Simple_Return_Statement (N); - when N_Function_Call | N_Procedure_Call_Statement => Expand_Alfa_Call (N); - when N_Attribute_Reference => - Expand_Alfa_N_Attribute_Reference (N); + when N_Expanded_Name | + N_Identifier => + Expand_Potential_Renaming (N); when N_In => Expand_Alfa_N_In (N); @@ -92,6 +101,12 @@ package body Exp_Alfa is when N_Not_In => Expand_N_Not_In (N); + when N_Object_Renaming_Declaration => + Expand_Alfa_N_Object_Renaming_Declaration (N); + + when N_Simple_Return_Statement => + Expand_Alfa_N_Simple_Return_Statement (N); + when others => null; end case; @@ -157,7 +172,6 @@ package body Exp_Alfa is Set_Entity (Name (Call_Node), Parent_Subp); end if; - end Expand_Alfa_Call; --------------------------------------- @@ -186,10 +200,20 @@ package body Exp_Alfa is begin if Present (Alternatives (N)) then Expand_Set_Membership (N); - return; end if; end Expand_Alfa_N_In; + ----------------------------------------------- + -- Expand_Alfa_N_Object_Renaming_Declaration -- + ----------------------------------------------- + + procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id) is + begin + -- Unconditionally remove all side effects from the name + + Evaluate_Name (Name (N)); + end Expand_Alfa_N_Object_Renaming_Declaration; + ------------------------------------------- -- Expand_Alfa_N_Simple_Return_Statement -- ------------------------------------------- @@ -218,7 +242,6 @@ package body Exp_Alfa is E_Entry | E_Entry_Family | E_Return_Statement => - -- Expand_Non_Function_Return (N); null; when others => @@ -265,4 +288,23 @@ package body Exp_Alfa is end if; end Expand_Alfa_Simple_Function_Return; + ------------------------------- + -- Expand_Potential_Renaming -- + ------------------------------- + + procedure Expand_Potential_Renaming (N : Node_Id) is + E : constant Entity_Id := Entity (N); + T : constant Entity_Id := Etype (N); + + begin + -- Substitute a reference to a renaming with the actual renamed object + + if Present (Renamed_Object (E)) then + Rewrite (N, New_Copy_Tree (Renamed_Object (E))); + + Reset_Analyzed_Flags (N); + Analyze_And_Resolve (N, T); + end if; + end Expand_Potential_Renaming; + end Exp_Alfa; diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index af33868b799..c1fc7e8bc67 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -44,6 +44,100 @@ with Tbuild; use Tbuild; package body Exp_Ch8 is + ------------------- + -- Evaluate_Name -- + ------------------- + + procedure Evaluate_Name (Nam : Node_Id) is + K : constant Node_Kind := Nkind (Nam); + + begin + -- For an explicit dereference, we simply force the evaluation of the + -- name expression. The dereference provides a value that is the address + -- for the renamed object, and it is precisely this value that we want + -- to preserve. + + if K = N_Explicit_Dereference then + Force_Evaluation (Prefix (Nam)); + + -- For a selected component, we simply evaluate the prefix + + elsif K = N_Selected_Component then + Evaluate_Name (Prefix (Nam)); + + -- For an indexed component, or an attribute reference, we evaluate the + -- prefix, which is itself a name, recursively, and then force the + -- evaluation of all the subscripts (or attribute expressions). + + elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then + Evaluate_Name (Prefix (Nam)); + + declare + E : Node_Id; + + begin + E := First (Expressions (Nam)); + while Present (E) loop + Force_Evaluation (E); + + if Original_Node (E) /= E then + Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E))); + end if; + + Next (E); + end loop; + end; + + -- For a slice, we evaluate the prefix, as for the indexed component + -- case and then, if there is a range present, either directly or as the + -- constraint of a discrete subtype indication, we evaluate the two + -- bounds of this range. + + elsif K = N_Slice then + Evaluate_Name (Prefix (Nam)); + + declare + DR : constant Node_Id := Discrete_Range (Nam); + Constr : Node_Id; + Rexpr : Node_Id; + + begin + if Nkind (DR) = N_Range then + Force_Evaluation (Low_Bound (DR)); + Force_Evaluation (High_Bound (DR)); + + elsif Nkind (DR) = N_Subtype_Indication then + Constr := Constraint (DR); + + if Nkind (Constr) = N_Range_Constraint then + Rexpr := Range_Expression (Constr); + + Force_Evaluation (Low_Bound (Rexpr)); + Force_Evaluation (High_Bound (Rexpr)); + end if; + end if; + end; + + -- For a type conversion, the expression of the conversion must be the + -- name of an object, and we simply need to evaluate this name. + + elsif K = N_Type_Conversion then + Evaluate_Name (Expression (Nam)); + + -- For a function call, we evaluate the call + + elsif K = N_Function_Call then + Force_Evaluation (Nam); + + -- The remaining cases are direct name, operator symbol and character + -- literal. In all these cases, we do nothing, since we want to + -- reevaluate each time the renamed object is used. + + else + return; + end if; + end Evaluate_Name; + --------------------------------------------- -- Expand_N_Exception_Renaming_Declaration -- --------------------------------------------- @@ -91,114 +185,17 @@ package body Exp_Ch8 is procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is Nam : constant Node_Id := Name (N); - T : Entity_Id; Decl : Node_Id; - - procedure Evaluate_Name (Fname : Node_Id); - -- A recursive procedure used to freeze a name in the sense described - -- above, i.e. any variable references or function calls are removed. - -- Of course the outer level variable reference must not be removed. - -- For example in A(J,F(K)), A is left as is, but J and F(K) are - -- evaluated and removed. + T : Entity_Id; function Evaluation_Required (Nam : Node_Id) return Boolean; - -- Determines whether it is necessary to do static name evaluation - -- for renaming of Nam. It is considered necessary if evaluating the - -- name involves indexing a packed array, or extracting a component - -- of a record to which a component clause applies. Note that we are - -- only interested in these operations if they occur as part of the - -- name itself, subscripts are just values that are computed as part - -- of the evaluation, so their form is unimportant. - - ------------------- - -- Evaluate_Name -- - ------------------- - - procedure Evaluate_Name (Fname : Node_Id) is - K : constant Node_Kind := Nkind (Fname); - E : Node_Id; - - begin - -- For an explicit dereference, we simply force the evaluation - -- of the name expression. The dereference provides a value that - -- is the address for the renamed object, and it is precisely - -- this value that we want to preserve. - - if K = N_Explicit_Dereference then - Force_Evaluation (Prefix (Fname)); - - -- For a selected component, we simply evaluate the prefix - - elsif K = N_Selected_Component then - Evaluate_Name (Prefix (Fname)); - - -- For an indexed component, or an attribute reference, we evaluate - -- the prefix, which is itself a name, recursively, and then force - -- the evaluation of all the subscripts (or attribute expressions). - - elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then - Evaluate_Name (Prefix (Fname)); - - E := First (Expressions (Fname)); - while Present (E) loop - Force_Evaluation (E); - - if Original_Node (E) /= E then - Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E))); - end if; - - Next (E); - end loop; - - -- For a slice, we evaluate the prefix, as for the indexed component - -- case and then, if there is a range present, either directly or - -- as the constraint of a discrete subtype indication, we evaluate - -- the two bounds of this range. - - elsif K = N_Slice then - Evaluate_Name (Prefix (Fname)); - - declare - DR : constant Node_Id := Discrete_Range (Fname); - Constr : Node_Id; - Rexpr : Node_Id; - - begin - if Nkind (DR) = N_Range then - Force_Evaluation (Low_Bound (DR)); - Force_Evaluation (High_Bound (DR)); - - elsif Nkind (DR) = N_Subtype_Indication then - Constr := Constraint (DR); - - if Nkind (Constr) = N_Range_Constraint then - Rexpr := Range_Expression (Constr); - - Force_Evaluation (Low_Bound (Rexpr)); - Force_Evaluation (High_Bound (Rexpr)); - end if; - end if; - end; - - -- For a type conversion, the expression of the conversion must be - -- the name of an object, and we simply need to evaluate this name. - - elsif K = N_Type_Conversion then - Evaluate_Name (Expression (Fname)); - - -- For a function call, we evaluate the call - - elsif K = N_Function_Call then - Force_Evaluation (Fname); - - -- The remaining cases are direct name, operator symbol and - -- character literal. In all these cases, we do nothing, since - -- we want to reevaluate each time the renamed object is used. - - else - return; - end if; - end Evaluate_Name; + -- Determines whether it is necessary to do static name evaluation for + -- renaming of Nam. It is considered necessary if evaluating the name + -- involves indexing a packed array, or extracting a component of a + -- record to which a component clause applies. Note that we are only + -- interested in these operations if they occur as part of the name + -- itself, subscripts are just values that are computed as part of the + -- evaluation, so their form is unimportant. ------------------------- -- Evaluation_Required -- diff --git a/gcc/ada/exp_ch8.ads b/gcc/ada/exp_ch8.ads index 7df54f3069a..b5056ab2e7f 100644 --- a/gcc/ada/exp_ch8.ads +++ b/gcc/ada/exp_ch8.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -32,4 +32,9 @@ package Exp_Ch8 is procedure Expand_N_Object_Renaming_Declaration (N : Node_Id); procedure Expand_N_Package_Renaming_Declaration (N : Node_Id); procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id); + + procedure Evaluate_Name (Nam : Node_Id); + -- Remove the all side effects from a name except for the outermost + -- construct. + end Exp_Ch8; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 0f7fe592722..8281ded0c30 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6531,32 +6531,57 @@ package body Exp_Util is end; end if; - Ref_Type := Make_Temporary (Loc, 'A'); - - Ptr_Typ_Decl := - Make_Full_Type_Declaration (Loc, - Defining_Identifier => Ref_Type, - Type_Definition => - Make_Access_To_Object_Definition (Loc, - All_Present => True, - Subtype_Indication => - New_Reference_To (Exp_Type, Loc))); - - E := Exp; - Insert_Action (Exp, Ptr_Typ_Decl); - Def_Id := Make_Temporary (Loc, 'R', Exp); Set_Etype (Def_Id, Exp_Type); - Res := - Make_Explicit_Dereference (Loc, - Prefix => New_Reference_To (Def_Id, Loc)); + -- The regular expansion of functions with side effects involves the + -- generation of an access type to capture the return value found on + -- the secondary stack. Since Alfa (and why) cannot process access + -- types, use a different approach which ignores the secondary stack + -- and "copies" the returned object. + if Alfa_Mode then + Res := New_Reference_To (Def_Id, Loc); + Ref_Type := Exp_Type; + + -- Regular expansion utilizing an access type and 'reference + + else + Res := + Make_Explicit_Dereference (Loc, + Prefix => New_Reference_To (Def_Id, Loc)); + + -- Generate: + -- type Ann is access all ; + + Ref_Type := Make_Temporary (Loc, 'A'); + + Ptr_Typ_Decl := + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Ref_Type, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Subtype_Indication => + New_Reference_To (Exp_Type, Loc))); + + Insert_Action (Exp, Ptr_Typ_Decl); + end if; + + E := Exp; if Nkind (E) = N_Explicit_Dereference then New_Exp := Relocate_Node (Prefix (E)); else E := Relocate_Node (E); - New_Exp := Make_Reference (Loc, E); + + -- Do not generate a 'reference in Alfa since the access type is + -- not generated. + + if Alfa_Mode then + New_Exp := E; + else + New_Exp := Make_Reference (Loc, E); + end if; end if; if Is_Delayed_Aggregate (E) then diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 170a9128dd7..dd9f55168a9 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9124,6 +9124,17 @@ only declared at the library level. This restriction ensures at compile time that there are no allocator expressions that attempt to allocate protected objects. +@item No_Relative_Delay +@findex No_Relative_Delay +This restriction ensures at compile time that there are no delay relative +statements and prevents expressions such as @code{delay 1.23;} from appearing +in source code. + +@item No_Requeue_Statements +@findex No_Requeue_Statements +This restriction ensures at compile time that no requeue statements are +permitted and prevents keyword @code{requeue} from being used in source code. + @item No_Secondary_Stack @findex No_Secondary_Stack This restriction ensures at compile time that the generated code does not @@ -9145,6 +9156,14 @@ use the standard default storage pool. Any access type declared must have an explicit Storage_Pool attribute defined specifying a user-defined storage pool. +@item No_Stream_Optimizations +@findex No_Stream_Optimizations +This restriction affects the performance of stream operations on types +@code{String}, @code{Wide_String} and @code{Wide_Wide_String}. By default, the +compiler uses block reads and writes when manipulating @code{String} objects +due to their supperior performance. When this restriction is in effect, the +compiler performs all IO operations on a per-character basis. + @item No_Streams @findex No_Streams This restriction ensures at compile/bind time that there are no diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index efc76f11398..1a88e77ede8 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6863,7 +6863,8 @@ package body Sem_Ch4 is First_Actual := First (Parameter_Associations (Call_Node)); -- For cross-reference purposes, treat the new node as being in - -- the source if the original one is. + -- the source if the original one is. Set entity and type, even + -- though they may be overwritten during resolution if overloaded. Set_Comes_From_Source (Subprog, Comes_From_Source (N)); Set_Comes_From_Source (Call_Node, Comes_From_Source (N)); @@ -6872,6 +6873,7 @@ package body Sem_Ch4 is and then not Inside_A_Generic then Set_Entity (Selector_Name (N), Entity (Subprog)); + Set_Etype (Selector_Name (N), Etype (Entity (Subprog))); end if; -- If need be, rewrite first actual as an explicit dereference