[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, 238 insertions, 128 deletions

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 8bbcb09..083c6c2 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -52,6 +52,7 @@ with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
 with Tbuild;   use Tbuild;
+with Ttypes;   use Ttypes;
 with Uintp;    use Uintp;
 with Validsw;  use Validsw;
 
@@ -97,7 +98,7 @@ package body Exp_Ch5 is
    --  of representation.
 
    function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
-   --  Generate the necessary code for controlled and Tagged assignment,
+   --  Generate the necessary code for controlled and tagged assignment,
    --  that is to say, finalization of the target before, adjustement of
    --  the target after and save and restore of the tag and finalization
    --  pointers which are not 'part of the value' and must not be changed
@@ -3031,12 +3032,7 @@ package body Exp_Ch5 is
 
       Res       : List_Id;
       Tag_Tmp   : Entity_Id;
-      Prev_Tmp  : Entity_Id;
-      Next_Tmp  : Entity_Id;
-      Ctrl_Ref  : Node_Id;
-      Ctrl_Ref2 : Node_Id   := Empty;
-      Prev_Tmp2 : Entity_Id := Empty;  -- prevent warning
-      Next_Tmp2 : Entity_Id := Empty;  -- prevent warning
+      Original_Size, Range_Type, Opaque_Type : Entity_Id;
 
    begin
       Res := New_List;
@@ -3074,8 +3070,6 @@ package body Exp_Ch5 is
              With_Detach => New_Reference_To (Standard_False, Loc)));
       end if;
 
-      Next_Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
-
       --  Save the Tag in a local variable Tag_Tmp
 
       if Save_Tag then
@@ -3097,102 +3091,263 @@ package body Exp_Ch5 is
          Tag_Tmp := Empty;
       end if;
 
-      --  Save the Finalization Pointers in local variables Prev_Tmp and
-      --  Next_Tmp. For objects with Has_Controlled_Component set, these
-      --  pointers are in the Record_Controller and if it is also
-      --  Is_Controlled, we need to save the object pointers as well.
+      --  We really need a comment here ???
 
       if Ctrl_Act then
-         Ctrl_Ref := Duplicate_Subexpr_No_Checks (L);
 
-         if Has_Controlled_Component (T) then
-            Ctrl_Ref :=
-              Make_Selected_Component (Loc,
-                Prefix => Ctrl_Ref,
-                Selector_Name =>
-                  New_Reference_To (Controller_Component (T), Loc));
+         --  subtype G is Storage_Offset range 1 .. Expr'Size
 
-            if Is_Controlled (T) then
-               Ctrl_Ref2 := Duplicate_Subexpr_No_Checks (L);
-            end if;
-         end if;
-
-         Prev_Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
+         Original_Size :=
+           Make_Defining_Identifier (Loc,
+             New_Internal_Name ('S'));
 
          Append_To (Res,
            Make_Object_Declaration (Loc,
-             Defining_Identifier => Prev_Tmp,
+             Defining_Identifier => Original_Size,
+             Constant_Present    => True,
+             Object_Definition   => New_Occurrence_Of (
+               RTE (RE_Storage_Offset), Loc),
+             Expression          =>
+               Make_Op_Divide (Loc,
+                 Left_Opnd =>
+                   Make_Attribute_Reference (Loc,
+                     Prefix =>
+                       Duplicate_Subexpr_No_Checks (L),
+                     Attribute_Name => Name_Size),
+                 Right_Opnd => Make_Integer_Literal (Loc,
+                     Intval => System_Storage_Unit))));
+
+         Range_Type :=
+           Make_Defining_Identifier (Loc,
+             New_Internal_Name ('G'));
 
-             Object_Definition =>
-               New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+         Append_To (Res,
+           Make_Subtype_Declaration (Loc,
+             Defining_Identifier => Range_Type,
+             Subtype_Indication =>
+               Make_Subtype_Indication (Loc,
+                 Subtype_Mark =>
+                   New_Reference_To (RTE (RE_Storage_Offset), Loc),
+                 Constraint   => Make_Range_Constraint (Loc,
+                   Range_Expression =>
+                     Make_Range (Loc,
+                       Low_Bound  => Make_Integer_Literal (Loc, 1),
+                       High_Bound => New_Occurrence_Of (
+                         Original_Size, Loc))))));
+
+         --  subtype S is Storage_Array (G)
 
