OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* gnat_rm.texi: Adjust previous change.

2012-07-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Process_Import_Or_Interface): If the pragma
	comes from an aspect, it applies to the corresponding entity
	without further check.

2012-07-17  Olivier Hainque  <hainque@adacore.com>

	* initialize.c (__gnat_initialize for VxWorks): Remove section with
	call to __gnat_vxw_setup_for_eh.
	* system-vxworks-ppc.ads: Add -auto-register to -crtbe, relying
	on the VxWorks constructor mechanism for network loaded modules
	by default.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* adaint.c: Minor reformatting.

2012-07-17  Pascal Obry  <obry@adacore.com>

	* s-regexp.adb (Adjust): Fix access violation in Adjust.

2012-07-17  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): Warn if an imported subprogram
	has pre/post conditions, because these will not be enforced.

2012-07-17  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch7.adb (Process_Transient_Objects): Put all the
	finalization blocks and the final raise statement into a wrapper
	block.

2012-07-17  Vincent Pucci  <pucci@adacore.com>

	* s-atopri.adb (Lock_Free_Try_Write_X): Atomic_Compare_Exchange_X
	replaced by Sync_Compare_And_Swap_X.
	(Lock_Free_Try_Write_64): Removed.
	* s-atopri.ads (Sync_Compare_And_Swap_X): Replaces previous
	routine Atomic_Compare_Exchange_X.
	(Lock_Free_Read_64): Renaming of Atomic_Load_64.
	(Lock_Free_Try_Write_64): Renaming of Sync_Compare_And_Swap_64.

2012-07-17  Vincent Celier  <celier@adacore.com>

	* switch-m.adb (Normalize_Compiler_Switches): Recognize new
	switches -gnatn1 and -gnatn2.

2012-07-17  Vincent Pucci  <pucci@adacore.com>

	* gnat_ugn.texi: GNAT dimensionality checking
	documentation updated with System.Dim.Mks modifications.

2012-07-17  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb: sloc of array init_proc is sloc of type declaration.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (get_call_site_action_for): Remove useless init
	expression for p.
	(get_action_description_for): Do not overwrite action->kind.

2012-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Add local variables Attr
	and Conversion_Added.  Add local constant Typ.
	Retrieve the original attribute after the arithmetic check
	machinery has modified the node. Add a conversion to the target
	type when the prefix of attribute Max_Size_In_Storage_Elements
	is a controlled type.

2012-07-17  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch6.adb (Expand_Inlined_Call): For each actual parameter
	of mode 'out' or 'in out' that denotes an entity, reset
	Last_Assignment on the entity so that any assignments to the
	corresponding formal in the inlining will not trigger spurious
	warnings about overwriting assignments.

From-SVN: r189569
This commit is contained in:
Arnaud Charlet 2012-07-17 12:14:38 +02:00
parent e3b3266c50
commit 79ee6ab38b
12 changed files with 205 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
gcc/ada/ChangeLog
View File

