Patchwork [Ada] New Ada 2012 language-defined System.Multiprocessors

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 11, 2010, 7:14 a.m.
Message ID <20101011071458.GA6535@adacore.com>
Download mbox | patch
Permalink /patch/67382/
State New
Headers show

Comments

Arnaud Charlet - Oct. 11, 2010, 7:14 a.m.
Package System.Multiprocessors, that should only be withed in Ada 2012
mode is added to the run-time.

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-11  Vincent Celier  <celier@adacore.com>

	* Makefile.rtl: Add s-multip.
	* adaint.c: New function __gnat_number_of_cpus, implemented for Linux,
	defaulting to 1 for other platforms.
	* adaint.h: New function __gnat_number_of_cpus.
	* impunit.adb (Non_Imp_File_Names_12): New file list for Ada 2012,
	with a single component "s-multip".
	* impunit.ads (Kind_Of_Unit): New enumerated value Ada_12_Unit for Ada
	2012.
	* rtsfind.ads (RTU_Id): New enumerated value System_Multiprocessors
	* s-multip.ads, s-multip.adb: New Ada 2012 package.
	* sem_ch10.adb (Analyze_With_Clause): Check also Ada 2012 units.

Patch

Index: impunit.adb
===================================================================
--- impunit.adb	(revision 165256)
+++ impunit.adb	(working copy)
@@ -497,6 +497,15 @@  package body Impunit is
      "g-zspche",    -- GNAT.Wide_Wide_Spelling_Checker
      "g-zstspl");   -- GNAT.Wide_Wide_String_Split
 
+   --------------------
+   -- Ada 2012 Units --
+   --------------------
+
+   --  The following units should be used only in Ada 05 mode
+
+   Non_Imp_File_Names_12 : constant File_List := (
+     0 => "s-multip");   -- System.Mutiprocessors
+
    -----------------------
    -- Alternative Units --
    -----------------------
@@ -596,7 +605,7 @@  package body Impunit is
          end if;
       end loop;
 
-      --  See if name is in 05 list
+      --  See if name is in 2005 list
 
       for J in Non_Imp_File_Names_05'Range loop
          if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
@@ -604,6 +613,14 @@  package body Impunit is
          end if;
       end loop;
 
+      --  See if name is in 2012 list
+
+      for J in Non_Imp_File_Names_12'Range loop
+         if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J) then
+            return Ada_12_Unit;
+         end if;
+      end loop;
+
       --  Only remaining special possibilities are children of System.RPC and
       --  System.Garlic and special files of the form System.Aux...
 
Index: impunit.ads
===================================================================
--- impunit.ads	(revision 165256)
+++ impunit.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -48,10 +48,15 @@  package Impunit is
       --  in both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no
       --  child units are allowed, so you can't even name such a unit.
 
-      Ada_05_Unit);
-   --  This unit is defined in the Ada 05 RM. Withing this unit from a
-   --  Ada 95 mode program will generate a warning (again, strictly speaking
-   --  this should be an error, but that seems over-strenuous).
+      Ada_05_Unit,
+      --  This unit is defined in the Ada 2005 RM. Withing this unit from a
+      --  Ada 95 mode program will generate a warning (again, strictly speaking
+      --  this should be an error, but that seems over-strenuous).
+
+      Ada_12_Unit);
+      --  This unit is defined in the Ada 2012 RM. Withing this unit from a Ada
+      --  95 mode or Ada 2005 program will generate a warning (again, strictly
+      --  speaking this should be an error, but that seems over-strenuous).
 
    function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit;
    --  Given the unit number of a unit, this function determines the type
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 165256)
+++ sem_ch10.adb	(working copy)
@@ -2457,6 +2457,12 @@  package body Sem_Ch10 is
                  and then Warn_On_Ada_2005_Compatibility
                then
                   Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
+
+               elsif U_Kind = Ada_12_Unit
+                 and then Ada_Version < Ada_12
+                 and then Warn_On_Ada_2012_Compatibility
+               then
+                  Error_Msg_N ("& is an Ada 2012 unit?", Name (N));
                end if;
             end;
          end if;
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 165256)
+++ rtsfind.ads	(working copy)
@@ -265,6 +265,7 @@  package Rtsfind is
       System_Machine_Code,
       System_Mantissa,
       System_Memcop,
+      System_Multiprocessors,
       System_Pack_03,
       System_Pack_05,
       System_Pack_06,
Index: Makefile.rtl
===================================================================
--- Makefile.rtl	(revision 165256)
+++ Makefile.rtl	(working copy)
@@ -504,6 +504,7 @@  GNATRTL_NONTASKING_OBJS= \
   s-mastop$(objext) \
   s-memcop$(objext) \
   s-memory$(objext) \
+  s-multip$(objext) \
   s-os_lib$(objext) \
   s-osprim$(objext) \
   s-pack03$(objext) \
Index: s-multip.adb
===================================================================
--- s-multip.adb	(revision 0)
+++ s-multip.adb	(revision 0)
@@ -0,0 +1,44 @@ 
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . M U L T I P R O C E S S O R S                --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--           Copyright (C) 2010, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Interfaces.C; use Interfaces.C;
+
+package body System.Multiprocessors is
+   function Gnat_Number_Of_CPUs return int;
+   pragma Import (C, Gnat_Number_Of_CPUs, "__gnat_number_of_cpus");
+
+   --------------------
+   -- Number_Of_CPUs --
+   --------------------
+
+   function Number_Of_CPUs return CPU is
+   begin
+      return CPU (Gnat_Number_Of_CPUs);
+   end Number_Of_CPUs;
+
+end System.Multiprocessors;
Index: s-multip.ads
===================================================================
--- s-multip.ads	(revision 0)
+++ s-multip.ads	(revision 0)
@@ -0,0 +1,44 @@ 
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . M U L T I P R O C E S S O R S                --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--           Copyright (C) 2010, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This unit may be used directly from an application program by providing
+--  an appropriate WITH, and the interface can be expected to remain stable.
+
+package System.Multiprocessors is
+   pragma Preelaborate (Multiprocessors);
+
+   type CPU_Range is range 0 .. 2 ** 16 - 1;
+
+   subtype CPU is CPU_Range range 1 .. CPU_Range'Last;
+
+   Not_A_Specific_CPU : constant CPU_Range := 0;
+
+   function Number_Of_CPUs return CPU;
+   --  Number of available CPUs
+
+end System.Multiprocessors;
Index: adaint.c
===================================================================
--- adaint.c	(revision 165256)
+++ adaint.c	(working copy)
@@ -2358,6 +2358,18 @@  __gnat_dup2 (int oldfd, int newfd)
 #endif
 }
 
+int
+__gnat_number_of_cpus (void)
+{
+  int cores = 1;
+
+#if defined (linux)
+  cores = (int)sysconf(_SC_NPROCESSORS_ONLN);
+#endif
+
+  return cores;
+}
+
 /* WIN32 code to implement a wait call that wait for any child process.  */
 
 #if defined (_WIN32) && !defined (RTX)
Index: adaint.h
===================================================================
--- adaint.h	(revision 165256)
+++ adaint.h	(working copy)
@@ -235,6 +235,8 @@  extern int    __gnat_set_close_on_exec		
 extern int    __gnat_dup			   (int);
 extern int    __gnat_dup2			   (int, int);
 
+extern int    __gnat_number_of_cpus                (void);
+
 extern void   __gnat_os_filename                   (char *, char *, char *,
 						    int *, char *, int *);
 #if defined (linux)