-             Expression =>
-               Make_Selected_Component (Loc,
-                 Prefix =>
-                   Unchecked_Convert_To (RTE (RE_Finalizable), Ctrl_Ref),
-                 Selector_Name => Make_Identifier (Loc, Name_Prev))));
+         Append_To (Res,
+           Make_Subtype_Declaration (Loc,
+             Defining_Identifier =>
+               Make_Defining_Identifier (Loc,
+                 New_Internal_Name ('S')),
+             Subtype_Indication  =>
+               Make_Subtype_Indication (Loc,
+                 Subtype_Mark =>
+                   New_Reference_To (RTE (RE_Storage_Array), Loc),
+                 Constraint =>
+                   Make_Index_Or_Discriminant_Constraint (Loc,
+                     Constraints =>
+                       New_List (New_Reference_To (Range_Type, Loc))))));
+
+         --  type A is access S
+
+         Opaque_Type := Make_Defining_Identifier (Loc,
+           New_Internal_Name ('A'));
+         Append_To (Res,
+           Make_Full_Type_Declaration (Loc,
+             Defining_Identifier => Opaque_Type,
+             Type_Definition     =>
+               Make_Access_To_Object_Definition (Loc,
+                 Subtype_Indication =>
+                   New_Occurrence_Of (
+                     Defining_Identifier (Last (Res)), Loc))));
 
-         Next_Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
+         --  Give a label name to this declare block, and add comments here???
 
-         Append_To (Res,
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Next_Tmp,
+         declare
+            Prev_Ref : Node_Id;
 
-             Object_Definition =>
-               New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+            First_After_Root : Node_Id := Empty;
+            --  Index of first byte to be copied (used to skip
+            --  Root_Controlled in controlled objects).
 
-             Expression =>
-               Make_Selected_Component (Loc,
+            Last_Before_Hole : Node_Id := Empty;
+            --  Index of last byte to be copied before outermost record
+            --  controller data.
+
+            Hole_Length      : Node_Id := Empty;
+            --  Length of record controller data (Prev and Next pointers)
+
+            First_After_Hole : Node_Id := Empty;
+            --  Index of first byte to be copied after outermost record
+            --  controller data.
+
+            function Build_Slice
+              (Rec    : Entity_Id;
+               Lo, Hi : Node_Id) return Node_Id;
+            --  Function specs must have comments, saying what all the
+            --  parameters are and what the function does ???
+
+            -----------------
+            -- Build_Slice --
+            -----------------
+
+            function Build_Slice
+              (Rec    : Node_Id;
+               Lo, Hi : Node_Id) return Node_Id
+            is
+               Lo_Bound, Hi_Bound : Node_Id;
+
+               Opaque : constant Node_Id :=
+                          Unchecked_Convert_To (Opaque_Type,
+                            Make_Attribute_Reference (Loc,
+                              Prefix         => Rec,
+                              Attribute_Name => Name_Address));
+               --  Comment required, what is this???
+
+            begin
+               --  Comments required in this body ???
+
+               if No (Lo) then
+                  Lo_Bound := Make_Integer_Literal (Loc, 1);
+               else
+                  Lo_Bound := Lo;
+               end if;
+
+               if No (Hi) then
+                  Hi_Bound := Make_Attribute_Reference (Loc,
+                    Prefix => New_Occurrence_Of (Range_Type, Loc),
+                    Attribute_Name => Name_Last);
+               else
+                  Hi_Bound := Hi;
+               end if;
+
+               return Make_Slice (Loc,
                  Prefix =>
-                   Unchecked_Convert_To (RTE (RE_Finalizable),
-                     New_Copy_Tree (Ctrl_Ref)),
-                 Selector_Name => Make_Identifier (Loc, Name_Next))));
+                   Opaque,
+                 Discrete_Range => Make_Range (Loc,
+                   Lo_Bound, Hi_Bound));
+            end Build_Slice;
 