@ -1,3 +1,87 @@
2012-07-17 Tristan Gingold <gingold@adacore.com>
* gnat_rm.texi: Adjust previous change.
2012-07-17 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Process_Import_Or_Interface): If the pragma
comes from an aspect, it applies to the corresponding entity
without further check.
2012-07-17 Olivier Hainque <hainque@adacore.com>
* initialize.c (__gnat_initialize for VxWorks): Remove section with
call to __gnat_vxw_setup_for_eh.
* system-vxworks-ppc.ads: Add -auto-register to -crtbe, relying
on the VxWorks constructor mechanism for network loaded modules
by default.
2012-07-17 Tristan Gingold <gingold@adacore.com>
* adaint.c: Minor reformatting.
2012-07-17 Pascal Obry <obry@adacore.com>
* s-regexp.adb (Adjust): Fix access violation in Adjust.
2012-07-17 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Freeze_Entity): Warn if an imported subprogram
has pre/post conditions, because these will not be enforced.
2012-07-17 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch7.adb (Process_Transient_Objects): Put all the
finalization blocks and the final raise statement into a wrapper
block.
2012-07-17 Vincent Pucci <pucci@adacore.com>
* s-atopri.adb (Lock_Free_Try_Write_X): Atomic_Compare_Exchange_X
replaced by Sync_Compare_And_Swap_X.
(Lock_Free_Try_Write_64): Removed.
* s-atopri.ads (Sync_Compare_And_Swap_X): Replaces previous
routine Atomic_Compare_Exchange_X.
(Lock_Free_Read_64): Renaming of Atomic_Load_64.
(Lock_Free_Try_Write_64): Renaming of Sync_Compare_And_Swap_64.
2012-07-17 Vincent Celier <celier@adacore.com>
* switch-m.adb (Normalize_Compiler_Switches): Recognize new
switches -gnatn1 and -gnatn2.
2012-07-17 Vincent Pucci <pucci@adacore.com>
* gnat_ugn.texi: GNAT dimensionality checking
documentation updated with System.Dim.Mks modifications.
2012-07-17 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb: sloc of array init_proc is sloc of type declaration.
2012-07-17 Tristan Gingold <gingold@adacore.com>
* raise-gcc.c (get_call_site_action_for): Remove useless init
expression for p.
(get_action_description_for): Do not overwrite action->kind.
2012-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Add local variables Attr
and Conversion_Added. Add local constant Typ.
Retrieve the original attribute after the arithmetic check
machinery has modified the node. Add a conversion to the target
type when the prefix of attribute Max_Size_In_Storage_Elements
is a controlled type.
2012-07-17 Gary Dismukes <dismukes@adacore.com>
* exp_ch6.adb (Expand_Inlined_Call): For each actual parameter
of mode 'out' or 'in out' that denotes an entity, reset
Last_Assignment on the entity so that any assignments to the
corresponding formal in the inlining will not trigger spurious
warnings about overwriting assignments.
2012-07-17 Robert Dewar <dewar@adacore.com>
* s-assert.ads: Fix comments to make it clear that this is used

1
gcc/ada/adaint.c
View File

@ -83,7 +83,6 @@ extern "C" {
#include <sys/stat.h>
#include <fcntl.h>
#include <time.h>
#ifdef VMS
#include <unixio.h>
#endif

20
gcc/ada/exp_ch7.adb
View File

@ -4390,6 +4390,7 @@ package body Exp_Ch7 is
Obj_Id : Entity_Id;
Obj_Ref : Node_Id;
Obj_Typ : Entity_Id;
Prev_Fin : Node_Id := Empty;
Stmt : Node_Id;
Stmts : List_Id;
Temp_Id : Entity_Id;
@ -4428,7 +4429,6 @@ package body Exp_Ch7 is
Fin_Decls := New_List;
Build_Object_Declarations (Fin_Data, Fin_Decls, Loc);
Insert_List_Before_And_Analyze (First_Object, Fin_Decls);
Built := True;
end if;
@ -4560,15 +4560,25 @@ package body Exp_Ch7 is
Exception_Handlers => New_List (
Build_Exception_Handler (Fin_Data))));
Insert_After_And_Analyze (Last_Object, Fin_Block);
-- The single raise statement must be inserted after all the
-- finalization blocks. And we put everything into a wrapper
-- block to clearly expose the construct to the back-end.
-- The raise statement must be inserted after all the
-- finalization blocks.
if Present (Prev_Fin) then
Insert_Before_And_Analyze (Prev_Fin, Fin_Block);
else
Insert_After_And_Analyze (Last_Object,
Make_Block_Statement (Loc,
Declarations => Fin_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Fin_Block))));
if No (Last_Fin) then
Last_Fin := Fin_Block;
end if;
Prev_Fin := Fin_Block;
-- When the associated node is an array object, the expander may
-- sometimes generate a loop and create transient objects inside
-- the loop.

15
gcc/ada/freeze.adb
View File

@ -3026,6 +3026,21 @@ package body Freeze is
end if;
end if;
end;
-- Pre/Post conditions are implemented through a subprogram in
-- the corresponding body, and therefore are not checked on an
-- imported subprogram for which the body is not available.
if Is_Subprogram (E)
and then Is_Imported (E)
and then Present (Contract (E))
and then Present (Spec_PPC_List (Contract (E)))
then
Error_Msg_NE ("pre/post conditions on imported subprogram "
& "are not enforced?",
E, Spec_PPC_List (Contract (E)));
end if;
end if;
-- Must freeze its parent first if it is a derived subprogram

