git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2011-08-03  Robert Dewar  <dewar@adacore.com>

	* gnatcmd.adb, prj-proc.adb, mlib-prj.adb, prj.adb, makeutl.ads,
	prj-util.adb, prj-util.ads, prj-conf.adb, prj-env.adb: Minor
	reformatting.

2011-08-03  Javier Miranda  <miranda@adacore.com>

	* exp_util.adb (Is_VM_By_Copy_Actual): Include N_Slide nodes as actuals
	that must be passed by copy in VM targets.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj.ads, prj-nmsc.adb (Files_Htable): removed this htable, which
	duplicates a similar htable now in the project tree.

2011-08-03  Claire Dross  <dross@adacore.com>

	* a-cfdlli.adb, a-cfhama.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb,
	a-cofove.adb ("=", Length, Is_Empty, Clear, Assign, Copy, Element,
	Replace_Element, Query_Element, Update_Element, Move, Insert, Prepend,
	Append, Delete, Delete_First, Delete_Last, Reverse_Element, Swap,
	Splice, First, First_Element, Last, Last_Element, Next, Previous, Find,
	Reverse_Find, Contains, Has_Element, Iterate, Reverse_Iterate, Capacity,
	Reserve_Length, Length, Strict_Equal, Left, Right): Data-structure
	update.

2011-08-03  Arnaud Charlet  <charlet@adacore.com>

	* s-taprop-posix.adb, s-taprop-linux.adb, s-taprop-tru64.adb
	(ATCB_Key): Removed, not always used.
	* s-tpopsp-posix.adb, s-tpopsp-posix-foreign.adb (ATCB_Key): Moved from
	s-taprop-posix.adb.
	* s-tpopsp-tls.adb: New file.
	* gcc-interface/Makefile.in: Use TLS implementation of s-tpopsp.adb on
	x86/x64/ia64/powerpc/sparc Linux.

2011-08-03  Arnaud Charlet  <charlet@adacore.com>

	* system-aix.ads, system-aix64.ads: Set ZCX_By_Default to True.
	* gcc-interface/Makefile.in: Switch to ZCX by default on AIX ports.

2011-08-03  Thomas Quinot  <quinot@adacore.com>

	* rtsfind.ads, exp_dist.adb, exp_dist.ads
	(Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call):
	Fix type selection for mapping integer types to PolyORB types.

2011-08-03  Bob Duff  <duff@adacore.com>

	* sem_ch7.adb: Minor comment clarification.

2011-08-03  Bob Duff  <duff@adacore.com>

	* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): If we get
	an error analyzing a choice, skip further processing. Further
	processing could cause a crash or cascade errors.

From-SVN: r177262
This commit is contained in:
Arnaud Charlet 2011-08-03 12:38:26 +02:00
parent 40ecf2f5d1
commit 686d09844f
40 changed files with 2315 additions and 5183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
gcc/ada/ChangeLog
View File

@ -1,3 +1,61 @@
2011-08-03 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, prj-proc.adb, mlib-prj.adb, prj.adb, makeutl.ads,
prj-util.adb, prj-util.ads, prj-conf.adb, prj-env.adb: Minor
reformatting.
2011-08-03 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Is_VM_By_Copy_Actual): Include N_Slide nodes as actuals
that must be passed by copy in VM targets.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj.ads, prj-nmsc.adb (Files_Htable): removed this htable, which
duplicates a similar htable now in the project tree.
2011-08-03 Claire Dross <dross@adacore.com>
* a-cfdlli.adb, a-cfhama.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb,
a-cofove.adb ("=", Length, Is_Empty, Clear, Assign, Copy, Element,
Replace_Element, Query_Element, Update_Element, Move, Insert, Prepend,
Append, Delete, Delete_First, Delete_Last, Reverse_Element, Swap,
Splice, First, First_Element, Last, Last_Element, Next, Previous, Find,
Reverse_Find, Contains, Has_Element, Iterate, Reverse_Iterate, Capacity,
Reserve_Length, Length, Strict_Equal, Left, Right): Data-structure
update.
2011-08-03 Arnaud Charlet <charlet@adacore.com>
* s-taprop-posix.adb, s-taprop-linux.adb, s-taprop-tru64.adb
(ATCB_Key): Removed, not always used.
* s-tpopsp-posix.adb, s-tpopsp-posix-foreign.adb (ATCB_Key): Moved from
s-taprop-posix.adb.
* s-tpopsp-tls.adb: New file.
* gcc-interface/Makefile.in: Use TLS implementation of s-tpopsp.adb on
x86/x64/ia64/powerpc/sparc Linux.
2011-08-03 Arnaud Charlet <charlet@adacore.com>
* system-aix.ads, system-aix64.ads: Set ZCX_By_Default to True.
* gcc-interface/Makefile.in: Switch to ZCX by default on AIX ports.
2011-08-03 Thomas Quinot <quinot@adacore.com>
* rtsfind.ads, exp_dist.adb, exp_dist.ads
(Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call):
Fix type selection for mapping integer types to PolyORB types.
2011-08-03 Bob Duff <duff@adacore.com>
* sem_ch7.adb: Minor comment clarification.
2011-08-03 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): If we get
an error analyzing a choice, skip further processing. Further
processing could cause a crash or cascade errors.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb,

1927
gcc/ada/a-cfdlli.adb
View File

File diff suppressed because it is too large Load Diff

23
gcc/ada/a-cfdlli.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -251,33 +251,14 @@ private
type Node_Array is array (Count_Type range <>) of Node_Type;
function "=" (L, R : Node_Array) return Boolean is abstract;
type List_Access is access all List;
for List_Access'Storage_Size use 0;
type Kind is (Plain, Part);
type Plain_List (Capacity : Count_Type) is record
type List (Capacity : Count_Type) is tagged record
Nodes : Node_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
type PList_Access is access Plain_List;
type Part_List is record
LLength : Count_Type := 0;
LFirst : Count_Type := 0;
LLast : Count_Type := 0;
end record;
type List (Capacity : Count_Type) is tagged record
K : Kind := Plain;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
Part : Part_List;
Plain : PList_Access := new Plain_List'(Capacity, others => <>);
end record;
use Ada.Streams;

743
gcc/ada/a-cfhama.adb
View File

File diff suppressed because it is too large Load Diff

20
gcc/ada/a-cfhama.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -66,8 +66,7 @@ package Ada.Containers.Formal_Hashed_Maps is
pragma Pure;
type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
-- pragma Preelaborable_Initialization (Map);
-- why is this commented out???
pragma Preelaborable_Initialization (Map);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
@ -232,19 +231,10 @@ private
package HT_Types is new
Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types
(Node_Type);
(Node_Type);
type HT_Access is access all HT_Types.Hash_Table_Type;
type Kind is (Plain, Part);
type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged record
HT : HT_Access := new HT_Types.Hash_Table_Type (Capacity, Modulus);
K : Kind := Plain;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
end record;
type Map (Capacity : Count_Type; Modulus : Hash_Type) is
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
use Ada.Streams;

1071
gcc/ada/a-cfhase.adb
View File

File diff suppressed because it is too large Load Diff

17
gcc/ada/a-cfhase.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -257,19 +257,8 @@ private
package HT_Types is new
Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
type HT_Access is access all HT_Types.Hash_Table_Type;
type Kind is (Plain, Part);
type Set (Capacity : Count_Type; Modulus : Hash_Type) is tagged record
HT : HT_Access :=
new HT_Types.Hash_Table_Type'(Capacity, Modulus,
others => <>);
K : Kind := Plain;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
end record;
type Set (Capacity : Count_Type; Modulus : Hash_Type) is
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
use Ada.Streams;