-         if Present (Ctrl_Ref2) then
-            Prev_Tmp2 :=
-              Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
+         --  Start of processing for ??? (name of block)
 
-            Append_To (Res,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Prev_Tmp2,
+         begin
+            First_After_Root := Make_Integer_Literal (Loc, 1);
 
-                Object_Definition =>
-                  New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+            --  Comment ???
 
-                Expression =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>
-                      Unchecked_Convert_To (RTE (RE_Finalizable), Ctrl_Ref2),
-                    Selector_Name => Make_Identifier (Loc, Name_Prev))));
+            if Is_Controlled (T) then
+               First_After_Root :=
+                 Make_Op_Add (Loc,
+                   First_After_Root,
+                   Make_Op_Divide (Loc,
+                     Make_Attribute_Reference (Loc,
+                       Prefix =>
+                         New_Occurrence_Of (RTE (RE_Root_Controlled), Loc),
+                       Attribute_Name => Name_Size),
+                     Make_Integer_Literal (Loc, System_Storage_Unit)));
+            end if;
 
-            Next_Tmp2 :=
-              Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
+            if Has_Controlled_Component (T) then
 
-            Append_To (Res,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Next_Tmp2,
+               --  The record controller Prev and Next pointers must be left
+               --  intact in the target object, not copied. Compute the bounds
+               --  of the hole to be skipped in copying the objecct.
 
-                Object_Definition =>
-                  New_Reference_To (RTE (RE_Finalizable_Ptr), Loc),
+               Prev_Ref :=
+                 Make_Selected_Component (Loc,
+                   Prefix =>
+                     Make_Selected_Component (Loc,
+                       Prefix => Duplicate_Subexpr_No_Checks (L),
+                       Selector_Name =>
+                         New_Reference_To (Controller_Component (T), Loc)),
+                   Selector_Name =>  Make_Identifier (Loc, Name_Prev));
 
-                Expression =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>
-                      Unchecked_Convert_To (RTE (RE_Finalizable),
-                        New_Copy_Tree (Ctrl_Ref2)),
-                    Selector_Name => Make_Identifier (Loc, Name_Next))));
-         end if;
+               --  Last index before hole
 
-      --  If not controlled type, then Prev_Tmp and Ctrl_Ref unused
+               Last_Before_Hole :=
+                 Make_Defining_Identifier (Loc,
+                   New_Internal_Name ('L'));
 
-      else
-         Prev_Tmp := Empty;
-         Ctrl_Ref := Empty;
-      end if;
+               Append_To (Res,
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Last_Before_Hole,
+                   Object_Definition   => New_Occurrence_Of (
+                     RTE (RE_Storage_Offset), Loc),
+                   Constant_Present    => True,
+                   Expression          => Make_Op_Add (Loc,
+                       Make_Attribute_Reference (Loc,
+                         Prefix => Prev_Ref,
+                         Attribute_Name => Name_Position),
+                       Make_Attribute_Reference (Loc,
+                         Prefix => New_Copy_Tree (Prefix (Prev_Ref)),
+                         Attribute_Name => Name_Position))));
 
-      --  Do the Assignment
+               --  Hole length
+
+               Hole_Length :=
+                 Make_Op_Multiply (Loc,
+                   Make_Integer_Literal (Loc, Uint_2),
+                     Make_Op_Divide (Loc,
+                       Make_Attribute_Reference (Loc,
+                         Prefix =>
+                           New_Copy_Tree (Prev_Ref),
+                         Attribute_Name =>
+                           Name_Size),
+                     Make_Integer_Literal (Loc, System_Storage_Unit)));
+
+               --  First index after hole
+
+               First_After_Hole :=
+                 Make_Defining_Identifier (Loc,
+                   New_Internal_Name ('F'));
+
+               Append_To (Res,
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => First_After_Hole,
+                   Object_Definition   => New_Occurrence_Of (
+                     RTE (RE_Storage_Offset), Loc),
+                   Constant_Present    => True,
+                   Expression          =>
+                     Make_Op_Add (Loc,
+                       Make_Op_Add (Loc,
+                         New_Occurrence_Of (Last_Before_Hole, Loc),
+                         Hole_Length),
+                       Make_Integer_Literal (Loc, 1))));
+
+               Last_Before_Hole := New_Occurrence_Of (Last_Before_Hole, Loc);
+               First_After_Hole := New_Occurrence_Of (First_After_Hole, Loc);
+            end if;
 