5
gcc/ada/gnat_rm.texi
View File

@ -16638,10 +16638,11 @@ This pragma identifies an imported function (imported in the usual way
with pragma @code{Import}) as corresponding to a C++ constructor.
@end table
In addition, C++ exceptions are propagated and can be handled in a
In addition, C++ exceptions are propagated and can be handled in an
@code{others} choice of an exception handler. The corresponding Ada
occurrence has no message, and the simple name of the exception identity
contains @samp{Foreign_Exception}.
contains @samp{Foreign_Exception}. Finalization and awaiting dependent
tasks works properly when such foreign exceptions are propagated.
@node Interfacing to COBOL
@section Interfacing to COBOL

57
gcc/ada/initialize.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. *
* Copyright (C) 1992-2012, 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- *
@ -221,7 +221,8 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
FindClose (hDir);
free (dir);
if (dir != NULL)
free (dir);
}
}
else
@ -280,58 +281,6 @@ void
__gnat_initialize (void *eh)
{
__gnat_init_float ();
/* On targets where we use the ZCX scheme, we need to register the frame
tables at load/startup time.
For applications loaded as a set of "modules", the crtstuff objects
linked in (crtbegin.o/end.o) are tailored to provide this service
automatically, a-la C++ constructor fashion, triggered by the VxWorks
loader thanks to a special variable declaration in crtbegin.o (_ctors).
Automatic de-registration is handled symmetrically, a-la C++ destructor
fashion (with a _dtors variable also in crtbegin.o) triggered by the
dynamic unloader.
Note that since the tables shall be registered against a common
data structure, libgcc should be one of the modules (vs being partially
linked against all the others at build time) and shall be loaded first.
For applications linked with the kernel, the scheme above would lead to
duplicated symbols because the VxWorks kernel build "munches" by default,
so we link against crtbeginT.o instead of crtbegin.o, which doesn't
include the special variables. We know which set of crt objects is used
thanks to a boolean indicator present in both sets (__module_has_ctors),
and directly call the appropriate function here in the not-automatic
case. We'll never unload that, so there is no de-registration to worry
about.
For whole applications loaded as a single module, we may use one scheme
or the other, except for the mixed Ada/C++ case in which the first scheme
would fail for the same reason as in the linked-with-kernel situation.
The crt set selection is controlled by command line options via GCC's
STARTFILE_SPEC in rs6000/vxworks.h. This is tightly synchronized with a
number of other GCC configuration and crtstuff changes, and we need to
ensure that those changes are there to activate this circuitry. */
#if (__GNUC__ >= 3) && (defined (_ARCH_PPC) || defined (__ppc))
{
/* The scheme described above is only useful for the actual ZCX case, and
we don't want any reference to the crt provided symbols otherwise. We
may not link with any of the crt objects in the non-ZCX case, e.g. from
documented procedures instructing the use of -nostdlib, and references
to the ctors symbols here would just remain unsatisfied.
We have no way to avoid those references in the right conditions in this
C module, because we have nothing like a IN_ZCX_RTS macro. This aspect
is then deferred to an Ada routine, which can do that based on a test
against a constant System flag value. */
extern void __gnat_vxw_setup_for_eh (void);
__gnat_vxw_setup_for_eh ();
}
#endif
}
#elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10))

30
gcc/ada/s-atopri.adb
View File

