From 523456dbde953a6f2dac504b2fd2ff1ddc8ec03d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 15 Jul 2004 22:34:43 +0200 Subject: [multiple changes] 2004-07-15 Robert Dewar * makegpr.adb, s-secsta.ads, sem_ch3.adb, sem_case.adb: Minor reformatting * gnat_ugn.texi: Add instantiation of direct_io or sequential_io with access values as an example of a warning. * gnat_rm.texi: Document new attribute Has_Access_Values * gnat-style.texi: Document that box comments belong on nested subprograms * sem_util.ads (Has_Access_Values): Improved documentation * s-finimp.ads, s-finimp.adb: Fix spelling error in comment * sem_prag.adb (Check_Duplicated_Export_Name): New procedure (Process_Interface_Name): Call to this new procedure (Set_Extended_Import_Export_External_Name): Call to this new procedure * s-mastop-x86.adb, 9drpc.adb: Fix spelling error in comment * a-direio.ads, a-sequio.ads: Warn if Element_Type has access values * einfo.ads: Minor comment typo fixed 2004-07-15 Jose Ruiz * snames.adb: Add _atcb. * snames.ads: Add Name_uATCB. * s-tarest.adb (Create_Restricted_Task): ATCBs are always preallocated (in the expanded code) when using the restricted run time. * s-tarest.ads (Create_Restricted_Task): Created_Task transformed into a in parameter in order to allow ATCBs to be preallocated (in the expanded code). * s-taskin.adb (Initialize_ATCB): T converted into a in parameter in order to allow ATCBs to be preallocated. In case of error, the ATCB is deallocated in System.Tasking.Stages. * s-taskin.ads (Initialize_ATCB): T converted into a in parameter in order to allow ATCBs to be preallocated. * s-tassta.adb (Create_Task): In case of error the ATCB is deallocated here. It was previously done in Initialize_ATCB. * rtsfind.ads: Make the Ada_Task_Control_Block visible. * exp_ch9.adb: Preallocate the Ada_Task_Control_Block when using the Restricted run time. * exp_ch3.adb: When using the Restricted run time, pass the preallocated Ada_Task_Control_Block when creating a task. 2004-07-15 Ed Schonberg * sem_util.adb (Normalize_Actuals): If there are no actuals on a function call that is itself an actual in an enclosing call, diagnose problem here rather than assuming that resolution will catch it. * sem_ch7.adb (Analyze_Package_Specification): If the specification is the local copy of a generic unit for a formal package, and the generic is a child unit, install private part of ancestors before compiling private part of spec. * sem_cat.adb (Validate_Categorization_Dependency): Simplify code to use scope entities rather than tree structures, to handle properly parent units that are instances rewritten as bodies for inlining purposes. * sem_ch10.adb (Get_Parent_Entity, Implicit_With_On_Parent, Remove_Parents): Handle properly a parent unit that is an instantiation, when the unit has been rewritten as a body for inlining purposes. * par.adb (Goto_List): Global variable to collect goto statements in a given unit, for use in detecting natural loops. * par-ch5.adb (P_Goto_Statement): Add goto to global Goto_List, for use in detecting natural loops. * par-labl.adb (Find_Natural_Loops): Recognize loops create by backwards goto's, and rewrite as a infinite loop, to improve locality of temporaries. * exp_util.adb (Force_Evaluation): Recognize a left-hand side subcomponent that includes an indexed reference, to prevent the generation of copies that would miscompile the desired assignment statement. (Build_Task_Image_Decls): Add a numeric suffix to generated name for string variable, to avoid spurious conflicts with the name of the type of a single protected object. * exp_ch4.adb (Expand_Array_Equality): If indices are distinct, use a loop with an explicit exit statement, to avoid generating an out-of-range value with 'Succ leading to spurious constraint_errors when compiling with -gnatVo. 2004-07-15 Thomas Quinot * sem_ch4.adb (Analyze_Slice): Always call Analyze on the prefix: it might not be analyzed yet, even if its Etype is already set (case of an unchecked conversion built using Unchecked_Convert_To, for example). If the prefix has already been analyzed, this will be a nop anyway. * exp_ch5.adb (Make_Tag_Ctrl_Assignment): For an assignment of a controller type, or an assignment of a record type with controlled components, copy only user data, and leave the finalization chain pointers untouched. 2004-07-15 Vincent Celier * make.adb (Collect_Arguments): Improve error message when attempting to compile a source not part of any project, when -x is not used. * prj.ads: (Defined_Variable_Kind): New subtype * prj-attr.adb (Register_New_Package): Two new procedures to register a package with or without its attributes. (Register_New_Attribute): Mew procedure to register a new attribute in a package. New attribute oriented subprograms: Attribute_Node_Id_Of, Attribute_Kind_Of, Set_Attribute_Kind_Of, Attribute_Name_Of, Variable_Kind_Of, Set_Variable_Kind_Of, Optional_Index_Of, Next_Attribute. New package oriented subprograms: Package_Node_Id_Of, Add_Unknown_Package, First_Attribute_Of, Add_Attribute. * prj-attr.ads (Attribute_Node_Id): Now a private, self initialized type. (Package_Node_Id): Now a private, self initialized type (Register_New_Package): New procedure to register a package with its attributes. New attribute oriented subprograms: Attribute_Node_Id_Of, Attribute_Kind_Of, Set_Attribute_Kind_Of, Attribute_Name_Of, Variable_Kind_Of, Set_Variable_Kind_Of, Optional_Index_Of, Next_Attribute. New package oriented subprograms: Package_Node_Id_Of, Add_Unknown_Package, First_Attribute_Of, Add_Attribute. * prj-dect.adb (Parse_Attribute_Declaration, Parse_Package_Declaration): Adapt to new spec of Prj.Attr. * prj-makr.adb (Make): Parse existing project file before creating other files. Fail if there was an error during parsing. * prj-proc.adb (Add_Attributes, Process_Declarative_Items): Adapt to new spec of Prj.Attr. * prj-strt.adb (Attribute_Reference, Parse_Variable_Reference): Adapt to new spec of Prj.Attr. 2004-07-15 Richard Kenner * utils2.c: Fix typo in comment. From-SVN: r84774 --- gcc/ada/exp_ch4.adb | 92 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 66 insertions(+), 26 deletions(-) (limited to 'gcc/ada/exp_ch4.adb') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index a9d26bd..7e51ca3 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -877,21 +877,27 @@ package body Exp_Ch4 is -- end if; -- declare - -- B1 : Index_T1 := B'first (1) + -- A1 : Index_T1 := A'first (1); + -- B1 : Index_T1 := B'first (1); -- begin - -- for A1 in A'range (1) loop + -- loop -- declare - -- B2 : Index_T2 := B'first (2) + -- A2 : Index_T2 := A'first (2); + -- B2 : Index_T2 := B'first (2); -- begin - -- for A2 in A'range (2) loop + -- loop -- if A (A1, A2) /= B (B1, B2) then -- return False; -- end if; + -- exit when A2 = A'last (2); + -- A2 := Index_T2'succ (A2); -- B2 := Index_T2'succ (B2); -- end loop; -- end; + -- exit when A1 = A'last (1); + -- A1 := Index_T1'succ (A1); -- B1 := Index_T1'succ (B1); -- end loop; -- end; @@ -905,6 +911,10 @@ package body Exp_Ch4 is -- has a bound depending on a discriminant, then we use the base type -- since otherwise we have an escaped discriminant in the function. + -- If both arrays are constrained and have the same bounds, we can + -- generate a loop with an explicit iteration scheme using a 'Range + -- attribute over the first array. + function Expand_Array_Equality (Nod : Node_Id; Lhs : Node_Id; @@ -949,27 +959,29 @@ package body Exp_Ch4 is -- This procedure returns the following code -- -- declare - -- Bn : Index_T := B'First (n); + -- Bn : Index_T := B'First (N); -- begin - -- for An in A'range (n) loop + -- loop -- xxx + -- exit when An = A'Last (N); + -- An := Index_T'Succ (An) -- Bn := Index_T'Succ (Bn) -- end loop; -- end; -- - -- Note: we don't need Bn or the declare block when the index types - -- of the two arrays are constrained and identical. + -- If both indices are constrained and identical, the procedure + -- returns a simpler loop: + -- + -- for An in A'Range (N) loop + -- xxx + -- end loop -- - -- where N is the value of "n" in the above code. Index is the + -- N is the dimension for which we are generating a loop. Index is the -- N'th index node, whose Etype is Index_Type_n in the above code. -- The xxx statement is either the loop or declare for the next -- dimension or if this is the last dimension the comparison -- of corresponding components of the arrays. -- - -- Note: if the index types are identical and constrained, we - -- need only one index, so we generate only An and we do not - -- need the declare block. - -- -- The actual way the code works is to return the comparison -- of corresponding components for the N+1 call. That's neater! @@ -1119,6 +1131,24 @@ package body Exp_Ch4 is Handle_One_Dimension (N + 1, Next_Index (Index))); if Need_Separate_Indexes then + -- Generate guard for loop, followed by increments of indices. + + Append_To (Stm_List, + Make_Exit_Statement (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => New_Reference_To (An, Loc), + Right_Opnd => Arr_Attr (A, Name_Last, N)))); + + Append_To (Stm_List, + Make_Assignment_Statement (Loc, + Name => New_Reference_To (An, Loc), + Expression => + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Index_T, Loc), + Attribute_Name => Name_Succ, + Expressions => New_List (New_Reference_To (An, Loc))))); + Append_To (Stm_List, Make_Assignment_Statement (Loc, Name => New_Reference_To (Bn, Loc), @@ -1129,34 +1159,44 @@ package body Exp_Ch4 is Expressions => New_List (New_Reference_To (Bn, Loc))))); end if; - Loop_Stm := - Make_Implicit_Loop_Statement (Nod, - Statements => Stm_List, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Loop_Parameter_Specification => - Make_Loop_Parameter_Specification (Loc, - Defining_Identifier => An, - Discrete_Subtype_Definition => - Arr_Attr (A, Name_Range, N)))); - - -- If separate indexes, need a declare block to declare Bn + -- If separate indexes, we need a declare block for An and Bn, + -- and a loop without an iteration scheme. if Need_Separate_Indexes then + Loop_Stm := + Make_Implicit_Loop_Statement (Nod, Statements => Stm_List); + return Make_Block_Statement (Loc, Declarations => New_List ( Make_Object_Declaration (Loc, + Defining_Identifier => An, + Object_Definition => New_Reference_To (Index_T, Loc), + Expression => Arr_Attr (A, Name_First, N)), + + Make_Object_Declaration (Loc, Defining_Identifier => Bn, Object_Definition => New_Reference_To (Index_T, Loc), Expression => Arr_Attr (B, Name_First, N))), + Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List (Loop_Stm))); - -- If no separate indexes, return loop statement on its own + -- If no separate indexes, return loop statement with explicit + -- iteration scheme on its own else + Loop_Stm := + Make_Implicit_Loop_Statement (Nod, + Statements => Stm_List, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => An, + Discrete_Subtype_Definition => + Arr_Attr (A, Name_Range, N)))); return Loop_Stm; end if; end Handle_One_Dimension; -- cgit v1.1