[multiple changes]

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* s-excdeb.ads, s-excdeb.adb: New files, created from s-except.
	* rtsfind.ads (RTU_Id): Replaces System_Exceptions by
	System_Exceptions_Debug
	(RE_Unit_Table): Search RE_Local_Raise in System_Exceptions_Debug
	* a-except.adb: With and use System.Exceptions_Debug instead of
	System.Exceptions.
	* a-except-2005.adb: Likewise.
	* s-assert.adb: Likewise.
	* s-except.adb, s-except.ads: Move debugging hooks to s-excdeb.
	* Makefile.rtl: Add s-excdeb.  Adjust compilation rule.
	* gcc-interfaces/Makefile.in, gcc-interface/Make-lang.in: Add
	s-excdeb. Update dependencies.
	(GNATRTL_LINEARALGEBRA_OBJS): Remove a-nlrear.o a-nurear.o a-nllrar.o
	as these no longer need external libraries.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Op_Expon): Additional check to reject an
	exponentiation operator on universal values in a context that requires
	a fixed-point type.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (personnality_routine): Fix thinko.  Set Ada occurrence
	before calling notify_handled_exception.
	* a-exextr.adb: Fix comment.

From-SVN: r178221
This commit is contained in:
Arnaud Charlet 2011-08-29 15:13:26 +02:00
parent b254da66e7
commit 4d79254934
15 changed files with 1512 additions and 1341 deletions

View File

@ -1,3 +1,32 @@
2011-08-29 Tristan Gingold <gingold@adacore.com>
* s-excdeb.ads, s-excdeb.adb: New files, created from s-except.
* rtsfind.ads (RTU_Id): Replaces System_Exceptions by
System_Exceptions_Debug
(RE_Unit_Table): Search RE_Local_Raise in System_Exceptions_Debug
* a-except.adb: With and use System.Exceptions_Debug instead of
System.Exceptions.
* a-except-2005.adb: Likewise.
* s-assert.adb: Likewise.
* s-except.adb, s-except.ads: Move debugging hooks to s-excdeb.
* Makefile.rtl: Add s-excdeb. Adjust compilation rule.
* gcc-interfaces/Makefile.in, gcc-interface/Make-lang.in: Add
s-excdeb. Update dependencies.
(GNATRTL_LINEARALGEBRA_OBJS): Remove a-nlrear.o a-nurear.o a-nllrar.o
as these no longer need external libraries.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Op_Expon): Additional check to reject an
exponentiation operator on universal values in a context that requires
a fixed-point type.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* raise-gcc.c (personnality_routine): Fix thinko. Set Ada occurrence
before calling notify_handled_exception.
* a-exextr.adb: Fix comment.
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Expand_Allocator_Expression): Add code to set attribute

View File

@ -479,6 +479,7 @@ GNATRTL_NONTASKING_OBJS= \
s-crtrun$(objext) \
s-direio$(objext) \
s-dsaser$(objext) \
s-excdeb$(objext) \
s-except$(objext) \
s-exctab$(objext) \
s-exnint$(objext) \

View File

@ -46,6 +46,7 @@ pragma Polling (Off);
with System; use System;
with System.Exceptions; use System.Exceptions;
with System.Exceptions_Debug; use System.Exceptions_Debug;
with System.Standard_Library; use System.Standard_Library;
with System.Soft_Links; use System.Soft_Links;
with System.WCh_Con; use System.WCh_Con;

View File

@ -50,7 +50,7 @@ pragma Polling (Off);
-- elaboration circularities with System.Exception_Tables.
with System; use System;
with System.Exceptions; use System.Exceptions;
with System.Exceptions_Debug; use System.Exceptions_Debug;
with System.Standard_Library; use System.Standard_Library;
with System.Soft_Links; use System.Soft_Links;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -93,11 +93,6 @@ package body Exception_Traces is
-- configuration. Take care not to output information about internal
-- exceptions.
-- ??? In the Front-End ZCX case, the traceback entries we have at this
-- point only include the ones we stored while walking up the stack *up
-- to the handler*. All the frames above the subprogram in which the
-- handler is found are missing.
if not Excep.Id.Not_Handled_By_Others
and then
(Exception_Trace = Every_Raise

File diff suppressed because it is too large Load Diff

View File

@ -2263,8 +2263,8 @@ LIBGNAT_OBJS = adadecode.o adaint.o argv.o cio.o cstreams.o ctrl_c.o \
include $(fsrcdir)/ada/Makefile.rtl
GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o a-nllrar.o a-nlrear.o \
a-nucoar.o a-nurear.o i-forbla.o i-forlap.o s-gearop.o
GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o \
a-nucoar.o i-forbla.o i-forlap.o s-gearop.o
GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS) $(GNATRTL_TASKING_OBJS) \
$(GNATRTL_LINEARALGEBRA_OBJS) g-trasym.o memtrack.o
@ -2774,11 +2774,11 @@ a-except.o : a-except.adb a-except.ads
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \
$(NO_REORDER_ADAFLAGS) $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
# compile s-except.o without optimization and with debug info to let the
# compile s-excdeb.o without optimization and with debug info to let the
# debugger set breakpoints and inspect subprogram parameters on exception
# related events.
s-except.o : s-except.adb s-except.ads
s-excdeb.o : s-excdeb.adb s-excdeb.ads s-except.ads
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \
$< $(OUTPUT_OPTION)

View File

@ -1149,7 +1149,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
else
{
/* Trigger the appropriate notification routines before the second
phase starts, which ensures the stack is still intact. */
phase starts, which ensures the stack is still intact.
First, setup the Ada occurrence. */
__gnat_setup_current_excep (uw_exception);
__gnat_notify_handled_exception ();
return _URC_HANDLER_FOUND;

View File

@ -226,7 +226,7 @@ package Rtsfind is
System_DSA_Services,
System_DSA_Types,
System_Exception_Table,
System_Exceptions,
System_Exceptions_Debug,
System_Exn_Int,
System_Exn_LLF,
System_Exn_LLI,
@ -753,7 +753,7 @@ package Rtsfind is
RE_Register_Exception, -- System.Exception_Table
RE_Local_Raise, -- System.Exceptions
RE_Local_Raise, -- System.Exceptions_Debug
RE_Exn_Integer, -- System.Exn_Int
@ -1940,7 +1940,7 @@ package Rtsfind is
RE_Register_Exception => System_Exception_Table,
RE_Local_Raise => System_Exceptions,
RE_Local_Raise => System_Exceptions_Debug,
RE_Exn_Integer => System_Exn_Int,

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, 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- --
@ -32,7 +32,7 @@
pragma Compiler_Unit;
with Ada.Exceptions;
with System.Exceptions;
with System.Exceptions_Debug;
package body System.Assertions is
@ -42,7 +42,7 @@ package body System.Assertions is
procedure Raise_Assert_Failure (Msg : String) is
begin
System.Exceptions.Debug_Raise_Assert_Failure;
System.Exceptions_Debug.Debug_Raise_Assert_Failure;
Ada.Exceptions.Raise_Exception (Assert_Failure'Identity, Msg);
end Raise_Assert_Failure;

75
gcc/ada/s-excdeb.adb Normal file
View File

@ -0,0 +1,75 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . E X C E P T I O N S _ D E B U G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
pragma Compiler_Unit;
package body System.Exceptions_Debug 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_Debug;

77
gcc/ada/s-excdeb.ads Normal file
View File

@ -0,0 +1,77 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . E X C E P T I O N S _ D E B U G --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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.
pragma Compiler_Unit;
with System.Standard_Library;
package System.Exceptions_Debug is
pragma Preelaborate_05;
-- 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_Debug;

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2011, 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- --
@ -29,47 +29,4 @@
-- --
------------------------------------------------------------------------------
pragma Compiler_Unit;
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;
pragma No_Body;

View File

@ -29,14 +29,8 @@
-- --
------------------------------------------------------------------------------
-- 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.
pragma Compiler_Unit;
with System.Standard_Library;
package System.Exceptions is
pragma Preelaborate_05;
@ -45,39 +39,6 @@ package System.Exceptions is
ZCX_By_Default : constant Boolean;
-- Visible copy to allow Ada.Exceptions to know the exception model.
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
private
ZCX_By_Default : constant Boolean := System.ZCX_By_Default;

View File

@ -7839,6 +7839,14 @@ package body Sem_Res is
if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
Error_Msg_N ("exponentiation not available for fixed point", N);
return;
elsif Nkind (Parent (N)) in N_Op
and then Is_Fixed_Point_Type (Etype (Parent (N)))
and then Etype (N) = Universal_Real
and then Comes_From_Source (N)
then
Error_Msg_N ("exponentiation not available for fixed point", N);
return;
end if;
if Comes_From_Source (N)