@ -44,7 +44,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
Actual := Atomic_Compare_Exchange_8 (Ptr, Expected, Desired);
Actual := Sync_Compare_And_Swap_8 (Ptr, Expected, Desired);
if Actual /= Expected then
Expected := Actual;
@ -68,7 +68,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
Actual := Atomic_Compare_Exchange_16 (Ptr, Expected, Desired);
Actual := Sync_Compare_And_Swap_16 (Ptr, Expected, Desired);
if Actual /= Expected then
Expected := Actual;
@ -92,7 +92,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
Actual := Atomic_Compare_Exchange_32 (Ptr, Expected, Desired);
Actual := Sync_Compare_And_Swap_32 (Ptr, Expected, Desired);
if Actual /= Expected then
Expected := Actual;
@ -102,28 +102,4 @@ package body System.Atomic_Primitives is
return True;
end Lock_Free_Try_Write_32;
----------------------------
-- Lock_Free_Try_Write_64 --
----------------------------
function Lock_Free_Try_Write_64
(Ptr : Address;
Expected : in out uint64;
Desired : uint64) return Boolean
is
Actual : uint64;
begin
if Expected /= Desired then
Actual := Atomic_Compare_Exchange_64 (Ptr, Expected, Desired);
if Actual /= Expected then
Expected := Actual;
return False;
end if;
end if;
return True;
end Lock_Free_Try_Write_64;
end System.Atomic_Primitives;

101
gcc/ada/s-atopri.ads
View File

@ -62,50 +62,6 @@ package System.Atomic_Primitives is
-- GCC built-in atomic primitives --
------------------------------------
function Atomic_Compare_Exchange_8
(Ptr : Address;
Expected : uint8;
Desired : uint8) return uint8;
pragma Import (Intrinsic,
Atomic_Compare_Exchange_8,
"__sync_val_compare_and_swap_1");
-- ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
-- function Atomic_Compare_Exchange_8
-- (Ptr : Address;
-- Expected : Address;
-- Desired : uint8;
-- Weak : Boolean := False;
-- Success_Model : Mem_Model := Seq_Cst;
-- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
-- pragma Import (Intrinsic,
-- Atomic_Compare_Exchange_8,
-- "__atomic_compare_exchange_1");
function Atomic_Compare_Exchange_16
(Ptr : Address;
Expected : uint16;
Desired : uint16) return uint16;
pragma Import (Intrinsic,
Atomic_Compare_Exchange_16,
"__sync_val_compare_and_swap_2");
function Atomic_Compare_Exchange_32
(Ptr : Address;
Expected : uint32;
Desired : uint32) return uint32;
pragma Import (Intrinsic,
Atomic_Compare_Exchange_32,
"__sync_val_compare_and_swap_4");
function Atomic_Compare_Exchange_64
(Ptr : Address;
Expected : uint64;
Desired : uint64) return uint64;
pragma Import (Intrinsic,
Atomic_Compare_Exchange_64,
"__sync_val_compare_and_swap_8");
function Atomic_Load_8
(Ptr : Address;
Model : Mem_Model := Seq_Cst) return uint8;
@ -126,6 +82,50 @@ package System.Atomic_Primitives is
Model : Mem_Model := Seq_Cst) return uint64;
pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
function Sync_Compare_And_Swap_8
(Ptr : Address;
Expected : uint8;
Desired : uint8) return uint8;
pragma Import (Intrinsic,
Sync_Compare_And_Swap_8,
"__sync_val_compare_and_swap_1");
-- ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
-- function Sync_Compare_And_Swap_8
-- (Ptr : Address;
-- Expected : Address;
-- Desired : uint8;
-- Weak : Boolean := False;
-- Success_Model : Mem_Model := Seq_Cst;
-- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
-- pragma Import (Intrinsic,
-- Sync_Compare_And_Swap_8,
-- "__atomic_compare_exchange_1");
function Sync_Compare_And_Swap_16
(Ptr : Address;
Expected : uint16;
Desired : uint16) return uint16;
pragma Import (Intrinsic,
Sync_Compare_And_Swap_16,
"__sync_val_compare_and_swap_2");
function Sync_Compare_And_Swap_32
(Ptr : Address;
Expected : uint32;
Desired : uint32) return uint32;
pragma Import (Intrinsic,
Sync_Compare_And_Swap_32,
"__sync_val_compare_and_swap_4");
function Sync_Compare_And_Swap_64
(Ptr : Address;
Expected : uint64;
Desired : uint64) return Boolean;
pragma Import (Intrinsic,
Sync_Compare_And_Swap_64,
"__sync_bool_compare_and_swap_8");
--------------------------
-- Lock-free operations --
--------------------------
@ -136,8 +136,8 @@ package System.Atomic_Primitives is
-- * Lock_Free_Read_N atomically loads the value of the protected component
-- accessed by the current protected operation.
-- * Lock_Free_Try_Write_N tries to write the the Desired value into Ptr
-- only if Expected and Desired mismatch.
-- * Lock_Free_Try_Write_N tries to write the Desired value into Ptr only
-- if Expected and Desired mismatch.
function Lock_Free_Read_8 (Ptr : Address) return uint8 is
(Atomic_Load_8 (Ptr, Acquire));
@ -148,8 +148,9 @@ package System.Atomic_Primitives is
function Lock_Free_Read_32 (Ptr : Address) return uint32 is
(Atomic_Load_32 (Ptr, Acquire));
function Lock_Free_Read_64 (Ptr : Address) return uint64 is
(Atomic_Load_64 (Ptr, Acquire));
function Lock_Free_Read_64
(Ptr : Address;
Model : Mem_Model := Seq_Cst) return uint64 renames Atomic_Load_64;
function Lock_Free_Try_Write_8
(Ptr : Address;
@ -168,8 +169,8 @@ package System.Atomic_Primitives is
function Lock_Free_Try_Write_64
(Ptr : Address;
Expected : in out uint64;
Desired : uint64) return Boolean;
Expected : uint64;
Desired : uint64) return Boolean renames Sync_Compare_And_Swap_64;
pragma Inline (Lock_Free_Read_8);
pragma Inline (Lock_Free_Read_16);

12
gcc/ada/s-regexp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2010, AdaCore --
-- Copyright (C) 1999-2012, AdaCore --
-- --
-- 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- --
@ -100,10 +100,12 @@ package body System.Regexp is
Tmp : Regexp_Access;
begin
Tmp := new Regexp_Value (Alphabet_Size => R.R.Alphabet_Size,
Num_States => R.R.Num_States);
Tmp.all := R.R.all;
R.R := Tmp;
if R.R /= null then
Tmp := new Regexp_Value (Alphabet_Size => R.R.Alphabet_Size,
Num_States => R.R.Num_States);
Tmp.all := R.R.all;
R.R := Tmp;
end if;
end Adjust;
-------------

4
gcc/ada/sem_prag.adb
View File

@ -4555,10 +4555,12 @@ package body Sem_Prag is
null;
-- Verify that the homonym is in the same declarative part (not
-- just the same scope).
-- just the same scope). If the pragma comes from an aspect
-- specification we know that it is part of the declaration.
elsif Parent (Unit_Declaration_Node (Def_Id)) /= Parent (N)
and then Nkind (Parent (N)) /= N_Compilation_Unit_Aux
and then not From_Aspect_Specification (N)
then
exit;

