[multiple changes]

2014-11-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Expand_Call, Inlined_Subprogram): Do not suppress
	debugging information for a call to a predefined unit, if the
	call comes from source and the unit is in the Ada hierarchy.

2014-11-20  Bob Duff  <duff@adacore.com>

	* s-mudido.ads: Update signature of Create and Get_Last_CPU. Add
	CPU_Set, another Create, and Get_CPU_Set.
	* s-mudido.adb: Corresponding changes to the spec. New
	operations just raise an exception.  Also minor cleanup: use
	raise_expressions.
	* s-mudido-affinity.adb: Implementations of new operations from
	* s-mudido.ads, for the platforms that actually support processor
	affinity. The new Create (which takes a set) now does all the
	work; the old Create (which takes a range) now just calls the
	new one. Change error messages to reflect the fact that it's an
	arbitrary set, not just a range.

From-SVN: r217859

5 files changed, 126 insertions, 64 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ce9c839..d25786b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2014-11-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch6.adb (Expand_Call, Inlined_Subprogram): Do not suppress
+	debugging information for a call to a predefined unit, if the
+	call comes from source and the unit is in the Ada hierarchy.
+
+2014-11-20  Bob Duff  <duff@adacore.com>
+
+	* s-mudido.ads: Update signature of Create and Get_Last_CPU. Add
+	CPU_Set, another Create, and Get_CPU_Set.
+	* s-mudido.adb: Corresponding changes to the spec. New
+	operations just raise an exception.  Also minor cleanup: use
+	raise_expressions.
+	* s-mudido-affinity.adb: Implementations of new operations from
+	* s-mudido.ads, for the platforms that actually support processor
+	affinity. The new Create (which takes a set) now does all the
+	work; the old Create (which takes a range) now just calls the
+	new one. Change error messages to reflect the fact that it's an
+	arbitrary set, not just a range.
+
 2014-11-20  Robert Dewar  <dewar@adacore.com>
 
 	* exp_attr.adb: Minor reformatting.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index b3f9ab6..c16fc49 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3720,7 +3720,17 @@ package body Exp_Ch6 is
                  (Unit_File_Name (Get_Source_Unit (Sloc (Subp))))
               and then In_Extended_Main_Source_Unit (N)
             then
-               Set_Needs_Debug_Info (Subp, False);
+               --  We make an exception for calls to the Ada hierarchy if call
+               --  comes from source, because some user applications need the
+               --  debugging information for such calls.
+
+               if Comes_From_Source (Call_Node)
+                 and then Name_Buffer (1 .. 2) = "a-"
+               then
+                  null;
+               else
+                  Set_Needs_Debug_Info (Subp, False);
+               end if;
             end if;
 
          --  Front end expansion of simple functions returning unconstrained
diff --git a/gcc/ada/s-mudido-affinity.adb b/gcc/ada/s-mudido-affinity.adb
index 35239b8..475d245 100644
--- a/gcc/ada/s-mudido-affinity.adb
+++ b/gcc/ada/s-mudido-affinity.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--          Copyright (C) 2011-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -77,7 +77,7 @@ package body System.Multiprocessors.Dispatching_Domains is
    is
       Target : constant ST.Task_Id := Convert_Ids (T);
 
-      use type System.Tasking.Dispatching_Domain_Access;
+      use type ST.Dispatching_Domain_Access;
 
    begin
       --  The exception Dispatching_Domain_Error is propagated if T is already
@@ -114,62 +114,49 @@ package body System.Multiprocessors.Dispatching_Domains is
    -- Create --
    ------------
 
