Skip to content

R
riscv-gcc-1
Commit 6b6bce61 by Arnaud Charlet
Options

[multiple changes] 

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* a-chtgop.ads, a-chtgop.adb (Delete_Node_At_Index): New
	subprogram, used by all versions of hashed sets, to delete a node
	whose element has been improperly updated through a Reference_
	Preserving key.
	* a-cohase.adb: Remove Delete_Node, use new common procedure
	Delete_Node_At_Index.
	* a-cihase.ads: Add Reference_Control_Type to package Generic_Keys.
	* a-cihase.adb: Add Adjust and Finalize routines for
	Reference_Control_Type.
	(Reference_Preserving_Key): Build aggregate for
	Reference_Control_Type

2014-07-30  Yannick Moy  <moy@adacore.com>

	* checks.adb, checks.ads (Determine_Range_R): New procedure to
	determine the possible range of a floating-point expression.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* a-cborse.ads: Add Reference_Control_Type to package Generic_Keys.
	* a-cborse.adb: Add Adjust and Finalize routines for
	Reference_Control_Type.
	(Reference_Preserving_Key): Build aggregate for
	Reference_Control_Type.
	(Delete): Check for tampering, and raise Program_Error (not
	Constraint_Error) when attempting to delete an element not in
	the set.
	(Insert): Ditto.

2014-07-30  Bob Duff  <duff@adacore.com>

	* a-elchha.adb, a-except-2005.adb, a-except.adb, a-exexda.adb,
	* a-exextr.adb, a-exstat.adb, exp_intr.ads, s-tassta.adb:
	Exception_Information is used to produce useful debugging
	information for the programmer. However, it was also used to
	implement the stream attributes for type Exception_Occurrence. The
	latter requires a stable and portable interface, which meant
	that we couldn't include a symbolic traceback. A separate set of
	routines was used to provide symbolic tracebacks under program
	control (i.e. not automatically). The goal of this ticket is
	to provide such automatic tracebacks, so the change here is to
	split the two functionalities: Exception_Information gives the
	maximally useful information for debugging (i.e. it now includes
	a symbolic traceback when a decorator is set, and it can be
	improved freely in the future without disturbing streaming).
	Untailored_Exception_Information always uses hexadecimal addresses
	in the traceback, has a stable and portable output, and is now
	used for streaming.

2014-07-30  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): Add missing test
	on the target of the assignment to find out whether it
	can be directly done by the back-end.
	* exp_util.adb (Is_Possibly_Unaligned_Slice): Remove obscure test.

