[multiple changes]

2009-04-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Map_Formal_Package_Entities): renamed from Map_Entities
	and made global, to be used when installing parents of a child
	instance, to provide mappings for entities declared in formal packages
	of ancestor units. Now called from Install_Formal_Packages.

2009-04-16  Doug Rupp  <rupp@adacore.com>

	* s-taskin.adb (Initialize_ATCB): Initialize Debug_Events with others
	notation for clarity.

	* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
	s-taprop-mingw.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
	s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-posix.adb
	(Initialize): Initialize Known_Tasks with Environment task.

	* s-taskin.ads (Task_States): Move new states to end for the sake of
	GDB compatibility.

	* s-tassta.adb (Task_Wrapper): Fix comment about Enter_Task.

From-SVN: r146158

14 files changed, 233 insertions, 107 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6b706bd225a..7748446d7d8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,27 @@
 2009-04-16  Ed Schonberg  <schonberg@adacore.com>
 
+	* sem_ch12.adb (Map_Formal_Package_Entities): renamed from Map_Entities
+	and made global, to be used when installing parents of a child
+	instance, to provide mappings for entities declared in formal packages
+	of ancestor units. Now called from Install_Formal_Packages.
+
+2009-04-16  Doug Rupp  <rupp@adacore.com>
+
+	* s-taskin.adb (Initialize_ATCB): Initialize Debug_Events with others
+	notation for clarity.
+
+	* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
+	s-taprop-mingw.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
+	s-taprop-irix.adb, s-taprop-hpux-dce.adb, s-taprop-posix.adb
+	(Initialize): Initialize Known_Tasks with Environment task.
+
+	* s-taskin.ads (Task_States): Move new states to end for the sake of
+	GDB compatibility.
+
+	* s-tassta.adb (Task_Wrapper): Fix comment about Enter_Task.
+
+2009-04-16  Ed Schonberg  <schonberg@adacore.com>
+
 	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): If a protected
 	operation has an inline pragma, propagate the flag to the internal
 	unprotected subprogram.
diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb
index 0afd56b6360..6288af5a776 100644
--- a/gcc/ada/s-taprop-hpux-dce.adb
+++ b/gcc/ada/s-taprop-hpux-dce.adb
@@ -1218,6 +1218,12 @@ package body System.Task_Primitives.Operations is
 
       Specific.Initialize (Environment_Task);
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler
diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index d3344b35eaa..2d38f6e4a5c 100644
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -1303,6 +1303,12 @@ package body System.Task_Primitives.Operations is
 
       Specific.Initialize (Environment_Task);
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
 
       --  Prepare the set of signals that should unblocked in all tasks
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index d3597a2a242..aebfcb65383 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -1244,6 +1244,12 @@ package body System.Task_Primitives.Operations is
            Alternate_Stack'Address;
       end if;
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler
diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index f32d426eda8..cb51841a54d 100644
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -1069,6 +1069,13 @@ package body System.Task_Primitives.Operations is
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
 
       Environment_Task.Common.LL.Thread := GetCurrentThread;
+
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
    end Initialize;
 
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 51f20a6cc9c..d87b1e670c2 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -1423,6 +1423,12 @@ package body System.Task_Primitives.Operations is
            Alternate_Stack'Address;
       end if;
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index 4156e368b66..795750bed85 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -479,6 +479,12 @@ package body System.Task_Primitives.Operations is
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index 94649e2ae94..4c55c58a0a4 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -1332,6 +1332,12 @@ package body System.Task_Primitives.Operations is
 
       Specific.Initialize (Environment_Task);
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler
diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index cc640a8ac16..01a77d6ff3a 100644
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -1264,6 +1264,12 @@ package body System.Task_Primitives.Operations is
         0                  --  False, we don't have the std TCB prolog
        );
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
    end Initialize;
 
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 5f6d8d48202..7f823ac0c45 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -1383,6 +1383,12 @@ package body System.Task_Primitives.Operations is
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
 
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
       Enter_Task (Environment_Task);
    end Initialize;
 
diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb
index 8cc9d91df25..ba5ef095345 100644
--- a/gcc/ada/s-taskin.adb
+++ b/gcc/ada/s-taskin.adb
@@ -114,25 +114,25 @@ package body System.Tasking is
          return;
       end if;
 
-      T.Common.Parent := Parent;
-      T.Common.Base_Priority := Base_Priority;
-      T.Common.Current_Priority := 0;
+      --  Wouldn't the following be better done using an assignment of an
+      --  aggregate so that we could be sure no components were forgotten???
+
+      T.Common.Parent                   := Parent;
+      T.Common.Base_Priority            := Base_Priority;
+      T.Common.Current_Priority         := 0;
       T.Common.Protected_Action_Nesting := 0;