741
gcc/ada/a-cforma.adb
View File

File diff suppressed because it is too large Load Diff

26
gcc/ada/a-cforma.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -69,7 +69,7 @@ package Ada.Containers.Formal_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map (Capacity : Count_Type) is tagged private;
-- pragma Preelaborable_Initialization (Map);
pragma Preelaborable_Initialization (Map);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
@ -220,34 +220,22 @@ private
type Node_Type is record
Has_Element : Boolean := False;
Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Parent : Node_Access := 0;
Left : Node_Access := 0;
Right : Node_Access := 0;
Color : Red_Black_Trees.Color_Type := Red;
Key : Key_Type;
Element : Element_Type;
end record;
type Kind is (Plain, Part);
package Tree_Types is
new Ada.Containers.Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
type Tree_Type_Access is access all Tree_Types.Tree_Type;
type Map (Capacity : Count_Type) is tagged record
Tree : Tree_Type_Access := new Tree_Types.Tree_Type (Capacity);
K : Kind := Plain;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
end record;
type Map (Capacity : Count_Type) is
new Tree_Types.Tree_Type (Capacity) with null record;
use Ada.Streams;
type Map_Access is access all Map;
for Map_Access'Storage_Size use 0;
type Cursor is record
Node : Node_Access;
end record;

1442
gcc/ada/a-cforse.adb
View File

File diff suppressed because it is too large Load Diff

21
gcc/ada/a-cforse.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -265,27 +265,18 @@ private
type Node_Type is record
Has_Element : Boolean := False;
Parent : Count_Type;
Left : Count_Type;
Right : Count_Type;
Parent : Count_Type := 0;
Left : Count_Type := 0;
Right : Count_Type := 0;
Color : Red_Black_Trees.Color_Type;
Element : Element_Type;
end record;
type Kind is (Plain, Part);
package Tree_Types is
new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
type Tree_Type_Access is access all Tree_Types.Tree_Type;
type Set (Capacity : Count_Type) is tagged record
Tree : Tree_Type_Access := new Tree_Types.Tree_Type (Capacity);
K : Kind := Plain;
Length : Count_Type := 0;
First : Count_Type := 0;
Last : Count_Type := 0;
end record;
type Set (Capacity : Count_Type) is
new Tree_Types.Tree_Type (Capacity) with null record;
use Red_Black_Trees;
use Ada.Streams;

559
gcc/ada/a-cofove.adb
View File

File diff suppressed because it is too large Load Diff

