From patchwork Mon Oct 18 10:30:59 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 68164 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 153D0B70E9 for ; Mon, 18 Oct 2010 21:31:36 +1100 (EST) Received: (qmail 4388 invoked by alias); 18 Oct 2010 10:31:33 -0000 Received: (qmail 4363 invoked by uid 22791); 18 Oct 2010 10:31:23 -0000 X-SWARE-Spam-Status: Yes, hits=5.9 required=5.0 tests=BAYES_50, BOTNET, TW_CP, T_RP_MATCHES_RCVD, WEIRD_QUOTING X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 18 Oct 2010 10:31:03 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id EBDBACB0269; Mon, 18 Oct 2010 12:30: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 ybit-nfDD2t9; Mon, 18 Oct 2010 12:30: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 D135ECB022E; Mon, 18 Oct 2010 12:30:59 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id B4191D9BB4; Mon, 18 Oct 2010 12:30:59 +0200 (CEST) Date: Mon, 18 Oct 2010 12:30:59 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Jose Ruiz Subject: [Ada] Implementation of pragma CPU Message-ID: <20101018103059.GA8188@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 This patch adds the support of "pragma CPU" for controlling task affinity. This pragma can appear in the task definition or in the declarative part of the main subprogram. It uses the support of the underlying operating system, and it is implemented (so far) on top of Linux, Windows and Solaris. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-18 Jose Ruiz * exp_ch9.adb (Expand_N_Task_Type_Declaration): Add field corresponding to the affinity when expanding the task declaration. (Make_Task_Create_Call): Add the affinity parameter to the call to create task. * sem_prag.adb (Analyze_Pragma): Add the analysis for pragma CPU, taking into account the case when it applies to a subprogram (only for main and with static expression) or to a task. * par_prag.adb:(Prag): Make pragma CPU a valid one. * snames.ads-tmpl (Name_uCPU, Name_CPU): Add these new name identifiers used by the expander for handling the affinity parameter when creating a task. (Pragma_Id): Add Pragma_CPU as a valid one. * rtsfind.ads (RTU_Id): Make System_Multiprocessors accesible. (RE_Id, RE_Unit_Table): Make the entities RE_CPU_Range and RE_Unspecified_CPU visible. * sinfo.ads, sinfo.adb (Has_Pragma_CPU, Set_Has_Pragma_CPU): Add these two subprograms to set/get the flag indicating whether there is a pragma CPU which applies to the entity. * lib.ads, lib.adb (Unit_Record, Default_Main_CPU, Main_CPU, Set_Main_CPU): Add the field Main_CPU to Unit_Record to store the value of the affinity associated to the main subprogram (if any). Default_Main_CPU is used when no affinity is set. Subprograms Set_Main_CPU and Main_CPU are added to set/get the affinity of the main subprogram. * ali.ads, ali.adb (ALIs_Record): Add field Main_CPU to contain the value of the affinity of the main subprogram. (Scan_ALI): Get the affinity of the main subprogram (encoded as C=XX in the M line). * lib-writ.ads, lib-writ.adb (M_Parameters): Encode the affinity of the main subprogram in the M (main) line using C=XX. * lib-load.adb (Create_Dummy_Package_Unit, Load_Main_Source, Load_Unit): Add new field Main_CPU. * bindgen.adb (Gen_Adainit_Ada, Gen_Adainit_C): Add the code to pass the affinity of the main subprogram to the run time. * s-taskin.ads (Common_ATCB): Add the field Base_CPU to store the affinity. (Unspecified_CPU): Add this constant to identify the case when no affinity is set for tasks. * s-taskin.adb (Initialize_ATCB): Store the value coming from pragma CPU in the common part of the ATCB. (Initialize): Store the value coming from pragma CPU (for the environment task) in the common part of the ATCB. * s-tassta.ads, s-tassta.adb (Create_Task): Add the affinity specified by pragma CPU to the ATCB. * s-tarest.ads, s-tarest.adb (Create_Restricted_Task): Add the affinity specified by pragma CPU to the ATCB. * s-tporft.adb (Register_Foreign_Thread): Add the new affinity parameter to the call to Initialize_ATCB. * s-taprop-linux.adb (Create_Task): Change the attributes of the thread to include the task affinity before creation. Additionally, the affinity selected with Task_Info is also enforced changing the attributes at task creation time, instead of changing it after creation. (Initialize): Change the affinity of the environment task if required by a pragma CPU. * s-osinte-linux.ads (pthread_setaffinity_np): Instead of using a wrapper to check whether the function is available or not, use a weak symbol. (pthread_attr_setaffinity_np): Add the import of this function which is used to change the affinity in the attributes used to create a thread. * adaint.c (__gnat_pthread_attr_setaffinity_np): Remove this wrapper. It was used to check whether the pthread function was available or not, but the use of a weak symbol handles this situation in a cleaner way. * s-taprop-mingw.adb (Create_Task, Initialize): Change the affinity of tasks (including the environment task) if required by a pragma CPU. * s-taprop-solaris.adb (Enter_Task): Change the affinity of tasks (including the environment task) if required by a pragma CPU. * s-taprop-vxworks.adb (Create_Task, Initialize): Change the affinity of tasks (including the environment task) if required by a pragma CPU. * init.c (__gl_main_cpu): Make this value visible to the run time. It will pass the affinity of the environment task. Index: lib.adb =================================================================== --- lib.adb (revision 165610) +++ lib.adb (working copy) @@ -138,6 +138,11 @@ package body Lib is return Units.Table (U).Loading; end Loading; + function Main_CPU (U : Unit_Number_Type) return Int is + begin + return Units.Table (U).Main_CPU; + end Main_CPU; + function Main_Priority (U : Unit_Number_Type) return Int is begin return Units.Table (U).Main_Priority; @@ -231,6 +236,11 @@ package body Lib is Units.Table (U).Loading := B; end Set_Loading; + procedure Set_Main_CPU (U : Unit_Number_Type; P : Int) is + begin + Units.Table (U).Main_CPU := P; + end Set_Main_CPU; + procedure Set_Main_Priority (U : Unit_Number_Type; P : Int) is begin Units.Table (U).Main_Priority := P; Index: s-osinte-linux.ads =================================================================== --- s-osinte-linux.ads (revision 165610) +++ s-osinte-linux.ads (working copy) @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-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- -- @@ -490,7 +490,18 @@ package System.OS_Interface is (thread : pthread_t; cpusetsize : size_t; cpuset : access cpu_set_t) return int; - pragma Import (C, pthread_setaffinity_np, "__gnat_pthread_setaffinity_np"); + pragma Import (C, pthread_setaffinity_np, "pthread_setaffinity_np"); + pragma Weak_External (pthread_setaffinity_np); + -- Use a weak symbol because this function may be available or not, + -- depending on the version of the system. + + function pthread_attr_setaffinity_np + (attr : access pthread_attr_t; + cpusetsize : size_t; + cpuset : access cpu_set_t) return int; + pragma Import (C, pthread_attr_setaffinity_np, + "pthread_attr_setaffinity_np"); + pragma Weak_External (pthread_attr_setaffinity_np); private Index: lib.ads =================================================================== --- lib.ads (revision 165610) +++ lib.ads (working copy) @@ -357,6 +357,12 @@ package Lib is -- that the default priority is to be used (and is also used for -- entries that do not correspond to possible main programs). + -- Main_CPU + -- This field is used to indicate the affinity of a possible main + -- program, as set by a pragma CPU. A value of -1 indicates + -- that the default affinity is to be used (and is also used for + -- entries that do not correspond to possible main programs). + -- Has_Allocator -- This flag is set if a subprogram unit has an allocator after the -- BEGIN (it is used to set the AB flag in the M ALI line). @@ -392,6 +398,9 @@ package Lib is Default_Main_Priority : constant Int := -1; -- Value used in Main_Priority field to indicate default main priority + Default_Main_CPU : constant Int := -1; + -- Value used in Main_CPU field to indicate default main affinity + function Cunit (U : Unit_Number_Type) return Node_Id; function Cunit_Entity (U : Unit_Number_Type) return Entity_Id; function Dependency_Num (U : Unit_Number_Type) return Nat; @@ -405,6 +414,7 @@ package Lib is function Has_RACW (U : Unit_Number_Type) return Boolean; function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean; function Loading (U : Unit_Number_Type) return Boolean; + function Main_CPU (U : Unit_Number_Type) return Int; function Main_Priority (U : Unit_Number_Type) return Int; function Munit_Index (U : Unit_Number_Type) return Nat; function OA_Setting (U : Unit_Number_Type) return Character; @@ -424,6 +434,7 @@ package Lib is procedure Set_Is_Compiler_Unit (U : Unit_Number_Type; B : Boolean := True); procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id); procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True); + procedure Set_Main_CPU (U : Unit_Number_Type; P : Int); procedure Set_Main_Priority (U : Unit_Number_Type; P : Int); procedure Set_OA_Setting (U : Unit_Number_Type; C : Character); procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type); @@ -664,6 +675,7 @@ private pragma Inline (Is_Compiler_Unit); pragma Inline (Increment_Serial_Number); pragma Inline (Loading); + pragma Inline (Main_CPU); pragma Inline (Main_Priority); pragma Inline (Munit_Index); pragma Inline (OA_Setting); @@ -674,6 +686,7 @@ private pragma Inline (Set_Has_Allocator); pragma Inline (Set_Has_RACW); pragma Inline (Set_Loading); + pragma Inline (Set_Main_CPU); pragma Inline (Set_Main_Priority); pragma Inline (Set_OA_Setting); pragma Inline (Set_Unit_Name); @@ -692,6 +705,7 @@ private Dependency_Num : Int; Ident_String : Node_Id; Main_Priority : Int; + Main_CPU : Int; Serial_Number : Nat; Version : Word; Error_Location : Source_Ptr; @@ -720,20 +734,21 @@ private Dependency_Num at 28 range 0 .. 31; Ident_String at 32 range 0 .. 31; Main_Priority at 36 range 0 .. 31; - Serial_Number at 40 range 0 .. 31; - Version at 44 range 0 .. 31; - Error_Location at 48 range 0 .. 31; - Fatal_Error at 52 range 0 .. 7; - Generate_Code at 53 range 0 .. 7; - Has_RACW at 54 range 0 .. 7; - Dynamic_Elab at 55 range 0 .. 7; - Is_Compiler_Unit at 56 range 0 .. 7; - OA_Setting at 57 range 0 .. 7; - Loading at 58 range 0 .. 7; - Has_Allocator at 59 range 0 .. 7; + Main_CPU at 40 range 0 .. 31; + Serial_Number at 44 range 0 .. 31; + Version at 48 range 0 .. 31; + Error_Location at 52 range 0 .. 31; + Fatal_Error at 56 range 0 .. 7; + Generate_Code at 57 range 0 .. 7; + Has_RACW at 58 range 0 .. 7; + Dynamic_Elab at 59 range 0 .. 7; + Is_Compiler_Unit at 60 range 0 .. 7; + OA_Setting at 61 range 0 .. 7; + Loading at 62 range 0 .. 7; + Has_Allocator at 63 range 0 .. 7; end record; - for Unit_Record'Size use 60 * 8; + for Unit_Record'Size use 64 * 8; -- This ensures that we did not leave out any fields package Units is new Table.Table ( Index: s-taprop-vxworks.adb =================================================================== --- s-taprop-vxworks.adb (revision 165610) +++ s-taprop-vxworks.adb (working copy) @@ -43,6 +43,7 @@ with Ada.Unchecked_Deallocation; with Interfaces.C; +with System.Multiprocessors; with System.Tasking.Debug; with System.Interrupt_Management; @@ -868,9 +869,10 @@ package body System.Task_Primitives.Oper Succeeded : out Boolean) is Adjusted_Stack_Size : size_t; - Result : int; + Result : int := 0; use System.Task_Info; + use type System.Multiprocessors.CPU_Range; begin -- Ask for four extra bytes of stack space so that the ATCB pointer can @@ -936,14 +938,18 @@ package body System.Task_Primitives.Oper -- Set processor affinity - if T.Common.Task_Info /= Unspecified_Task_Info then + if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then + Result := + taskCpuAffinitySet (T.Common.LL.Thread, int (T.Common.Base_CPU)); + + elsif T.Common.Task_Info /= Unspecified_Task_Info then Result := taskCpuAffinitySet (T.Common.LL.Thread, T.Common.Task_Info); + end if; - if Result = -1 then - taskDelete (T.Common.LL.Thread); - T.Common.LL.Thread := -1; - end if; + if Result = -1 then + taskDelete (T.Common.LL.Thread); + T.Common.LL.Thread := -1; end if; if T.Common.LL.Thread = -1 then @@ -1347,6 +1353,8 @@ package body System.Task_Primitives.Oper procedure Initialize (Environment_Task : Task_Id) is Result : int; + use type System.Multiprocessors.CPU_Range; + begin Environment_Task_Id := Environment_Task; @@ -1393,6 +1401,18 @@ package body System.Task_Primitives.Oper Environment_Task.Known_Tasks_Index := Known_Tasks'First; Enter_Task (Environment_Task); + + -- Set processor affinity + + if Environment_Task.Common.Base_CPU /= + System.Multiprocessors.Not_A_Specific_CPU + then + Result := + taskCpuAffinitySet + (Environment_Task.Common.LL.Thread, + int (Environment_Task.Common.Base_CPU)); + pragma Assert (Result /= -1); + end if; end Initialize; end System.Task_Primitives.Operations; Index: sinfo.adb =================================================================== --- sinfo.adb (revision 165610) +++ sinfo.adb (working copy) @@ -1453,6 +1453,15 @@ package body Sinfo is return Flag17 (N); end Has_No_Elaboration_Code; + function Has_Pragma_CPU + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Body + or else NT (N).Nkind = N_Task_Definition); + return Flag10 (N); + end Has_Pragma_CPU; + function Has_Pragma_Priority (N : Node_Id) return Boolean is begin @@ -4423,6 +4432,15 @@ package body Sinfo is Set_Flag17 (N, Val); end Set_Has_No_Elaboration_Code; + procedure Set_Has_Pragma_CPU + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Body + or else NT (N).Nkind = N_Task_Definition); + Set_Flag10 (N, Val); + end Set_Has_Pragma_CPU; + procedure Set_Has_Pragma_Priority (N : Node_Id; Val : Boolean := True) is begin Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 165622) +++ exp_ch9.adb (working copy) @@ -10315,6 +10315,7 @@ package body Exp_Ch9 is -- _Priority : Integer := priority_expression; -- _Size : Size_Type := Size_Type (size_expression); -- _Task_Info : Task_Info_Type := task_info_expression; + -- _CPU : Integer := cpu_range_expression; -- end record; -- The discriminants are present only if the corresponding task type has @@ -10348,6 +10349,11 @@ package body Exp_Ch9 is -- present in the pragma, and is used to provide the Task_Image parameter -- to the call to Create_Task. + -- The _CPU field is present only if a CPU pragma appears in the task + -- definition. The expression captures the argument that was present in + -- the pragma, and is used to provide the CPU parameter to the call to + -- Create_Task. + -- The _Relative_Deadline field is present only if a Relative_Deadline -- pragma appears in the task definition. The expression captures the -- argument that was present in the pragma, and is used to provide the @@ -10666,6 +10672,27 @@ package body Exp_Ch9 is (Taskdef, Name_Task_Info))))))); end if; + -- Add the _CPU component if a CPU pragma is present + + if Present (Taskdef) and then Has_Pragma_CPU (Taskdef) then + Append_To (Cdecls, + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uCPU), + + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Reference_To (RTE (RE_CPU_Range), Loc)), + + Expression => New_Copy ( + Expression (First ( + Pragma_Argument_Associations ( + Find_Task_Or_Protected_Pragma + (Taskdef, Name_CPU))))))); + end if; + -- Add the _Relative_Deadline component if a Relative_Deadline pragma is -- present. If we are using a restricted run time this component will -- not be added (deadlines are not allowed by the Ravenscar profile). @@ -12593,6 +12620,23 @@ package body Exp_Ch9 is New_Reference_To (RTE (RE_Unspecified_Task_Info), Loc)); end if; + -- CPU parameter. Set to Unspecified_CPU unless there is a CPU pragma, + -- in which case we take the value from the pragma. The parameter is + -- passed as an Integer because in the case of unspecified CPU the + -- value is not in the range of CPU_Range. + + if Present (Tdef) and then Has_Pragma_CPU (Tdef) then + Append_To (Args, + Convert_To (Standard_Integer, + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_uInit), + Selector_Name => Make_Identifier (Loc, Name_uCPU)))); + + else + Append_To (Args, + New_Reference_To (RTE (RE_Unspecified_CPU), Loc)); + end if; + if not Restricted_Profile then -- Deadline parameter. If no Relative_Deadline pragma is present, Index: sinfo.ads =================================================================== --- sinfo.ads (revision 165610) +++ sinfo.ads (working copy) @@ -1133,6 +1133,11 @@ package Sinfo is -- generate elaboration code, and non-preelaborated packages which do -- not generate elaboration code. + -- Has_Pragma_CPU (Flag10-Sem) + -- A flag present in N_Subprogram_Body and N_Task_Definition nodes to + -- flag the presence of a CPU pragma in the declaration sequence (public + -- or private in the task case). + -- Has_Pragma_Suppress_All (Flag14-Sem) -- This flag is set in an N_Compilation_Unit node if the Suppress_All -- pragma appears anywhere in the unit. This accomodates the rather @@ -4486,6 +4491,7 @@ package Sinfo is -- Is_Task_Master (Flag5-Sem) -- Was_Originally_Stub (Flag13-Sem) -- Has_Relative_Deadline_Pragma (Flag9-Sem) + -- Has_Pragma_CPU (Flag10-Sem) ------------------------------ -- Parameterized Expression -- @@ -4969,6 +4975,7 @@ package Sinfo is -- Has_Task_Info_Pragma (Flag7-Sem) -- Has_Task_Name_Pragma (Flag8-Sem) -- Has_Relative_Deadline_Pragma (Flag9-Sem) + -- Has_Pragma_CPU (Flag10-Sem) -------------------- -- 9.1 Task Item -- @@ -8316,6 +8323,9 @@ package Sinfo is function Has_No_Elaboration_Code (N : Node_Id) return Boolean; -- Flag17 + function Has_Pragma_CPU + (N : Node_Id) return Boolean; -- Flag10 + function Has_Pragma_Priority (N : Node_Id) return Boolean; -- Flag6 @@ -9264,6 +9274,9 @@ package Sinfo is procedure Set_Has_No_Elaboration_Code (N : Node_Id; Val : Boolean := True); -- Flag17 + procedure Set_Has_Pragma_CPU + (N : Node_Id; Val : Boolean := True); -- Flag10 + procedure Set_Has_Pragma_Priority (N : Node_Id; Val : Boolean := True); -- Flag6 @@ -11630,6 +11643,7 @@ package Sinfo is pragma Inline (Has_Local_Raise); pragma Inline (Has_Self_Reference); pragma Inline (Has_No_Elaboration_Code); + pragma Inline (Has_Pragma_CPU); pragma Inline (Has_Pragma_Priority); pragma Inline (Has_Pragma_Suppress_All); pragma Inline (Has_Private_View); @@ -11942,6 +11956,7 @@ package Sinfo is pragma Inline (Set_Has_Local_Raise); pragma Inline (Set_Has_Dynamic_Range_Check); pragma Inline (Set_Has_No_Elaboration_Code); + pragma Inline (Set_Has_Pragma_CPU); pragma Inline (Set_Has_Pragma_Priority); pragma Inline (Set_Has_Pragma_Suppress_All); pragma Inline (Set_Has_Private_View); Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 165610) +++ lib-writ.adb (working copy) @@ -86,6 +86,7 @@ package body Lib.Writ is Ident_String => Empty, Loading => False, Main_Priority => -1, + Main_CPU => -1, Munit_Index => 0, Serial_Number => 0, Version => 0, @@ -142,6 +143,7 @@ package body Lib.Writ is Ident_String => Empty, Loading => False, Main_Priority => -1, + Main_CPU => -1, Munit_Index => 0, Serial_Number => 0, Version => 0, @@ -931,6 +933,11 @@ package body Lib.Writ is Write_Info_Str (" AB"); end if; + if Main_CPU (Main_Unit) /= Default_Main_CPU then + Write_Info_Str (" C="); + Write_Info_Nat (Main_CPU (Main_Unit)); + end if; + Write_Info_Str (" W="); Write_Info_Char (WC_Encoding_Letters (Wide_Character_Encoding_Method)); Index: lib-writ.ads =================================================================== --- lib-writ.ads (revision 165610) +++ lib-writ.ads (working copy) @@ -116,7 +116,7 @@ package Lib.Writ is -- -- M Main Program -- -- --------------------- - -- M type [priority] [T=time-slice] [AB] W=? + -- M type [priority] [T=time-slice] [AB] [C=cpu] W=? -- This line appears only if the main unit for this file is suitable -- for use as a main program. The parameters are: @@ -148,7 +148,12 @@ package Lib.Writ is -- No_Allocators_After_Elaboration if it is present, and this -- unit is used as a main program (only the binder can find the -- violation, since only the binder knows the main program). - -- + + -- C=cpu + + -- Present only if there was a valid pragma CPU in the + -- corresponding unit to set the main task affinity. It is an + -- unsigned decimal integer. -- W=? Index: bindgen.adb =================================================================== --- bindgen.adb (revision 165610) +++ bindgen.adb (working copy) @@ -127,6 +127,7 @@ package body Bindgen is -- Detect_Blocking : Integer; -- Default_Stack_Size : Integer; -- Leap_Seconds_Support : Integer; + -- Main_CPU : Integer; -- Main_Priority is the priority value set by pragma Priority in the main -- program. If no such pragma is present, the value is -1. @@ -215,6 +216,9 @@ package body Bindgen is -- disabled. A value of zero indicates that leap seconds are turned "off", -- while a value of one signifies "on" status. + -- Main_CPU is the processor set by pragma CPU in the main program. If no + -- such pragma is present, the value is -1. + ----------------------- -- Local Subprograms -- ----------------------- @@ -436,6 +440,7 @@ package body Bindgen is procedure Gen_Adainit_Ada is Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority; + Main_CPU : Int renames ALIs.Table (ALIs.First).Main_CPU; begin WBI (" procedure " & Ada_Init_Name.all & " is"); @@ -520,9 +525,9 @@ package body Bindgen is Write_Statement_Buffer; - -- If the standard library is suppressed, then the only global variable - -- that might be needed (by the Ravenscar profile) is the priority of - -- the environment. + -- If the standard library is suppressed, then the only global variables + -- that might be needed (by the Ravenscar profile) are the priority and + -- the processor for the environment task. if Suppress_Standard_Library_On_Target then if Main_Priority /= No_Main_Priority then @@ -532,6 +537,13 @@ package body Bindgen is WBI (""); end if; + if Main_CPU /= No_Main_CPU then + WBI (" Main_CPU : Integer;"); + WBI (" pragma Import (C, Main_CPU," & + " ""__gl_main_cpu"");"); + WBI (""); + end if; + WBI (" begin"); if Main_Priority /= No_Main_Priority then @@ -539,8 +551,18 @@ package body Bindgen is Set_Int (Main_Priority); Set_Char (';'); Write_Statement_Buffer; + end if; - else + if Main_CPU /= No_Main_CPU then + Set_String (" Main_CPU := "); + Set_Int (Main_CPU); + Set_Char (';'); + Write_Statement_Buffer; + end if; + + if Main_Priority = No_Main_Priority + and then Main_CPU = No_Main_CPU + then WBI (" null;"); end if; @@ -571,6 +593,9 @@ package body Bindgen is WBI (" Num_Specific_Dispatching : Integer;"); WBI (" pragma Import (C, Num_Specific_Dispatching, " & """__gl_num_specific_dispatching"");"); + WBI (" Main_CPU : Integer;"); + WBI (" pragma Import (C, Main_CPU, " & + """__gl_main_cpu"");"); WBI (" Interrupt_States : System.Address;"); WBI (" pragma Import (C, Interrupt_States, " & @@ -731,6 +756,11 @@ package body Bindgen is Set_Char (';'); Write_Statement_Buffer; + Set_String (" Main_CPU := "); + Set_Int (Main_CPU); + Set_Char (';'); + Write_Statement_Buffer; + WBI (" Interrupt_States := Local_Interrupt_States'Address;"); Set_String (" Num_Interrupt_States := "); @@ -891,6 +921,7 @@ package body Bindgen is procedure Gen_Adainit_C is Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority; + Main_CPU : Int renames ALIs.Table (ALIs.First).Main_CPU; begin WBI ("void " & Ada_Init_Name.all & " (void)"); @@ -934,8 +965,8 @@ package body Bindgen is if Suppress_Standard_Library_On_Target then - -- Case of High_Integrity_Mode mode. Set __gl_main_priority if needed - -- for the Ravenscar profile. + -- Case of High_Integrity_Mode mode. Set __gl_main_priority and + -- __gl_main_cpu if needed for the Ravenscar profile. if Main_Priority /= No_Main_Priority then WBI (" extern int __gl_main_priority;"); @@ -945,6 +976,14 @@ package body Bindgen is Write_Statement_Buffer; end if; + if Main_CPU /= No_Main_CPU then + WBI (" extern int __gl_main_cpu;"); + Set_String (" __gl_main_cpu = "); + Set_Int (Main_CPU); + Set_Char (';'); + Write_Statement_Buffer; + end if; + -- Normal case (standard library not suppressed) else @@ -1030,6 +1069,12 @@ package body Bindgen is Set_String ("';"); Write_Statement_Buffer; + WBI (" extern int __gl_main_cpu;"); + Set_String (" __gl_main_cpu = "); + Set_Int (Main_CPU); + Set_Char (';'); + Write_Statement_Buffer; + Gen_Restrictions_C; WBI (" extern const void *__gl_interrupt_states;"); Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 165614) +++ sem_prag.adb (working copy) @@ -415,7 +415,7 @@ package body Sem_Prag is procedure Check_In_Main_Program; -- Common checks for pragmas that appear within a main program - -- (Priority, Main_Storage, Time_Slice, Relative_Deadline). + -- (Priority, Main_Storage, Time_Slice, Relative_Deadline, CPU). procedure Check_Interrupt_Or_Attach_Handler; -- Common processing for first argument of pragma Interrupt_Handler or @@ -6961,6 +6961,92 @@ package body Sem_Prag is end if; end CPP_Vtable; + --------- + -- CPU -- + --------- + + -- pragma CPU (EXPRESSION); + + when Pragma_CPU => CPU : declare + P : constant Node_Id := Parent (N); + Arg : Node_Id; + + begin + Ada_2012_Pragma; + Check_No_Identifiers; + Check_Arg_Count (1); + + -- Subprogram case + + if Nkind (P) = N_Subprogram_Body then + Check_In_Main_Program; + + Arg := Get_Pragma_Arg (Arg1); + Analyze_And_Resolve (Arg, Any_Integer); + + -- Must be static + + if not Is_Static_Expression (Arg) then + Flag_Non_Static_Expr + ("main subprogram affinity is not static!", Arg); + raise Pragma_Exit; + + -- If constraint error, then we already signalled an error + + elsif Raises_Constraint_Error (Arg) then + null; + + -- Otherwise check in range + + else + declare + CPU_Id : constant Entity_Id := RTE (RE_CPU_Range); + -- This is the entity System.Multiprocessors.CPU_Range; + + Val : constant Uint := Expr_Value (Arg); + + begin + if Val < Expr_Value (Type_Low_Bound (CPU_Id)) + or else + Val > Expr_Value (Type_High_Bound (CPU_Id)) + then + Error_Pragma_Arg + ("main subprogram CPU is out of range", Arg1); + end if; + end; + end if; + + Set_Main_CPU + (Current_Sem_Unit, UI_To_Int (Expr_Value (Arg))); + + -- Task case + + elsif Nkind (P) = N_Task_Definition then + Arg := Get_Pragma_Arg (Arg1); + + -- The expression must be analyzed in the special manner + -- described in "Handling of Default and Per-Object + -- Expressions" in sem.ads. + + Preanalyze_Spec_Expression (Arg, RTE (RE_CPU_Range)); + + -- Anything else is incorrect + + else + Pragma_Misplaced; + end if; + + if Has_Pragma_CPU (P) then + Error_Pragma ("duplicate pragma% not allowed"); + else + Set_Has_Pragma_CPU (P, True); + + if Nkind (P) = N_Task_Definition then + Record_Rep_Item (Defining_Identifier (Parent (P)), N); + end if; + end if; + end CPU; + ----------- -- Debug -- ----------- @@ -13513,6 +13599,7 @@ package body Sem_Prag is Pragma_CPP_Constructor => 0, Pragma_CPP_Virtual => 0, Pragma_CPP_Vtable => 0, + Pragma_CPU => -1, Pragma_C_Pass_By_Copy => 0, Pragma_Comment => 0, Pragma_Common_Object => -1, Index: s-tassta.adb =================================================================== --- s-tassta.adb (revision 165624) +++ s-tassta.adb (working copy) @@ -473,6 +473,7 @@ package body System.Tasking.Stages is (Priority : Integer; Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; Relative_Deadline : Ada.Real_Time.Time_Span; Num_Entries : Task_Entry_Index; Master : Master_Level; @@ -489,6 +490,7 @@ package body System.Tasking.Stages is Success : Boolean; Base_Priority : System.Any_Priority; Len : Natural; + Base_CPU : System.Multiprocessors.CPU_Range; pragma Unreferenced (Relative_Deadline); -- EDF scheduling is not supported by any of the target platforms so @@ -522,6 +524,21 @@ package body System.Tasking.Stages is then Self_ID.Common.Base_Priority else System.Any_Priority (Priority)); + if CPU /= Unspecified_CPU + and then (CPU < Integer (System.Multiprocessors.CPU_Range'First) + or else CPU > Integer (System.Multiprocessors.CPU_Range'Last) + or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs)) + then + raise Tasking_Error with "CPU not in range"; + + -- Normal CPU affinity + else + Base_CPU := + (if CPU = Unspecified_CPU + then Self_ID.Common.Base_CPU + else System.Multiprocessors.CPU_Range (CPU)); + end if; + -- Find parent P of new Task, via master level number P := Self_ID; @@ -570,7 +587,7 @@ package body System.Tasking.Stages is end if; Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated, - Base_Priority, Task_Info, Size, T, Success); + Base_Priority, Base_CPU, Task_Info, Size, T, Success); if not Success then Free (T); Index: s-tassta.ads =================================================================== --- s-tassta.ads (revision 165610) +++ s-tassta.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -81,10 +81,10 @@ package System.Tasking.Stages is -- _init.discr := discr; -- _init._task_id := null; -- create_task (unspecified_priority, tZ, - -- unspecified_task_info, ada__real_time__time_span_zero, 0, - -- _master, task_procedure_access!(tB'address), - -- _init'address, tE'unchecked_access, _chain, _task_id, _init. - -- _task_id); + -- unspecified_task_info, unspecified_cpu, + -- ada__real_time__time_span_zero, 0, _master, + -- task_procedure_access!(tB'address), _init'address, + -- tE'unchecked_access, _chain, _task_id, _init._task_id); -- return; -- end tVIP; -- ] @@ -170,6 +170,7 @@ package System.Tasking.Stages is (Priority : Integer; Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; Relative_Deadline : Ada.Real_Time.Time_Span; Num_Entries : Task_Entry_Index; Master : Master_Level; @@ -188,6 +189,10 @@ package System.Tasking.Stages is -- Size is the stack size of the task to create -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. + -- CPU is the task affinity. We pass it as an Integer because the + -- undefined value is not in the range of CPU_Range. Static range + -- checks are performed when analyzing the pragma, and dynamic ones are + -- performed before setting the affinity at run time. -- Relative_Deadline is the relative deadline associated with the created -- task by means of a pragma Relative_Deadline, or 0.0 if none. -- State is the compiler generated task's procedure body Index: rtsfind.ads =================================================================== --- rtsfind.ads (revision 165610) +++ 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, @@ -839,6 +840,8 @@ package Rtsfind is RE_Mantissa_Value, -- System_Mantissa + RE_CPU_Range, -- System.Multiprocessors + RE_Bits_03, -- System.Pack_03 RE_Get_03, -- System.Pack_03 RE_Set_03, -- System.Pack_03 @@ -1426,6 +1429,8 @@ package Rtsfind is RE_Activation_Chain_Access, -- System.Tasking RE_Storage_Size, -- System.Tasking + RE_Unspecified_CPU, -- System.Tasking + RE_Abort_Defer, -- System.Soft_Links RE_Abort_Undefer, -- System.Soft_Links RE_Complete_Master, -- System.Soft_Links @@ -2012,6 +2017,8 @@ package Rtsfind is RE_Mantissa_Value => System_Mantissa, + RE_CPU_Range => System_Multiprocessors, + RE_Bits_03 => System_Pack_03, RE_Get_03 => System_Pack_03, RE_Set_03 => System_Pack_03, @@ -2599,6 +2606,8 @@ package Rtsfind is RE_Activation_Chain_Access => System_Tasking, RE_Storage_Size => System_Tasking, + RE_Unspecified_CPU => System_Tasking, + RE_Abort_Defer => System_Soft_Links, RE_Abort_Undefer => System_Soft_Links, RE_Complete_Master => System_Soft_Links, Index: s-tarest.adb =================================================================== --- s-tarest.adb (revision 165610) +++ s-tarest.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-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- -- @@ -458,6 +458,7 @@ package body System.Tasking.Restricted.S Stack_Address : System.Address; Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; State : Task_Procedure_Access; Discriminants : System.Address; Elaborated : Access_Boolean; @@ -467,6 +468,7 @@ package body System.Tasking.Restricted.S is Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; Success : Boolean; Len : Integer; @@ -481,6 +483,21 @@ package body System.Tasking.Restricted.S then Self_ID.Common.Base_Priority else System.Any_Priority (Priority)); + if CPU /= Unspecified_CPU + and then (CPU < Integer (System.Multiprocessors.CPU_Range'First) + or else CPU > Integer (System.Multiprocessors.CPU_Range'Last) + or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs)) + then + raise Tasking_Error with "CPU not in range"; + + -- Normal CPU affinity + else + Base_CPU := + (if CPU = Unspecified_CPU + then Self_ID.Common.Base_CPU + else System.Multiprocessors.CPU_Range (CPU)); + end if; + if Single_Lock then Lock_RTS; end if; @@ -492,7 +509,7 @@ package body System.Tasking.Restricted.S Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, - Task_Info, Size, Created_Task, Success); + Base_CPU, Task_Info, Size, Created_Task, Success); -- If we do our job right then there should never be any failures, which -- was probably said about the Titanic; so just to be safe, let's retain Index: s-tarest.ads =================================================================== --- s-tarest.ads (revision 165610) +++ s-tarest.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -87,9 +87,9 @@ package System.Tasking.Restricted.Stages -- system__tasking__ada_task_control_blockIP (_init._atcb, 0); -- _init._task_id := _init._atcb'unchecked_access; -- create_restricted_task (unspecified_priority, tZ, - -- unspecified_task_info, task_procedure_access!(tB'address), - -- _init'address, tE'unchecked_access, _chain, _task_name, _init. - -- _task_id); + -- unspecified_task_info, unspecified_cpu, + -- task_procedure_access!(tB'address), _init'address, + -- tE'unchecked_access, _chain, _task_name, _init._task_id); -- return; -- end tVIP; @@ -127,6 +127,7 @@ package System.Tasking.Restricted.Stages Stack_Address : System.Address; Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; State : Task_Procedure_Access; Discriminants : System.Address; Elaborated : Access_Boolean; @@ -149,6 +150,11 @@ package System.Tasking.Restricted.Stages -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. -- + -- CPU is the task affinity. We pass it as an Integer to avoid an explicit + -- dependency from System.Multiprocessors when not needed. Static range + -- checks are performed when analyzing the pragma, and dynamic ones are + -- performed before setting the affinity at run time. + -- -- State is the compiler generated task's procedure body -- -- Discriminants is a pointer to a limited record whose discriminants are Index: s-taprop-mingw.adb =================================================================== --- s-taprop-mingw.adb (revision 165615) +++ s-taprop-mingw.adb (working copy) @@ -43,6 +43,7 @@ with Ada.Unchecked_Deallocation; with Interfaces.C; with Interfaces.C.Strings; +with System.Multiprocessors; with System.Tasking.Debug; with System.OS_Primitives; with System.Task_Info; @@ -890,6 +891,8 @@ package body System.Task_Primitives.Oper Result : DWORD; Entry_Point : PTHREAD_START_ROUTINE; + use type System.Multiprocessors.CPU_Range; + begin pTaskParameter := To_Address (T); @@ -949,9 +952,17 @@ package body System.Task_Primitives.Oper SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE); end if; - -- Step 4: Handle Task_Info + -- Step 4: Handle pragma CPU and Task_Info + + if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then + -- The CPU numbering in pragma CPU starts at 1 while the subprogram + -- to set the affinity starts at 0, therefore we must substract 1. + + Result := SetThreadIdealProcessor + (hTask, ProcessorId (T.Common.Base_CPU) - 1); + pragma Assert (Result = 1); - if T.Common.Task_Info /= null then + elsif T.Common.Task_Info /= null then if T.Common.Task_Info.CPU /= Task_Info.Any_CPU then Result := SetThreadIdealProcessor (hTask, T.Common.Task_Info.CPU); pragma Assert (Result = 1); @@ -1062,6 +1073,10 @@ package body System.Task_Primitives.Oper Discard : BOOL; pragma Unreferenced (Discard); + Result : DWORD; + + use type System.Multiprocessors.CPU_Range; + begin Environment_Task_Id := Environment_Task; OS_Primitives.Initialize; @@ -1092,6 +1107,20 @@ package body System.Task_Primitives.Oper Environment_Task.Known_Tasks_Index := Known_Tasks'First; Enter_Task (Environment_Task); + + -- pragma CPU for the environment task + + if Environment_Task.Common.Base_CPU /= + System.Multiprocessors.Not_A_Specific_CPU + then + -- The CPU numbering in pragma CPU starts at 1 while the subprogram + -- to set the affinity starts at 0, therefore we must substract 1. + + Result := SetThreadIdealProcessor + (Environment_Task.Common.LL.Thread, + ProcessorId (Environment_Task.Common.Base_CPU) - 1); + pragma Assert (Result = 1); + end if; end Initialize; --------------------- Index: s-taprop-linux.adb =================================================================== --- s-taprop-linux.adb (revision 165610) +++ s-taprop-linux.adb (working copy) @@ -48,6 +48,7 @@ with System.Tasking.Debug; with System.Interrupt_Management; with System.OS_Primitives; with System.Stack_Checking.Operations; +with System.Multiprocessors; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -819,6 +820,8 @@ package body System.Task_Primitives.Oper Adjusted_Stack_Size : Interfaces.C.size_t; Result : Interfaces.C.int; + use type System.Multiprocessors.CPU_Range; + begin Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size); @@ -841,6 +844,48 @@ package body System.Task_Primitives.Oper (Attributes'Access, PTHREAD_CREATE_DETACHED); pragma Assert (Result = 0); + -- We were calling pthread_setaffinity_np (after thread creation but + -- before thread activation) to set the affinity but it was not + -- behaving as expected. Now we set the required attributes for the + -- creation of the thread, which is working correctly and it is + -- more appropriate. + + if pthread_attr_setaffinity_np'Address = System.Null_Address then + -- Nothing to do with the affinities if there is not the underlying + -- support. + + null; + + -- Handle pragma CPU + + elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then + declare + CPU_Set : aliased cpu_set_t := (bits => (others => False)); + + begin + CPU_Set.bits (Integer (T.Common.Base_CPU)) := True; + + Result := + pthread_attr_setaffinity_np + (Attributes'Access, + CPU_SETSIZE / 8, + CPU_Set'Access); + pragma Assert (Result = 0); + end; + + -- Handle Task_Info + + elsif T.Common.Task_Info /= null + and then T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU + then + Result := + pthread_attr_setaffinity_np + (Attributes'Access, + CPU_SETSIZE / 8, + T.Common.Task_Info.CPU_Affinity'Access); + pragma Assert (Result = 0); + end if; + -- Since the initial signal mask of a thread is inherited from the -- creator, and the Environment task has all its signals masked, we -- do not need to manipulate caller's signal mask at this point. @@ -863,19 +908,6 @@ package body System.Task_Primitives.Oper Succeeded := True; - -- Handle Task_Info - - if T.Common.Task_Info /= null then - if T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU then - Result := - pthread_setaffinity_np - (T.Common.LL.Thread, - CPU_SETSIZE / 8, - T.Common.Task_Info.CPU_Affinity'Access); - pragma Assert (Result = 0); - end if; - end if; - Result := pthread_attr_destroy (Attributes'Access); pragma Assert (Result = 0); @@ -1238,6 +1270,8 @@ package body System.Task_Primitives.Oper -- 's' Interrupt_State pragma set state to System (use "default" -- system handler) + use type System.Multiprocessors.CPU_Range; + begin Environment_Task_Id := Environment_Task; @@ -1298,6 +1332,26 @@ package body System.Task_Primitives.Oper pragma Assert (Result = 0); Abort_Handler_Installed := True; end if; + + -- pragma CPU for the environment task + + if Environment_Task.Common.Base_CPU /= + System.Multiprocessors.Not_A_Specific_CPU + then + declare + CPU_Set : aliased cpu_set_t := (bits => (others => False)); + + begin + CPU_Set.bits (Integer (Environment_Task.Common.Base_CPU)) := True; + + Result := + pthread_setaffinity_np + (Environment_Task.Common.LL.Thread, + CPU_SETSIZE / 8, + CPU_Set'Access); + pragma Assert (Result = 0); + end; + end if; end Initialize; end System.Task_Primitives.Operations; Index: s-taprop-solaris.adb =================================================================== --- s-taprop-solaris.adb (revision 165610) +++ s-taprop-solaris.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -42,6 +42,7 @@ with Ada.Unchecked_Deallocation; with Interfaces.C; +with System.Multiprocessors; with System.Tasking.Debug; with System.Interrupt_Management; with System.OS_Primitives; @@ -866,12 +867,30 @@ package body System.Task_Primitives.Oper Last_Proc : processorid_t; -- Last processor # use System.Task_Info; + use type System.Multiprocessors.CPU_Range; + begin Self_ID.Common.LL.Thread := thr_self; Self_ID.Common.LL.LWP := lwp_self; - if Self_ID.Common.Task_Info /= null then + -- pragma CPU + + if Self_ID.Common.Base_CPU /= + System.Multiprocessors.Not_A_Specific_CPU + then + -- The CPU numbering in pragma CPU starts at 1 while the subprogram + -- to set the affinity starts at 0, therefore we must substract 1. + + Result := + processor_bind + (P_LWPID, P_MYID, processorid_t (Self_ID.Common.Base_CPU) - 1, + null); + pragma Assert (Result = 0); + + -- Task_Info + + elsif Self_ID.Common.Task_Info /= null then if Self_ID.Common.Task_Info.New_LWP and then Self_ID.Common.Task_Info.CPU /= CPU_UNCHANGED then Index: init.c =================================================================== --- init.c (revision 165620) +++ init.c (working copy) @@ -86,6 +86,7 @@ extern void Raise_From_Signal_Handler (s /* Global values computed by the binder. */ int __gl_main_priority = -1; +int __gl_main_cpu = -1; int __gl_time_slice_val = -1; char __gl_wc_encoding = 'n'; char __gl_locking_policy = ' '; Index: ali.adb =================================================================== --- ali.adb (revision 165610) +++ ali.adb (working copy) @@ -818,6 +818,7 @@ package body ALI is Last_Unit => No_Unit_Id, Locking_Policy => ' ', Main_Priority => -1, + Main_CPU => -1, Main_Program => None, No_Object => False, Normalize_Scalars => False, @@ -919,6 +920,14 @@ package body ALI is Skip_Space; + if Nextc = 'C' then + P := P + 1; + Checkc ('='); + ALIs.Table (Id).Main_CPU := Get_Nat; + end if; + + Skip_Space; + Checkc ('W'); Checkc ('='); ALIs.Table (Id).WC_Encoding := Getc; Index: ali.ads =================================================================== --- ali.ads (revision 165610) +++ ali.ads (working copy) @@ -131,6 +131,12 @@ package ALI is -- that no parameter was found, or no M line was present. Not set if -- 'M' appears in Ignore_Lines. + Main_CPU : Int; + -- Indicates processor if Main_Program field indicates that this can + -- be a main program. A value of -1 (No_Main_CPU) indicates that no C + -- parameter was found, or no M line was present. Not set if 'M' appears + -- in Ignore_Lines. + Time_Slice_Value : Int; -- Indicates value of time slice parameter from T=xxx on main program -- line. A value of -1 indicates that no T=xxx parameter was found, or @@ -212,6 +218,9 @@ package ALI is No_Main_Priority : constant Int := -1; -- Code for no main priority set + No_Main_CPU : constant Int := -1; + -- Code for no main cpu set + package ALIs is new Table.Table ( Table_Component_Type => ALIs_Record, Table_Index_Type => ALI_Id, Index: lib-load.adb =================================================================== --- lib-load.adb (revision 165610) +++ lib-load.adb (working copy) @@ -220,6 +220,7 @@ package body Lib.Load is Ident_String => Empty, Loading => False, Main_Priority => Default_Main_Priority, + Main_CPU => Default_Main_CPU, Munit_Index => 0, Serial_Number => 0, Source_Index => No_Source_File, @@ -325,6 +326,7 @@ package body Lib.Load is Ident_String => Empty, Loading => True, Main_Priority => Default_Main_Priority, + Main_CPU => Default_Main_CPU, Munit_Index => 0, Serial_Number => 0, Source_Index => Main_Source_File, @@ -655,6 +657,7 @@ package body Lib.Load is Ident_String => Empty, Loading => True, Main_Priority => Default_Main_Priority, + Main_CPU => Default_Main_CPU, Munit_Index => 0, Serial_Number => 0, Source_Index => Src_Ind, Index: par-prag.adb =================================================================== --- par-prag.adb (revision 165610) +++ par-prag.adb (working copy) @@ -1118,6 +1118,7 @@ begin Pragma_CPP_Constructor | Pragma_CPP_Virtual | Pragma_CPP_Vtable | + Pragma_CPU | Pragma_C_Pass_By_Copy | Pragma_Comment | Pragma_Common_Object | Index: s-tporft.adb =================================================================== --- s-tporft.adb (revision 165610) +++ s-tporft.adb (working copy) @@ -35,6 +35,8 @@ with System.Task_Info; with System.Soft_Links; -- used to initialize TSD for a C thread, in function Self +with System.Multiprocessors; + separate (System.Task_Primitives.Operations) function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is Local_ATCB : aliased Ada_Task_Control_Block (0); @@ -63,8 +65,8 @@ begin System.Tasking.Initialize_ATCB (Self_Id, null, Null_Address, Null_Task, Foreign_Task_Elaborated'Access, - System.Priority'First, Task_Info.Unspecified_Task_Info, 0, Self_Id, - Succeeded); + System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, + Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded); Unlock_RTS; pragma Assert (Succeeded); Index: adaint.c =================================================================== --- adaint.c (revision 165610) +++ adaint.c (working copy) @@ -811,7 +811,10 @@ __gnat_fopen (char *path, char *mode, in } FILE * -__gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED) +__gnat_freopen (char *path, + char *mode, + FILE *stream, + int encoding ATTRIBUTE_UNUSED) { #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -1094,7 +1097,8 @@ __gnat_stat_to_attr (int fd, char* name, attr->file_length = statbuf.st_size; /* all systems */ #ifndef __MINGW32__ - /* on Windows requires extra system call, see comment in __gnat_file_exists_attr */ + /* on Windows requires extra system call, see comment in + __gnat_file_exists_attr */ attr->exists = !ret; #endif @@ -2035,7 +2039,8 @@ __gnat_is_readable_file_attr (char* name { ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); GenericMapping.GenericRead = GENERIC_READ; - attr->readable = __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping); + attr->readable = + __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping); } else attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES; @@ -2108,7 +2113,8 @@ __gnat_is_executable_file_attr (char* na ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); GenericMapping.GenericExecute = GENERIC_EXECUTE; - attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping); + attr->executable = + __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping); } else attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES @@ -2717,7 +2723,8 @@ __gnat_locate_regular_file (char *file_n { /* The result has to be smaller than path_val + file_name. */ - char *file_path = (char *) alloca (strlen (path_val) + strlen (file_name) + 2); + char *file_path = + (char *) alloca (strlen (path_val) + strlen (file_name) + 2); for (;;) { @@ -2773,8 +2780,9 @@ __gnat_locate_exec (char *exec_name, cha char *ptr; if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX)) { - char *full_exec_name - = (char *) alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1); + char *full_exec_name = + (char *) alloca + (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1); strcpy (full_exec_name, exec_name); strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX); @@ -3654,33 +3662,6 @@ void __main (void) {} #endif #endif -#if defined (linux) || defined(__GLIBC__) -/* pthread affinity support */ - -int __gnat_pthread_setaffinity_np (pthread_t th, - size_t cpusetsize, - const void *cpuset); - -#ifdef CPU_SETSIZE -#include -int -__gnat_pthread_setaffinity_np (pthread_t th, - size_t cpusetsize, - const cpu_set_t *cpuset) -{ - return pthread_setaffinity_np (th, cpusetsize, cpuset); -} -#else -int -__gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED, - size_t cpusetsize ATTRIBUTE_UNUSED, - const void *cpuset ATTRIBUTE_UNUSED) -{ - return 0; -} -#endif -#endif - #if defined (linux) /* There is no function in the glibc to retrieve the LWP of the current thread. We need to do a system call in order to retrieve this Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 165619) +++ snames.ads-tmpl (working copy) @@ -153,6 +153,7 @@ package Snames is Name_uChain : constant Name_Id := N + $; Name_uClean : constant Name_Id := N + $; Name_uController : constant Name_Id := N + $; + Name_uCPU : constant Name_Id := N + $; Name_uEntry_Bodies : constant Name_Id := N + $; Name_uExpunge : constant Name_Id := N + $; Name_uFinal_List : constant Name_Id := N + $; @@ -442,6 +443,7 @@ package Snames is Name_CPP_Constructor : constant Name_Id := N + $; -- GNAT Name_CPP_Virtual : constant Name_Id := N + $; -- GNAT Name_CPP_Vtable : constant Name_Id := N + $; -- GNAT + Name_CPU : constant Name_Id := N + $; -- Ada 12 Name_Debug : constant Name_Id := N + $; -- GNAT Name_Dimension : constant Name_Id := N + $; -- GNAT Name_Elaborate : constant Name_Id := N + $; -- Ada 83 @@ -1528,6 +1530,7 @@ package Snames is Pragma_CPP_Constructor, Pragma_CPP_Virtual, Pragma_CPP_Vtable, + Pragma_CPU, Pragma_Debug, Pragma_Dimension, Pragma_Elaborate, Index: s-taskin.adb =================================================================== --- s-taskin.adb (revision 165610) +++ s-taskin.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -98,6 +98,7 @@ package body System.Tasking is Parent : Task_Id; Elaborated : Access_Boolean; Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; Task_Info : System.Task_Info.Task_Info_Type; Stack_Size : System.Parameters.Size_Type; T : Task_Id; @@ -119,6 +120,7 @@ package body System.Tasking is T.Common.Parent := Parent; T.Common.Base_Priority := Base_Priority; + T.Common.Base_CPU := Base_CPU; T.Common.Current_Priority := 0; T.Common.Protected_Action_Nesting := 0; T.Common.Call := null; @@ -170,12 +172,19 @@ package body System.Tasking is -- because we use the value -1 to indicate the default main priority, and -- that is of course not in Priority'range. + Main_CPU : Integer; + pragma Import (C, Main_CPU, "__gl_main_cpu"); + -- Affinity for main task. Note that this is of type Integer, not + -- CPU_Range, because we use the value -1 to indicate the unassigned + -- affinity, and that is of course not in CPU_Range'Range. + Initialized : Boolean := False; -- Used to prevent multiple calls to Initialize procedure Initialize is T : Task_Id; Base_Priority : Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; Success : Boolean; begin @@ -192,9 +201,14 @@ package body System.Tasking is then Default_Priority else Priority (Main_Priority)); + Base_CPU := + (if Main_CPU = Unspecified_CPU + then System.Multiprocessors.Not_A_Specific_CPU + else System.Multiprocessors.CPU_Range (Main_CPU)); + T := STPO.New_ATCB (0); Initialize_ATCB - (null, null, Null_Address, Null_Task, null, Base_Priority, + (null, null, Null_Address, Null_Task, null, Base_Priority, Base_CPU, Task_Info.Unspecified_Task_Info, 0, T, Success); pragma Assert (Success); Index: s-taskin.ads =================================================================== --- s-taskin.ads (revision 165610) +++ s-taskin.ads (working copy) @@ -42,6 +42,7 @@ with System.Task_Info; with System.Soft_Links; with System.Task_Primitives; with System.Stack_Usage; +with System.Multiprocessors; package System.Tasking is pragma Preelaborate; @@ -464,6 +465,11 @@ package System.Tasking is -- -- Protection: Only written by Self, accessed by anyone + Base_CPU : System.Multiprocessors.CPU_Range; + -- Base CPU, only changed via dispatching domains package. + -- + -- Protection: Self.L + Current_Priority : System.Any_Priority; -- Active priority, except that the effects of protected object -- priority ceilings are not reflected. This only reflects explicit @@ -694,9 +700,9 @@ package System.Tasking is Independent_Task_Level : constant Master_Level := 2; Library_Task_Level : constant Master_Level := 3; - ------------------------------ - -- Task size, priority info -- - ------------------------------ + ------------------- + -- Priority info -- + ------------------- Unspecified_Priority : constant Integer := System.Priority'First - 1; @@ -706,6 +712,13 @@ package System.Tasking is subtype Rendezvous_Priority is Integer range Priority_Not_Boosted .. System.Any_Priority'Last; + ------------------- + -- Affinity info -- + ------------------- + + Unspecified_CPU : constant := -1; + -- No affinity specified + ------------------------------------ -- Rendezvous related definitions -- ------------------------------------ @@ -1091,6 +1104,7 @@ package System.Tasking is Parent : Task_Id; Elaborated : Access_Boolean; Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; Task_Info : System.Task_Info.Task_Info_Type; Stack_Size : System.Parameters.Size_Type; T : Task_Id;