+2011-09-01 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb, s-taprop-linux.adb, gnatls.adb: Minor reformatting.
+
+2011-09-01 Jose Ruiz <ruiz@adacore.com>
+
+ * adaint.h (__gnat_cpu_free): Fix the name of this profile.
+ * adaint.c (__gnat_cpu_alloc, __gnat_cpu_alloc_size, __gnat_cpu_free,
+ __gnat_cpu_zero, __gnat_cpu_set): Create version of these subprograms
+ specific for systems where their glibc version does not define the
+ routines to handle dynamically allocated CPU sets.
+
+2011-09-01 Vincent Celier <celier@adacore.com>
+
+ * prj-proc.adb, prj.ads, prj-nmsc.adb, prj-util.adb, prj-util.ads,
+ prj-env.adb: Implement inheritance of naming exceptions in extending
+ projects.
+
2011-09-01 Romain Berrendonner <berrendo@adacore.com>
* gnatls.adb: Display simple message instead of content of
#include <sched.h>
+/* glibc versions earlier than 2.7 do not define the routines to handle
+ dynamically allocated CPU sets. For these targets, we use the static
+ versions. */
+
+#ifdef CPU_ALLOC
+
+/* Dynamic cpu sets */
+
cpu_set_t *__gnat_cpu_alloc (size_t count)
{
return CPU_ALLOC (count);
CPU by a 0, so we need to adjust. */
CPU_SET_S (cpu - 1, count, set);
}
+
+#else
+
+/* Static cpu sets */
+
+cpu_set_t *__gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
+{
+ return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
+}
+
+size_t __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
+{
+ return sizeof (cpu_set_t);
+}
+
+void __gnat_cpu_free (cpu_set_t *set)
+{
+ free (set);
+}
+
+void __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
+{
+ CPU_ZERO (set);
+}
+
+void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
+{
+ /* Ada handles CPU numbers starting from 1, while C identifies the first
+ CPU by a 0, so we need to adjust. */
+ CPU_SET (cpu - 1, set);
+}
#endif
#ifdef __cplusplus
extern cpu_set_t *__gnat_cpu_alloc (size_t);
extern size_t __gnat_cpu_alloc_size (size_t);
-extern void __gnat_cpu_set_free (cpu_set_t *);
+extern void __gnat_cpu_free (cpu_set_t *);
extern void __gnat_cpu_zero (size_t, cpu_set_t *);
extern void __gnat_cpu_set (int, size_t, cpu_set_t *);
#endif
& " GNAT Tracker at http://www.adacore.com/"
& " for license terms.");
Write_Eol;
+
when others =>
Write_Str ("Please refer to file COPYING in your distribution"
& " for license terms.");
if not Source.Locally_Removed
and then Source.Unit /= null
and then
- (Source.Index >= 1 or else Source.Naming_Exception)
+ (Source.Index >= 1 or else Source.Naming_Exception /= No)
then
Put (Source);
end if;
while Unit /= null loop
if Unit.File_Names (Spec) /= null
+ and then not Unit.File_Names (Spec).Locally_Removed
and then Unit.File_Names (Spec).File /= No_File
and then
(Namet.Get_Name_String
elsif Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).File /= No_File
+ and then not Unit.File_Names (Impl).Locally_Removed
and then
(Namet.Get_Name_String
(Unit.File_Names (Impl).File) = Original_Name
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
- Naming_Exception : Boolean := False;
- Path : Path_Information := No_Path_Information;
- Alternate_Languages : Language_List := null;
- Unit : Name_Id := No_Name;
- Index : Int := 0;
- Locally_Removed : Boolean := False;
- Location : Source_Ptr := No_Location);
+ Naming_Exception : Naming_Exception_Type := No;
+ Path : Path_Information := No_Path_Information;
+ Alternate_Languages : Language_List := null;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Locally_Removed : Boolean := False;
+ Location : Source_Ptr := No_Location);
-- Add a new source to the different lists: list of all sources in the
-- project tree, list of source of a project and list of sources of a
-- language. If Path is specified, the file is also added to
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
- Naming_Exception : Boolean := False;
- Path : Path_Information := No_Path_Information;
- Alternate_Languages : Language_List := null;
- Unit : Name_Id := No_Name;
- Index : Int := 0;
- Locally_Removed : Boolean := False;
- Location : Source_Ptr := No_Location)
+ Naming_Exception : Naming_Exception_Type := No;
+ Path : Path_Information := No_Path_Information;
+ Alternate_Languages : Language_List := null;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Locally_Removed : Boolean := False;
+ Location : Source_Ptr := No_Location)
is
Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
-- file name in unrelated projects.
elsif Is_Extending (Project, Source.Project) then
- if not Locally_Removed then
+ if not Locally_Removed and then Naming_Exception /= Inherited then
Source_To_Replace := Source;
end if;
if UData = No_Unit_Index then
UData := new Unit_Data;
UData.Name := Unit;
- Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
+
+ if Naming_Exception /= Inherited then
+ Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
+ end if;
end if;
Id.Unit := UData;
-- Note that this updates Unit information as well
- Override_Kind (Id, Kind);
+ if Naming_Exception /= Inherited then
+ Override_Kind (Id, Kind);
+ end if;
end if;
if Path /= No_Path_Information then
when Name_Runtime_Source_Dir =>
- -- Attribute Runtime_Library_Dir (<language>)
+ -- Attribute Runtime_Source_Dir (<language>)
Lang_Index.Config.Runtime_Source_Dir :=
Element.Value.Value;
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value),
- Naming_Exception => True,
+ Naming_Exception => Yes,
Location => Element.Location);
else
File_Name : File_Name_Type;
Source : Source_Id;
+ Naming_Exception : Naming_Exception_Type;
+
begin
case Kind is
when Impl | Sep =>
if Exceptions = No_Array_Element then
Exceptions :=
Value_Of
- (Name_Spec,
+ (Name_Specification,
In_Arrays => Naming.Decl.Arrays,
Shared => Shared);
end if;
while Exceptions /= No_Array_Element loop
Element := Shared.Array_Elements.Table (Exceptions);
+
+ if Element.Restricted then
+ Naming_Exception := Inherited;
+ else
+ Naming_Exception := Yes;
+ end if;
+
File_Name := Canonical_Case_File_Name (Element.Value.Value);
Get_Name_String (Element.Index);
Unit => Unit,
Index => Index,
Location => Element.Value.Location,
- Naming_Exception => True);
+ Naming_Exception => Naming_Exception);
end if;
Exceptions := Element.Next;
Source := Prj.Element (Iter);
exit Source_Loop when Source = No_Source;
- if Source.Naming_Exception then
+ if Source.Naming_Exception /= No then
NL := Source_Names_Htable.Get
(Project.Source_Names, Source.File);
-- the same file has received the full path, so we need to
-- propagate it.
- if Source.Naming_Exception
- and then Source.Path = No_Path_Information
- then
- if Source.Unit /= No_Unit_Index then
- Found := False;
+ if Source.Path = No_Path_Information then
+ if Source.Naming_Exception = Yes then
+ if Source.Unit /= No_Unit_Index then
+ Found := False;
- if Source.Index /= 0 then -- Only multi-unit files
- declare
- S : Source_Id :=
- Source_Files_Htable.Get
- (Data.Tree.Source_Files_HT, Source.File);
- begin
- while S /= null loop
- if S.Path /= No_Path_Information then
- Source.Path := S.Path;
- Found := True;
+ if Source.Index /= 0 then -- Only multi-unit files
+ declare
+ S : Source_Id :=
+ Source_Files_Htable.Get
+ (Data.Tree.Source_Files_HT, Source.File);
+ begin
+ while S /= null loop
+ if S.Path /= No_Path_Information then
+ Source.Path := S.Path;
+ Found := True;
+
+ if Current_Verbosity = High then
+ Debug_Output
+ ("setting full path for "
+ & Get_Name_String (Source.File)
+ & " at" & Source.Index'Img
+ & " to "
+ & Get_Name_String (Source.Path.Name));
+ end if;
- if Current_Verbosity = High then
- Debug_Output
- ("setting full path for "
- & Get_Name_String (Source.File)
- & " at" & Source.Index'Img
- & " to "
- & Get_Name_String (Source.Path.Name));
+ exit;
end if;
- exit;
- end if;
+ S := S.Next_With_File_Name;
+ end loop;
+ end;
+ end if;
- S := S.Next_With_File_Name;
- end loop;
- end;
+ if not Found then
+ Error_Msg_Name_1 := Name_Id (Source.Display_File);
+ Error_Msg_Name_2 := Source.Unit.Name;
+ Error_Or_Warning
+ (Data.Flags, Data.Flags.Missing_Source_Files,
+ "source file %% for unit %% not found",
+ No_Location, Project.Project);
+ end if;
end if;
- if not Found then
- Error_Msg_Name_1 := Name_Id (Source.Display_File);
- Error_Msg_Name_2 := Source.Unit.Name;
- Error_Or_Warning
- (Data.Flags, Data.Flags.Missing_Source_Files,
- "source file %% for unit %% not found",
- No_Location, Project.Project);
+ if Source.Path = No_Path_Information then
+ Remove_Source (Data.Tree, Source, No_Source);
end if;
- end if;
- if Source.Path = No_Path_Information then
+ elsif Source.Naming_Exception = Inherited then
Remove_Source (Data.Tree, Source, No_Source);
end if;
end if;
-- If we had another file referencing the same unit (for instance it
-- was in an extended project), that source file is in fact invisible
-- from now on, and in particular doesn't belong to the same unit.
+ -- If the source is an inherited naming exception, then it may not
+ -- really exist: the source potentially replaced is left untouched.
if Source.Unit.File_Names (Source.Kind) /= Source then
Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
Override_Kind (Name_Loc.Source, Sep);
end if;
end if;
+
+ -- If this is an inherited naming exception, make sure that
+ -- the naming exception it replaces is no longer a source.
+
+ if Name_Loc.Source.Naming_Exception = Inherited then
+ declare
+ Proj : Project_Id := Name_Loc.Source.Project.Extends;
+ Iter : Source_Iterator;
+ Src : Source_Id;
+ begin
+ while Proj /= No_Project loop
+ Iter := For_Each_Source (Data.Tree, Proj);
+ Src := Prj.Element (Iter);
+ while Src /= No_Source loop
+ if Src.File = Name_Loc.Source.File then
+ Src.Replaced_By := Name_Loc.Source;
+ exit;
+ end if;
+
+ Next (Iter);
+ Src := Prj.Element (Iter);
+ end loop;
+
+ Proj := Proj.Extends;
+ end loop;
+ end;
+
+ if Name_Loc.Source.Unit /= No_Unit_Index then
+ if Name_Loc.Source.Kind = Spec then
+ Name_Loc.Source.Unit.File_Names (Spec) :=
+ Name_Loc.Source;
+
+ elsif Name_Loc.Source.Kind = Impl then
+ Name_Loc.Source.Unit.File_Names (Impl) :=
+ Name_Loc.Source;
+ end if;
+
+ Units_Htable.Set
+ (Data.Tree.Units_HT,
+ Name_Loc.Source.Unit.Name,
+ Name_Loc.Source.Unit);
+ end if;
+
+ end if;
end if;
end if;
end if;
Name_Loc.Source := Source;
Source_Names_Htable.Set
(Project.Source_Names, File_Name, Name_Loc);
+
end if;
+
+-- if Source /= No_Source and then Source.Unit /= No_Unit_Index then
+-- Units_Htable.Set
+-- (Data.Tree.Units_HT,
+-- Source.Unit.Name,
+-- Source.Unit);
+-- end if;
end if;
end if;
if Source /= No_Source
and then Source.Path /= Src.Path
+ and then Src.Project = Source.Project
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;
Arr := Shared.Arrays.Table (A1);
A1 := Arr.Next;
- if not Restricted
- or else
- (Arr.Name /= Snames.Name_Body and then
- Arr.Name /= Snames.Name_Spec and then
- Arr.Name /= Snames.Name_Implementation and then
- Arr.Name /= Snames.Name_Specification)
- then
- -- Remove the Next component
+ -- Remove the Next component
- Arr.Next := No_Array;
- Array_Table.Increment_Last (Shared.Arrays);
+ Arr.Next := No_Array;
+ Array_Table.Increment_Last (Shared.Arrays);
- -- Create new Array declaration
+ -- Create new Array declaration
- if To.Arrays = No_Array then
- To.Arrays := Array_Table.Last (Shared.Arrays);
- else
- Shared.Arrays.Table (A2).Next :=
- Array_Table.Last (Shared.Arrays);
- end if;
+ if To.Arrays = No_Array then
+ To.Arrays := Array_Table.Last (Shared.Arrays);
+ else
+ Shared.Arrays.Table (A2).Next :=
+ Array_Table.Last (Shared.Arrays);
+ end if;
- A2 := Array_Table.Last (Shared.Arrays);
+ A2 := Array_Table.Last (Shared.Arrays);
- -- Don't store the array as its first element has not been set yet
+ -- Don't store the array as its first element has not been set yet
- -- Copy the array elements of the array
+ -- Copy the array elements of the array
- E1 := Arr.Value;
- Arr.Value := No_Array_Element;
- while E1 /= No_Array_Element loop
+ E1 := Arr.Value;
+ Arr.Value := No_Array_Element;
+ while E1 /= No_Array_Element loop
- -- Copy the array element
+ -- Copy the array element
- Elm := Shared.Array_Elements.Table (E1);
- E1 := Elm.Next;
+ Elm := Shared.Array_Elements.Table (E1);
+ E1 := Elm.Next;
- -- Remove the Next component
+ -- Remove the Next component
- Elm.Next := No_Array_Element;
+ Elm.Next := No_Array_Element;
- -- Change the location
+ Elm.Restricted := Restricted;
+ -- Change the location
- Elm.Value.Location := New_Loc;
- Array_Element_Table.Increment_Last (Shared.Array_Elements);
+ Elm.Value.Location := New_Loc;
+ Array_Element_Table.Increment_Last (Shared.Array_Elements);
- -- Create new array element
+ -- Create new array element
- if Arr.Value = No_Array_Element then
- Arr.Value :=
- Array_Element_Table.Last (Shared.Array_Elements);
- else
- Shared.Array_Elements.Table (E2).Next :=
- Array_Element_Table.Last (Shared.Array_Elements);
- end if;
+ if Arr.Value = No_Array_Element then
+ Arr.Value :=
+ Array_Element_Table.Last (Shared.Array_Elements);
+ else
+ Shared.Array_Elements.Table (E2).Next :=
+ Array_Element_Table.Last (Shared.Array_Elements);
+ end if;
- E2 := Array_Element_Table.Last (Shared.Array_Elements);
- Shared.Array_Elements.Table (E2) := Elm;
- end loop;
+ E2 := Array_Element_Table.Last (Shared.Array_Elements);
+ Shared.Array_Elements.Table (E2) := Elm;
+ end loop;
- -- Finally, store the new array
+ -- Finally, store the new array
- Shared.Arrays.Table (A2) := Arr;
- end if;
+ Shared.Arrays.Table (A2) := Arr;
end loop;
end Copy_Package_Declarations;
Shared.Array_Elements.Table
(Elem) :=
(Index => Index_Name,
+ Restricted => False,
Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive (Current, Node_Tree),
elsif Name_Buffer (1 .. 2) = "I=" then
Info.Info.Index := Int'Value (Name_Buffer (3 .. Name_Len));
- elsif Name_Buffer (1 .. Name_Len) = "N=T" then
- Info.Info.Naming_Exception := True;
+ elsif Name_Buffer (1 .. Name_Len) = "N=Y" then
+ Info.Info.Naming_Exception := Yes;
+
+ elsif Name_Buffer (1 .. Name_Len) = "N=I" then
+ Info.Info.Naming_Exception := Inherited;
else
Report_Error;
-- Naming exception ("N=T");
- if Source.Naming_Exception then
- Put_Line (File, "N=T");
+ if Source.Naming_Exception = Yes then
+ Put_Line (File, "N=Y");
+
+ elsif Source.Naming_Exception = Inherited then
+ Put_Line (File, "N=I");
end if;
-- Empty line to indicate end of info on this source
Path_Name : Name_Id;
Unit_Name : Name_Id := No_Name;
Index : Int := 0;
- Naming_Exception : Boolean := False;
+ Naming_Exception : Naming_Exception_Type := No;
end record;
-- Data read from a source info file for a single source
No_Array_Element : constant Array_Element_Id := 0;
type Array_Element is record
Index : Name_Id;
+ Restricted : Boolean := False;
Src_Index : Int := 0;
Index_Case_Sensitive : Boolean := True;
Value : Variable_Value;
-- corresponding to an Ada file). In general, these are dependencies that
-- cannot be computed automatically by the builder.
+ type Naming_Exception_Type is (No, Yes, Inherited);
+
-- Structure to define source data
type Source_Data is record
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Switches file time stamp
- Naming_Exception : Boolean := False;
+ Naming_Exception : Naming_Exception_Type := No;
-- True if the source has an exceptional name
Duplicate_Unit : Boolean := False;
Switches => No_File,
Switches_Path => No_Path,
Switches_TS => Empty_Time_Stamp,
- Naming_Exception => False,
+ Naming_Exception => No,
Duplicate_Unit => False,
Next_In_Lang => No_Source,
Next_With_File_Name => No_Source,
Equal => "=");
-- Mapping of source paths to source ids
- package Unit_Sources_Htable is new Simple_HTable
- (Header_Num => Header_Num,
- Element => Source_Id,
- No_Element => No_Source,
- Key => Name_Id,
- Hash => Hash,
- Equal => "=");
-
type Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
declare
CPUs : constant size_t :=
- Interfaces.C.size_t (System.Multiprocessors.Number_Of_CPUs);
+ Interfaces.C.size_t
+ (System.Multiprocessors.Number_Of_CPUs);
CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
then
declare
CPUs : constant size_t :=
- Interfaces.C.size_t (System.Multiprocessors.Number_Of_CPUs);
+ Interfaces.C.size_t
+ (System.Multiprocessors.Number_Of_CPUs);
CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));
+
pragma Assert
(Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
if T.Known_Tasks_Index /= -1 then
Known_Tasks (T.Known_Tasks_Index) := null;
end if;
+
SC.Invalidate_Stack_Cache (T.Common.Compiler_Data.Pri_Stack_Info'Access);
Free (Tmp);
then
declare
CPUs : constant size_t :=
- Interfaces.C.size_t (System.Multiprocessors.Number_Of_CPUs);
+ Interfaces.C.size_t
+ (System.Multiprocessors.Number_Of_CPUs);
CPU_Set : cpu_set_t_ptr := null;
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
Set_Anonymous_Type (New_C);
elsif (Is_Private_Type (Derived_Base)
- and then not Is_Generic_Type (Derived_Base))
+ and then not Is_Generic_Type (Derived_Base))
or else (Is_Empty_Elmt_List (Discs)
and then not Expander_Active)
then
-- type T_2 is new Pack_1.T_1 with ...;
-- end Pack_2;
- Set_Etype (New_C,
- Constrain_Component_Type
- (Old_C, Derived_Base, N, Parent_Base, Discs));
+ Set_Etype
+ (New_C,
+ Constrain_Component_Type
+ (Old_C, Derived_Base, N, Parent_Base, Discs));
end if;
end if;
projects / thirdparty / gcc.git / commitdiff
