diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/clean.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.adb | 146 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.ads | 69 | ||||
| -rw-r--r-- | gcc/ada/prj-makr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/prj-part.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 15 | ||||
| -rw-r--r-- | gcc/ada/s-taprop-vxworks.adb | 15 |
16 files changed, 274 insertions, 70 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5ef41f80ce2..1c1cf9b4849 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2011-08-03 Emmanuel Briot <briot@adacore.com> + + * prj-part.adb, prj-part.ads, prj-makr.adb, prj-pars.adb, prj-conf.adb, + prj-env.adb (Prj.Part.Parse): change parameter Always_Errout_Finalize + to Errout_Handling. + +2011-08-03 Emmanuel Briot <briot@adacore.com> + + * prj-dect.adb (Parse_Attribute_Declaration): make sure we can use + "external" as an attribute name in aggregate projects. + +2011-08-03 Jose Ruiz <ruiz@adacore.com> + + * s-taprop-vxworks.adb: (Create_Task, Initialize): Ada 2012 pragma CPU + uses CPU numbers starting 1, while VxWorks uses CPU numbers starting + from 0, so we need to adjust. + +2011-08-03 Emmanuel Briot <briot@adacore.com> + + * prj-proc.adb, prj-ext.adb, prj-ext.ads, makeutl.adb, prj-tree.adb, + prj-tree.ads, gnatcmd.adb, clean.adb (External_References): new type. + 2011-08-03 Yannick Moy <moy@adacore.com> * sem_ch6.adb (New_Overloaded_Entity): only issue error for SPARK diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index cb56697a582..16897bf3030 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1886,7 +1886,7 @@ package body Clean is if OK then Prj.Ext.Add - (Project_Node_Tree, + (Project_Node_Tree.External, External_Name => Ext_Asgn (Start .. Equal_Pos - 1), Value => diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 329f1b069e9..09b95488a12 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1822,7 +1822,7 @@ begin if Equal_Pos >= Argv'First + 3 and then Equal_Pos /= Argv'Last then - Add (Project_Node_Tree, + Add (Project_Node_Tree.External, External_Name => Argv (Argv'First + 2 .. Equal_Pos - 1), Value => Argv (Equal_Pos + 1 .. Argv'Last)); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index bf352d774eb..6673de19841 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -724,7 +724,7 @@ package body Makeutl is end if; return Prj.Ext.Check - (Tree => Tree, + (Self => Tree.External, Declaration => Argv (Start .. Finish)); end Is_External_Assignment; diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index da1d9287fa4..8a0a749a9cd 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -1119,7 +1119,7 @@ package body Prj.Conf is (In_Tree => Project_Node_Tree, Project => Config_Project_Node, Project_File_Name => Config_File_Path.all, - Always_Errout_Finalize => False, + Errout_Handling => Prj.Part.Finalize_If_Error, Packages_To_Check => Packages_To_Check, Current_Directory => Current_Directory, Is_Config_File => True, @@ -1212,7 +1212,7 @@ package body Prj.Conf is (In_Tree => Project_Node_Tree, Project => User_Project_Node, Project_File_Name => Project_File_Name, - Always_Errout_Finalize => False, + Errout_Handling => Prj.Part.Finalize_If_Error, Packages_To_Check => Packages_To_Check, Current_Directory => Current_Directory, Is_Config_File => False, diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 83ec3575b32..8f0ca61af86 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -494,13 +494,18 @@ package body Prj.Dect is Scan (In_Tree); - -- Body may be an attribute name + -- Body or External may be an attribute name if Token = Tok_Body then Token := Tok_Identifier; Token_Name := Snames.Name_Body; end if; + if Token = Tok_External then + Token := Tok_Identifier; + Token_Name := Snames.Name_External; + end if; + Expect (Tok_Identifier, "identifier"); Process_Attribute_Name; Rename_Obsolescent_Attributes (In_Tree, Attribute, Current_Package); diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 9c7458e95d4..ee6d2c32935 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -23,31 +23,65 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Deallocation; with Osint; use Osint; -with Prj.Tree; use Prj.Tree; package body Prj.Ext is + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (Self : out External_References; + Copy_From : External_References := No_External_Refs) + is + N : Name_To_Name_Ptr; + N2 : Name_To_Name_Ptr; + begin + if Self.Refs = null then + Self.Refs := new Name_To_Name_HTable.Instance; + + if Copy_From.Refs /= null then + N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all); + while N /= null loop + N2 := new Name_To_Name; + N2.Key := N.Key; + N2.Value := N.Value; + Name_To_Name_HTable.Set (Self.Refs.all, N2); + N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all); + end loop; + end if; + end if; + end Initialize; + --------- -- Add -- --------- procedure Add - (Tree : Prj.Tree.Project_Node_Tree_Ref; + (Self : External_References; External_Name : String; Value : String) is - The_Key : Name_Id; - The_Value : Name_Id; + N : Name_To_Name_Ptr; begin + N := new Name_To_Name; + Name_Len := Value'Length; Name_Buffer (1 .. Name_Len) := Value; - The_Value := Name_Find; + N.Value := Name_Find; + Name_Len := External_Name'Length; Name_Buffer (1 .. Name_Len) := External_Name; Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len)); - The_Key := Name_Find; - Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value); + N.Key := Name_Find; + + if Current_Verbosity = High then + Debug_Output ("Add (" & External_Name & ") is", N.Value); + end if; + + Name_To_Name_HTable.Set (Self.Refs.all, N); end Add; ----------- @@ -55,7 +89,7 @@ package body Prj.Ext is ----------- function Check - (Tree : Prj.Tree.Project_Node_Tree_Ref; + (Self : External_References; Declaration : String) return Boolean is begin @@ -63,7 +97,7 @@ package body Prj.Ext is if Declaration (Equal_Pos) = '=' then exit when Equal_Pos = Declaration'First; Add - (Tree => Tree, + (Self => Self, External_Name => Declaration (Declaration'First .. Equal_Pos - 1), Value => @@ -79,9 +113,12 @@ package body Prj.Ext is -- Reset -- ----------- - procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref) is + procedure Reset (Self : External_References) is begin - Name_To_Name_HTable.Reset (Tree.External_References); + if Self.Refs /= null then + Debug_Output ("Reset external references"); + Name_To_Name_HTable.Reset (Self.Refs.all); + end if; end Reset; -------------- @@ -89,23 +126,26 @@ package body Prj.Ext is -------------- function Value_Of - (Tree : Prj.Tree.Project_Node_Tree_Ref; + (Self : External_References; External_Name : Name_Id; With_Default : Name_Id := No_Name) return Name_Id is - The_Value : Name_Id; - Name : String := Get_Name_String (External_Name); + Value : Name_To_Name_Ptr; + Val : Name_Id; + Name : String := Get_Name_String (External_Name); begin Canonical_Case_Env_Var_Name (Name); - Name_Len := Name'Length; - Name_Buffer (1 .. Name_Len) := Name; - The_Value := - Name_To_Name_HTable.Get (Tree.External_References, Name_Find); - if The_Value /= No_Name then - return The_Value; + if Self.Refs /= null then + Name_Len := Name'Length; + Name_Buffer (1 .. Name_Len) := Name; + Value := Name_To_Name_HTable.Get (Self.Refs.all, Name_Find); + + if Value /= null then + return Value.Value; + end if; end if; -- Find if it is an environment, if it is, put value in the hash table @@ -117,17 +157,73 @@ package body Prj.Ext is if Env_Value /= null and then Env_Value'Length > 0 then Name_Len := Env_Value'Length; Name_Buffer (1 .. Name_Len) := Env_Value.all; - The_Value := Name_Find; - Name_To_Name_HTable.Set - (Tree.External_References, External_Name, The_Value); + Val := Name_Find; + + if Current_Verbosity = High then + Debug_Output ("Value_Of (" & Get_Name_String (External_Name) + & ") is", Val); + end if; + + if Self.Refs /= null then + Value := new Name_To_Name; + Value.Key := External_Name; + Value.Value := Val; + Name_To_Name_HTable.Set (Self.Refs.all, Value); + end if; + Free (Env_Value); - return The_Value; + return Val; else + if Current_Verbosity = High then + Debug_Output ("Value_Of (" & Get_Name_String (External_Name) + & ") is default", With_Default); + end if; Free (Env_Value); return With_Default; end if; end; end Value_Of; + ---------- + -- Free -- + ---------- + + procedure Free (Self : in out External_References) is + procedure Unchecked_Free is new Ada.Unchecked_Deallocation + (Name_To_Name_HTable.Instance, Instance_Access); + begin + if Self.Refs /= null then + Reset (Self); + Unchecked_Free (Self.Refs); + end if; + end Free; + + -------------- + -- Set_Next -- + -------------- + + procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr) is + begin + E.Next := Next; + end Set_Next; + + ---------- + -- Next -- + ---------- + + function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr is + begin + return E.Next; + end Next; + + ------------- + -- Get_Key -- + ------------- + + function Get_Key (E : Name_To_Name_Ptr) return Name_Id is + begin + return E.Key; + end Get_Key; + end Prj.Ext; diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads index 1fb389c4a7c..26ad2199301 100644 --- a/gcc/ada/prj-ext.ads +++ b/gcc/ada/prj-ext.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -26,7 +26,7 @@ -- Subprograms to set, get and cache external references, to be used as -- External functions in project files. -with Prj.Tree; +with GNAT.Dynamic_HTables; package Prj.Ext is @@ -42,27 +42,84 @@ package Prj.Ext is -- trees are loaded in parallel we can have different scenarios (or even -- load the same tree twice and see different views of it). + type External_References is private; + No_External_Refs : constant External_References; + + procedure Initialize + (Self : out External_References; + Copy_From : External_References := No_External_Refs); + -- Initialize Self, and copy all values from Copy_From if needed. + -- This has no effect if Self was already initialized. + + procedure Free (Self : in out External_References); + -- Free memory used by Self + procedure Add - (Tree : Prj.Tree.Project_Node_Tree_Ref; + (Self : External_References; External_Name : String; Value : String); -- Add an external reference (or modify an existing one) function Value_Of - (Tree : Prj.Tree.Project_Node_Tree_Ref; + (Self : External_References; External_Name : Name_Id; With_Default : Name_Id := No_Name) return Name_Id; -- Get the value of an external reference, and cache it for future uses function Check - (Tree : Prj.Tree.Project_Node_Tree_Ref; + (Self : External_References; Declaration : String) return Boolean; -- Check that an external declaration <external>=<value> is correct. -- If it is correct, the external reference is Added. - procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref); + procedure Reset (Self : External_References); -- Clear the internal data structure that stores the external references -- and free any allocated memory. +private + + -- Use a Static_HTable, not a Simple_HTable. + -- The issue is that we need to be able to copy the contents of the table + -- (in Initialize), but this isn't doable for Simple_HTable for which + -- iterators do not return the key. + + type Name_To_Name; + type Name_To_Name_Ptr is access all Name_To_Name; + type Name_To_Name is record + Key : Name_Id; + Value : Name_Id; + Next : Name_To_Name_Ptr; + end record; + + procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr); + function Next (E : Name_To_Name_Ptr) return Name_To_Name_Ptr; + function Get_Key (E : Name_To_Name_Ptr) return Name_Id; + + package Name_To_Name_HTable is new GNAT.Dynamic_HTables.Static_HTable + (Header_Num => Header_Num, + Element => Name_To_Name, + Elmt_Ptr => Name_To_Name_Ptr, + Null_Ptr => null, + Set_Next => Set_Next, + Next => Next, + Key => Name_Id, + Get_Key => Get_Key, + Hash => Hash, + Equal => "="); + -- General type for htables associating name_id to name_id. This is in + -- particular used to store the values of external references. + + type Instance_Access is access all Name_To_Name_HTable.Instance; + + type External_References is record + Refs : Instance_Access; + -- External references are stored in this hash table (and manipulated + -- through subprogrames in prj-ext.ads). External references are + -- project-tree specific so that one can load the same tree twice but + -- have two views of it, for instance. + end record; + + No_External_Refs : constant External_References := (Refs => null); + end Prj.Ext; diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 3e3210d71e9..2910a3a3d0d 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -863,7 +863,7 @@ package body Prj.Makr is (In_Tree => Tree, Project => Project_Node, Project_File_Name => Output_Name.all, - Always_Errout_Finalize => False, + Errout_Handling => Part.Finalize_If_Error, Store_Comments => True, Is_Config_File => False, Flags => Flags, diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index 4811fc6c87f..c638d9e6d9b 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -72,7 +72,7 @@ package body Prj.Pars is (In_Tree => Project_Node_Tree, Project => Project_Node, Project_File_Name => Project_File_Name, - Always_Errout_Finalize => False, + Errout_Handling => Prj.Part.Finalize_If_Error, Packages_To_Check => Packages_To_Check, Current_Directory => Current_Dir, Flags => Flags, diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 7fedc86e368..3438fdee679 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -443,7 +443,7 @@ package body Prj.Part is (In_Tree : Project_Node_Tree_Ref; Project : out Project_Node_Id; Project_File_Name : String; - Always_Errout_Finalize : Boolean; + Errout_Handling : Errout_Mode := Always_Finalize; Packages_To_Check : String_List_Access := All_Packages; Store_Comments : Boolean := False; Current_Directory : String := ""; @@ -477,7 +477,10 @@ package body Prj.Part is Path => Path_Name_Id); Free (Real_Project_File_Name); - Prj.Err.Initialize; + if Errout_Handling /= Never_Finalize then + Prj.Err.Initialize; + end if; + Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments); Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments); @@ -607,13 +610,22 @@ package body Prj.Part is Project := Empty_Node; end if; - if No (Project) or else Always_Errout_Finalize then - Prj.Err.Finalize; + case Errout_Handling is + when Always_Finalize => + Prj.Err.Finalize; - -- Reinitialize to avoid duplicate warnings later on + -- Reinitialize to avoid duplicate warnings later on + Prj.Err.Initialize; - Prj.Err.Initialize; - end if; + when Finalize_If_Error => + if No (Project) then + Prj.Err.Finalize; + Prj.Err.Initialize; + end if; + + when Never_Finalize => + null; + end case; exception when X : others => diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads index 7f8be2147e8..c4468a41531 100644 --- a/gcc/ada/prj-part.ads +++ b/gcc/ada/prj-part.ads @@ -29,11 +29,19 @@ with Prj.Tree; use Prj.Tree; package Prj.Part is + type Errout_Mode is + (Always_Finalize, + Finalize_If_Error, + Never_Finalize); + -- Whether Parse should call Errout.Finalize (which prints the error + -- messages on stdout). When Never_Finalize is used, Errout is not reset + -- either at the beginning of Parse. + procedure Parse (In_Tree : Project_Node_Tree_Ref; Project : out Project_Node_Id; Project_File_Name : String; - Always_Errout_Finalize : Boolean; + Errout_Handling : Errout_Mode := Always_Finalize; Packages_To_Check : String_List_Access := All_Packages; Store_Comments : Boolean := False; Current_Directory : String := ""; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index ddab4362fd8..1a94e71d85b 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -1065,7 +1065,7 @@ package body Prj.Proc is if Ext_List then Value := Prj.Ext.Value_Of - (From_Project_Node_Tree, Name, No_Name); + (From_Project_Node_Tree.External, Name, No_Name); if Value /= No_Name then declare @@ -1171,7 +1171,7 @@ package body Prj.Proc is Value := Prj.Ext.Value_Of - (From_Project_Node_Tree, Name, Default); + (From_Project_Node_Tree.External, Name, Default); if Value = No_Name then if not Quiet_Output then diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index f1b700bd962..6fdb02e64aa 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -988,8 +988,12 @@ package body Prj.Tree is Projects_Htable.Reset (Tree.Projects_HT); -- Do not reset the external references, in case we are reloading a - -- project, since we want to preserve the current environment - -- Name_To_Name_HTable.Reset (Tree.External_References); + -- project, since we want to preserve the current environment. + -- But we still need to ensure that the external references are properly + -- initialized. + + Prj.Ext.Initialize (Tree.External); + -- Prj.Ext.Reset (Tree.External); end Initialize; ---------- @@ -1003,7 +1007,7 @@ package body Prj.Tree is if Proj /= null then Project_Node_Table.Free (Proj.Project_Nodes); Projects_Htable.Reset (Proj.Projects_HT); - Name_To_Name_HTable.Reset (Proj.External_References); + Prj.Ext.Free (Proj.External); Free (Proj.Project_Path); Unchecked_Free (Proj); end if; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 4cd66c0d220..f24c4060cfa 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,6 +32,7 @@ with Table; with Prj.Attr; use Prj.Attr; with Prj.Env; +with Prj.Ext; package Prj.Tree is @@ -1453,21 +1454,11 @@ package Prj.Tree is end Tree_Private_Part; - package Name_To_Name_HTable is new GNAT.Dynamic_HTables.Simple_HTable - (Header_Num => Header_Num, - Element => Name_Id, - No_Element => No_Name, - Key => Name_Id, - Hash => Hash, - Equal => "="); - -- General type for htables associating name_id to name_id. This is in - -- particular used to store the values of external references. - type Project_Node_Tree_Data is record Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance; Projects_HT : Tree_Private_Part.Projects_Htable.Instance; - External_References : Name_To_Name_HTable.Instance; + External : Prj.Ext.External_References; -- External references are stored in this hash table (and manipulated -- through subprograms in prj-ext.ads). External references are -- project-tree specific so that one can load the same tree twice but diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index d51a2ebaa7b..f94e3886742 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -954,8 +954,13 @@ package body System.Task_Primitives.Operations is -- Set processor affinity if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then + -- Ada 2012 pragma CPU uses CPU numbers starting from 1, while + -- on VxWorks the first CPU is identified by a 0, so we need to + -- adjust. + Result := - taskCpuAffinitySet (T.Common.LL.Thread, int (T.Common.Base_CPU)); + taskCpuAffinitySet + (T.Common.LL.Thread, int (T.Common.Base_CPU) - 1); elsif T.Common.Task_Info /= Unspecified_Task_Info then Result := @@ -1412,10 +1417,14 @@ package body System.Task_Primitives.Operations is if Environment_Task.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then + -- Ada 2012 pragma CPU uses CPU numbers starting from 1, while + -- on VxWorks the first CPU is identified by a 0, so we need to + -- adjust. + Result := taskCpuAffinitySet (Environment_Task.Common.LL.Thread, - int (Environment_Task.Common.Base_CPU)); + int (Environment_Task.Common.Base_CPU) - 1); pragma Assert (Result /= -1); end if; end Initialize; |