-      Append_To (Res, Relocate_Node (N));
+            --  More comments needed everywhere ???
+
+            Append_To (Res, Make_Assignment_Statement (Loc,
+              Name       => Build_Slice (Duplicate_Subexpr_No_Checks (L),
+                                         First_After_Root,
+                                         Last_Before_Hole),
+
+              Expression => Build_Slice (Expression (N),
+                                         First_After_Root,
+                                         New_Copy_Tree (Last_Before_Hole))));
+
+
+            if Present (First_After_Hole) then
+               Remove_Side_Effects (Expression (N));
+               Append_To (Res, Make_Assignment_Statement (Loc,
+                 Name       => Build_Slice (Duplicate_Subexpr_No_Checks (L),
+                                            First_After_Hole,
+                                            Empty),
+                 Expression => Build_Slice (New_Copy_Tree (Expression (N)),
+                                            New_Copy_Tree (First_After_Hole),
+                                            Empty)));
+            end if;
+         end;
+
+      else
+         Append_To (Res, Relocate_Node (N));
+      end if;
 
       --  Restore the Tag
 
@@ -3206,55 +3361,8 @@ package body Exp_Ch5 is
              Expression => New_Reference_To (Tag_Tmp, Loc)));
       end if;
 
-      --  Restore the finalization pointers
-
-      if Ctrl_Act then
-         Append_To (Res,
-           Make_Assignment_Statement (Loc,
-             Name =>
-               Make_Selected_Component (Loc,
-                 Prefix =>
-                   Unchecked_Convert_To (RTE (RE_Finalizable),
-                     New_Copy_Tree (Ctrl_Ref)),
-                 Selector_Name => Make_Identifier (Loc, Name_Prev)),
-             Expression => New_Reference_To (Prev_Tmp, Loc)));
-
-         Append_To (Res,
-           Make_Assignment_Statement (Loc,
-             Name =>
-               Make_Selected_Component (Loc,
-                 Prefix =>
-                   Unchecked_Convert_To (RTE (RE_Finalizable),
-                     New_Copy_Tree (Ctrl_Ref)),
-                 Selector_Name => Make_Identifier (Loc, Name_Next)),
-             Expression => New_Reference_To (Next_Tmp, Loc)));
-
-         if Present (Ctrl_Ref2) then
-            Append_To (Res,
-              Make_Assignment_Statement (Loc,
-                Name =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>
-                      Unchecked_Convert_To (RTE (RE_Finalizable),
-                        New_Copy_Tree (Ctrl_Ref2)),
-                    Selector_Name => Make_Identifier (Loc, Name_Prev)),
-                Expression => New_Reference_To (Prev_Tmp2, Loc)));
-
-            Append_To (Res,
-              Make_Assignment_Statement (Loc,
-                Name =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>
-                      Unchecked_Convert_To (RTE (RE_Finalizable),
-                        New_Copy_Tree (Ctrl_Ref2)),
-                    Selector_Name => Make_Identifier (Loc, Name_Next)),
-                Expression => New_Reference_To (Next_Tmp2, Loc)));
-         end if;
-      end if;
-
-      --  Adjust the target after the assignment when controlled. (not in
-      --  the init proc since it is an initialization more than an
-      --  assignment)
+      --  Adjust the target after the assignment when controlled (not in the
+      --  init proc since it is an initialization more than an assignment).
 
       if Ctrl_Act then
          Append_List_To (Res,
@@ -3268,6 +3376,8 @@ package body Exp_Ch5 is
       return Res;
 
    exception
+      --  Could use comment here ???
+
       when RE_Not_Available =>
          return Empty_List;
    end Make_Tag_Ctrl_Assignment;