-   function Create (First, Last : CPU) return Dispatching_Domain is
-      use type System.Tasking.Dispatching_Domain;
-      use type System.Tasking.Dispatching_Domain_Access;
-      use type System.Tasking.Array_Allocated_Tasks;
-      use type System.Tasking.Task_Id;
-
-      Valid_System_Domain : constant Boolean :=
-        (First > CPU'First
-          and then
-            not (System_Dispatching_Domain (CPU'First .. First - 1) =
-                                         (CPU'First .. First - 1 => False)))
-                  or else (Last < Number_Of_CPUs
-                            and then not
-                              (System_Dispatching_Domain
-                                (Last + 1 .. Number_Of_CPUs) =
-                                  (Last + 1 .. Number_Of_CPUs => False)));
-      --  Constant that indicates whether there would exist a non-empty system
-      --  dispatching domain after the creation of this dispatching domain.
+   function Create (First : CPU; Last : CPU_Range) return Dispatching_Domain is
+   begin
+      return Create ((First .. Last => True));
+   end Create;
+
+   function Create (Set : CPU_Set) return Dispatching_Domain is
+      ST_DD : aliased constant ST.Dispatching_Domain
+        := ST.Dispatching_Domain (Set);
+      subtype Rng is CPU_Range range
+        Get_First_CPU (ST_DD'Unrestricted_Access) ..
+        Get_Last_CPU (ST_DD'Unrestricted_Access);
+
+      use type ST.Dispatching_Domain;
+      use type ST.Dispatching_Domain_Access;
+      use type ST.Array_Allocated_Tasks;
+      use type ST.Task_Id;
 
       T : ST.Task_Id;
 
+      New_System_Domain : ST.Dispatching_Domain := ST.System_Domain.all;
+
       New_Domain : Dispatching_Domain;
 
    begin
-      --  The range of processors for creating a dispatching domain must
+      --  The set of processors for creating a dispatching domain must
       --  comply with the following restrictions:
-      --    - Non-empty range
-      --    - Not exceeding the range of available processors
-      --    - Range from the System_Dispatching_Domain
-      --    - Range does not contain a processor with a task assigned to it
-      --    - The allocation cannot leave System_Dispatching_Domain empty
-      --    - The calling task must be the environment task
+      --    - Not exceeding the range of available processors.
+      --    - CPUs from the System_Dispatching_Domain.
+      --    - The calling task must be the environment task.
       --    - The call to Create must take place before the call to the main
-      --      subprogram
+      --      subprogram.
+      --    - Set does not contain a processor with a task assigned to it.
+      --    - The allocation cannot leave System_Dispatching_Domain empty.
 
-      if First > Last then
-         raise Dispatching_Domain_Error with "empty dispatching domain";
+      --  Note that a previous version of the language forbade empty domains.
 
-      elsif Last > Number_Of_CPUs then
+      if Rng'Last > Number_Of_CPUs then
          raise Dispatching_Domain_Error with
-           "CPU range not supported by the target";
+           "CPU not supported by the target";
 
-      elsif
-        System_Dispatching_Domain (First .. Last) /= (First .. Last => True)
-      then
+      elsif (ST_DD and not ST.System_Domain (Rng)) /= (Rng => False) then
          raise Dispatching_Domain_Error with
-           "CPU range not currently in System_Dispatching_Domain";
-
-      elsif
-        ST.Dispatching_Domain_Tasks (First .. Last) /= (First .. Last => 0)
-      then
-         raise Dispatching_Domain_Error with "CPU range has tasks assigned";
-
-      elsif not Valid_System_Domain then
-         raise Dispatching_Domain_Error with
-           "would leave System_Dispatching_Domain empty";
+           "CPU not currently in System_Dispatching_Domain";
 
       elsif Self /= Environment_Task then
          raise Dispatching_Domain_Error with
@@ -177,10 +164,25 @@ package body System.Multiprocessors.Dispatching_Domains is
 
       elsif ST.Dispatching_Domains_Frozen then
          raise Dispatching_Domain_Error with
-           "cannot create dispatching domain after call to main program";
+           "cannot create dispatching domain after call to main procedure";
+      end if;
+
+      for Proc in Rng loop
+         if ST_DD (Proc) and then
+           ST.Dispatching_Domain_Tasks (Proc) /= 0
+         then
+            raise Dispatching_Domain_Error with "CPU has tasks assigned";
+         end if;
+      end loop;
+
+      New_System_Domain (Rng) := New_System_Domain (Rng) and not ST_DD;
+
+      if New_System_Domain = (New_System_Domain'Range => False) then
+         raise Dispatching_Domain_Error with
+           "would leave System_Dispatching_Domain empty";
       end if;
 
-      New_Domain := new ST.Dispatching_Domain'(First .. Last => True);
+      New_Domain := new ST.Dispatching_Domain'(ST_DD);
 
       --  At this point we need to fix the processors belonging to the system
       --  domain, and change the affinity of every task that has been created
@@ -190,7 +192,8 @@ package body System.Multiprocessors.Dispatching_Domains is
 
       Lock_RTS;
 
-      System_Dispatching_Domain (First .. Last) := (First .. Last => False);
+      ST.System_Domain (Rng) := New_System_Domain (Rng);
+      pragma Assert (ST.System_Domain.all = New_System_Domain);
 
       --  Iterate the list of tasks belonging to the default system
       --  dispatching domain and set the appropriate affinity.
@@ -254,6 +257,15 @@ package body System.Multiprocessors.Dispatching_Domains is
       return Convert_Ids (T).Common.Base_CPU;
    end Get_CPU;
 
+   -----------------
+   -- Get_CPU_Set --
+   -----------------
+
+   function Get_CPU_Set (Domain : Dispatching_Domain) return CPU_Set is
+   begin
+      return CPU_Set (Domain.all);
+   end Get_CPU_Set;
+
    ----------------------------
    -- Get_Dispatching_Domain --
    ----------------------------
@@ -278,16 +290,14 @@ package body System.Multiprocessors.Dispatching_Domains is
          end if;
       end loop;
 
-      --  Should never reach the following return
-
-      return Domain'First;
+      return CPU'First;
    end Get_First_CPU;
 
    ------------------
    -- Get_Last_CPU --
    ------------------
 
-   function Get_Last_CPU (Domain : Dispatching_Domain) return CPU is
+   function Get_Last_CPU (Domain : Dispatching_Domain) return CPU_Range is
    begin
       for Proc in reverse Domain'Range loop
          if Domain (Proc) then
@@ -295,9 +305,7 @@ package body System.Multiprocessors.Dispatching_Domains is
          end if;
       end loop;
 
-      --  Should never reach the following return
-
-      return Domain'Last;
+      return CPU_Range'First;
    end Get_Last_CPU;
 
    -------------
@@ -340,7 +348,7 @@ package body System.Multiprocessors.Dispatching_Domains is
    is
       Source_CPU : constant CPU_Range := T.Common.Base_CPU;
 
-      use type System.Tasking.Dispatching_Domain_Access;
+      use type ST.Dispatching_Domain_Access;
 
    begin
       Write_Lock (T);
diff --git a/gcc/ada/s-mudido.adb b/gcc/ada/s-mudido.adb
index 990a7bc..b982df4 100644
--- a/gcc/ada/s-mudido.adb
+++ b/gcc/ada/s-mudido.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--          Copyright (C) 2011-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -65,11 +65,18 @@ package body System.Multiprocessors.Dispatching_Domains is
    -- Create --
    ------------
 
-   function Create (First, Last : CPU) return Dispatching_Domain is
+   function Create (First : CPU; Last : CPU_Range) return Dispatching_Domain is
       pragma Unreferenced (First, Last);
    begin
-      raise Dispatching_Domain_Error with "dispatching domains not supported";
-      return System_Dispatching_Domain;
+      return raise Dispatching_Domain_Error with
+        "dispatching domains not supported";
+   end Create;
+
+   function Create (Set : CPU_Set) return Dispatching_Domain is
+      pragma Unreferenced (Set);
+   begin
+      return raise Dispatching_Domain_Error with
+        "dispatching domains not supported";
    end Create;
 
    -----------------------------
@@ -107,6 +114,17 @@ package body System.Multiprocessors.Dispatching_Domains is
       return Not_A_Specific_CPU;
    end Get_CPU;
 
+   -----------------
+   -- Get_CPU_Set --
+   -----------------
+
+   function Get_CPU_Set (Domain : Dispatching_Domain) return CPU_Set is
+      pragma Unreferenced (Domain);
+   begin
+      return raise Dispatching_Domain_Error
+        with "dispatching domains not supported";
+   end Get_CPU_Set;
+
    ----------------------------
    -- Get_Dispatching_Domain --
    ----------------------------
@@ -134,7 +152,7 @@ package body System.Multiprocessors.Dispatching_Domains is
    -- Get_Last_CPU --
    ------------------
 
-   function Get_Last_CPU (Domain : Dispatching_Domain) return CPU is
+   function Get_Last_CPU (Domain : Dispatching_Domain) return CPU_Range is
       pragma Unreferenced (Domain);
    begin
       return Number_Of_CPUs;
diff --git a/gcc/ada/s-mudido.ads b/gcc/ada/s-mudido.ads
index 635a847d..06e48bd 100644
--- a/gcc/ada/s-mudido.ads
+++ b/gcc/ada/s-mudido.ads
@@ -31,11 +31,17 @@ package System.Multiprocessors.Dispatching_Domains is
 
    System_Dispatching_Domain : constant Dispatching_Domain;
 
-   function Create (First, Last : CPU) return Dispatching_Domain;
+   function Create (First : CPU; Last : CPU_Range) return Dispatching_Domain;
 
    function Get_First_CPU (Domain : Dispatching_Domain) return CPU;
 
-   function Get_Last_CPU (Domain : Dispatching_Domain) return CPU;
+   function Get_Last_CPU (Domain : Dispatching_Domain) return CPU_Range;
+
+   type CPU_Set is array (CPU range <>) of Boolean;
+
+   function Create (Set : CPU_Set) return Dispatching_Domain;
+
+   function Get_CPU_Set (Domain : Dispatching_Domain) return CPU_Set;
 
    function Get_Dispatching_Domain
      (T : Ada.Task_Identification.Task_Id :=