Skip to content

R
riscv-gcc-1
Commit 8918fe18 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r165625
parent e57ab550
Showing with 648 additions and 100 deletions
gcc/ada/ChangeLog
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.
......
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
......
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;
......
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,
......
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;");
......
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;
......
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,
......
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 = ' ';
......
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,
......
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));
......
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=?
......
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;
......
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 (
......
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 |
......
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,
......
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
......
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;
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;
---------------------
......
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
......
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;
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
......
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
......
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);
......
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;
......
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);
......
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
......
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);
......
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,
......
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
......
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);
......
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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment