Skip to content

R
riscv-gcc-1
Commit 6c5290ce by Thomas Quinot Committed by Arnaud Charlet
Options

a-except.ads, [...]: (Rmsg_28): Fix description for E.4(18) check. 

2007-04-20  Thomas Quinot  <quinot@adacore.com>
	    Olivier Hainque  <hainque@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* a-except.ads, a-except.adb: (Rmsg_28): Fix description for E.4(18)
	check.
	(Raise_Current_Excep): Call Debug_Raise_Exception just before
	propagation starts, to let debuggers know about the event in a reliable
	fashion.
	(Local_Raise): Moved to System.Exceptions
	More convenient to have this as a separate unit

	* s-except.adb, s-except.ads: New files.

	* a-exextr.adb (Unhandled_Exception): Delete - replaced by
	Debug_Unhandled_Exception in System.Exceptions where it belongs
	together with a couple of other debug helpers.
	(Notify_Unhandled_Exception): Use Debug_Unhandled_Exception instead of
	the former Unhandled_Exception.

	* exp_ch11.ads, exp_ch11.adb: (Possible_Local_Raise): New procedure
	(Warn_No_Exception_Propagation): New procedure
	(Warn_If_No_Propagation): Rewritten for new warning generation
	(Expand_Exception_Handlers): New warning generation
	(Expand_N_Raise_xxx_Error): Rewritten for new warnings
	(Add_Exception_Label): Use Special_Exception_Package_Used for test
	instead of Most_Recent_Exception_Used (accomodates Exception_Traces)
	(Expand_Local_Exception_Handlers): Unconditionally add extra block wrap
	even if restriction is set (makes life easier in Check_Returns)
	(Expand_Local_Exception_Handlers): Follow renamed entity chain when
	checking exception identities.
	(Expand_Local_Exception_Handlers): Do not optimize when all others case
	(Expand_Local_Exception_Handlers): Set Exception_Junk flag on generated
	block for handler (used by Check_Returns)
	(Expand_Local_Exception_Handlers): Local_Raise now takes an address
	(Expand_N_Handled_Sequence_Of_Statements): Properly handle -gnatd.x to
	remove all exception handlers when optimizing local raise statements.
	(Find_Local_Handler): Use Get_Renamed_Entity
	(Expand_N_Handled_Sequence_Of_Statements): If the handled sequence is
	marked analyzed after expanding exception handlers, do not generate
	redundant cleanup actions, because they have been constructed already.