22
gcc/ada/switch-m.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, 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- --
@ -236,7 +236,7 @@ package body Switch.M is
-- One-letter switches
when 'a' | 'A' | 'b' | 'B' | 'c' | 'C' | 'E' | 'f' |
'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'n' | 'N' |
'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'N' |
'o' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 'S' |
't' | 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
Storing (First_Stored) := C;
@ -423,6 +423,24 @@ package body Switch.M is
return;
end if;
-- -gnatn may be -gnatn, -gnatn1 or -gnat2
when 'n' =>
Last_Stored := First_Stored;
Storing (Last_Stored) := 'n';
Ptr := Ptr + 1;
if Ptr <= Max
and then Switch_Chars (Ptr) in '1' .. '2'
then
Last_Stored := Last_Stored + 1;
Storing (Last_Stored) := Switch_Chars (Ptr);
Ptr := Ptr + 1;
end if;
Add_Switch_Component
(Storing (Storing'First .. Last_Stored));
-- -gnatR may be followed by '0', '1', '2' or '3',
-- then by 's'

2
gcc/ada/system-vxworks-ppc.ads
View File

@ -115,7 +115,7 @@ package System is
private
pragma Linker_Options ("-crtbe");
pragma Linker_Options ("-crtbe" & ASCII.NUL & "-auto-register");
-- Required by ZCX on VxWorks kernel
type Address is mod Memory_Size;