From patchwork Mon Oct 11 07:14:58 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 67382 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 76AD9B70A3 for ; Mon, 11 Oct 2010 18:15:13 +1100 (EST) Received: (qmail 31524 invoked by alias); 11 Oct 2010 07:15:09 -0000 Received: (qmail 31495 invoked by uid 22791); 11 Oct 2010 07:15:07 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 11 Oct 2010 07:15:01 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 421DE29000D; Mon, 11 Oct 2010 09:14:59 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Kdkdmk60Isfa; Mon, 11 Oct 2010 09:14:59 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 1FB56CB01EC; Mon, 11 Oct 2010 09:14:59 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id F286CD9BB5; Mon, 11 Oct 2010 09:14:58 +0200 (CEST) Date: Mon, 11 Oct 2010 09:14:58 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] New Ada 2012 language-defined System.Multiprocessors Message-ID: <20101011071458.GA6535@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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. 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 -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +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 -- +-- . -- +-- -- +------------------------------------------------------------------------------ + +-- 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)