[multiple changes]

2004-07-15  Robert Dewar  <dewar@gnat.com>

	* 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  <ruiz@act-europe.fr>

	* 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  <schonberg@gnat.com>

	* 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  <quinot@act-europe.fr>

	* 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  <celier@gnat.com>

	* 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  <kenner@vlsi1.ultra.nyu.edu>

	* utils2.c: Fix typo in comment.

From-SVN: r84774

1 files changed, 66 insertions, 26 deletions

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;