diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-10-18 10:27:48 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-10-18 10:27:48 +0000 |
| commit | d9c927cc34dae95c3dca6300d1629ebc6c29b189 (patch) | |
| tree | 857aedf3baf2b3a0ed2ad1c3eaef04565c4b834b /gcc/ada | |
| parent | dd99cc6e9dcb1a419d3be8b1b10c1f8b33078e16 (diff) | |
| download | gcc-d9c927cc34dae95c3dca6300d1629ebc6c29b189.tar.gz | |
2010-10-18 Jose Ruiz <ruiz@adacore.com>
* 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.
2010-10-18 Javier Miranda <miranda@adacore.com>
* einfo.adb (Direct_Primitive_Operations): Complete assertion.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165625 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
31 files changed, 648 insertions, 100 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 172416b35e1..30806a99a34 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,80 @@ +2010-10-18 Jose Ruiz <ruiz@adacore.com> + + * 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. + +2010-10-18 Javier Miranda <miranda@adacore.com> + + * einfo.adb (Direct_Primitive_Operations): Complete assertion. + 2010-10-18 Vincent Celier <celier@adacore.com> * prj.ads (Source_Data): New Boolean flag In_The_Queue. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 982ae115a91..3f4654f7a2a 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -811,7 +811,10 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) } 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, struct file_attributes* attr) 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, struct file_attributes* attr) { 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* name, struct file_attributes* attr) 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_name, char *path_val) { /* 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, char *path_val) 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 <pthread.h> -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 diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index bf7ace87a45..4ea38e2eff4 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -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; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 062652c4820..b9f953126c0 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -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, diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index ff2498cc768..8facb270b0a 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -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;"); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 5675f79aa2b..87c9edc84f5 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -819,7 +819,8 @@ package body Einfo is function Direct_Primitive_Operations (Id : E) return L is begin - pragma Assert (Is_Tagged_Type (Id)); + pragma Assert (Is_Tagged_Type (Id) + and then not Is_Concurrent_Type (Id)); return Elist15 (Id); end Direct_Primitive_Operations; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index c16ffba8c9b..0df9e44d773 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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, diff --git a/gcc/ada/init.c b/gcc/ada/init.c index d90a1ace197..766dbddf9b0 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -86,6 +86,7 @@ extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *); /* 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 = ' '; diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 328bbeb6d03..894c76017d9 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -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, diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index b7bc2cfcf59..d1e442a32b0 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -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)); diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index b3ea32d1282..ef5f23a9ee3 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -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=? diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 90577e481af..42d922fcc95 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -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; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 13962528e3e..b316fec221d 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -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 ( diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 109326cc183..b74ad4007c1 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -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 | diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 959a580b08f..ca8bfb85428 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -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, diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads index 6c0f1353762..6d6a0c44e99 100644 --- a/gcc/ada/s-osinte-linux.ads +++ b/gcc/ada/s-osinte-linux.ads @@ -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 diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 38b4cf6f53b..f19ca55cffd 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -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.Operations is 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.Operations is (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.Operations is 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.Operations is -- '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.Operations is 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; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 29465a1c8f5..bafb0674c9d 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -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.Operations is 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.Operations is 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.Operations is 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.Operations is 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; --------------------- diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 5250e0e2c15..d3cc4909d14 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -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.Operations is 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 diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 45686ea0423..3186f6fb962 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -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.Operations is 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.Operations is -- 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.Operations is 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.Operations is 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; diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 07ddbce8c60..5c83412435f 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -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.Stages is 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.Stages is 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.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; + if Single_Lock then Lock_RTS; end if; @@ -492,7 +509,7 @@ package body System.Tasking.Restricted.Stages is 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 diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index aeb94d053f3..7b853914bff 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -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 is -- 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 is 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 is -- 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 diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index e3d30fc0cbf..d2d29f9246e 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -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); diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 104a3a68c24..45906232720 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -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; diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index c10cdd82d0a..1663b89c62c 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -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); diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index 036474321c5..a6359c0e0c7 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -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 diff --git a/gcc/ada/s-tporft.adb b/gcc/ada/s-tporft.adb index 58badd6722a..0158ca28401 100644 --- a/gcc/ada/s-tporft.adb +++ b/gcc/ada/s-tporft.adb @@ -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); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 443aa92368f..b39d3038253 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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, diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index b75139f59a6..d76d33a0b6c 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index aa0dfe37a28..2b2d8828c95 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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); diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index fa85239ccef..11199ec7eca 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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, |