15
gcc/ada/a-cofove.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -366,24 +366,13 @@ private
type Elements_Array is array (Count_Type range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Kind is (Plain, Part);
type Plain_Vector (Capacity : Capacity_Subtype) is record
type Vector (Capacity : Capacity_Subtype) is tagged record
Elements : Elements_Array (1 .. Capacity);
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
type Plain_Access is access all Plain_Vector;
type Vector (Capacity : Capacity_Subtype) is tagged record
Plain : Plain_Access := new Plain_Vector (Capacity);
K : Kind := Formal_Vectors.Plain;
First : Count_Type := 0;
Last : Index_Type'Base := No_Index;
end record;
use Ada.Streams;
procedure Write

164
gcc/ada/exp_dist.adb
View File

@ -8280,9 +8280,9 @@ package body Exp_Dist is
function Find_Numeric_Representation
(Typ : Entity_Id) return Entity_Id;
-- Given a numeric type Typ, return the smallest integer or floating
-- point type from Standard, or the smallest unsigned (modular) type
-- from System.Unsigned_Types, whose range encompasses that of Typ.
-- Given a numeric type Typ, return the smallest integer or modular
-- type from Interfaces, or the smallest floating point type from
-- Standard whose range encompasses that of Typ.
function Make_Helper_Function_Name
(Loc : Source_Ptr;
@ -8583,37 +8583,31 @@ package body Exp_Dist is
-- Integer types
elsif U_Type = Etype (Standard_Short_Short_Integer) then
Lib_RE := RE_FA_SSI;
elsif U_Type = RTE (RE_Integer_8) then
Lib_RE := RE_FA_I8;
elsif U_Type = Etype (Standard_Short_Integer) then
Lib_RE := RE_FA_SI;
elsif U_Type = RTE (RE_Integer_16) then
Lib_RE := RE_FA_I16;
elsif U_Type = Etype (Standard_Integer) then
Lib_RE := RE_FA_I;
elsif U_Type = RTE (RE_Integer_32) then
Lib_RE := RE_FA_I32;
elsif U_Type = Etype (Standard_Long_Integer) then
Lib_RE := RE_FA_LI;
elsif U_Type = Etype (Standard_Long_Long_Integer) then
Lib_RE := RE_FA_LLI;
elsif U_Type = RTE (RE_Integer_64) then
Lib_RE := RE_FA_I64;
-- Unsigned integer types
elsif U_Type = RTE (RE_Short_Short_Unsigned) then
Lib_RE := RE_FA_SSU;
elsif U_Type = RTE (RE_Unsigned_8) then
Lib_RE := RE_FA_U8;
elsif U_Type = RTE (RE_Short_Unsigned) then
Lib_RE := RE_FA_SU;
elsif U_Type = RTE (RE_Unsigned_16) then
Lib_RE := RE_FA_U16;
elsif U_Type = RTE (RE_Unsigned) then
Lib_RE := RE_FA_U;
elsif U_Type = RTE (RE_Unsigned_32) then
Lib_RE := RE_FA_U32;
elsif U_Type = RTE (RE_Long_Unsigned) then
Lib_RE := RE_FA_LU;
elsif U_Type = RTE (RE_Long_Long_Unsigned) then
Lib_RE := RE_FA_LLU;
elsif U_Type = RTE (RE_Unsigned_64) then
Lib_RE := RE_FA_U64;
elsif Is_RTE (U_Type, RE_Unbounded_String) then
Lib_RE := RE_FA_String;
@ -9213,7 +9207,7 @@ package body Exp_Dist is
Make_Object_Declaration (Loc,
Defining_Identifier => Counter,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Long_Unsigned), Loc),
New_Occurrence_Of (RTE (RE_Unsigned_32), Loc),
Expression =>
Make_Integer_Literal (Loc, Initial_Counter_Value)));
@ -9398,37 +9392,31 @@ package body Exp_Dist is
-- Integer types
elsif U_Type = Etype (Standard_Short_Short_Integer) then
Lib_RE := RE_TA_SSI;
elsif U_Type = RTE (RE_Integer_8) then
Lib_RE := RE_TA_I8;
elsif U_Type = Etype (Standard_Short_Integer) then
Lib_RE := RE_TA_SI;
elsif U_Type = RTE (RE_Integer_16) then
Lib_RE := RE_TA_I16;
elsif U_Type = Etype (Standard_Integer) then
Lib_RE := RE_TA_I;
elsif U_Type = RTE (RE_Integer_32) then
Lib_RE := RE_TA_I32;
elsif U_Type = Etype (Standard_Long_Integer) then
Lib_RE := RE_TA_LI;
elsif U_Type = Etype (Standard_Long_Long_Integer) then
Lib_RE := RE_TA_LLI;
elsif U_Type = RTE (RE_Integer_64) then
Lib_RE := RE_TA_I64;
-- Unsigned integer types
elsif U_Type = RTE (RE_Short_Short_Unsigned) then
Lib_RE := RE_TA_SSU;
elsif U_Type = RTE (RE_Unsigned_8) then
Lib_RE := RE_TA_U8;
elsif U_Type = RTE (RE_Short_Unsigned) then
Lib_RE := RE_TA_SU;
elsif U_Type = RTE (RE_Unsigned_16) then
Lib_RE := RE_TA_U16;
elsif U_Type = RTE (RE_Unsigned) then
Lib_RE := RE_TA_U;
elsif U_Type = RTE (RE_Unsigned_32) then
Lib_RE := RE_TA_U32;
elsif U_Type = RTE (RE_Long_Unsigned) then
Lib_RE := RE_TA_LU;
elsif U_Type = RTE (RE_Long_Long_Unsigned) then
Lib_RE := RE_TA_LLU;
elsif U_Type = RTE (RE_Unsigned_64) then
Lib_RE := RE_TA_U64;
elsif Is_RTE (U_Type, RE_Unbounded_String) then
Lib_RE := RE_TA_String;
@ -10176,37 +10164,31 @@ package body Exp_Dist is
-- Integer types (walk back to the base type)
elsif U_Type = Etype (Standard_Short_Short_Integer) then
Lib_RE := RE_TC_SSI;
elsif U_Type = RTE (RE_Integer_8) then
Lib_RE := RE_TC_I8;
elsif U_Type = Etype (Standard_Short_Integer) then
Lib_RE := RE_TC_SI;
elsif U_Type = RTE (RE_Integer_16) then
Lib_RE := RE_TC_I16;
elsif U_Type = Etype (Standard_Integer) then
Lib_RE := RE_TC_I;
elsif U_Type = RTE (RE_Integer_32) then
Lib_RE := RE_TC_I32;
elsif U_Type = Etype (Standard_Long_Integer) then
Lib_RE := RE_TC_LI;
elsif U_Type = Etype (Standard_Long_Long_Integer) then
Lib_RE := RE_TC_LLI;
elsif U_Type = RTE (RE_Integer_64) then
Lib_RE := RE_TC_I64;
-- Unsigned integer types
elsif U_Type = RTE (RE_Short_Short_Unsigned) then
Lib_RE := RE_TC_SSU;
elsif U_Type = RTE (RE_Unsigned_8) then
Lib_RE := RE_TC_U8;
elsif U_Type = RTE (RE_Short_Unsigned) then
Lib_RE := RE_TC_SU;
elsif U_Type = RTE (RE_Unsigned_16) then
Lib_RE := RE_TC_U16;
elsif U_Type = RTE (RE_Unsigned) then
Lib_RE := RE_TC_U;
elsif U_Type = RTE (RE_Unsigned_32) then
Lib_RE := RE_TC_U32;
elsif U_Type = RTE (RE_Long_Unsigned) then
Lib_RE := RE_TC_LU;
elsif U_Type = RTE (RE_Long_Long_Unsigned) then
Lib_RE := RE_TC_LLU;
elsif U_Type = RTE (RE_Unsigned_64) then
Lib_RE := RE_TC_U64;
elsif Is_RTE (U_Type, RE_Unbounded_String) then
Lib_RE := RE_TC_String;
@ -10339,7 +10321,7 @@ package body Exp_Dist is
begin
Append_To (Parameter_List,
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_TA_LI), Loc),
Name => New_Occurrence_Of (RTE (RE_TA_I32), Loc),
Parameter_Associations => New_List (Expr_Node)));
end Add_Long_Parameter;
@ -10584,7 +10566,7 @@ package body Exp_Dist is
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of
(RTE (RE_TA_LI), Loc),
(RTE (RE_TA_I32), Loc),
Parameter_Associations =>
New_List (
Make_Integer_Literal
@ -10795,7 +10777,7 @@ package body Exp_Dist is
Inner_TypeCode := Make_Constructed_TypeCode
(RTE (RE_TC_Array), New_List (
Build_To_Any_Call (
OK_Convert_To (RTE (RE_Long_Unsigned),
OK_Convert_To (RTE (RE_Unsigned_32),
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Length,
@ -10821,7 +10803,7 @@ package body Exp_Dist is
Inner_TypeCode := Make_Constructed_TypeCode
(RTE (RE_TC_Sequence), New_List (
Build_To_Any_Call (
OK_Convert_To (RTE (RE_Long_Unsigned),
OK_Convert_To (RTE (RE_Unsigned_32),
Make_Integer_Literal (Loc, 0)),
Decls),
Build_To_Any_Call (Inner_TypeCode, Decls)));
@ -10867,37 +10849,31 @@ package body Exp_Dist is
begin
if Is_Unsigned_Type (Typ) then
if P_Size <= Standard_Short_Short_Integer_Size then
return RTE (RE_Short_Short_Unsigned);
if P_Size <= 8 then
return RTE (RE_Unsigned_8);
elsif P_Size <= Standard_Short_Integer_Size then
return RTE (RE_Short_Unsigned);
elsif P_Size <= 16 then
return RTE (RE_Unsigned_16);
elsif P_Size <= Standard_Integer_Size then
return RTE (RE_Unsigned);
elsif P_Size <= Standard_Long_Integer_Size then
return RTE (RE_Long_Unsigned);
elsif P_Size <= 32 then
return RTE (RE_Unsigned_32);
else
return RTE (RE_Long_Long_Unsigned);
return RTE (RE_Unsigned_64);
end if;
elsif Is_Integer_Type (Typ) then
if P_Size <= Standard_Short_Short_Integer_Size then
return Standard_Short_Short_Integer;
if P_Size <= 8 then
return RTE (RE_Integer_8);
elsif P_Size <= Standard_Short_Integer_Size then
return Standard_Short_Integer;
return RTE (RE_Integer_16);
elsif P_Size <= Standard_Integer_Size then
return Standard_Integer;
elsif P_Size <= Standard_Long_Integer_Size then
return Standard_Long_Integer;
return RTE (RE_Integer_32);
else
return Standard_Long_Long_Integer;
return RTE (RE_Integer_64);
end if;
elsif Is_Floating_Point_Type (Typ) then
@ -11086,7 +11062,7 @@ package body Exp_Dist is
Make_Object_Declaration (Loc,
Defining_Identifier => Inner_Counter,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Long_Unsigned), Loc),
New_Occurrence_Of (RTE (RE_Unsigned_32), Loc),
Expression =>
Make_Integer_Literal (Loc, 0)));
end if;
@ -11097,7 +11073,7 @@ package body Exp_Dist is
Attribute_Name => Name_Length,
Expressions =>
New_List (Make_Integer_Literal (Loc, Depth)));
Set_Etype (Length_Node, RTE (RE_Long_Unsigned));
Set_Etype (Length_Node, RTE (RE_Unsigned_32));
Add_Process_Element (Dimen_Stmts,
Datum => Length_Node,

4
gcc/ada/exp_dist.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -35,7 +35,7 @@ package Exp_Dist is
PCS_Version_Number : constant array (PCS_Names) of Int :=
(Name_No_DSA => 1,
Name_GARLIC_DSA => 1,
Name_PolyORB_DSA => 4);
Name_PolyORB_DSA => 5);
-- PCS interface version. This is used to check for consistency between the
-- compiler used to generate distribution stubs and the PCS implementation.
-- It must be incremented whenever a change is made to the generated code

9
gcc/ada/exp_util.adb
View File

@ -3568,9 +3568,12 @@ package body Exp_Util is
function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean is
begin
return VM_Target /= No_VM
and then Nkind (N) = N_Identifier
and then Present (Renamed_Object (Entity (N)))
and then Nkind (Renamed_Object (Entity (N))) = N_Slice;
and then (Nkind (N) = N_Slice
or else
(Nkind (N) = N_Identifier
and then Present (Renamed_Object (Entity (N)))
and then Nkind (Renamed_Object (Entity (N)))
= N_Slice));
end Is_VM_By_Copy_Actual;
--------------------

82
gcc/ada/gcc-interface/Make-lang.in
View File

@ -2256,31 +2256,33 @@ ada/exp_dist.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads \
ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
ada/exp_atag.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_dist.ads \
ada/exp_dist.adb ada/exp_strm.ads ada/exp_tss.ads ada/exp_util.ads \
ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/get_targ.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hlo.ads \
ada/hostparm.ads ada/inline.ads ada/inline.adb ada/interfac.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
ada/lib-sort.adb ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem.adb \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads \
ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \
ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
ada/sem_dist.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_util.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/elists.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
ada/erroutc.ads ada/erroutc.adb ada/exp_atag.ads ada/exp_ch7.ads \
ada/exp_disp.ads ada/exp_dist.ads ada/exp_dist.adb ada/exp_strm.ads \
ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads \
ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
ada/inline.ads ada/inline.adb ada/interfac.ads ada/lib.ads ada/lib.adb \
ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads \
ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \
ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dist.ads \
ada/sem_eval.ads ada/sem_prag.ads ada/sem_util.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
ada/stringt.ads ada/stringt.adb ada/stylesw.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/widechar.ads
ada/exp_fixd.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@ -2872,14 +2874,14 @@ ada/inline.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \
ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
ada/sem_ch9.ads ada/sem_prag.ads ada/sem_util.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/instpar.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
@ -3329,13 +3331,13 @@ ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/restrict.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/einfo.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
ada/erroutc.ads ada/erroutc.adb ada/fname.ads ada/fname-uf.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \
ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/namet.adb \
ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
ada/atree.adb ada/casing.ads ada/casing.adb ada/csets.ads ada/debug.ads \
ada/einfo.ads ada/einfo.adb ada/err_vars.ads ada/errout.ads \
ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/fname.ads \
ada/fname-uf.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/namet.ads \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/scans.ads \
ada/sem_aux.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \

14
gcc/ada/gcc-interface/Makefile.in
View File

@ -529,6 +529,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-vxwext.adb<s-vxwext-kernel-smp.adb \
system.ads<system-vxworks-ppc-kernel.ads
EH_MECHANISM=-gcc
EXTRA_GNATRTL_TASKING_OBJS=affinity.o
else
LIBGNAT_TARGET_PAIRS += \
@ -536,6 +537,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-tpopsp.adb<s-tpopsp-vxworks.adb
ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),)
EH_MECHANISM=-gcc
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel.adb \
@ -1072,7 +1074,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
g-bytswa.adb<g-bytswa-x86.adb \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
s-tpopsp.adb<s-tpopsp-tls.adb \
g-sercom.adb<g-sercom-linux.adb
ifeq ($(strip $(filter-out marte,$(THREAD_KIND))),)
@ -1383,7 +1385,7 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
endif
THREADSLIB = -lpthreads
EH_MECHANISM=-gcc
TOOLS_TARGET_PAIRS = \
mlib-tgt-specific.adb<mlib-tgt-specific-aix.adb \
indepsw.adb<indepsw-aix.adb
@ -1800,7 +1802,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
s-intman.adb<s-intman-posix.adb \
s-linux.ads<s-linux.ads \
s-osinte.adb<s-osinte-posix.adb \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
s-tpopsp.adb<s-tpopsp-tls.adb \
g-sercom.adb<g-sercom-linux.adb \
$(ATOMICS_TARGET_PAIRS)
@ -1898,7 +1900,7 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),)
s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb
s-tpopsp.adb<s-tpopsp-tls.adb
LIBGNAT_TARGET_PAIRS_32 = \
g-trasym.ads<g-trasym-unimplemented.ads \
@ -2002,7 +2004,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
s-taprop.adb<s-taprop-linux.adb \
s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
s-tpopsp.adb<s-tpopsp-tls.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \
g-sercom.adb<g-sercom-linux.adb \
system.ads<system-linux-ia64.ads \
@ -2094,7 +2096,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
s-taprop.adb<s-taprop-linux.adb \
s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
s-tpopsp.adb<s-tpopsp-tls.adb \
s-taspri.ads<s-taspri-posix.ads \
g-sercom.adb<g-sercom-linux.adb \
system.ads<system-linux-x86_64.ads \