-      T.Common.Call := null;
-      T.Common.Task_Arg := Task_Arg;
-      T.Common.Task_Entry_Point := Task_Entry_Point;
-      T.Common.Activator := Self_ID;
-      T.Common.Wait_Count := 0;
-      T.Common.Elaborated := Elaborated;
-      T.Common.Activation_Failed := False;
-      T.Common.Task_Info := Task_Info;
+      T.Common.Call                     := null;
+      T.Common.Task_Arg                 := Task_Arg;
+      T.Common.Task_Entry_Point         := Task_Entry_Point;
+      T.Common.Activator                := Self_ID;
+      T.Common.Wait_Count               := 0;
+      T.Common.Elaborated               := Elaborated;
+      T.Common.Activation_Failed        := False;
+      T.Common.Task_Info                := Task_Info;
       T.Common.Global_Task_Lock_Nesting := 0;
-      T.Common.Fall_Back_Handler := null;
-      T.Common.Specific_Handler  := null;
-      T.Common.Debug_Events :=
-        (False, False, False, False, False, False, False, False,
-         False, False, False, False, False, False, False, False);
-      --  Wouldn't (others => False) be clearer ???
+      T.Common.Fall_Back_Handler        := null;
+      T.Common.Specific_Handler         := null;
+      T.Common.Debug_Events             := (others => False);
 
       if T.Common.Parent = null then
 
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 5912eac7f37..5012abec555 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -131,8 +131,9 @@ package System.Tasking is
       --  TCB initialized but not task has not been created.
       --  It cannot be executing.
 
-      Activating,
-      --  Task has been created and is being made Runnable.
+--    Activating,
+--    --  ??? Temporarily at end of list for GDB compatibility
+--    --  Task has been created and is being made Runnable.
 
       --  Active states
       --  For all states from here down, the task has been activated.
@@ -156,8 +157,9 @@ package System.Tasking is
       Acceptor_Sleep,
       --  Task is waiting on an accept or select with terminate
 
-      Acceptor_Delay_Sleep,
-      --  Task is waiting on an selective wait statement
+--    Acceptor_Delay_Sleep,
+--    --  ??? Temporarily at end of list for GDB compatibility
+--    --  Task is waiting on an selective wait statement
 
       Entry_Caller_Sleep,
       --  Task is waiting on an entry call
@@ -193,9 +195,15 @@ package System.Tasking is
       Asynchronous_Hold,
       --  The task has been held by Asynchronous_Task_Control.Hold_Task
 
-      Interrupt_Server_Blocked_On_Event_Flag
+      Interrupt_Server_Blocked_On_Event_Flag,
       --  The task has been blocked on a system call waiting for a
       --  completion event/signal to occur.
+
+      Activating,
+      --  Task has been created and is being made Runnable.
+
+      Acceptor_Delay_Sleep
+      --  Task is waiting on an selective wait statement
      );
 
    type Call_Modes is
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 5d4e7cbd9ad..0dd9ac3316f 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1111,8 +1111,7 @@ package body System.Tasking.Stages is
       Stack_Guard (Self_ID, True);
 
       --  Initialize low-level TCB components, that cannot be initialized by
-      --  the creator. Enter_Task sets Self_ID.Known_Tasks_Index and also
-      --  Self_ID.LL.Thread
+      --  the creator. Enter_Task sets Self_ID.LL.Thread
 
       Enter_Task (Self_ID);
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index f0212e032ed..808723177b3 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -681,6 +681,19 @@ package body Sem_Ch12 is
    --  this field overlaps Entity, which is fine, because the whole point is
    --  that we don't need or want the normal Entity field in this situation.
 
