+2014-07-30 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_prag.adb, a-tags.ads: Minor typo fixes.
+
+2014-07-30 Bob Duff <duff@adacore.com>
+
+ * a-excach.adb, a-excach-cert.adb, a-except-2005.ads,
+ a-except.ads, g-traceb.adb, memtrack.adb,
+ s-traceb.adb, s-traceb.ads, s-traceb-hpux.adb, s-traceb-mastop.adb:
+ Cleanup: Make the three versions of System.Traceback.Call_Chain
+ have the same interface. Use an array for the Traceback parameter
+ instead of an Address. This will enable reduction in code
+ duplication.
+
+2014-07-30 Pat Rogers <rogers@adacore.com>
+
+ * gnat_ugn.texi: Corrected minor textual error in description
+ of switch -gnatwl.
+
+2014-07-30 Bob Duff <duff@adacore.com>
+
+ * Makefile.rtl: Sort file names.
+
+2014-07-30 Arnaud Charlet <charlet@adacore.com>
+
+ * a-tasatt.adb: Complete previous change: kill spurious warning
+ on e.g. sparc, and make sure we only use the fast path when the
+ alignment is compatible.
+
+2014-07-30 Yannick Moy <moy@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Mark new Spec_Id as
+ coming from source.
+
2014-07-30 Yannick Moy <moy@adacore.com>
* inline.adb (Build_Body_To_Inline): Issue more precise messages
a-calend$(objext) \
a-calfor$(objext) \
a-catizo$(objext) \
+ a-cbdlli$(objext) \
a-cbhama$(objext) \
a-cbhase$(objext) \
- a-cborse$(objext) \
- a-cbdlli$(objext) \
a-cbmutr$(objext) \
a-cborma$(objext) \
+ a-cborse$(objext) \
a-cbprqu$(objext) \
a-cbsyqu$(objext) \
a-cdlili$(objext) \
a-charac$(objext) \
a-chlat1$(objext) \
a-chlat9$(objext) \
- a-chtgbo$(objext) \
a-chtgbk$(objext) \
+ a-chtgbo$(objext) \
a-chtgke$(objext) \
a-chtgop$(objext) \
a-chzla1$(objext) \
a-cidlli$(objext) \
a-cihama$(objext) \
a-cihase$(objext) \
+ a-cimutr$(objext) \
a-ciorma$(objext) \
a-ciormu$(objext) \
a-ciorse$(objext) \
a-clrefi$(objext) \
+ a-cobove$(objext) \
+ a-cofove$(objext) \
a-cogeso$(objext) \
a-cohama$(objext) \
a-cohase$(objext) \
a-colien$(objext) \
a-colire$(objext) \
a-comlin$(objext) \
+ a-comutr$(objext) \
a-contai$(objext) \
a-convec$(objext) \
- a-cobove$(objext) \
- a-cofove$(objext) \
a-coorma$(objext) \
a-coormu$(objext) \
a-coorse$(objext) \
a-crbtgk$(objext) \
a-crbtgo$(objext) \
a-crdlli$(objext) \
- a-comutr$(objext) \
- a-cimutr$(objext) \
a-csquin$(objext) \
a-cuprqu$(objext) \
a-cusyqu$(objext) \
a-nlcoar$(objext) \
a-nlcoty$(objext) \
a-nlelfu$(objext) \
- a-nlrear$(objext) \
a-nllcar$(objext) \
a-nllcef$(objext) \
a-nllcty$(objext) \
a-nllefu$(objext) \
a-nllrar$(objext) \
+ a-nlrear$(objext) \
a-nscefu$(objext) \
a-nscoty$(objext) \
a-nselfu$(objext) \
a-numaux$(objext) \
a-numeri$(objext) \
a-nurear$(objext) \
- a-rbtgbo$(objext) \
a-rbtgbk$(objext) \
+ a-rbtgbo$(objext) \
a-rbtgso$(objext) \
a-sbecin$(objext) \
a-sbhcin$(objext) \
s-crc32$(objext) \
s-crtl$(objext) \
s-diflio$(objext) \
- s-dim$(objext) \
s-diinio$(objext) \
+ s-dim$(objext) \
s-dimkio$(objext) \
s-dimmks$(objext) \
s-direio$(objext) \
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, 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- --
-- outside the AAA/ZZZ range.
System.Traceback.Call_Chain
- (Traceback => Excep.Tracebacks'Address,
+ (Traceback => Excep.Tracebacks,
Max_Len => Max_Tracebacks,
Len => Excep.Num_Tracebacks,
Exclude_Min => Code_Address_For_AAA,
Max_Tracebacks : constant := 50;
-- Maximum number of trace backs stored in exception occurrence
- type Tracebacks_Array is array (1 .. Max_Tracebacks) of TBE.Traceback_Entry;
+ subtype Tracebacks_Array is TBE.Tracebacks_Array (1 .. Max_Tracebacks);
-- Traceback array stored in exception occurrence
type Exception_Occurrence is record
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Max_Tracebacks : constant := 50;
-- Maximum number of trace backs stored in exception occurrence
- type Tracebacks_Array is array (1 .. Max_Tracebacks) of TBE.Traceback_Entry;
+ subtype Tracebacks_Array is TBE.Tracebacks_Array (1 .. Max_Tracebacks);
-- Traceback array stored in exception occurrence
type Exception_Occurrence is record
-- Descendant_Tag (when used with a library-level tagged type),
-- Internal_Tag (when used with a library-level tagged type).
--- The following subprograms of the public part of this package take non
--- constant time (in terms of sources line executed):
+-- The following subprograms of the public part of this package execute in
+-- time that is not constant (in terms of sources line executed):
-- Internal_Tag (when used with a locally defined tagged type), because in
--- such case this routine processes the external tag, extract from it an
--- address available there, and convert it into the tag value returned by
+-- such cases this routine processes the external tag, extracts from it an
+-- address available there, and converts it into the tag value returned by
-- this function. The number of instructions executed is not constant since
-- it depends on the length of the external tag string.
Fast_Path : constant Boolean :=
Attribute'Size <= Atomic_Address'Size
+ and then Attribute'Alignment <= Atomic_Address'Alignment
and then To_Address (Initial_Value) = 0;
- -- If the attribute fits in an Atomic_Address and Initial_Value is 0 (or
- -- null), then we will map the attribute directly into
- -- ATCB.Attributes (Index), otherwise we will create a level of indirection
- -- and instead use Attributes (Index) as a Real_Attribute_Access.
+ -- If the attribute fits in an Atomic_Address (both size and alignment)
+ -- and Initial_Value is 0 (or null), then we will map the attribute
+ -- directly into ATCB.Attributes (Index), otherwise we will create a level
+ -- of indirection and instead use Attributes (Index) as a
+ -- Real_Attribute_Access.
Index : constant Integer :=
Next_Index (Require_Finalization => not Fast_Path);
end if;
if Fast_Path then
+ -- Kill warning about possible alignment mismatch. If this happens,
+ -- Fast_Path will be False anyway
+ pragma Warnings (Off);
return To_Handle (TT.Attributes (Index)'Address);
+ pragma Warnings (On);
else
Self_Id := STPO.Self;
Task_Lock (Self_Id);
-- Generate a temporary to capture the value of the prefix:
-- Temp : <Pref type>;
-- Place that temporary at the beginning of declarations, to
- -- prevent anomolies in the GNATprove flow analysis pass in
+ -- prevent anomalies in the GNATprove flow-analysis pass in
-- the precondition procedure that follows.
Decl :=
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2010, AdaCore --
+-- Copyright (C) 1999-2014, 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- --
Len : out Natural)
is
begin
- System.Traceback.Call_Chain (Traceback'Address, Traceback'Length, Len);
+ System.Traceback.Call_Chain (Traceback, Traceback'Length, Len);
end Call_Chain;
end GNAT.Traceback;
@emph{Activate warnings for elaboration pragmas.}
@cindex @option{-gnatwl} (@command{gcc})
@cindex Elaboration, warnings
-This switch activates warnings on missing
-for possible elaboration problems, including suspicious use
+This switch activates warnings for possible elaboration problems,
+including suspicious use
of @code{Elaborate} pragmas, when using the static elaboration model, and
possible situations that may raise @code{Program_Error} when using the
dynamic elaboration model.
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, 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- --
Max_Call_Stack : constant := 200;
-- Maximum number of frames supported
- Tracebk : aliased array (0 .. Max_Call_Stack) of Traceback_Entry;
+ Tracebk : Tracebacks_Array (1 .. Max_Call_Stack);
Num_Calls : aliased Integer := 0;
Gmemfname : constant String := "gmem.out" & ASCII.NUL;
end if;
Timestamp := System.OS_Primitives.Clock;
- Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
+ Call_Chain (Tracebk, Max_Call_Stack, Num_Calls,
Skip_Frames => 2);
fputc (Character'Pos ('A'), Gmemfile);
fwrite (Result'Address, Address_Size, 1, Gmemfile);
Gmem_Initialize;
end if;
- Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
+ Call_Chain (Tracebk, Max_Call_Stack, Num_Calls,
Skip_Frames => 2);
Timestamp := System.OS_Primitives.Clock;
fputc (Character'Pos ('D'), Gmemfile);
if Needs_Init then
Gmem_Initialize;
end if;
- Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
+ Call_Chain (Tracebk, Max_Call_Stack, Num_Calls,
Skip_Frames => 2);
Timestamp := System.OS_Primitives.Clock;
fputc (Character'Pos ('D'), Gmemfile);
-- --
-- B o d y --
-- --
--- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2014, 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- --
-- but it is not usable when frames with dynamically allocated space are
-- on the way.
+ procedure Call_Chain
+ (Traceback : System.Address;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1);
+ -- Same as the exported version, but takes Traceback as an Address
+
------------------
-- C_Call_Chain --
------------------
Len := J - 1;
end Call_Chain;
+ procedure Call_Chain
+ (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1)
+ is
+ begin
+ Call_Chain
+ (Traceback'Address, Max_Len, Len,
+ Exclude_Min, Exclude_Max, Skip_Frames);
+ end Call_Chain;
+
end System.Traceback;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2010, AdaCore --
+-- Copyright (C) 1999-2014, 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- --
use System.Machine_State_Operations;
+ procedure Call_Chain
+ (Traceback : System.Address;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1);
+ -- Same as the exported version, but takes Traceback as an Address
+
----------------
-- Call_Chain --
----------------
Free_Machine_State (M);
end Call_Chain;
+ procedure Call_Chain
+ (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1)
+ is
+ begin
+ Call_Chain
+ (Traceback'Address, Max_Len, Len,
+ Exclude_Min, Exclude_Max, Skip_Frames);
+ end Call_Chain;
+
------------------
-- C_Call_Chain --
------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2014, 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- --
package body System.Traceback is
+ procedure Call_Chain
+ (Traceback : System.Address;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1);
+ -- Same as the exported version, but takes Traceback as an Address
+
------------------
-- C_Call_Chain --
------------------
Skip_Frames => Skip_Frames + 1);
end Call_Chain;
+ procedure Call_Chain
+ (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1)
+ is
+ begin
+ Call_Chain
+ (Traceback'Address, Max_Len, Len,
+ Exclude_Min, Exclude_Max, Skip_Frames);
+ end Call_Chain;
+
end System.Traceback;
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2014, 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- --
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with System.Exception_Tables.
+with System.Traceback_Entries;
+
package System.Traceback is
----------------
----------------
procedure Call_Chain
- (Traceback : System.Address;
+ (Traceback : in out System.Traceback_Entries.Tracebacks_Array;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Spec_Id := Defining_Entity (New_Decl);
+ -- As Body_Id originally comes from source, mark the new
+ -- Spec_Id as such, which is required so that calls to
+ -- this subprogram are registered in the local effects
+ -- stored in ALI files for GNATprove.
+
+ Set_Comes_From_Source (Spec_Id, True);
+
-- If aspect SPARK_Mode was specified on the body, it
-- needs to be repeated on the generated decl and the
-- body. Since the original aspect was moved to the
projects / gcc.git / commitdiff