6
gcc/ada/gnatcmd.adb
View File

@ -470,7 +470,7 @@ procedure GNATCmd is
end if;
Main := Project_Tree.Shared.String_Elements.Table
(Main).Next;
(Main).Next;
end loop;
if Proj.Project.Library then
@ -1241,6 +1241,7 @@ procedure GNATCmd is
Libraries_Present : in out Boolean)
is
pragma Unreferenced (Tree);
Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option;
@ -2307,7 +2308,8 @@ begin
Attribute_Or_Array_Name =>
Name_Local_Config_File,
In_Package => Pkg,
Shared => Project_Tree.Shared);
Shared =>
Project_Tree.Shared);
end if;
if Variable /= Nil_Variable_Value

3
gcc/ada/makeutl.ads
View File

@ -36,12 +36,13 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package Makeutl is
type Fail_Proc is access procedure (S : String);
Do_Fail : Fail_Proc := Osint.Fail'Access;
-- Failing procedure called from procedure Test_If_Relative_Path below. May
-- be redirected.
Project_Tree : constant Project_Tree_Ref :=
new Project_Tree_Data (Is_Root_Tree => True);
new Project_Tree_Data (Is_Root_Tree => True);
-- The project tree
Source_Info_Option : constant String := "--source-info=";

4
gcc/ada/mlib-prj.adb
View File

@ -1304,8 +1304,8 @@ package body MLib.Prj is
Lib_Dirpath :=
new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
Lib_Filename := new String'
(Get_Name_String (For_Project.Library_Name));
Lib_Filename :=
new String'(Get_Name_String (For_Project.Library_Name));
case For_Project.Library_Kind is
when Static =>

32
gcc/ada/prj-conf.adb
View File

@ -102,8 +102,8 @@ package body Prj.Conf is
-- Raises exception Invalid_Config with given message
procedure Apply_Config_File
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref);
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref);
-- Apply the configuration file settings to all the projects in the
-- project tree. The Project_Tree must have been parsed first, and
-- processed through the first phase so that all its projects are known.
@ -174,8 +174,8 @@ package body Prj.Conf is
String_Element_Table.Increment_Last
(Shared.String_Elements);
New_List := String_Element_Table.Last
(Shared.String_Elements);
New_List :=
String_Element_Table.Last (Shared.String_Elements);
-- Value of attribute is new list
@ -183,11 +183,10 @@ package body Prj.Conf is
Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
loop
-- Get each element of configuration list
Conf_Elem := Shared.String_Elements.Table (Conf_List);
New_Elem := Conf_Elem;
New_Elem := Conf_Elem;
Conf_List := Conf_Elem.Next;
if Conf_List = Nil_String then
@ -240,9 +239,9 @@ package body Prj.Conf is
User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
else
-- Otherwise, check each array element
-- Otherwise, check each array element
else
Conf_Array_Elem_Id := Conf_Array.Value;
while Conf_Array_Elem_Id /= No_Array_Element loop
Conf_Array_Elem :=
@ -256,9 +255,8 @@ package body Prj.Conf is
User_Array_Elem_Id := User_Array_Elem.Next;
end loop;
-- If the array element does not exist in the user array,
-- insert a shallow copy of the conf array element in the
-- user array.
-- If the array element doesn't exist in the user array, insert
-- a shallow copy of the conf array element in the user array.
if User_Array_Elem_Id = No_Array_Element then
Array_Element_Table.Increment_Last (Shared.Array_Elements);
@ -270,8 +268,8 @@ package body Prj.Conf is
User_Array_Elem;
Shared.Arrays.Table (User_Array_Id) := User_Array;
-- Otherwise, if the value is a string list, prepend the
-- user array element with the conf array element value.
-- Otherwise, if the value is a string list, prepend the conf
-- array element value to the array element.
elsif Conf_Array_Elem.Value.Kind = List then
Conf_List := Conf_Array_Elem.Value.Values;
@ -351,12 +349,13 @@ package body Prj.Conf is
Index : String := "";
Pkg : Project_Node_Id := Empty_Node)
is
Attr : Project_Node_Id;
Attr : Project_Node_Id;
pragma Unreferenced (Attr);
Expr : Name_Id := No_Name;
Val : Name_Id := No_Name;
Parent : Project_Node_Id := Config_File;
begin
if Index /= "" then
Name_Len := Index'Length;
@ -456,10 +455,11 @@ package body Prj.Conf is
-----------------------
procedure Apply_Config_File
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref)
(Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref)
is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Decl : constant Declarations := Config_File.Decl;
Conf_Pack_Id : Package_Id;
Conf_Pack : Package_Element;

5
gcc/ada/prj-env.adb
View File

@ -208,6 +208,7 @@ package body Prj.Env is
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree);
Path : constant Path_Name_Type :=
Get_Object_Directory
(Project,
@ -509,6 +510,7 @@ package body Prj.Env is
State : in out Integer)
is
pragma Unreferenced (State, In_Tree);
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
Naming : Lang_Naming_Data;
@ -821,6 +823,7 @@ package body Prj.Env is
State : in out Integer)
is
pragma Unreferenced (State);
Source : Source_Id;
Suffix : File_Name_Type;
Iter : Source_Iterator;
@ -1224,6 +1227,7 @@ package body Prj.Env is
Dummy : in out Integer)
is
pragma Unreferenced (Dummy, Tree);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ?
@ -1268,6 +1272,7 @@ package body Prj.Env is
Dummy : in out Integer)
is
pragma Unreferenced (Dummy);
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;

100
gcc/ada/prj-nmsc.adb
View File

@ -150,20 +150,9 @@ package body Prj.Nmsc is
-- information which is only useful while processing the project, and can
-- be discarded as soon as we have finished processing the project
package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping from base file names to Source_Id (containing full info about
-- the source).
type Tree_Processing_Data is record
Tree : Project_Tree_Ref;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
File_To_Source : Files_Htable.Instance;
Flags : Prj.Processing_Flags;
end record;
-- Temporary data which is needed while parsing a project. It does not need
@ -673,7 +662,8 @@ package body Prj.Nmsc is
Source := Prev_Unit.File_Names (Kind);
else
Source := Files_Htable.Get (Data.File_To_Source, File_Name);
Source := Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, File_Name);
if Source /= No_Source
and then Source.Index = Index
@ -900,8 +890,6 @@ package body Prj.Nmsc is
Data.Tree.Replaced_Source_Number :=
Data.Tree.Replaced_Source_Number - 1;
end if;
Files_Htable.Set (Data.File_To_Source, File_Name, Id);
end Add_Source;
------------------------------
@ -932,7 +920,6 @@ package body Prj.Nmsc is
Data : Tree_Processing_Data :=
(Tree => Tree,
Node_Tree => Node_Tree,
File_To_Source => Files_Htable.Nil,
Flags => Flags);
Project_Files : constant Prj.Variable_Value :=
@ -6366,7 +6353,6 @@ package body Prj.Nmsc is
Source : Source_Id;
Iter : Source_Iterator;
Found : Boolean := False;
Path : Path_Information;
begin
Iter := For_Each_Source (Data.Tree, Project.Project);
@ -6374,23 +6360,45 @@ package body Prj.Nmsc is
Source := Prj.Element (Iter);
exit when Source = No_Source;
-- If the full source path is unknown for this source_id, there
-- could be several reasons:
-- * we simply did not find the file itself, this is an error
-- * we have a multi-unit source file. Another Source_Id from
-- 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;
-- For multi-unit source files, source_id gets duplicated
-- once for every unit. Only the first source_id got its
-- full path set.
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
Path := Files_Htable.Get
(Data.File_To_Source, Source.File).Path;
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 Path /= No_Path_Information then
Found := True;
end if;
exit;
end if;
S := S.Next_With_File_Name;
end loop;
end;
end if;
if not Found then
@ -6400,21 +6408,6 @@ package body Prj.Nmsc is
(Data.Flags, Data.Flags.Missing_Source_Files,
"source file %% for unit %% not found",
No_Location, Project.Project);
else
Source.Path := Path;
if Current_Verbosity = High then
Debug_Indent;
if Source.Path /= No_Path_Information then
Write_Line ("Setting full path for "
& Get_Name_String (Source.File)
& " at" & Source.Index'Img
& " to "
& Get_Name_String (Path.Name));
end if;
end if;
end if;
end if;
@ -6472,7 +6465,6 @@ package body Prj.Nmsc is
Flags : Prj.Processing_Flags)
is
begin
Files_Htable.Reset (Data.File_To_Source);
Data.Tree := Tree;
Data.Node_Tree := Node_Tree;
Data.Flags := Flags;
@ -6483,8 +6475,9 @@ package body Prj.Nmsc is
----------
procedure Free (Data : in out Tree_Processing_Data) is
pragma Unreferenced (Data);
begin
Files_Htable.Reset (Data.File_To_Source);
null;
end Free;
----------------
@ -6666,6 +6659,7 @@ package body Prj.Nmsc is
then
Debug_Output ("Override kind for "
& Get_Name_String (Source.File)
& " idx=" & Source.Index'Img
& " kind=" & Source.Kind'Img);
end if;
@ -6736,12 +6730,20 @@ package body Prj.Nmsc is
Check_Name := True;
else
-- Set the full path for the source_id (which might have been
-- created when parsing the naming exceptions, and therefore
-- might not have the full path).
-- We only set this for this source_id, but not for other
-- source_id in the same file (case of multi-unit source files)
-- For the latter, they will be set in Find_Sources when we
-- check that all source_id have known full paths.
-- Doing this later saves one htable lookup per file in the
-- common case where the user is not using multi-unit files.
Name_Loc.Source.Path := (Path, Display_Path);
Source_Paths_Htable.Set
(Data.Tree.Source_Paths_HT,
Path,
Name_Loc.Source);
(Data.Tree.Source_Paths_HT, Path, Name_Loc.Source);
-- Check if this is a subunit
@ -6755,9 +6757,6 @@ package body Prj.Nmsc is
Override_Kind (Name_Loc.Source, Sep);
end if;
end if;
Files_Htable.Set
(Data.File_To_Source, File_Name, Name_Loc.Source);
end if;
end if;
end if;
@ -7427,7 +7426,7 @@ package body Prj.Nmsc is
procedure Get_Sources_From_Source_Info;
-- Get the source information from the tables that were created when a
-- source info fie was read.
-- source info file was read.
---------------------------
-- Check_Missing_Sources --
@ -7720,7 +7719,6 @@ package body Prj.Nmsc is
Id.Language := Lang_Id;
Id.Kind := Src.Kind;
Id.Index := Src.Index;
Id.Path :=
@ -7783,8 +7781,6 @@ package body Prj.Nmsc is
Id.Next_In_Lang := Id.Language.First_Source;
Id.Language.First_Source := Id;
Files_Htable.Set (Data.File_To_Source, Id.File, Id);
Next (Iter);
end loop;
end Get_Sources_From_Source_Info;

46
gcc/ada/prj-proc.adb
View File

@ -154,6 +154,7 @@ package body Prj.Proc is
-- as processed, call itself recursively for all imported projects and a
-- extended project, if any. Then process the declarative items of the
-- project.
--
-- Is_Root_Project should be true only for the project that the user
-- explicitly loaded. In the context of aggregate projects, only that
-- project is allowed to modify the environment that will be used to load
@ -268,8 +269,9 @@ package body Prj.Proc is
(Next => Decl.Attributes,
Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute);
Decl.Attributes := Variable_Element_Table.Last
(Shared.Variable_Elements);
Decl.Attributes :=
Variable_Element_Table.Last
(Shared.Variable_Elements);
end;
end if;
@ -610,16 +612,17 @@ package body Prj.Proc is
-- This literal string list is the first term in a
-- string list expression
Result.Values := String_Element_Table.Last
(Shared.String_Elements);
Result.Values :=
String_Element_Table.Last
(Shared.String_Elements);
else
Shared.String_Elements.Table (Last).Next :=
String_Element_Table.Last (Shared.String_Elements);
end if;
Last := String_Element_Table.Last
(Shared.String_Elements);
Last :=
String_Element_Table.Last (Shared.String_Elements);
Shared.String_Elements.Table (Last) :=
(Value => Value.Value,
@ -706,8 +709,8 @@ package body Prj.Proc is
The_Name :=
Name_Of (Term_Package, From_Project_Node_Tree);
The_Package := The_Project.Decl.Packages;
The_Package := The_Project.Decl.Packages;
while The_Package /= No_Package
and then Shared.Packages.Table (The_Package).Name /=
The_Name
@ -760,10 +763,11 @@ package body Prj.Proc is
while The_Variable_Id /= No_Variable
and then Shared.Variable_Elements.Table
(The_Variable_Id).Name /= The_Name
(The_Variable_Id).Name /= The_Name
loop
The_Variable_Id := Shared.Variable_Elements.Table
(The_Variable_Id).Next;
The_Variable_Id :=
Shared.Variable_Elements.Table
(The_Variable_Id).Next;
end loop;
end if;
@ -808,15 +812,15 @@ package body Prj.Proc is
begin
if The_Package /= No_Package then
The_Array := Shared.Packages.Table
(The_Package).Decl.Arrays;
The_Array :=
Shared.Packages.Table (The_Package).Decl.Arrays;
else
The_Array := The_Project.Decl.Arrays;
end if;
while The_Array /= No_Array
and then Shared.Arrays.Table (The_Array).Name /=
The_Name
The_Name
loop
The_Array := Shared.Arrays.Table (The_Array).Next;
end loop;
@ -835,19 +839,18 @@ package body Prj.Proc is
(The_Element).Index /= Array_Index
loop
The_Element :=
Shared.Array_Elements.Table
(The_Element).Next;
Shared.Array_Elements.Table (The_Element).Next;
end loop;
end if;
if The_Element /= No_Array_Element then
The_Variable := Shared.Array_Elements.Table
(The_Element).Value;
The_Variable :=
Shared.Array_Elements.Table (The_Element).Value;
else
if Expression_Kind_Of
(The_Current_Term, From_Project_Node_Tree) =
(The_Current_Term, From_Project_Node_Tree) =
List
then
The_Variable :=
@ -1085,12 +1088,13 @@ package body Prj.Proc is
end if;
if not Done then
-- Count the number of string
-- Count the number of strings
declare
Saved : constant Positive := First;
begin
begin
Nmb := 1;
loop
Lst :=
@ -1479,11 +1483,13 @@ package body Prj.Proc is
Error_Msg
(Env.Flags, "value %% is illegal for typed string %%",
Loc, Project);
when Warning =>
Error_Msg
(Env.Flags, "?value %% is illegal for typed string %%",
Loc, Project);
Reset_Value := True;
when Silent =>
Reset_Value := True;
end case;

2
gcc/ada/prj-util.adb
View File

@ -1025,7 +1025,7 @@ package body Prj.Util is
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id;
Shared : Shared_Project_Tree_Data_Access) return Variable_Value
Shared : Shared_Project_Tree_Data_Access) return Variable_Value
is
Current : Variable_Id;
The_Variable : Variable;

2
gcc/ada/prj-util.ads
View File

@ -141,7 +141,7 @@ package Prj.Util is
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id;
Shared : Shared_Project_Tree_Data_Access) return Variable_Value;
Shared : Shared_Project_Tree_Data_Access) return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if
-- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.

30
gcc/ada/prj.adb
View File

@ -413,7 +413,8 @@ package body Prj is
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref);
(Project : Project_Id;
Tree : Project_Tree_Ref);
-- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects.
@ -422,7 +423,8 @@ package body Prj is
---------------------
procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref)
(Project : Project_Id;
Tree : Project_Tree_Ref)
is
List : Project_List;
Agg : Aggregated_Project_List;
@ -937,23 +939,25 @@ package body Prj is
-- Visible tables
if Tree.Is_Root_Tree then
-- We cannot use 'Access here:
-- "illegal attribute for discriminant-dependent component"
-- However, we know this is valid since Shared and Shared_Data have
-- the same lifetime and will always exist concurrently.
Tree.Shared := Tree.Shared_Data'Unrestricted_Access;
Name_List_Table.Init (Tree.Shared.Name_Lists);
Number_List_Table.Init (Tree.Shared.Number_Lists);
String_Element_Table.Init (Tree.Shared.String_Elements);
Variable_Element_Table.Init (Tree.Shared.Variable_Elements);
Array_Element_Table.Init (Tree.Shared.Array_Elements);
Array_Table.Init (Tree.Shared.Arrays);
Package_Table.Init (Tree.Shared.Packages);
Name_List_Table.Init (Tree.Shared.Name_Lists);
Number_List_Table.Init (Tree.Shared.Number_Lists);
String_Element_Table.Init (Tree.Shared.String_Elements);
Variable_Element_Table.Init (Tree.Shared.Variable_Elements);
Array_Element_Table.Init (Tree.Shared.Array_Elements);
Array_Table.Init (Tree.Shared.Arrays);
Package_Table.Init (Tree.Shared.Packages);
end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
Tree.Replaced_Source_Number := 0;
@ -962,7 +966,7 @@ package body Prj is
-- Private part table
Temp_Files_Table.Init (Tree.Private_Part.Temp_Files);
Temp_Files_Table.Init (Tree.Private_Part.Temp_Files);
Tree.Private_Part.Current_Source_Path_File := No_Path;
Tree.Private_Part.Current_Object_Path_File := No_Path;

2
gcc/ada/prj.ads
View File

@ -1442,6 +1442,8 @@ package Prj is
Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id
-- ??? What is behavior for multi-unit source files, where there are
-- several source_id per file ?
Source_Info_File_Name : String_Access := null;
-- The name of the source info file, if specified by the builder

