+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
#include <sys/stat.h>
#include <fcntl.h>
#include <time.h>
-
#ifdef VMS
#include <unixio.h>
#endif
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;
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;
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.
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
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
* *
* 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- *
FindClose (hDir);
- free (dir);
+ if (dir != NULL)
+ free (dir);
}
}
else
__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))
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;
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;
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;
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;
-- GCC built-in atomic primitives --
------------------------------------
- function Atomic_Compare_Exchange_8
+ function Atomic_Load_8
+ (Ptr : Address;
+ Model : Mem_Model := Seq_Cst) return uint8;
+ pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
+
+ function Atomic_Load_16
+ (Ptr : Address;
+ Model : Mem_Model := Seq_Cst) return uint16;
+ pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
+
+ function Atomic_Load_32
+ (Ptr : Address;
+ Model : Mem_Model := Seq_Cst) return uint32;
+ pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
+
+ function Atomic_Load_64
+ (Ptr : Address;
+ 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,
- Atomic_Compare_Exchange_8,
+ Sync_Compare_And_Swap_8,
"__sync_val_compare_and_swap_1");
-- ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
- -- function Atomic_Compare_Exchange_8
+ -- function Sync_Compare_And_Swap_8
-- (Ptr : Address;
-- Expected : Address;
-- Desired : uint8;
-- Success_Model : Mem_Model := Seq_Cst;
-- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
-- pragma Import (Intrinsic,
- -- Atomic_Compare_Exchange_8,
+ -- Sync_Compare_And_Swap_8,
-- "__atomic_compare_exchange_1");
- function Atomic_Compare_Exchange_16
+ function Sync_Compare_And_Swap_16
(Ptr : Address;
Expected : uint16;
Desired : uint16) return uint16;
pragma Import (Intrinsic,
- Atomic_Compare_Exchange_16,
+ Sync_Compare_And_Swap_16,
"__sync_val_compare_and_swap_2");
- function Atomic_Compare_Exchange_32
+ function Sync_Compare_And_Swap_32
(Ptr : Address;
Expected : uint32;
Desired : uint32) return uint32;
pragma Import (Intrinsic,
- Atomic_Compare_Exchange_32,
+ Sync_Compare_And_Swap_32,
"__sync_val_compare_and_swap_4");
- function Atomic_Compare_Exchange_64
+ function Sync_Compare_And_Swap_64
(Ptr : Address;
Expected : uint64;
- Desired : uint64) return uint64;
+ Desired : uint64) return Boolean;
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;
- pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
-
- function Atomic_Load_16
- (Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint16;
- pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
-
- function Atomic_Load_32
- (Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint32;
- pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
-
- function Atomic_Load_64
- (Ptr : Address;
- Model : Mem_Model := Seq_Cst) return uint64;
- pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
+ Sync_Compare_And_Swap_64,
+ "__sync_bool_compare_and_swap_8");
--------------------------
-- Lock-free operations --
-- * 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));
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;
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);
-- --
-- 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- --
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;
-------------
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;
-- --
-- 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- --
-- 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;
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'
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;