From-SVN: r213279
parent facfa165
Showing with 405 additions and 167 deletions
gcc/ada/ChangeLog
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* a-chtgop.ads, a-chtgop.adb (Delete_Node_At_Index): New
subprogram, used by all versions of hashed sets, to delete a node
whose element has been improperly updated through a Reference_
Preserving key.
* a-cohase.adb: Remove Delete_Node, use new common procedure
Delete_Node_At_Index.
* a-cihase.ads: Add Reference_Control_Type to package Generic_Keys.
* a-cihase.adb: Add Adjust and Finalize routines for
Reference_Control_Type.
(Reference_Preserving_Key): Build aggregate for
Reference_Control_Type
2014-07-30 Yannick Moy <moy@adacore.com>
* checks.adb, checks.ads (Determine_Range_R): New procedure to
determine the possible range of a floating-point expression.
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* a-cborse.ads: Add Reference_Control_Type to package Generic_Keys.
* a-cborse.adb: Add Adjust and Finalize routines for
Reference_Control_Type.
(Reference_Preserving_Key): Build aggregate for
Reference_Control_Type.
(Delete): Check for tampering, and raise Program_Error (not
Constraint_Error) when attempting to delete an element not in
the set.
(Insert): Ditto.
2014-07-30 Bob Duff <duff@adacore.com>
* a-elchha.adb, a-except-2005.adb, a-except.adb, a-exexda.adb,
* a-exextr.adb, a-exstat.adb, exp_intr.ads, s-tassta.adb:
Exception_Information is used to produce useful debugging
information for the programmer. However, it was also used to
implement the stream attributes for type Exception_Occurrence. The
latter requires a stable and portable interface, which meant
that we couldn't include a symbolic traceback. A separate set of
routines was used to provide symbolic tracebacks under program
control (i.e. not automatically). The goal of this ticket is
to provide such automatic tracebacks, so the change here is to
split the two functionalities: Exception_Information gives the
maximally useful information for debugging (i.e. it now includes
a symbolic traceback when a decorator is set, and it can be
improved freely in the future without disturbing streaming).
Untailored_Exception_Information always uses hexadecimal addresses
in the traceback, has a stable and portable output, and is now
used for streaming.
2014-07-30 Eric Botcazou <ebotcazou@adacore.com>
* exp_aggr.adb (Expand_Array_Aggregate): Add missing test
on the target of the assignment to find out whether it
can be directly done by the back-end.
* exp_util.adb (Is_Possibly_Unaligned_Slice): Remove obscure test.
2014-07-30 Robert Dewar <dewar@adacore.com>
* inline.adb, a-coorse.adb, a-coorse.ads, a-cohase.adb, a-cohase.ads,
......
gcc/ada/a-cborse.adb
......@@ -482,6 +482,11 @@ package body Ada.Containers.Bounded_Ordered_Sets is
raise Program_Error with "Position cursor designates wrong set";
end if;
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (set is busy)";
end if;
pragma Assert (Vet (Container, Position.Node),
"bad cursor in Delete");
......@@ -496,7 +501,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
begin
if X = 0 then
raise Constraint_Error with "attempt to delete element not in set";
raise Program_Error with "attempt to delete element not in set";
end if;
Tree_Operations.Delete_Node_Sans_Free (Container, X);
......@@ -734,6 +739,23 @@ package body Ada.Containers.Bounded_Ordered_Sets is
Is_Less_Key_Node => Is_Less_Key_Node,
Is_Greater_Key_Node => Is_Greater_Key_Node);
------------
-- Adjust --
------------
procedure Adjust (Control : in out Reference_Control_Type) is
begin
if Control.Container /= null then
declare
B : Natural renames Control.Container.Busy;
L : Natural renames Control.Container.Lock;
begin
B := B + 1;
L := L + 1;
end;
end if;
end Adjust;
-------------
-- Ceiling --
-------------
......@@ -842,6 +864,30 @@ package body Ada.Containers.Bounded_Ordered_Sets is
end if;
end Exclude;
--------------
-- Finalize --
--------------
procedure Finalize (Control : in out Reference_Control_Type) is
begin
if Control.Container /= null then
declare
B : Natural renames Control.Container.Busy;
L : Natural renames Control.Container.Lock;
begin
B := B - 1;
L := L - 1;
end;
if not (Key (Control.Pos) = Control.Old_Key.all) then
Delete (Control.Container.all, Key (Control.Pos));
raise Program_Error;
end if;
Control.Container := null;
end if;
end Finalize;
----------
-- Find --
----------
......@@ -939,15 +985,24 @@ package body Ada.Containers.Bounded_Ordered_Sets is
(Vet (Container, Position.Node),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
declare
N : Node_Type renames Container.Nodes (Position.Node);
B : Natural renames Container.Busy;
L : Natural renames Container.Lock;
begin
return (Element => N.Element'Access);
return R : constant Reference_Type :=
(Element => N.Element'Access,
Control =>
(Controlled with
Container => Container'Access,
Pos => Position,
Old_Key => new Key_Type'(Key (Position))))
do
B := B + 1;
L := L + 1;
end return;
end;
end Reference_Preserving_Key;
function Reference_Preserving_Key
......@@ -963,8 +1018,21 @@ package body Ada.Containers.Bounded_Ordered_Sets is
declare
N : Node_Type renames Container.Nodes (Node);
B : Natural renames Container.Busy;
L : Natural renames Container.Lock;
begin
return (Element => N.Element'Access);
return R : constant Reference_Type :=
(Element => N.Element'Access,
Control =>
(Controlled with
Container => Container'Access,
Pos => Find (Container, Key),
Old_Key => new Key_Type'(Key)))
do
B := B + 1;
L := L + 1;
end return;
end;
end Reference_Preserving_Key;
......@@ -1181,6 +1249,11 @@ package body Ada.Containers.Bounded_Ordered_Sets is
-- Start of processing for Insert_Sans_Hint
begin
if Container.Busy > 0 then
raise Program_Error with
"attemot to tamper with cursors (set is busy)";
end if;
Conditional_Insert_Sans_Hint
(Container,
New_Item,
......
gcc/ada/a-cborse.ads
......@@ -277,11 +277,33 @@ package Ada.Containers.Bounded_Ordered_Sets is
Key : Key_Type) return Reference_Type;
private
type Reference_Type (Element : not null access Element_Type) is
null record;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0;
type Key_Access is access all Key_Type;
use Ada.Streams;
type Reference_Control_Type is
new Ada.Finalization.Controlled with
record
Container : Set_Access;
Pos : Cursor;
Old_Key : Key_Access;
end record;
overriding procedure
Adjust (Control : in out Reference_Control_Type);
pragma Inline (Adjust);
overriding procedure
Finalize (Control : in out Reference_Control_Type);
pragma Inline (Finalize);
type Reference_Type (Element : not null access Element_Type) is record
Control : Reference_Control_Type;
end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Item : out Reference_Type);
......
gcc/ada/a-chtgop.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -195,6 +195,51 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop;
end Clear;
--------------------------
-- Delete_Node_At_Index --
--------------------------
procedure Delete_Node_At_Index
(HT : in out Hash_Table_Type;
Indx : Hash_Type;
X : in out Node_Access)
is
Prev : Node_Access;
Curr : Node_Access;
begin
Prev := HT.Buckets (Indx);
if Prev = X then
HT.Buckets (Indx) := Next (Prev);
HT.Length := HT.Length - 1;
Free (X);
return;
end if;
if HT.Length = 1 then
raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if;
loop
Curr := Next (Prev);
if Curr = null then
raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if;
if Curr = X then
Set_Next (Node => Prev, Next => Next (Curr));
HT.Length := HT.Length - 1;
Free (X);
return;
end if;
Prev := Curr;
end loop;
end Delete_Node_At_Index
;
---------------------------
-- Delete_Node_Sans_Free --
---------------------------
......
gcc/ada/a-chtgop.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -128,6 +128,16 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
-- rehashed onto the new buckets array, and the old buckets array is
-- deallocated. Program_Error is raised if the hash table is busy.
procedure Delete_Node_At_Index
(HT : in out Hash_Table_Type;
Indx : Hash_Type;
X : in out Node_Access);
-- Delete a node whose bucket position is known. Used to remove a node
-- whose element has been modified through a key_preserving reference.
-- We cannot use the value of the element precisely because the current
-- value does not correspond to the hash code that determines the bucket.
procedure Delete_Node_Sans_Free
(HT : in out Hash_Table_Type;
X : Node_Access);
......
gcc/ada/a-cihase.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -2139,6 +2139,24 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Hash => Hash,
Equivalent_Keys => Equivalent_Key_Node);
------------
-- Adjust --
------------
procedure Adjust (Control : in out Reference_Control_Type) is
begin
if Control.Container /= null then
declare
HT : Hash_Table_Type renames Control.Container.HT;
B : Natural renames HT.Busy;
L : Natural renames HT.Lock;
begin
B := B + 1;
L := L + 1;
end;
end if;
end Adjust;
------------------------
-- Constant_Reference --
------------------------
......@@ -2249,6 +2267,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Free (X);
end Exclude;
--------------
-- Finalize --
--------------
procedure Finalize (Control : in out Reference_Control_Type) is
begin
if Control.Container /= null then
declare
HT : Hash_Table_Type renames Control.Container.HT;
B : Natural renames HT.Busy;
L : Natural renames HT.Lock;
begin
B := B - 1;
L := L - 1;
end;
if Hash (Key (Control.Old_Pos)) /= Control.Old_Hash then
HT_Ops.Delete_Node_At_Index
(Control.Container.HT, Control.Index, Control.Old_Pos.Node);
raise Program_Error;
end if;
Control.Container := null;
end if;
end Finalize;
----------
-- Find --
----------
......@@ -2322,11 +2366,25 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
(Vet (Position),
"bad cursor in function Reference_Preserving_Key");
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Position has
-- not changed. ???
declare
HT : Hash_Table_Type renames Container.HT;
B : Natural renames HT.Busy;
L : Natural renames HT.Lock;
return (Element => Position.Node.Element.all'Access);
begin
return R : constant Reference_Type :=
(Element => Position.Node.Element.all'Access,
Control =>
(Controlled with
Container => Container'Access,
Index => HT_Ops.Index (HT, Position.Node),
Old_Pos => Position,
Old_Hash => Hash (Key (Position))))
do
B := B + 1;
L := L + 1;
end return;
end;
end Reference_Preserving_Key;
function Reference_Preserving_Key
......@@ -2345,11 +2403,26 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
raise Program_Error with "Node has no element";
end if;
-- Some form of finalization will be required in order to actually
-- check that the key-part of the element designated by Key has not
-- changed. ???
declare
HT : Hash_Table_Type renames Container.HT;
B : Natural renames HT.Busy;
L : Natural renames HT.Lock;
P : constant Cursor := Find (Container, Key);
return (Element => Node.Element.all'Access);
begin
return R : constant Reference_Type :=
(Element => Node.Element.all'Access,
Control =>
(Controlled with
Container => Container'Access,
Index => HT_Ops.Index (HT, P.Node),
Old_Pos => P,
Old_Hash => Hash (Key)))
do
B := B + 1;
L := L + 1;
end return;
end;
end Reference_Preserving_Key;
-------------
......
gcc/ada/a-cihase.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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 --
......@@ -430,8 +430,29 @@ package Ada.Containers.Indefinite_Hashed_Sets is
Key : Key_Type) return Reference_Type;
private
type Reference_Type (Element : not null access Element_Type)
is null record;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0;
type Reference_Control_Type is
new Ada.Finalization.Controlled with
record
Container : Set_Access;
Index : Hash_Type;
Old_Pos : Cursor;
Old_Hash : Hash_Type;
end record;
overriding procedure
Adjust (Control : in out Reference_Control_Type);
pragma Inline (Adjust);
overriding procedure
Finalize (Control : in out Reference_Control_Type);
pragma Inline (Finalize);
type Reference_Type (Element : not null access Element_Type) is record
Control : Reference_Control_Type;
end record;
use Ada.Streams;
......
gcc/ada/a-cohase.adb
......@@ -132,15 +132,6 @@ package body Ada.Containers.Hashed_Sets is
procedure Write_Nodes is
new HT_Ops.Generic_Write (Write_Node);
procedure Delete_Node
(C : in out Set;
Indx : Hash_Type;
X : in out Node_Access);
-- Delete a node whose bucket position is known. Used to remove a node
-- whose element has been modified through a key_preserving reference.
-- We cannot use the value of the element precisely because the current
-- value does not correspond to the hash code that determines the bucket.
---------
-- "=" --
---------
......@@ -337,48 +328,6 @@ package body Ada.Containers.Hashed_Sets is
Position.Container := null;
end Delete;
procedure Delete_Node
(C : in out Set;
Indx : Hash_Type;
X : in out Node_Access)
is
HT : Hash_Table_Type renames C.HT;
Prev : Node_Access;
Curr : Node_Access;
begin
Prev := HT.Buckets (Indx);
if Prev = X then
HT.Buckets (Indx) := Next (Prev);
HT.Length := HT.Length - 1;
Free (X);
return;
end if;
if HT.Length = 1 then
raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if;
loop
Curr := Next (Prev);
if Curr = null then
raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if;
if Curr = X then
Set_Next (Node => Prev, Next => Next (Curr));
HT.Length := HT.Length - 1;
Free (X);
return;
end if;
Prev := Curr;
end loop;
end Delete_Node;
----------------
-- Difference --
----------------
......@@ -2138,8 +2087,8 @@ package body Ada.Containers.Hashed_Sets is
if Hash (Key (Element (Control.Old_Pos))) /= Control.Old_Hash
then
Delete_Node
(Control.Container.all, Control.Index, Control.Old_Pos.Node);
HT_Ops.Delete_Node_At_Index
(Control.Container.HT, Control.Index, Control.Old_Pos.Node);
raise Program_Error with "key not preserved in reference";
end if;
......
gcc/ada/a-elchha.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2003-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- --
......@@ -53,10 +53,11 @@ is
pragma Import
(Ada, Append_Info_Exception_Message, "__gnat_append_info_e_msg");
procedure Append_Info_Exception_Information
procedure Append_Info_Untailored_Exception_Information
(X : Exception_Occurrence; Info : in out String; Ptr : in out Natural);
pragma Import
(Ada, Append_Info_Exception_Information, "__gnat_append_info_e_info");
(Ada, Append_Info_Untailored_Exception_Information,
"__gnat_append_info_u_e_info");
procedure To_Stderr (S : String);
pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
......@@ -129,7 +130,7 @@ begin
To_Stderr ("Execution terminated by unhandled exception");
To_Stderr (Nline);
Append_Info_Exception_Information (Except, Nobuf, Ptr);
Append_Info_Untailored_Exception_Information (Except, Nobuf, Ptr);
end if;
Unhandled_Terminate;
......
gcc/ada/a-except-2005.adb
......@@ -138,12 +138,17 @@ package body Ada.Exceptions is
-- to contain the indicated Id value and message. Message is a string
-- which is generated as the exception message.
--------------------------------------
-- Exception information subprogram --
--------------------------------------
---------------------------------------
-- Exception information subprograms --
---------------------------------------
function Exception_Information (X : Exception_Occurrence) return String;
-- The format of the exception information is as follows:
function Untailored_Exception_Information
(X : Exception_Occurrence) return String;
-- This is used by Stream_Attributes.EO_To_String to convert an
-- Exception_Occurrence to a String for the stream attributes.
-- String_To_EO understands the format, as documented here.
--
-- The format of the string is as follows:
--
-- Exception_Name: <exception name> (as in Exception_Name)
-- Message: <message> (only if Exception_Message is empty)
......@@ -164,10 +169,6 @@ package body Ada.Exceptions is
-- that an equivalent modification to the routine String_To_EO must be
-- made to preserve proper functioning of the stream attributes.
---------------------------------------
-- Exception backtracing subprograms --
---------------------------------------
-- What is automatically output when exception tracing is on is the
-- usual exception information with the call chain backtrace possibly
-- tailored by a backtrace decorator. Modifying Exception_Information
......@@ -177,28 +178,23 @@ package body Ada.Exceptions is
-- the possibly tailored output, which is equivalent if no decorator is
-- currently set:
function Tailored_Exception_Information
(X : Exception_Occurrence) return String;
-- Exception information to be output in the case of automatic tracing
-- requested through GNAT.Exception_Traces.
function Exception_Information (X : Exception_Occurrence) return String;
-- This is the implementation of Ada.Exceptions.Exception_Information,
-- as defined in the Ada RM.
--
-- This is the same as Exception_Information if no backtrace decorator
-- is currently in place. Otherwise, this is Exception_Information with
-- the call chain raw addresses replaced by the result of a call to the
-- current decorator provided with the call chain addresses.
pragma Export
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
-- This is currently used by System.Tasking.Stages
-- If no traceback decorator (see GNAT.Exception_Traces) is currently
-- in place, this is the same as Untailored_Exception_Information.
-- Otherwise, the decorator is used to produce a symbolic traceback
-- instead of hexadecimal addresses.
--
-- Note that unlike Untailored_Exception_Information, there is no need
-- to keep the output of Exception_Information stable for streaming
-- purposes, and in fact the output differs across platforms.
end Exception_Data;
package Exception_Traces is
use Exception_Data;
-- Imports Tailored_Exception_Information
----------------------------------------------
-- Run-Time Exception Notification Routines --
----------------------------------------------
......@@ -737,8 +733,8 @@ package body Ada.Exceptions is
-- EO_To_String --
------------------
-- We use the null string to represent the null occurrence, otherwise
-- we output the Exception_Information string for the occurrence.
-- We use the null string to represent the null occurrence, otherwise we
-- output the Untailored_Exception_Information string for the occurrence.
function EO_To_String (X : Exception_Occurrence) return String
renames Stream_Attributes.EO_To_String;
......
gcc/ada/a-except.adb
......@@ -116,12 +116,17 @@ package body Ada.Exceptions is
-- message. Message is a string which is generated as the exception
-- message.
--------------------------------------
-- Exception information subprogram --
--------------------------------------
---------------------------------------
-- Exception information subprograms --
---------------------------------------
function Exception_Information (X : Exception_Occurrence) return String;
-- The format of the exception information is as follows:
function Untailored_Exception_Information
(X : Exception_Occurrence) return String;
-- This is used by Stream_Attributes.EO_To_String to convert an
-- Exception_Occurrence to a String for the stream attributes.
-- String_To_EO understands the format, as documented here.
--
-- The format of the string is as follows:
--
-- Exception_Name: <exception name> (as in Exception_Name)
-- Message: <message> (only if Exception_Message is empty)
......@@ -129,25 +134,19 @@ package body Ada.Exceptions is
-- Call stack traceback locations: (only if at least one location)
-- <0xyyyyyyyy 0xyyyyyyyy ...> (is recorded)
--
-- The lines are separated by a ASCII.LF character
--
-- The nnnn is the partition Id given as decimal digits
--
-- The lines are separated by a ASCII.LF character.
-- The nnnn is the partition Id given as decimal digits.
-- The 0x... line represents traceback program counter locations, in
-- execution order with the first one being the exception location. It
-- is present only
--
-- The Exception_Name and Message lines are omitted in the abort signal
-- case, since this is not really an exception.
-- The Exception_Name and Message lines are omitted in the abort
-- signal case, since this is not really an exception.
-- Note: If the format of the generated string is changed, please note
-- that an equivalent modification to the routine String_To_EO must be
-- made to preserve proper functioning of the stream attributes.
---------------------------------------
-- Exception backtracing subprograms --
---------------------------------------
-- What is automatically output when exception tracing is on is the
-- usual exception information with the call chain backtrace possibly
-- tailored by a backtrace decorator. Modifying Exception_Information
......@@ -157,28 +156,23 @@ package body Ada.Exceptions is
-- the possibly tailored output, which is equivalent if no decorator is
-- currently set:
function Tailored_Exception_Information
(X : Exception_Occurrence) return String;
-- Exception information to be output in the case of automatic tracing
-- requested through GNAT.Exception_Traces.
function Exception_Information (X : Exception_Occurrence) return String;
-- This is the implementation of Ada.Exceptions.Exception_Information,
-- as defined in the Ada RM.
--
-- This is the same as Exception_Information if no backtrace decorator
-- is currently in place. Otherwise, this is Exception_Information with
-- the call chain raw addresses replaced by the result of a call to the
-- current decorator provided with the call chain addresses.
pragma Export
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
-- This is currently used by System.Tasking.Stages
-- If no traceback decorator (see GNAT.Exception_Traces) is currently
-- in place, this is the same as Untailored_Exception_Information.
-- Otherwise, the decorator is used to produce a symbolic traceback
-- instead of hexadecimal addresses.
--
-- Note that unlike Untailored_Exception_Information, there is no need
-- to keep the output of Exception_Information stable for streaming
-- purposes, and in fact the output differs across platforms.
end Exception_Data;
package Exception_Traces is
use Exception_Data;
-- Imports Tailored_Exception_Information
----------------------------------------------
-- Run-Time Exception Notification Routines --
----------------------------------------------
......@@ -774,7 +768,7 @@ package body Ada.Exceptions is
------------------
-- We use the null string to represent the null occurrence, otherwise we
-- output the Exception_Information string for the occurrence.
-- output the Untailored_Exception_Information string for the occurrence.
function EO_To_String (X : Exception_Occurrence) return String
renames Stream_Attributes.EO_To_String;
......@@ -806,9 +800,9 @@ package body Ada.Exceptions is
begin
if X.Id = Null_Id then
raise Constraint_Error;
else
return Exception_Data.Exception_Information (X);
end if;
return Exception_Data.Exception_Information (X);
end Exception_Information;
-----------------------
......
gcc/ada/a-exextr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, 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- --
......@@ -99,7 +99,7 @@ package body Exception_Traces is
To_Stderr ("Exception raised");
To_Stderr (Nline);
To_Stderr (Tailored_Exception_Information (Excep.all));
To_Stderr (Exception_Information (Excep.all));
Unlock_Task.all;
end if;
......
gcc/ada/a-exstat.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -59,15 +59,15 @@ package body Stream_Attributes is
-- EO_To_String --
------------------
-- We use the null string to represent the null occurrence, otherwise
-- we output the Exception_Information string for the occurrence.
-- We use the null string to represent the null occurrence, otherwise we
-- output the Untailored_Exception_Information string for the occurrence.
function EO_To_String (X : Exception_Occurrence) return String is
begin
if X.Id = Null_Id then
return "";
else
return Exception_Information (X);
return Exception_Data.Untailored_Exception_Information (X);
end if;
end EO_To_String;
......
gcc/ada/checks.ads
......@@ -40,6 +40,7 @@ with Namet; use Namet;
with Table;
with Types; use Types;
with Uintp; use Uintp;
with Urealp; use Urealp;
package Checks is
......@@ -302,6 +303,18 @@ package Checks is
-- then this assumption is valid, if False, then processing is done using
-- base types to allow invalid values.
procedure Determine_Range_R
(N : Node_Id;
OK : out Boolean;
Lo : out Ureal;
Hi : out Ureal;
Assume_Valid : Boolean := False);
-- Similar to Determine_Range, but for a node N of floating-point type. OK
-- is True on return only for IEEE floating-point types and only if we do
-- not have to worry about extended precision (i.e. on the x86, we must be
-- using -msse2 -mfpmath=sse. At the current time, this is used only in
-- GNATprove, though we could consider using it more generally in future.
procedure Install_Null_Excluding_Check (N : Node_Id);
-- Determines whether an access node requires a runtime access check and
-- if so inserts the appropriate run-time check.
......
gcc/ada/exp_aggr.adb
......@@ -5345,10 +5345,11 @@ package body Exp_Aggr is
-- then we could go into an infinite recursion.
if (In_Place_Assign_OK_For_Declaration or else Maybe_In_Place_OK)
and then not AAMP_On_Target
and then VM_Target = No_VM
and then not AAMP_On_Target
and then not Generate_SCIL
and then not Possible_Bit_Aligned_Component (Target)
and then not Is_Possibly_Unaligned_Slice (Target)
and then Aggr_Assignment_OK_For_Backend (N)
then
if Maybe_In_Place_OK then
......
gcc/ada/exp_util.adb
......@@ -5041,18 +5041,6 @@ package body Exp_Util is
return False;
end if;
-- Always assume the worst for a nested record component with a
-- component clause, which gigi/gcc does not appear to handle well.
-- It is not clear why this special test is needed at all ???
if Nkind (Prefix (N)) = N_Selected_Component
and then Nkind (Prefix (Prefix (N))) = N_Selected_Component
and then
Present (Component_Clause (Entity (Selector_Name (Prefix (N)))))
then
return True;
end if;
-- We only need to worry if the target has strict alignment
if not Target_Strict_Alignment then
......
gcc/ada/s-tassta.adb
......@@ -1524,12 +1524,6 @@ package body System.Tasking.Stages is
Ada.Unchecked_Conversion
(Task_Id, System.Task_Primitives.Task_Address);
function Tailored_Exception_Information
(E : Exception_Occurrence) return String;
pragma Import
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
Excep : constant Exception_Occurrence_Access :=
SSL.Get_Current_Excep.all;
......@@ -1553,7 +1547,7 @@ package body System.Tasking.Stages is
To_Stderr (System.Address_Image (To_Address (Self_Id)));
To_Stderr (" terminated by unhandled exception");
To_Stderr ((1 => ASCII.LF));
To_Stderr (Tailored_Exception_Information (Excep.all));
To_Stderr (Exception_Information (Excep.all));
Initialization.Task_Unlock (Self_Id);
end Trace_Unhandled_Exception_In_Task;
......
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