116
gcc/ada/rtsfind.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -639,6 +639,9 @@ package Rtsfind is
RE_Current_Task, -- Ada.Task_Identification
RO_AT_Task_Id, -- Ada.Task_Identification
RE_Integer_8, -- Interfaces
RE_Integer_16, -- Interfaces
RE_Integer_32, -- Interfaces
RE_Integer_64, -- Interfaces
RE_Unsigned_8, -- Interfaces
RE_Unsigned_16, -- Interfaces
@ -1210,19 +1213,17 @@ package Rtsfind is
RE_FA_B, -- System.Partition_Interface
RE_FA_C, -- System.Partition_Interface
RE_FA_F, -- System.Partition_Interface
RE_FA_I, -- System.Partition_Interface
RE_FA_I8, -- System.Partition_Interface
RE_FA_I16, -- System.Partition_Interface
RE_FA_I32, -- System.Partition_Interface
RE_FA_I64, -- System.Partition_Interface
RE_FA_LF, -- System.Partition_Interface
RE_FA_LI, -- System.Partition_Interface
RE_FA_LLF, -- System.Partition_Interface
RE_FA_LLI, -- System.Partition_Interface
RE_FA_LLU, -- System.Partition_Interface
RE_FA_LU, -- System.Partition_Interface
RE_FA_SF, -- System.Partition_Interface
RE_FA_SI, -- System.Partition_Interface
RE_FA_SSI, -- System.Partition_Interface
RE_FA_SSU, -- System.Partition_Interface
RE_FA_SU, -- System.Partition_Interface
RE_FA_U, -- System.Partition_Interface
RE_FA_U8, -- System.Partition_Interface
RE_FA_U16, -- System.Partition_Interface
RE_FA_U32, -- System.Partition_Interface
RE_FA_U64, -- System.Partition_Interface
RE_FA_WC, -- System.Partition_Interface
RE_FA_WWC, -- System.Partition_Interface
RE_FA_String, -- System.Partition_Interface
@ -1232,19 +1233,17 @@ package Rtsfind is
RE_TA_B, -- System.Partition_Interface
RE_TA_C, -- System.Partition_Interface
RE_TA_F, -- System.Partition_Interface
RE_TA_I, -- System.Partition_Interface
RE_TA_I8, -- System.Partition_Interface
RE_TA_I16, -- System.Partition_Interface
RE_TA_I32, -- System.Partition_Interface
RE_TA_I64, -- System.Partition_Interface
RE_TA_LF, -- System.Partition_Interface
RE_TA_LI, -- System.Partition_Interface
RE_TA_LLF, -- System.Partition_Interface
RE_TA_LLI, -- System.Partition_Interface
RE_TA_LLU, -- System.Partition_Interface
RE_TA_LU, -- System.Partition_Interface
RE_TA_SF, -- System.Partition_Interface
RE_TA_SI, -- System.Partition_Interface
RE_TA_SSI, -- System.Partition_Interface
RE_TA_SSU, -- System.Partition_Interface
RE_TA_SU, -- System.Partition_Interface
RE_TA_U, -- System.Partition_Interface
RE_TA_U8, -- System.Partition_Interface
RE_TA_U16, -- System.Partition_Interface
RE_TA_U32, -- System.Partition_Interface
RE_TA_U64, -- System.Partition_Interface
RE_TA_WC, -- System.Partition_Interface
RE_TA_WWC, -- System.Partition_Interface
RE_TA_String, -- System.Partition_Interface
@ -1260,19 +1259,17 @@ package Rtsfind is
RE_TC_B, -- System.Partition_Interface
RE_TC_C, -- System.Partition_Interface
RE_TC_F, -- System.Partition_Interface
RE_TC_I, -- System.Partition_Interface
RE_TC_I8, -- System.Partition_Interface
RE_TC_I16, -- System.Partition_Interface
RE_TC_I32, -- System.Partition_Interface
RE_TC_I64, -- System.Partition_Interface
RE_TC_LF, -- System.Partition_Interface
RE_TC_LI, -- System.Partition_Interface
RE_TC_LLF, -- System.Partition_Interface
RE_TC_LLI, -- System.Partition_Interface
RE_TC_LLU, -- System.Partition_Interface
RE_TC_LU, -- System.Partition_Interface
RE_TC_SF, -- System.Partition_Interface
RE_TC_SI, -- System.Partition_Interface
RE_TC_SSI, -- System.Partition_Interface
RE_TC_SSU, -- System.Partition_Interface
RE_TC_SU, -- System.Partition_Interface
RE_TC_U, -- System.Partition_Interface
RE_TC_U8, -- System.Partition_Interface
RE_TC_U16, -- System.Partition_Interface
RE_TC_U32, -- System.Partition_Interface
RE_TC_U64, -- System.Partition_Interface
RE_TC_Void, -- System.Partition_Interface
RE_TC_Opaque, -- System.Partition_Interface
RE_TC_WC, -- System.Partition_Interface
@ -1819,6 +1816,9 @@ package Rtsfind is
RE_Current_Task => Ada_Task_Identification,
RO_AT_Task_Id => Ada_Task_Identification,
RE_Integer_8 => Interfaces,
RE_Integer_16 => Interfaces,
RE_Integer_32 => Interfaces,
RE_Integer_64 => Interfaces,
RE_Unsigned_8 => Interfaces,
RE_Unsigned_16 => Interfaces,
@ -2381,19 +2381,17 @@ package Rtsfind is
RE_FA_B => System_Partition_Interface,
RE_FA_C => System_Partition_Interface,
RE_FA_F => System_Partition_Interface,
RE_FA_I => System_Partition_Interface,
RE_FA_I8 => System_Partition_Interface,
RE_FA_I16 => System_Partition_Interface,
RE_FA_I32 => System_Partition_Interface,
RE_FA_I64 => System_Partition_Interface,
RE_FA_LF => System_Partition_Interface,
RE_FA_LI => System_Partition_Interface,
RE_FA_LLF => System_Partition_Interface,
RE_FA_LLI => System_Partition_Interface,
RE_FA_LLU => System_Partition_Interface,
RE_FA_LU => System_Partition_Interface,
RE_FA_SF => System_Partition_Interface,
RE_FA_SI => System_Partition_Interface,
RE_FA_SSI => System_Partition_Interface,
RE_FA_SSU => System_Partition_Interface,
RE_FA_SU => System_Partition_Interface,
RE_FA_U => System_Partition_Interface,
RE_FA_U8 => System_Partition_Interface,
RE_FA_U16 => System_Partition_Interface,
RE_FA_U32 => System_Partition_Interface,
RE_FA_U64 => System_Partition_Interface,
RE_FA_WC => System_Partition_Interface,
RE_FA_WWC => System_Partition_Interface,
RE_FA_String => System_Partition_Interface,
@ -2403,19 +2401,17 @@ package Rtsfind is
RE_TA_B => System_Partition_Interface,
RE_TA_C => System_Partition_Interface,
RE_TA_F => System_Partition_Interface,
RE_TA_I => System_Partition_Interface,
RE_TA_I8 => System_Partition_Interface,
RE_TA_I16 => System_Partition_Interface,
RE_TA_I32 => System_Partition_Interface,
RE_TA_I64 => System_Partition_Interface,
RE_TA_LF => System_Partition_Interface,
RE_TA_LI => System_Partition_Interface,
RE_TA_LLF => System_Partition_Interface,
RE_TA_LLI => System_Partition_Interface,
RE_TA_LLU => System_Partition_Interface,
RE_TA_LU => System_Partition_Interface,
RE_TA_SF => System_Partition_Interface,
RE_TA_SI => System_Partition_Interface,
RE_TA_SSI => System_Partition_Interface,
RE_TA_SSU => System_Partition_Interface,
RE_TA_SU => System_Partition_Interface,
RE_TA_U => System_Partition_Interface,
RE_TA_U8 => System_Partition_Interface,
RE_TA_U16 => System_Partition_Interface,
RE_TA_U32 => System_Partition_Interface,
RE_TA_U64 => System_Partition_Interface,
RE_TA_WC => System_Partition_Interface,
RE_TA_WWC => System_Partition_Interface,
RE_TA_String => System_Partition_Interface,
@ -2431,19 +2427,17 @@ package Rtsfind is
RE_TC_B => System_Partition_Interface,
RE_TC_C => System_Partition_Interface,
RE_TC_F => System_Partition_Interface,
RE_TC_I => System_Partition_Interface,
RE_TC_I8 => System_Partition_Interface,
RE_TC_I16 => System_Partition_Interface,
RE_TC_I32 => System_Partition_Interface,
RE_TC_I64 => System_Partition_Interface,
RE_TC_LF => System_Partition_Interface,
RE_TC_LI => System_Partition_Interface,
RE_TC_LLF => System_Partition_Interface,
RE_TC_LLI => System_Partition_Interface,
RE_TC_LLU => System_Partition_Interface,
RE_TC_LU => System_Partition_Interface,
RE_TC_SF => System_Partition_Interface,
RE_TC_SI => System_Partition_Interface,
RE_TC_SSI => System_Partition_Interface,
RE_TC_SSU => System_Partition_Interface,
RE_TC_SU => System_Partition_Interface,
RE_TC_U => System_Partition_Interface,
RE_TC_U8 => System_Partition_Interface,
RE_TC_U16 => System_Partition_Interface,
RE_TC_U32 => System_Partition_Interface,
RE_TC_U64 => System_Partition_Interface,
RE_TC_Void => System_Partition_Interface,
RE_TC_Opaque => System_Partition_Interface,
RE_TC_WC => System_Partition_Interface,

