Skip to content

R
riscv-gcc-1
Commit 686d0984 by Arnaud Charlet
Options

[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
parent 40ecf2f5
Showing with 417 additions and 310 deletions
gcc/ada/ChangeLog
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> 2011-08-03 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb, * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, mlib-prj.adb,
......
gcc/ada/a-cfdlli.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -251,33 +251,14 @@ private ...@@ -251,33 +251,14 @@ private
type Node_Array is array (Count_Type range <>) of Node_Type; type Node_Array is array (Count_Type range <>) of Node_Type;
function "=" (L, R : Node_Array) return Boolean is abstract; function "=" (L, R : Node_Array) return Boolean is abstract;
type List_Access is access all List; type List (Capacity : Count_Type) is tagged record
for List_Access'Storage_Size use 0;
type Kind is (Plain, Part);
type Plain_List (Capacity : Count_Type) is record
Nodes : Node_Array (1 .. Capacity) := (others => <>); Nodes : Node_Array (1 .. Capacity) := (others => <>);
Free : Count_Type'Base := -1; Free : Count_Type'Base := -1;
Busy : Natural := 0; Busy : Natural := 0;
Lock : 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; Length : Count_Type := 0;
First : Count_Type := 0; First : Count_Type := 0;
Last : Count_Type := 0; Last : Count_Type := 0;
Part : Part_List;
Plain : PList_Access := new Plain_List'(Capacity, others => <>);
end record; end record;
use Ada.Streams; use Ada.Streams;
......
gcc/ada/a-cfhama.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -66,8 +66,7 @@ package Ada.Containers.Formal_Hashed_Maps is ...@@ -66,8 +66,7 @@ package Ada.Containers.Formal_Hashed_Maps is
pragma Pure; pragma Pure;
type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private; type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
-- pragma Preelaborable_Initialization (Map); pragma Preelaborable_Initialization (Map);
-- why is this commented out???
type Cursor is private; type Cursor is private;
pragma Preelaborable_Initialization (Cursor); pragma Preelaborable_Initialization (Cursor);
...@@ -232,19 +231,10 @@ private ...@@ -232,19 +231,10 @@ private
package HT_Types is new package HT_Types is new
Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types 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 Map (Capacity : Count_Type; Modulus : Hash_Type) is
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
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;
use HT_Types; use HT_Types;
use Ada.Streams; use Ada.Streams;
......
gcc/ada/a-cfhase.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -257,19 +257,8 @@ private ...@@ -257,19 +257,8 @@ private
package HT_Types is new package HT_Types is new
Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
type HT_Access is access all HT_Types.Hash_Table_Type; type Set (Capacity : Count_Type; Modulus : Hash_Type) is
new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
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;
use HT_Types; use HT_Types;
use Ada.Streams; use Ada.Streams;
......
gcc/ada/a-cforma.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -69,7 +69,7 @@ package Ada.Containers.Formal_Ordered_Maps is ...@@ -69,7 +69,7 @@ package Ada.Containers.Formal_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map (Capacity : Count_Type) is tagged private; type Map (Capacity : Count_Type) is tagged private;
-- pragma Preelaborable_Initialization (Map); pragma Preelaborable_Initialization (Map);
type Cursor is private; type Cursor is private;
pragma Preelaborable_Initialization (Cursor); pragma Preelaborable_Initialization (Cursor);
...@@ -220,34 +220,22 @@ private ...@@ -220,34 +220,22 @@ private
type Node_Type is record type Node_Type is record
Has_Element : Boolean := False; Has_Element : Boolean := False;
Parent : Node_Access; Parent : Node_Access := 0;
Left : Node_Access; Left : Node_Access := 0;
Right : Node_Access; Right : Node_Access := 0;
Color : Red_Black_Trees.Color_Type := Red; Color : Red_Black_Trees.Color_Type := Red;
Key : Key_Type; Key : Key_Type;
Element : Element_Type; Element : Element_Type;
end record; end record;
type Kind is (Plain, Part);
package Tree_Types is package Tree_Types is
new Ada.Containers.Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type); 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
new Tree_Types.Tree_Type (Capacity) with null record;
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;
use Ada.Streams; use Ada.Streams;
type Map_Access is access all Map;
for Map_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
Node : Node_Access; Node : Node_Access;
end record; end record;
......
gcc/ada/a-cforse.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -265,27 +265,18 @@ private ...@@ -265,27 +265,18 @@ private
type Node_Type is record type Node_Type is record
Has_Element : Boolean := False; Has_Element : Boolean := False;
Parent : Count_Type; Parent : Count_Type := 0;
Left : Count_Type; Left : Count_Type := 0;
Right : Count_Type; Right : Count_Type := 0;
Color : Red_Black_Trees.Color_Type; Color : Red_Black_Trees.Color_Type;
Element : Element_Type; Element : Element_Type;
end record; end record;
type Kind is (Plain, Part);
package Tree_Types is package Tree_Types is
new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type); 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
new Tree_Types.Tree_Type (Capacity) with null record;
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;
use Red_Black_Trees; use Red_Black_Trees;
use Ada.Streams; use Ada.Streams;
......
gcc/ada/a-cofove.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -366,24 +366,13 @@ private ...@@ -366,24 +366,13 @@ private
type Elements_Array is array (Count_Type range <>) of Element_Type; type Elements_Array is array (Count_Type range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract; function "=" (L, R : Elements_Array) return Boolean is abstract;
type Kind is (Plain, Part); type Vector (Capacity : Capacity_Subtype) is tagged record
type Plain_Vector (Capacity : Capacity_Subtype) is record
Elements : Elements_Array (1 .. Capacity); Elements : Elements_Array (1 .. Capacity);
Last : Extended_Index := No_Index; Last : Extended_Index := No_Index;
Busy : Natural := 0; Busy : Natural := 0;
Lock : Natural := 0; Lock : Natural := 0;
end record; 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; use Ada.Streams;
procedure Write procedure Write
......
gcc/ada/exp_dist.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,7 +35,7 @@ package Exp_Dist is ...@@ -35,7 +35,7 @@ package Exp_Dist is
PCS_Version_Number : constant array (PCS_Names) of Int := PCS_Version_Number : constant array (PCS_Names) of Int :=
(Name_No_DSA => 1, (Name_No_DSA => 1,
Name_GARLIC_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 -- PCS interface version. This is used to check for consistency between the
-- compiler used to generate distribution stubs and the PCS implementation. -- compiler used to generate distribution stubs and the PCS implementation.
-- It must be incremented whenever a change is made to the generated code -- It must be incremented whenever a change is made to the generated code
......
gcc/ada/exp_util.adb
...@@ -3568,9 +3568,12 @@ package body Exp_Util is ...@@ -3568,9 +3568,12 @@ package body Exp_Util is
function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean is function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean is
begin begin
return VM_Target /= No_VM return VM_Target /= No_VM
and then Nkind (N) = N_Identifier and then (Nkind (N) = N_Slice
and then Present (Renamed_Object (Entity (N))) or else
and then Nkind (Renamed_Object (Entity (N))) = N_Slice; (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; end Is_VM_By_Copy_Actual;
-------------------- --------------------
......
gcc/ada/gcc-interface/Make-lang.in
...@@ -2256,31 +2256,33 @@ ada/exp_dist.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -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/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/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/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/elists.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
ada/exp_atag.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_dist.ads \ ada/erroutc.ads ada/erroutc.adb ada/exp_atag.ads ada/exp_ch7.ads \
ada/exp_dist.adb ada/exp_strm.ads ada/exp_tss.ads ada/exp_util.ads \ ada/exp_disp.ads ada/exp_dist.ads ada/exp_dist.adb ada/exp_strm.ads \
ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/get_targ.ads \ ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hlo.ads \ ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads \
ada/hostparm.ads ada/inline.ads ada/inline.adb ada/interfac.ads \ ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \ ada/inline.ads ada/inline.adb ada/interfac.ads ada/lib.ads ada/lib.adb \
ada/lib-sort.adb ada/namet.ads ada/namet.adb ada/nlists.ads \ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem.adb \ ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads \ ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \ ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads \
ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \ ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \
ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \ ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
ada/sem_dist.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_util.ads \ ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dist.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \ ada/sem_eval.ads ada/sem_prag.ads ada/sem_util.ads ada/sinfo.ads \
ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \ ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \ ada/stringt.ads ada/stringt.adb ada/stylesw.ads ada/system.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads \ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 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/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 \ 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 \ ...@@ -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_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_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/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/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \ ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.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/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 \ 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 \ ...@@ -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/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/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/atree.adb ada/casing.ads ada/casing.adb ada/csets.ads ada/debug.ads \
ada/einfo.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \ ada/einfo.ads ada/einfo.adb ada/err_vars.ads ada/errout.ads \
ada/erroutc.ads ada/erroutc.adb ada/fname.ads ada/fname-uf.ads \ ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/fname.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \ ada/fname-uf.ads ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads \
ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \ ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/namet.adb \ ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/namet.ads \
ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.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/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/sem_aux.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \ ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
......
gcc/ada/gcc-interface/Makefile.in
...@@ -529,6 +529,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ...@@ -529,6 +529,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-vxwext.adb<s-vxwext-kernel-smp.adb \ s-vxwext.adb<s-vxwext-kernel-smp.adb \
system.ads<system-vxworks-ppc-kernel.ads system.ads<system-vxworks-ppc-kernel.ads
EH_MECHANISM=-gcc
EXTRA_GNATRTL_TASKING_OBJS=affinity.o EXTRA_GNATRTL_TASKING_OBJS=affinity.o
else else
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
...@@ -536,6 +537,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ...@@ -536,6 +537,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-tpopsp.adb<s-tpopsp-vxworks.adb s-tpopsp.adb<s-tpopsp-vxworks.adb
ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),) ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),)
EH_MECHANISM=-gcc
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-kernel.ads \ s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel.adb \ s-vxwext.adb<s-vxwext-kernel.adb \
...@@ -1072,7 +1074,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),) ...@@ -1072,7 +1074,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
g-bytswa.adb<g-bytswa-x86.adb \ g-bytswa.adb<g-bytswa-x86.adb \
s-inmaop.adb<s-inmaop-posix.adb \ s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-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 g-sercom.adb<g-sercom-linux.adb
ifeq ($(strip $(filter-out marte,$(THREAD_KIND))),) ifeq ($(strip $(filter-out marte,$(THREAD_KIND))),)
...@@ -1383,7 +1385,7 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),) ...@@ -1383,7 +1385,7 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
endif endif
THREADSLIB = -lpthreads THREADSLIB = -lpthreads
EH_MECHANISM=-gcc
TOOLS_TARGET_PAIRS = \ TOOLS_TARGET_PAIRS = \
mlib-tgt-specific.adb<mlib-tgt-specific-aix.adb \ mlib-tgt-specific.adb<mlib-tgt-specific-aix.adb \
indepsw.adb<indepsw-aix.adb indepsw.adb<indepsw-aix.adb
...@@ -1800,7 +1802,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),) ...@@ -1800,7 +1802,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
s-intman.adb<s-intman-posix.adb \ s-intman.adb<s-intman-posix.adb \
s-linux.ads<s-linux.ads \ s-linux.ads<s-linux.ads \
s-osinte.adb<s-osinte-posix.adb \ 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 \ g-sercom.adb<g-sercom-linux.adb \
$(ATOMICS_TARGET_PAIRS) $(ATOMICS_TARGET_PAIRS)
...@@ -1898,7 +1900,7 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),) ...@@ -1898,7 +1900,7 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),)
s-tasinf.ads<s-tasinf-linux.ads \ s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \ s-tasinf.adb<s-tasinf-linux.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \ 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 = \ LIBGNAT_TARGET_PAIRS_32 = \
g-trasym.ads<g-trasym-unimplemented.ads \ g-trasym.ads<g-trasym-unimplemented.ads \
...@@ -2002,7 +2004,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),) ...@@ -2002,7 +2004,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
s-taprop.adb<s-taprop-linux.adb \ s-taprop.adb<s-taprop-linux.adb \
s-tasinf.ads<s-tasinf-linux.ads \ s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \ 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 \ s-taspri.ads<s-taspri-posix-noaltstack.ads \
g-sercom.adb<g-sercom-linux.adb \ g-sercom.adb<g-sercom-linux.adb \
system.ads<system-linux-ia64.ads \ system.ads<system-linux-ia64.ads \
...@@ -2094,7 +2096,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),) ...@@ -2094,7 +2096,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
s-taprop.adb<s-taprop-linux.adb \ s-taprop.adb<s-taprop-linux.adb \
s-tasinf.ads<s-tasinf-linux.ads \ s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \ 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 \ s-taspri.ads<s-taspri-posix.ads \
g-sercom.adb<g-sercom-linux.adb \ g-sercom.adb<g-sercom-linux.adb \
system.ads<system-linux-x86_64.ads \ system.ads<system-linux-x86_64.ads \
......
gcc/ada/gnatcmd.adb
...@@ -470,7 +470,7 @@ procedure GNATCmd is ...@@ -470,7 +470,7 @@ procedure GNATCmd is
end if; end if;
Main := Project_Tree.Shared.String_Elements.Table Main := Project_Tree.Shared.String_Elements.Table
(Main).Next; (Main).Next;
end loop; end loop;
if Proj.Project.Library then if Proj.Project.Library then
...@@ -1241,6 +1241,7 @@ procedure GNATCmd is ...@@ -1241,6 +1241,7 @@ procedure GNATCmd is
Libraries_Present : in out Boolean) Libraries_Present : in out Boolean)
is is
pragma Unreferenced (Tree); pragma Unreferenced (Tree);
Path_Option : constant String_Access := Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option; MLib.Linker_Library_Path_Option;
...@@ -2307,7 +2308,8 @@ begin ...@@ -2307,7 +2308,8 @@ begin
Attribute_Or_Array_Name => Attribute_Or_Array_Name =>
Name_Local_Config_File, Name_Local_Config_File,
In_Package => Pkg, In_Package => Pkg,
Shared => Project_Tree.Shared); Shared =>
Project_Tree.Shared);
end if; end if;
if Variable /= Nil_Variable_Value if Variable /= Nil_Variable_Value
......
gcc/ada/makeutl.ads
...@@ -36,12 +36,13 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; ...@@ -36,12 +36,13 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package Makeutl is package Makeutl is
type Fail_Proc is access procedure (S : String); type Fail_Proc is access procedure (S : String);
Do_Fail : Fail_Proc := Osint.Fail'Access; Do_Fail : Fail_Proc := Osint.Fail'Access;
-- Failing procedure called from procedure Test_If_Relative_Path below. May -- Failing procedure called from procedure Test_If_Relative_Path below. May
-- be redirected. -- be redirected.
Project_Tree : constant Project_Tree_Ref := 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 -- The project tree
Source_Info_Option : constant String := "--source-info="; Source_Info_Option : constant String := "--source-info=";
......
gcc/ada/mlib-prj.adb
...@@ -1304,8 +1304,8 @@ package body MLib.Prj is ...@@ -1304,8 +1304,8 @@ package body MLib.Prj is
Lib_Dirpath := Lib_Dirpath :=
new String'(Get_Name_String (For_Project.Library_Dir.Display_Name)); new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
Lib_Filename := new String' Lib_Filename :=
(Get_Name_String (For_Project.Library_Name)); new String'(Get_Name_String (For_Project.Library_Name));
case For_Project.Library_Kind is case For_Project.Library_Kind is
when Static => when Static =>
......
gcc/ada/prj-conf.adb
...@@ -102,8 +102,8 @@ package body Prj.Conf is ...@@ -102,8 +102,8 @@ package body Prj.Conf is
-- Raises exception Invalid_Config with given message -- Raises exception Invalid_Config with given message
procedure Apply_Config_File procedure Apply_Config_File
(Config_File : Prj.Project_Id; (Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref); Project_Tree : Prj.Project_Tree_Ref);
-- Apply the configuration file settings to all the projects in the -- Apply the configuration file settings to all the projects in the
-- project tree. The Project_Tree must have been parsed first, and -- project tree. The Project_Tree must have been parsed first, and
-- processed through the first phase so that all its projects are known. -- processed through the first phase so that all its projects are known.
...@@ -174,8 +174,8 @@ package body Prj.Conf is ...@@ -174,8 +174,8 @@ package body Prj.Conf is
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Shared.String_Elements); (Shared.String_Elements);
New_List := String_Element_Table.Last New_List :=
(Shared.String_Elements); String_Element_Table.Last (Shared.String_Elements);
-- Value of attribute is new list -- Value of attribute is new list
...@@ -183,11 +183,10 @@ package body Prj.Conf is ...@@ -183,11 +183,10 @@ package body Prj.Conf is
Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr; Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
loop loop
-- Get each element of configuration list -- Get each element of configuration list
Conf_Elem := Shared.String_Elements.Table (Conf_List); Conf_Elem := Shared.String_Elements.Table (Conf_List);
New_Elem := Conf_Elem; New_Elem := Conf_Elem;
Conf_List := Conf_Elem.Next; Conf_List := Conf_Elem.Next;
if Conf_List = Nil_String then if Conf_List = Nil_String then
...@@ -240,9 +239,9 @@ package body Prj.Conf is ...@@ -240,9 +239,9 @@ package body Prj.Conf is
User_Decl.Arrays := Array_Table.Last (Shared.Arrays); User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
Shared.Arrays.Table (User_Decl.Arrays) := User_Array; 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; Conf_Array_Elem_Id := Conf_Array.Value;
while Conf_Array_Elem_Id /= No_Array_Element loop while Conf_Array_Elem_Id /= No_Array_Element loop
Conf_Array_Elem := Conf_Array_Elem :=
...@@ -256,9 +255,8 @@ package body Prj.Conf is ...@@ -256,9 +255,8 @@ package body Prj.Conf is
User_Array_Elem_Id := User_Array_Elem.Next; User_Array_Elem_Id := User_Array_Elem.Next;
end loop; end loop;
-- If the array element does not exist in the user array, -- If the array element doesn't exist in the user array, insert
-- insert a shallow copy of the conf array element in the -- a shallow copy of the conf array element in the user array.
-- user array.
if User_Array_Elem_Id = No_Array_Element then if User_Array_Elem_Id = No_Array_Element then
Array_Element_Table.Increment_Last (Shared.Array_Elements); Array_Element_Table.Increment_Last (Shared.Array_Elements);
...@@ -270,8 +268,8 @@ package body Prj.Conf is ...@@ -270,8 +268,8 @@ package body Prj.Conf is
User_Array_Elem; User_Array_Elem;
Shared.Arrays.Table (User_Array_Id) := User_Array; Shared.Arrays.Table (User_Array_Id) := User_Array;
-- Otherwise, if the value is a string list, prepend the -- Otherwise, if the value is a string list, prepend the conf
-- user array element with the conf array element value. -- array element value to the array element.
elsif Conf_Array_Elem.Value.Kind = List then elsif Conf_Array_Elem.Value.Kind = List then
Conf_List := Conf_Array_Elem.Value.Values; Conf_List := Conf_Array_Elem.Value.Values;
...@@ -351,12 +349,13 @@ package body Prj.Conf is ...@@ -351,12 +349,13 @@ package body Prj.Conf is
Index : String := ""; Index : String := "";
Pkg : Project_Node_Id := Empty_Node) Pkg : Project_Node_Id := Empty_Node)
is is
Attr : Project_Node_Id; Attr : Project_Node_Id;
pragma Unreferenced (Attr); pragma Unreferenced (Attr);
Expr : Name_Id := No_Name; Expr : Name_Id := No_Name;
Val : Name_Id := No_Name; Val : Name_Id := No_Name;
Parent : Project_Node_Id := Config_File; Parent : Project_Node_Id := Config_File;
begin begin
if Index /= "" then if Index /= "" then
Name_Len := Index'Length; Name_Len := Index'Length;
...@@ -456,10 +455,11 @@ package body Prj.Conf is ...@@ -456,10 +455,11 @@ package body Prj.Conf is
----------------------- -----------------------
procedure Apply_Config_File procedure Apply_Config_File
(Config_File : Prj.Project_Id; (Config_File : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref) Project_Tree : Prj.Project_Tree_Ref)
is is
Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared; Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
Conf_Decl : constant Declarations := Config_File.Decl; Conf_Decl : constant Declarations := Config_File.Decl;
Conf_Pack_Id : Package_Id; Conf_Pack_Id : Package_Id;
Conf_Pack : Package_Element; Conf_Pack : Package_Element;
......
gcc/ada/prj-env.adb
...@@ -208,6 +208,7 @@ package body Prj.Env is ...@@ -208,6 +208,7 @@ package body Prj.Env is
Dummy : in out Boolean) Dummy : in out Boolean)
is is
pragma Unreferenced (Dummy, In_Tree); pragma Unreferenced (Dummy, In_Tree);
Path : constant Path_Name_Type := Path : constant Path_Name_Type :=
Get_Object_Directory Get_Object_Directory
(Project, (Project,
...@@ -509,6 +510,7 @@ package body Prj.Env is ...@@ -509,6 +510,7 @@ package body Prj.Env is
State : in out Integer) State : in out Integer)
is is
pragma Unreferenced (State, In_Tree); pragma Unreferenced (State, In_Tree);
Lang : constant Language_Ptr := Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada"); Get_Language_From_Name (Project, "ada");
Naming : Lang_Naming_Data; Naming : Lang_Naming_Data;
...@@ -821,6 +823,7 @@ package body Prj.Env is ...@@ -821,6 +823,7 @@ package body Prj.Env is
State : in out Integer) State : in out Integer)
is is
pragma Unreferenced (State); pragma Unreferenced (State);
Source : Source_Id; Source : Source_Id;
Suffix : File_Name_Type; Suffix : File_Name_Type;
Iter : Source_Iterator; Iter : Source_Iterator;
...@@ -1224,6 +1227,7 @@ package body Prj.Env is ...@@ -1224,6 +1227,7 @@ package body Prj.Env is
Dummy : in out Integer) Dummy : in out Integer)
is is
pragma Unreferenced (Dummy, Tree); pragma Unreferenced (Dummy, Tree);
begin begin
-- ??? Set_Ada_Paths has a different behavior for library project -- ??? Set_Ada_Paths has a different behavior for library project
-- files, should we have the same ? -- files, should we have the same ?
...@@ -1268,6 +1272,7 @@ package body Prj.Env is ...@@ -1268,6 +1272,7 @@ package body Prj.Env is
Dummy : in out Integer) Dummy : in out Integer)
is is
pragma Unreferenced (Dummy); pragma Unreferenced (Dummy);
Current : String_List_Id := Prj.Source_Dirs; Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element; The_String : String_Element;
......
gcc/ada/prj-nmsc.adb
...@@ -150,20 +150,9 @@ package body Prj.Nmsc is ...@@ -150,20 +150,9 @@ package body Prj.Nmsc is
-- information which is only useful while processing the project, and can -- information which is only useful while processing the project, and can
-- be discarded as soon as we have finished processing the project -- 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 type Tree_Processing_Data is record
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
File_To_Source : Files_Htable.Instance;
Flags : Prj.Processing_Flags; Flags : Prj.Processing_Flags;
end record; end record;
-- Temporary data which is needed while parsing a project. It does not need -- Temporary data which is needed while parsing a project. It does not need
...@@ -673,7 +662,8 @@ package body Prj.Nmsc is ...@@ -673,7 +662,8 @@ package body Prj.Nmsc is
Source := Prev_Unit.File_Names (Kind); Source := Prev_Unit.File_Names (Kind);
else 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 if Source /= No_Source
and then Source.Index = Index and then Source.Index = Index
...@@ -900,8 +890,6 @@ package body Prj.Nmsc is ...@@ -900,8 +890,6 @@ package body Prj.Nmsc is
Data.Tree.Replaced_Source_Number := Data.Tree.Replaced_Source_Number :=
Data.Tree.Replaced_Source_Number - 1; Data.Tree.Replaced_Source_Number - 1;
end if; end if;
Files_Htable.Set (Data.File_To_Source, File_Name, Id);
end Add_Source; end Add_Source;
------------------------------ ------------------------------
...@@ -932,7 +920,6 @@ package body Prj.Nmsc is ...@@ -932,7 +920,6 @@ package body Prj.Nmsc is
Data : Tree_Processing_Data := Data : Tree_Processing_Data :=
(Tree => Tree, (Tree => Tree,
Node_Tree => Node_Tree, Node_Tree => Node_Tree,
File_To_Source => Files_Htable.Nil,
Flags => Flags); Flags => Flags);
Project_Files : constant Prj.Variable_Value := Project_Files : constant Prj.Variable_Value :=
...@@ -6366,7 +6353,6 @@ package body Prj.Nmsc is ...@@ -6366,7 +6353,6 @@ package body Prj.Nmsc is
Source : Source_Id; Source : Source_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
Found : Boolean := False; Found : Boolean := False;
Path : Path_Information;
begin begin
Iter := For_Each_Source (Data.Tree, Project.Project); Iter := For_Each_Source (Data.Tree, Project.Project);
...@@ -6374,23 +6360,45 @@ package body Prj.Nmsc is ...@@ -6374,23 +6360,45 @@ package body Prj.Nmsc is
Source := Prj.Element (Iter); Source := Prj.Element (Iter);
exit when Source = No_Source; 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 if Source.Naming_Exception
and then Source.Path = No_Path_Information and then Source.Path = No_Path_Information
then then
if Source.Unit /= No_Unit_Index then if Source.Unit /= No_Unit_Index then
Found := False; Found := False;
-- For multi-unit source files, source_id gets duplicated if Source.Index /= 0 then -- Only multi-unit files
-- once for every unit. Only the first source_id got its declare
-- full path set. 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 if Current_Verbosity = High then
Path := Files_Htable.Get Debug_Output
(Data.File_To_Source, Source.File).Path; ("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 exit;
Found := True; end if;
end if;
S := S.Next_With_File_Name;
end loop;
end;
end if; end if;
if not Found then if not Found then
...@@ -6400,21 +6408,6 @@ package body Prj.Nmsc is ...@@ -6400,21 +6408,6 @@ package body Prj.Nmsc is
(Data.Flags, Data.Flags.Missing_Source_Files, (Data.Flags, Data.Flags.Missing_Source_Files,
"source file %% for unit %% not found", "source file %% for unit %% not found",
No_Location, Project.Project); 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;
end if; end if;
...@@ -6472,7 +6465,6 @@ package body Prj.Nmsc is ...@@ -6472,7 +6465,6 @@ package body Prj.Nmsc is
Flags : Prj.Processing_Flags) Flags : Prj.Processing_Flags)
is is
begin begin
Files_Htable.Reset (Data.File_To_Source);
Data.Tree := Tree; Data.Tree := Tree;
Data.Node_Tree := Node_Tree; Data.Node_Tree := Node_Tree;
Data.Flags := Flags; Data.Flags := Flags;
...@@ -6483,8 +6475,9 @@ package body Prj.Nmsc is ...@@ -6483,8 +6475,9 @@ package body Prj.Nmsc is
---------- ----------
procedure Free (Data : in out Tree_Processing_Data) is procedure Free (Data : in out Tree_Processing_Data) is
pragma Unreferenced (Data);
begin begin
Files_Htable.Reset (Data.File_To_Source); null;
end Free; end Free;
---------------- ----------------
...@@ -6666,6 +6659,7 @@ package body Prj.Nmsc is ...@@ -6666,6 +6659,7 @@ package body Prj.Nmsc is
then then
Debug_Output ("Override kind for " Debug_Output ("Override kind for "
& Get_Name_String (Source.File) & Get_Name_String (Source.File)
& " idx=" & Source.Index'Img
& " kind=" & Source.Kind'Img); & " kind=" & Source.Kind'Img);
end if; end if;
...@@ -6736,12 +6730,20 @@ package body Prj.Nmsc is ...@@ -6736,12 +6730,20 @@ package body Prj.Nmsc is
Check_Name := True; Check_Name := True;
else 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); Name_Loc.Source.Path := (Path, Display_Path);
Source_Paths_Htable.Set Source_Paths_Htable.Set
(Data.Tree.Source_Paths_HT, (Data.Tree.Source_Paths_HT, Path, Name_Loc.Source);
Path,
Name_Loc.Source);
-- Check if this is a subunit -- Check if this is a subunit
...@@ -6755,9 +6757,6 @@ package body Prj.Nmsc is ...@@ -6755,9 +6757,6 @@ package body Prj.Nmsc is
Override_Kind (Name_Loc.Source, Sep); Override_Kind (Name_Loc.Source, Sep);
end if; end if;
end if; end if;
Files_Htable.Set
(Data.File_To_Source, File_Name, Name_Loc.Source);
end if; end if;
end if; end if;
end if; end if;
...@@ -7427,7 +7426,7 @@ package body Prj.Nmsc is ...@@ -7427,7 +7426,7 @@ package body Prj.Nmsc is
procedure Get_Sources_From_Source_Info; procedure Get_Sources_From_Source_Info;
-- Get the source information from the tables that were created when a -- 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 -- -- Check_Missing_Sources --
...@@ -7720,7 +7719,6 @@ package body Prj.Nmsc is ...@@ -7720,7 +7719,6 @@ package body Prj.Nmsc is
Id.Language := Lang_Id; Id.Language := Lang_Id;
Id.Kind := Src.Kind; Id.Kind := Src.Kind;
Id.Index := Src.Index; Id.Index := Src.Index;
Id.Path := Id.Path :=
...@@ -7783,8 +7781,6 @@ package body Prj.Nmsc is ...@@ -7783,8 +7781,6 @@ package body Prj.Nmsc is
Id.Next_In_Lang := Id.Language.First_Source; Id.Next_In_Lang := Id.Language.First_Source;
Id.Language.First_Source := Id; Id.Language.First_Source := Id;
Files_Htable.Set (Data.File_To_Source, Id.File, Id);
Next (Iter); Next (Iter);
end loop; end loop;
end Get_Sources_From_Source_Info; end Get_Sources_From_Source_Info;
......
gcc/ada/prj-proc.adb
...@@ -154,6 +154,7 @@ package body Prj.Proc is ...@@ -154,6 +154,7 @@ package body Prj.Proc is
-- as processed, call itself recursively for all imported projects and a -- as processed, call itself recursively for all imported projects and a
-- extended project, if any. Then process the declarative items of the -- extended project, if any. Then process the declarative items of the
-- project. -- project.
--
-- Is_Root_Project should be true only for the project that the user -- Is_Root_Project should be true only for the project that the user
-- explicitly loaded. In the context of aggregate projects, only that -- explicitly loaded. In the context of aggregate projects, only that
-- project is allowed to modify the environment that will be used to load -- project is allowed to modify the environment that will be used to load
...@@ -268,8 +269,9 @@ package body Prj.Proc is ...@@ -268,8 +269,9 @@ package body Prj.Proc is
(Next => Decl.Attributes, (Next => Decl.Attributes,
Name => Attribute_Name_Of (The_Attribute), Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute); Value => New_Attribute);
Decl.Attributes := Variable_Element_Table.Last Decl.Attributes :=
(Shared.Variable_Elements); Variable_Element_Table.Last
(Shared.Variable_Elements);
end; end;
end if; end if;
...@@ -610,16 +612,17 @@ package body Prj.Proc is ...@@ -610,16 +612,17 @@ package body Prj.Proc is
-- This literal string list is the first term in a -- This literal string list is the first term in a
-- string list expression -- string list expression
Result.Values := String_Element_Table.Last Result.Values :=
(Shared.String_Elements); String_Element_Table.Last
(Shared.String_Elements);
else else
Shared.String_Elements.Table (Last).Next := Shared.String_Elements.Table (Last).Next :=
String_Element_Table.Last (Shared.String_Elements); String_Element_Table.Last (Shared.String_Elements);
end if; end if;
Last := String_Element_Table.Last Last :=
(Shared.String_Elements); String_Element_Table.Last (Shared.String_Elements);
Shared.String_Elements.Table (Last) := Shared.String_Elements.Table (Last) :=
(Value => Value.Value, (Value => Value.Value,
...@@ -706,8 +709,8 @@ package body Prj.Proc is ...@@ -706,8 +709,8 @@ package body Prj.Proc is
The_Name := The_Name :=
Name_Of (Term_Package, From_Project_Node_Tree); 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 while The_Package /= No_Package
and then Shared.Packages.Table (The_Package).Name /= and then Shared.Packages.Table (The_Package).Name /=
The_Name The_Name
...@@ -760,10 +763,11 @@ package body Prj.Proc is ...@@ -760,10 +763,11 @@ package body Prj.Proc is
while The_Variable_Id /= No_Variable while The_Variable_Id /= No_Variable
and then Shared.Variable_Elements.Table and then Shared.Variable_Elements.Table
(The_Variable_Id).Name /= The_Name (The_Variable_Id).Name /= The_Name
loop loop
The_Variable_Id := Shared.Variable_Elements.Table The_Variable_Id :=
(The_Variable_Id).Next; Shared.Variable_Elements.Table
(The_Variable_Id).Next;
end loop; end loop;
end if; end if;
...@@ -808,15 +812,15 @@ package body Prj.Proc is ...@@ -808,15 +812,15 @@ package body Prj.Proc is
begin begin
if The_Package /= No_Package then if The_Package /= No_Package then
The_Array := Shared.Packages.Table The_Array :=
(The_Package).Decl.Arrays; Shared.Packages.Table (The_Package).Decl.Arrays;
else else
The_Array := The_Project.Decl.Arrays; The_Array := The_Project.Decl.Arrays;
end if; end if;
while The_Array /= No_Array while The_Array /= No_Array
and then Shared.Arrays.Table (The_Array).Name /= and then Shared.Arrays.Table (The_Array).Name /=
The_Name The_Name
loop loop
The_Array := Shared.Arrays.Table (The_Array).Next; The_Array := Shared.Arrays.Table (The_Array).Next;
end loop; end loop;
...@@ -835,19 +839,18 @@ package body Prj.Proc is ...@@ -835,19 +839,18 @@ package body Prj.Proc is
(The_Element).Index /= Array_Index (The_Element).Index /= Array_Index
loop loop
The_Element := The_Element :=
Shared.Array_Elements.Table Shared.Array_Elements.Table (The_Element).Next;
(The_Element).Next;
end loop; end loop;
end if; end if;
if The_Element /= No_Array_Element then if The_Element /= No_Array_Element then
The_Variable := Shared.Array_Elements.Table The_Variable :=
(The_Element).Value; Shared.Array_Elements.Table (The_Element).Value;
else else
if Expression_Kind_Of if Expression_Kind_Of
(The_Current_Term, From_Project_Node_Tree) = (The_Current_Term, From_Project_Node_Tree) =
List List
then then
The_Variable := The_Variable :=
...@@ -1085,12 +1088,13 @@ package body Prj.Proc is ...@@ -1085,12 +1088,13 @@ package body Prj.Proc is
end if; end if;
if not Done then if not Done then
-- Count the number of string
-- Count the number of strings
declare declare
Saved : constant Positive := First; Saved : constant Positive := First;
begin
begin
Nmb := 1; Nmb := 1;
loop loop
Lst := Lst :=
...@@ -1479,11 +1483,13 @@ package body Prj.Proc is ...@@ -1479,11 +1483,13 @@ package body Prj.Proc is
Error_Msg Error_Msg
(Env.Flags, "value %% is illegal for typed string %%", (Env.Flags, "value %% is illegal for typed string %%",
Loc, Project); Loc, Project);
when Warning => when Warning =>
Error_Msg Error_Msg
(Env.Flags, "?value %% is illegal for typed string %%", (Env.Flags, "?value %% is illegal for typed string %%",
Loc, Project); Loc, Project);
Reset_Value := True; Reset_Value := True;
when Silent => when Silent =>
Reset_Value := True; Reset_Value := True;
end case; end case;
......
gcc/ada/prj-util.adb
...@@ -1025,7 +1025,7 @@ package body Prj.Util is ...@@ -1025,7 +1025,7 @@ package body Prj.Util is
function Value_Of function Value_Of
(Variable_Name : Name_Id; (Variable_Name : Name_Id;
In_Variables : Variable_Id; In_Variables : Variable_Id;
Shared : Shared_Project_Tree_Data_Access) return Variable_Value Shared : Shared_Project_Tree_Data_Access) return Variable_Value
is is
Current : Variable_Id; Current : Variable_Id;
The_Variable : Variable; The_Variable : Variable;
......
gcc/ada/prj-util.ads
...@@ -141,7 +141,7 @@ package Prj.Util is ...@@ -141,7 +141,7 @@ package Prj.Util is
function Value_Of function Value_Of
(Variable_Name : Name_Id; (Variable_Name : Name_Id;
In_Variables : Variable_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 -- 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 -- 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. -- variable in In_Variables. Caller must ensure that Name is lower case.
......
gcc/ada/prj.adb
...@@ -413,7 +413,8 @@ package body Prj is ...@@ -413,7 +413,8 @@ package body Prj is
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil; Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check 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 -- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects. -- Seen, Call Action, and check all its imported projects.
...@@ -422,7 +423,8 @@ package body Prj is ...@@ -422,7 +423,8 @@ package body Prj is
--------------------- ---------------------
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; Tree : Project_Tree_Ref) (Project : Project_Id;
Tree : Project_Tree_Ref)
is is
List : Project_List; List : Project_List;
Agg : Aggregated_Project_List; Agg : Aggregated_Project_List;
...@@ -937,23 +939,25 @@ package body Prj is ...@@ -937,23 +939,25 @@ package body Prj is
-- Visible tables -- Visible tables
if Tree.Is_Root_Tree then if Tree.Is_Root_Tree then
-- We cannot use 'Access here: -- We cannot use 'Access here:
-- "illegal attribute for discriminant-dependent component" -- "illegal attribute for discriminant-dependent component"
-- However, we know this is valid since Shared and Shared_Data have -- However, we know this is valid since Shared and Shared_Data have
-- the same lifetime and will always exist concurrently. -- the same lifetime and will always exist concurrently.
Tree.Shared := Tree.Shared_Data'Unrestricted_Access; Tree.Shared := Tree.Shared_Data'Unrestricted_Access;
Name_List_Table.Init (Tree.Shared.Name_Lists); Name_List_Table.Init (Tree.Shared.Name_Lists);
Number_List_Table.Init (Tree.Shared.Number_Lists); Number_List_Table.Init (Tree.Shared.Number_Lists);
String_Element_Table.Init (Tree.Shared.String_Elements); String_Element_Table.Init (Tree.Shared.String_Elements);
Variable_Element_Table.Init (Tree.Shared.Variable_Elements); Variable_Element_Table.Init (Tree.Shared.Variable_Elements);
Array_Element_Table.Init (Tree.Shared.Array_Elements); Array_Element_Table.Init (Tree.Shared.Array_Elements);
Array_Table.Init (Tree.Shared.Arrays); Array_Table.Init (Tree.Shared.Arrays);
Package_Table.Init (Tree.Shared.Packages); Package_Table.Init (Tree.Shared.Packages);
end if; end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT); Source_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources); Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
Tree.Replaced_Source_Number := 0; Tree.Replaced_Source_Number := 0;
...@@ -962,7 +966,7 @@ package body Prj is ...@@ -962,7 +966,7 @@ package body Prj is
-- Private part table -- 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_Source_Path_File := No_Path;
Tree.Private_Part.Current_Object_Path_File := No_Path; Tree.Private_Part.Current_Object_Path_File := No_Path;
......
gcc/ada/prj.ads
...@@ -1442,6 +1442,8 @@ package Prj is ...@@ -1442,6 +1442,8 @@ package Prj is
Source_Paths_HT : Source_Paths_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id -- 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; Source_Info_File_Name : String_Access := null;
-- The name of the source info file, if specified by the builder -- The name of the source info file, if specified by the builder
......
gcc/ada/s-taprop-linux.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -81,9 +81,6 @@ package body System.Task_Primitives.Operations is ...@@ -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. -- 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 -- 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; Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task -- A variable to hold Task_Id for the environment task
......
gcc/ada/s-taprop-posix.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -83,9 +83,6 @@ package body System.Task_Primitives.Operations is ...@@ -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. -- 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 -- 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; Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task -- A variable to hold Task_Id for the environment task
......
gcc/ada/s-taprop-tru64.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -77,9 +77,6 @@ package body System.Task_Primitives.Operations is ...@@ -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. -- 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 -- 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; Environment_Task_Id : Task_Id;
-- A variable to hold Task_Id for the environment task -- A variable to hold Task_Id for the environment task
......
gcc/ada/s-tpopsp-posix-foreign.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,12 +32,12 @@ ...@@ -32,12 +32,12 @@
-- This is a POSIX version of this package where foreign threads are -- This is a POSIX version of this package where foreign threads are
-- recognized. -- recognized.
-- Currently, DEC Unix, SCO UnixWare, Solaris pthread, HPUX pthread and
-- GNU/Linux threads use this version.
separate (System.Task_Primitives.Operations) separate (System.Task_Primitives.Operations)
package body Specific is package body Specific is
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
......
gcc/ada/s-tpopsp-posix.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -34,6 +34,9 @@ ...@@ -34,6 +34,9 @@
separate (System.Task_Primitives.Operations) separate (System.Task_Primitives.Operations)
package body Specific is package body Specific is
ATCB_Key : aliased pthread_key_t;
-- Key used to find the Ada Task_Id associated with a thread
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
......
gcc/ada/s-tpopsp-tls.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/sem_ch13.adb
...@@ -2841,6 +2841,7 @@ package body Sem_Ch13 is ...@@ -2841,6 +2841,7 @@ package body Sem_Ch13 is
Choice : Node_Id; Choice : Node_Id;
Val : Uint; Val : Uint;
Err : Boolean := False; 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)); Lo : constant Uint := Expr_Value (Type_Low_Bound (Universal_Integer));
Hi : constant Uint := Expr_Value (Type_High_Bound (Universal_Integer)); Hi : constant Uint := Expr_Value (Type_High_Bound (Universal_Integer));
...@@ -2985,45 +2986,51 @@ package body Sem_Ch13 is ...@@ -2985,45 +2986,51 @@ package body Sem_Ch13 is
else else
Analyze_And_Resolve (Choice, Enumtype); Analyze_And_Resolve (Choice, Enumtype);
if Error_Posted (Choice) then
if Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Error_Msg_N ("subtype name not allowed here", Choice);
Err := True; Err := True;
-- ??? should allow static subtype with zero/one entry end if;
elsif Etype (Choice) = Base_Type (Enumtype) then if not Err then
if not Is_Static_Expression (Choice) then if Is_Entity_Name (Choice)
Flag_Non_Static_Expr and then Is_Type (Entity (Choice))
("non-static expression used for choice!", Choice); then
Error_Msg_N ("subtype name not allowed here", Choice);
Err := True; Err := True;
-- ??? should allow static subtype with zero/one entry
else elsif Etype (Choice) = Base_Type (Enumtype) then
Elit := Expr_Value_E (Choice); if not Is_Static_Expression (Choice) then
Flag_Non_Static_Expr
if Present (Enumeration_Rep_Expr (Elit)) then ("non-static expression used for choice!", Choice);
Error_Msg_Sloc := Sloc (Enumeration_Rep_Expr (Elit));
Error_Msg_NE
("representation for& previously given#",
Choice, Elit);
Err := True; Err := True;
end if;
Set_Enumeration_Rep_Expr (Elit, Expression (Assoc)); 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;
Expr := Expression (Assoc); Set_Enumeration_Rep_Expr (Elit, Expression (Assoc));
Val := Static_Integer (Expr);
if Val = No_Uint then Expr := Expression (Assoc);
Err := True; Val := Static_Integer (Expr);
elsif Val < Lo or else Hi < Val then if Val = No_Uint then
Error_Msg_N ("value outside permitted range", Expr); Err := True;
Err := True;
end if; 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); Set_Enumeration_Rep (Elit, Val);
end if;
end if; end if;
end if; end if;
end if; end if;
......
gcc/ada/sem_ch7.adb
...@@ -1516,8 +1516,8 @@ package body Sem_Ch7 is ...@@ -1516,8 +1516,8 @@ package body Sem_Ch7 is
procedure Declare_Inherited_Private_Subprograms (Id : Entity_Id) is procedure Declare_Inherited_Private_Subprograms (Id : Entity_Id) is
function Is_Primitive_Of (T : Entity_Id; S : Entity_Id) return Boolean; function Is_Primitive_Of (T : Entity_Id; S : Entity_Id) return Boolean;
-- Check whether an inherited subprogram is an operation of an untagged -- Check whether an inherited subprogram S is an operation of an
-- derived type. -- untagged derived type T.
--------------------- ---------------------
-- Is_Primitive_Of -- -- Is_Primitive_Of --
......
gcc/ada/system-aix.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- (AIX/PPC Version) -- -- (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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -149,7 +149,7 @@ private ...@@ -149,7 +149,7 @@ private
Always_Compatible_Rep : constant Boolean := True; Always_Compatible_Rep : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False; ZCX_By_Default : constant Boolean := True;
GCC_ZCX_Support : constant Boolean := True; -- Post GCC 4 only GCC_ZCX_Support : constant Boolean := True;
end System; end System;
gcc/ada/system-aix64.ads
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- S p e c -- -- S p e c --
-- (PPC/AIX64 Version) -- -- (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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -149,7 +149,7 @@ private ...@@ -149,7 +149,7 @@ private
Always_Compatible_Rep : constant Boolean := True; Always_Compatible_Rep : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False; ZCX_By_Default : constant Boolean := True;
GCC_ZCX_Support : constant Boolean := True; -- Post GCC 4 only GCC_ZCX_Support : constant Boolean := True;
end System; end System;
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