Commit 9f55bc62 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r178418
parent d7386a7a
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
......
......@@ -3790,6 +3790,14 @@ void *__gnat_lwp_self (void)
#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);
......@@ -3816,6 +3824,37 @@ void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
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
......
......@@ -254,7 +254,7 @@ extern void *__gnat_lwp_self (void);
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
......
......@@ -829,6 +829,7 @@ procedure Gnatls is
& " 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.");
......
......@@ -529,7 +529,7 @@ package body Prj.Env is
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;
......@@ -1344,6 +1344,7 @@ package body Prj.Env is
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
......@@ -1368,6 +1369,7 @@ package body Prj.Env is
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
......
......@@ -398,69 +398,62 @@ package body Prj.Proc is
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;
......@@ -1940,6 +1933,7 @@ package body Prj.Proc is
Shared.Array_Elements.Table
(Elem) :=
(Index => Index_Name,
Restricted => False,
Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive (Current, Node_Tree),
......
......@@ -757,8 +757,11 @@ package body Prj.Util is
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;
......@@ -1116,8 +1119,11 @@ package body Prj.Util is
-- 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
......
......@@ -210,7 +210,7 @@ package Prj.Util is
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
......
......@@ -187,6 +187,7 @@ package Prj is
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;
......@@ -679,6 +680,8 @@ package Prj is
-- 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
......@@ -791,7 +794,7 @@ package Prj is
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;
......@@ -840,7 +843,7 @@ package Prj is
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,
......@@ -864,14 +867,6 @@ package Prj is
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);
......
......@@ -870,7 +870,8 @@ package body System.Task_Primitives.Operations is
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);
......@@ -909,7 +910,8 @@ package body System.Task_Primitives.Operations is
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);
......@@ -943,6 +945,7 @@ package body System.Task_Primitives.Operations is
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));
pragma Assert
(Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
......@@ -985,6 +988,7 @@ package body System.Task_Primitives.Operations is
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);
......@@ -1403,7 +1407,8 @@ package body System.Task_Primitives.Operations is
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);
......
......@@ -15761,7 +15761,7 @@ package body Sem_Ch3 is
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
......@@ -15784,9 +15784,10 @@ package body Sem_Ch3 is
-- 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;
......
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