5
gcc/ada/s-taprop-linux.adb
View File

@ -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- --
@ -81,9 +81,6 @@ package body System.Task_Primitives.Operations is
-- a time; it is used to execute in mutual exclusion from all other tasks.
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task

5
gcc/ada/s-taprop-posix.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, 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- --
@ -83,9 +83,6 @@ package body System.Task_Primitives.Operations is
-- a time; it is used to execute in mutual exclusion from all other tasks.
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task

5
gcc/ada/s-taprop-tru64.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, 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- --
@ -77,9 +77,6 @@ package body System.Task_Primitives.Operations is
-- a time; it is used to execute in mutual exclusion from all other tasks.
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task

8
gcc/ada/s-tpopsp-posix-foreign.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, 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- --
@ -32,12 +32,12 @@
-- This is a POSIX version of this package where foreign threads are
-- recognized.
-- Currently, DEC Unix, SCO UnixWare, Solaris pthread, HPUX pthread and
-- GNU/Linux threads use this version.
separate (System.Task_Primitives.Operations)
package body Specific is
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
----------------
-- Initialize --
----------------

5
gcc/ada/s-tpopsp-posix.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, 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- --
@ -34,6 +34,9 @@
separate (System.Task_Primitives.Operations)
package body Specific is
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
----------------
-- Initialize --
----------------

97
gcc/ada/s-tpopsp-tls.adb Normal file
View File

@ -0,0 +1,97 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC --
-- --
-- B o d y --
-- --
-- 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This is a version of this package using TLS and where foreign threads are
-- recognized.
separate (System.Task_Primitives.Operations)
package body Specific is
ATCB : aliased Task_Id := null;
pragma Thread_Local_Storage (ATCB);
----------------
-- Initialize --
----------------
procedure Initialize (Environment_Task : Task_Id) is
begin
ATCB := Environment_Task;
end Initialize;
-------------------
-- Is_Valid_Task --
-------------------
function Is_Valid_Task return Boolean is
begin
return ATCB /= null;
end Is_Valid_Task;
---------
-- Set --
---------
procedure Set (Self_Id : Task_Id) is
begin
ATCB := Self_Id;
end Set;
----------
-- Self --
----------
-- To make Ada tasks and C threads interoperate better, we have added some
-- functionality to Self. Suppose a C main program (with threads) calls an
-- Ada procedure and the Ada procedure calls the tasking runtime system.
-- Eventually, a call will be made to self. Since the call is not coming
-- from an Ada task, there will be no corresponding ATCB.
-- What we do in Self is to catch references that do not come from
-- recognized Ada tasks, and create an ATCB for the calling thread.
-- The new ATCB will be "detached" from the normal Ada task master
-- hierarchy, much like the existing implicitly created signal-server
-- tasks.
function Self return Task_Id is
Result : constant Task_Id := ATCB;
begin
if Result /= null then
return Result;
else
-- If the value is Null then it is a non-Ada task
return Register_Foreign_Thread;
end if;
end Self;
end Specific;

73
gcc/ada/sem_ch13.adb
View File

@ -2841,6 +2841,7 @@ package body Sem_Ch13 is
Choice : Node_Id;
Val : Uint;
Err : Boolean := False;
-- Set True to avoid cascade errors and crashes on incorrect source code
Lo : constant Uint := Expr_Value (Type_Low_Bound (Universal_Integer));
Hi : constant Uint := Expr_Value (Type_High_Bound (Universal_Integer));
@ -2985,45 +2986,51 @@ package body Sem_Ch13 is
else
Analyze_And_Resolve (Choice, Enumtype);
if Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Error_Msg_N ("subtype name not allowed here", Choice);
if Error_Posted (Choice) then
Err := True;
-- ??? should allow static subtype with zero/one entry
end if;
elsif Etype (Choice) = Base_Type (Enumtype) then
if not Is_Static_Expression (Choice) then
Flag_Non_Static_Expr
("non-static expression used for choice!", Choice);
if not Err then
if Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Error_Msg_N ("subtype name not allowed here", Choice);
Err := True;
-- ??? should allow static subtype with zero/one entry
else
Elit := Expr_Value_E (Choice);
if Present (Enumeration_Rep_Expr (Elit)) then
Error_Msg_Sloc := Sloc (Enumeration_Rep_Expr (Elit));
Error_Msg_NE
("representation for& previously given#",
Choice, Elit);
elsif Etype (Choice) = Base_Type (Enumtype) then
if not Is_Static_Expression (Choice) then
Flag_Non_Static_Expr
("non-static expression used for choice!", Choice);
Err := True;
else
Elit := Expr_Value_E (Choice);
if Present (Enumeration_Rep_Expr (Elit)) then
Error_Msg_Sloc :=
Sloc (Enumeration_Rep_Expr (Elit));
Error_Msg_NE
("representation for& previously given#",
Choice, Elit);
Err := True;
end if;
Set_Enumeration_Rep_Expr (Elit, Expression (Assoc));
Expr := Expression (Assoc);
Val := Static_Integer (Expr);
if Val = No_Uint then
Err := True;
elsif Val < Lo or else Hi < Val then
Error_Msg_N ("value outside permitted range", Expr);
Err := True;
end if;
Set_Enumeration_Rep (Elit, Val);
end if;
Set_Enumeration_Rep_Expr (Elit, Expression (Assoc));
Expr := Expression (Assoc);
Val := Static_Integer (Expr);
if Val = No_Uint then
Err := True;
elsif Val < Lo or else Hi < Val then
Error_Msg_N ("value outside permitted range", Expr);
Err := True;
end if;
Set_Enumeration_Rep (Elit, Val);
end if;
end if;
end if;

4
gcc/ada/sem_ch7.adb
View File

@ -1516,8 +1516,8 @@ package body Sem_Ch7 is
procedure Declare_Inherited_Private_Subprograms (Id : Entity_Id) is
function Is_Primitive_Of (T : Entity_Id; S : Entity_Id) return Boolean;
-- Check whether an inherited subprogram is an operation of an untagged
-- derived type.
-- Check whether an inherited subprogram S is an operation of an
-- untagged derived type T.
---------------------
-- Is_Primitive_Of --

6
gcc/ada/system-aix.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- (AIX/PPC Version) --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -149,7 +149,7 @@ private
Always_Compatible_Rep : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
GCC_ZCX_Support : constant Boolean := True; -- Post GCC 4 only
ZCX_By_Default : constant Boolean := True;
GCC_ZCX_Support : constant Boolean := True;
end System;

6
gcc/ada/system-aix64.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- (PPC/AIX64 Version) --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -149,7 +149,7 @@ private
Always_Compatible_Rep : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
GCC_ZCX_Support : constant Boolean := True; -- Post GCC 4 only
ZCX_By_Default : constant Boolean := True;
GCC_ZCX_Support : constant Boolean := True;
end System;