From-SVN: r125375
parent 107cd232
Showing with 230 additions and 53 deletions
gcc/ada/a-except.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
......@@ -50,6 +50,7 @@ pragma Polling (Off);
-- elaboration circularities with System.Exception_Tables.
with System; use System;
with System.Exceptions; use System.Exceptions;
with System.Standard_Library; use System.Standard_Library;
with System.Soft_Links; use System.Soft_Links;
......@@ -521,8 +522,8 @@ package body Ada.Exceptions is
Rmsg_25 : constant String := "potentially blocking operation" & NUL;
Rmsg_26 : constant String := "stubbed subprogram called" & NUL;
Rmsg_27 : constant String := "unchecked union restriction" & NUL;
Rmsg_28 : constant String := "illegal use of remote access-to-" &
"class-wide type, see RM E.4(18)" & NUL;
Rmsg_28 : constant String := "actual/returned class-wide value "
& "not transportable" & NUL;
Rmsg_29 : constant String := "empty storage pool" & NUL;
Rmsg_30 : constant String := "explicit raise" & NUL;
Rmsg_31 : constant String := "infinite recursion" & NUL;
......@@ -690,16 +691,6 @@ package body Ada.Exceptions is
-- in case we do not want any exception tracing support. This is
-- why this package is separated.
-----------------
-- Local_Raise --
-----------------
procedure Local_Raise (Excep : Exception_Id) is
pragma Warnings (Off, Excep);
begin
return;
end Local_Raise;
-----------------------
-- Stream Attributes --
-----------------------
......@@ -800,6 +791,7 @@ package body Ada.Exceptions is
-- pragma Volatile is peculiar!
begin
Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E));
Process_Raise_Exception (E);
end Raise_Current_Excep;
......@@ -837,6 +829,46 @@ package body Ada.Exceptions is
Raise_Current_Excep (E);
end Raise_Exception_Always;
-------------------------------------
-- Raise_From_Controlled_Operation --
-------------------------------------
procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence)
is
Prefix : constant String := "adjust/finalize raised ";
Orig_Msg : constant String := Exception_Message (X);
New_Msg : constant String := Prefix & Exception_Name (X);
begin
if Orig_Msg'Length >= Prefix'Length
and then
Orig_Msg (Orig_Msg'First .. Orig_Msg'First + Prefix'Length - 1) =
Prefix
then
-- Message already has proper prefix, just re-reraise PROGRAM_ERROR
Raise_Exception_No_Defer
(E => Program_Error'Identity,
Message => Orig_Msg);
elsif Orig_Msg = "" then
-- No message present: just provide our own
Raise_Exception_No_Defer
(E => Program_Error'Identity,
Message => New_Msg);
else
-- Message present, add informational prefix
Raise_Exception_No_Defer
(E => Program_Error'Identity,
Message => New_Msg & ": " & Orig_Msg);
end if;
end Raise_From_Controlled_Operation;
-------------------------------
-- Raise_From_Signal_Handler --
-------------------------------
......
gcc/ada/a-except.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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 --
......@@ -175,15 +175,6 @@ private
-- private barrier, so we can place this function in the private part
-- where the compiler can find it, but the spec is unchanged.)
procedure Local_Raise (Excep : Exception_Id);
pragma Export (Ada, Local_Raise);
-- This is a dummy routine, used only by the debugger for the purpose of
-- logging local raise statements that were transformed into a direct goto
-- to the handler code. The compiler in this case generates:
--
-- Local_Raise (exception_id);
-- goto Handler
procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
pragma No_Return (Raise_Exception_Always);
pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");
......@@ -211,6 +202,12 @@ private
-- PC value in the machine state or in some other way ask the operating
-- system to return here rather than to the original location.
procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence);
pragma No_Return (Raise_From_Controlled_Operation);
-- Raise Program_Error, proviving information about X (an exception
-- raised during a controlled operation) in the exception message.
procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
pragma No_Return (Reraise_Occurrence_Always);
-- This differs from Raise_Occurrence only in that the caller guarantees
......
gcc/ada/a-exextr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
with Unchecked_Conversion;
with Ada.Unchecked_Conversion;
pragma Warnings (Off);
with Ada.Exceptions.Last_Chance_Handler;
......@@ -62,7 +62,7 @@ package body Exception_Traces is
-- Users can replace the default version of this routine,
-- Ada.Exceptions.Last_Chance_Handler.
function To_Action is new Unchecked_Conversion
function To_Action is new Ada.Unchecked_Conversion
(Raise_Action, Exception_Action);
-----------------------
......@@ -75,22 +75,6 @@ package body Exception_Traces is
-- latter case because Notify_Handled_Exception may be called for an
-- actually unhandled occurrence in the Front-End-SJLJ case.
---------------------------------
-- Debugger Interface Routines --
---------------------------------
-- The routines here are null routines that normally have no effect.
-- They are provided for the debugger to place breakpoints on their
-- entry points to get control on an exception.
procedure Unhandled_Exception;
pragma Export (C, Unhandled_Exception, "__gnat_unhandled_exception");
-- Hook for GDB to support "break exception unhandled"
-- For "break exception", GDB uses __gnat_raise_nodefer_with_msg, which
-- is not in this section because it functions as more than simply a
-- debugger interface.
--------------------------------
-- Import Run-Time C Routines --
--------------------------------
......@@ -173,18 +157,9 @@ package body Exception_Traces is
Task_Termination_Handler.all (Excep.all);
Notify_Exception (Excep, Is_Unhandled => True);
Unhandled_Exception;
Debug_Unhandled_Exception (SSL.Exception_Data_Ptr (Excep.Id));
end Notify_Unhandled_Exception;
-------------------------
-- Unhandled_Exception --
-------------------------
procedure Unhandled_Exception is
begin
null;
end Unhandled_Exception;
-----------------------------------
-- Unhandled_Exception_Terminate --
-----------------------------------
......
gcc/ada/exp_ch11.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
......@@ -56,6 +56,16 @@ package Exp_Ch11 is
-- is also called to expand the special exception handler built for
-- accept bodies (see Exp_Ch9.Build_Accept_Body).
function Find_Local_Handler
(Ename : Entity_Id;
Nod : Node_Id) return Node_Id;
-- This function searches for a local exception handler that will handle
-- the exception named by Ename. If such a local hander exists, then the
-- corresponding N_Exception_Handler is returned. If no such handler is
-- found then Empty is returned. In order to match and return True, the
-- handler may not have a choice parameter specification. Nod is the raise
-- node that references the handler.
function Get_Local_Raise_Call_Entity return Entity_Id;
-- This function is provided for use by the back end in conjunction with
-- generation of Local_Raise calls when an exception raise is converted to
......@@ -74,4 +84,12 @@ package Exp_Ch11 is
-- VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
-- This is used to generate the special matching code for this exception.
procedure Possible_Local_Raise (N : Node_Id; E : Entity_Id);
-- This procedure is called whenever node N might cause the back end
-- to generate a local raise for a local Constraint/Program/Storage_Error
-- exception. It deals with generating a warning if there is no local
-- handler (and restriction No_Exception_Propagation is set), or if there
-- is a local handler marking that it has a local raise. E is the entity
-- of the corresponding exception.
end Exp_Ch11;
gcc/ada/s-except.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . E X C E P T I O N S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2007, 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- --
-- ware Foundation; either version 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body System.Exceptions is
---------------------------
-- Debug_Raise_Exception --
---------------------------
procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr) is
pragma Inspection_Point (E);
begin
null;
end Debug_Raise_Exception;
-------------------------------
-- Debug_unhandled_Exception --
-------------------------------
procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr) is
pragma Inspection_Point (E);
begin
null;
end Debug_Unhandled_Exception;
--------------------------------
-- Debug_Raise_Assert_Failure --
--------------------------------
procedure Debug_Raise_Assert_Failure is
begin
null;
end Debug_Raise_Assert_Failure;
-----------------
-- Local_Raise --
-----------------
procedure Local_Raise (Excep : System.Address) is
pragma Warnings (Off, Excep);
begin
return;
end Local_Raise;
end System.Exceptions;
gcc/ada/s-except.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . E X C E P T I O N S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2007, 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- --
-- ware Foundation; either version 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package contains internal routines used as debugger helpers.
-- It should be compiled without optimization to let debuggers inspect
-- parameter values reliably from breakpoints on the routines.
with System.Standard_Library;
package System.Exceptions is
pragma Warnings (Off);
pragma Preelaborate_05;
pragma Warnings (On);
-- To let Ada.Exceptions "with" us and let us "with" Standard_Library.
package SSL renames System.Standard_Library;
-- To let some of the hooks below have formal parameters typed in
-- accordance with what GDB expects.
procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr);
pragma Export
(Ada, Debug_Raise_Exception, "__gnat_debug_raise_exception");
-- Hook called at a "raise" point for an exception E, when it is
-- just about to be propagated.
procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr);
pragma Export
(Ada, Debug_Unhandled_Exception, "__gnat_unhandled_exception");
-- Hook called during the propagation process of an exception E, as soon
-- as it is known to be unhandled.
procedure Debug_Raise_Assert_Failure;
pragma Export
(Ada, Debug_Raise_Assert_Failure, "__gnat_debug_raise_assert_failure");
-- Hook called when an assertion failed. This is used by the debugger to
-- intercept assertion failures, and treat them specially.
procedure Local_Raise (Excep : System.Address);
pragma Export (Ada, Local_Raise);
-- This is a dummy routine, used only by the debugger for the purpose of
-- logging local raise statements that were transformed into a direct goto
-- to the handler code. The compiler in this case generates:
--
-- Local_Raise (exception_data'address);
-- goto Handler
--
-- The argument is the address of the exception data
end System.Exceptions;
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