+   procedure Map_Formal_Package_Entities (Form : Entity_Id; Act : Entity_Id);
+   --  Within the generic part, entities in the formal package are
+   --  visible. To validate subsequent type declarations, indicate
+   --  the correspondence between the entities in the analyzed formal,
+   --  and the entities in  the actual package. There are three packages
+   --  involved in the instantiation of a formal package: the parent
+   --  generic P1 which appears in the generic declaration, the fake
+   --  instantiation P2 which appears in the analyzed generic, and whose
+   --  visible entities may be used in subsequent formals, and the actual
+   --  P3 in the instance. To validate subsequent formals, me indicate
+   --  that the entities in P2 are mapped into those of P3. The mapping of
+   --  entities has to be done recursively for nested packages.
+
    procedure Move_Freeze_Nodes
      (Out_Of : Entity_Id;
       After  : Node_Id;
@@ -2952,6 +2965,15 @@ package body Sem_Ch12 is
 
       Init_Env;
       Env_Installed := True;
+
+      --  Reset renaming map for formal types. The mapping is established
+      --  when analyzing the generic associations, but some mappings are
+      --  inherited from formal packages of parent units, and these are
+      --  constructed when the parents are installed.
+
+      Generic_Renamings.Set_Last (0);
+      Generic_Renamings_HTable.Reset;
+
       Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
       Gen_Unit := Entity (Gen_Id);
 
@@ -3053,9 +3075,6 @@ package body Sem_Ch12 is
          --  validate an actual package, the instantiation environment is that
          --  of the enclosing instance.
 
-         Generic_Renamings.Set_Last (0);
-         Generic_Renamings_HTable.Reset;
-
          Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
 
          --  Copy original generic tree, to produce text for instantiation
@@ -7135,10 +7154,21 @@ package body Sem_Ch12 is
    -----------------------------
 
    procedure Install_Formal_Packages (Par : Entity_Id) is
-      E : Entity_Id;
+      E     : Entity_Id;
+      Gen   : Entity_Id;
+      Gen_E : Entity_Id := Empty;
 
    begin
       E := First_Entity (Par);
+
+      --  In we are installing an instance parent, locate the formal packages
+      --  of its generic parent.
+
+      if Is_Generic_Instance (Par) then
+         Gen   := Generic_Parent (Specification (Unit_Declaration_Node (Par)));
+         Gen_E := First_Entity (Gen);
+      end if;
+
       while Present (E) loop
          if Ekind (E) = E_Package
            and then Nkind (Parent (E)) = N_Package_Renaming_Declaration
@@ -7159,10 +7189,26 @@ package body Sem_Ch12 is
             then
                Check_Generic_Actuals (Renamed_Object (E), True);
                Set_Is_Hidden (E, False);
+
+               --  Find formal package in generic unit that corresponds to
+               --  (instance of) formal package in instance.
+
+               while Present (Gen_E)
+                 and then  Chars (Gen_E) /= Chars (E)
+               loop
+                  Next_Entity (Gen_E);
+               end loop;
+
+               if Present (Gen_E) then
+                  Map_Formal_Package_Entities (Gen_E, E);
+               end if;
             end if;
          end if;
 
          Next_Entity (E);
+         if Present (Gen_E) then
+            Next_Entity (Gen_E);
+         end if;
       end loop;
    end Install_Formal_Packages;
 
@@ -7397,19 +7443,6 @@ package body Sem_Ch12 is
       --  original generic ancestor. In that case, we recognize that the
       --  ultimate ancestor is the same by examining names and scopes.
 
-      procedure Map_Entities (Form : Entity_Id; Act : Entity_Id);
-      --  Within the generic part, entities in the formal package are
-      --  visible. To validate subsequent type declarations, indicate
-      --  the correspondence between the entities in the analyzed formal,
-      --  and the entities in  the actual package. There are three packages
-      --  involved in the instantiation of a formal package: the parent
-      --  generic P1 which appears in the generic declaration, the fake
-      --  instantiation P2 which appears in the analyzed generic, and whose
-      --  visible entities may be used in subsequent formals, and the actual
-      --  P3 in the instance. To validate subsequent formals, me indicate
-      --  that the entities in P2 are mapped into those of P3. The mapping of
-      --  entities has to be done recursively for nested packages.
-
       procedure Process_Nested_Formal (Formal : Entity_Id);
       --  If the current formal is declared with a box, its own formals are
       --  visible in the instance, as they were in the generic, and their
@@ -7590,65 +7623,6 @@ package body Sem_Ch12 is
          end if;
       end Is_Instance_Of;
 
-      ------------------
-      -- Map_Entities --
-      ------------------
-
-      procedure Map_Entities (Form : Entity_Id; Act : Entity_Id) is
-         E1 : Entity_Id;
-         E2 : Entity_Id;
-
-      begin
-         Set_Instance_Of (Form, Act);
-
-         --  Traverse formal and actual package to map the corresponding
-         --  entities. We skip over internal entities that may be generated
-         --  during semantic analysis, and find the matching entities by
-         --  name, given that they must appear in the same order.
-
-         E1 := First_Entity (Form);
-         E2 := First_Entity (Act);
-         while Present (E1)
-           and then E1 /= First_Private_Entity (Form)
-         loop
-            --  Could this test be a single condition???
-            --  Seems like it could, and isn't FPE (Form) a constant anyway???
-
-            if not Is_Internal (E1)
-              and then Present (Parent (E1))
-              and then not Is_Class_Wide_Type (E1)
-              and then not Is_Internal_Name (Chars (E1))
-            then
-               while Present (E2)
-                 and then Chars (E2) /= Chars (E1)
-               loop
-                  Next_Entity (E2);
-               end loop;
-
-               if No (E2) then
-                  exit;
-               else
-                  Set_Instance_Of (E1, E2);
-
-                  if Is_Type (E1)
-                    and then Is_Tagged_Type (E2)
-                  then
-                     Set_Instance_Of
-                       (Class_Wide_Type (E1), Class_Wide_Type (E2));
-                  end if;
-
-                  if Ekind (E1) = E_Package
-                    and then No (Renamed_Object (E1))
-                  then
-                     Map_Entities (E1, E2);
-                  end if;
-               end if;
-            end if;
-
-            Next_Entity (E1);
-         end loop;
-      end Map_Entities;
-
       ---------------------------
       -- Process_Nested_Formal --
       ---------------------------
@@ -7734,7 +7708,7 @@ package body Sem_Ch12 is
          end if;
 
          Set_Instance_Of (Defining_Identifier (Formal), Actual_Pack);
-         Map_Entities (Formal_Pack, Actual_Pack);
+         Map_Formal_Package_Entities (Formal_Pack, Actual_Pack);
 
          Nod :=
            Make_Package_Renaming_Declaration (Loc,
@@ -8378,7 +8352,7 @@ package body Sem_Ch12 is
                "with volatile actual", Actual);
          end if;
 
-      --  OUT not present
+      --  formal in-parameter
 
       else
          --  The instantiation of a generic formal in-parameter is constant
@@ -8426,11 +8400,15 @@ package body Sem_Ch12 is
             end if;
 
             declare
-               Typ : constant Entity_Id :=
-                       Get_Instance_Of
-                         (Etype (Defining_Identifier (Analyzed_Formal)));
+               Formal_Object : constant Entity_Id :=
+                                 Defining_Identifier (Analyzed_Formal);
+               Formal_Type   : constant Entity_Id := Etype (Formal_Object);
+
+               Typ : Entity_Id;
 
             begin
+               Typ := Get_Instance_Of (Formal_Type);
+
                Freeze_Before (Instantiation_Node, Typ);
 
                --  If the actual is an aggregate, perform name resolution on
@@ -10722,6 +10700,70 @@ package body Sem_Ch12 is
       end if;
    end Load_Parent_Of_Generic;
 
+   ---------------------------------
+   -- Map_Formal_Package_Entities --
+   ---------------------------------
+
+   procedure Map_Formal_Package_Entities (Form : Entity_Id; Act : Entity_Id) is
+      E1 : Entity_Id;
+      E2 : Entity_Id;
+
+   begin
+      Set_Instance_Of (Form, Act);
+
+      --  Traverse formal and actual package to map the corresponding entities.
+      --  We skip over internal entities that may be generated during semantic
+      --  analysis, and find the matching entities by name, given that they
+      --  must appear in the same order.
+
+      E1 := First_Entity (Form);
+      E2 := First_Entity (Act);
+      while Present (E1)
+        and then E1 /= First_Private_Entity (Form)
+      loop
+         --  Could this test be a single condition???
+         --  Seems like it could, and isn't FPE (Form) a constant anyway???
+
+         if not Is_Internal (E1)
+           and then Present (Parent (E1))
+           and then not Is_Class_Wide_Type (E1)
+           and then not Is_Internal_Name (Chars (E1))
+         then
+            while Present (E2)
+              and then Chars (E2) /= Chars (E1)
+            loop
+               Next_Entity (E2);
+            end loop;
+
+            if No (E2) then
+               exit;
+            else
+               Set_Instance_Of (E1, E2);
+
+               if Is_Type (E1)
+                 and then Is_Tagged_Type (E2)
+               then
+                  Set_Instance_Of
+                    (Class_Wide_Type (E1), Class_Wide_Type (E2));
+               end if;
+
+               if Is_Constrained (E1) then
+                  Set_Instance_Of
+                    (Base_Type (E1), Base_Type (E2));
+               end if;
+
+               if Ekind (E1) = E_Package
+                 and then No (Renamed_Object (E1))
+               then
+                  Map_Formal_Package_Entities (E1, E2);
+               end if;
+            end if;
+         end if;
+
+         Next_Entity (E1);
+      end loop;
+   end Map_Formal_Package_Entities;
+
    -----------------------
    -- Move_Freeze_Nodes --
    -----------------------
@@ -10737,8 +10779,8 @@ package body Sem_Ch12 is
       Spec      : Node_Id;
 
       function Is_Outer_Type (T : Entity_Id) return Boolean;
-      --  Check whether entity is declared in a scope external to that
-      --  of the generic unit.
+      --  Check whether entity is declared in a scope external to that of the
+      --  generic unit.
 
       -------------------
       -- Is_Outer_Type --