Commit 92db5dee by Arnaud Charlet

[multiple changes]

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

	* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
	(GNAT_GCC_Exception): Remove N_Cleanups_To_Trigger component.
	(Adjust_N_CLeanups_For): Remove.
	(CleanupUnwind_Handler): Call Unhandled_Exception_Terminate when end of
	stack is reached.
	(Propgate_Exception): Adjust.
	* raise-gcc.c: Add a few static/const.
	(Adjust_N_Cleanups_For): Remove declaration.
	(PERSONALITY_FUNCTION): Remove code dealing with N_Cleanups_To_Trigger.

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

	* sem_ch8.adb: Use type of function return when rewriting as object
	declaration.

From-SVN: r178188
parent 1378bf10
2011-08-29 Tristan Gingold <gingold@adacore.com>
* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
(GNAT_GCC_Exception): Remove N_Cleanups_To_Trigger component.
(Adjust_N_CLeanups_For): Remove.
(CleanupUnwind_Handler): Call Unhandled_Exception_Terminate when end of
stack is reached.
(Propgate_Exception): Adjust.
* raise-gcc.c: Add a few static/const.
(Adjust_N_Cleanups_For): Remove declaration.
(PERSONALITY_FUNCTION): Remove code dealing with N_Cleanups_To_Trigger.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb: Use type of function return when rewriting as object
declaration.
2011-08-29 Gary Dismukes <dismukes@adacore.com> 2011-08-29 Gary Dismukes <dismukes@adacore.com>
* sem_type.adb: Minor reformatting. * sem_type.adb: Minor reformatting.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -76,20 +76,21 @@ package body Exception_Propagation is ...@@ -76,20 +76,21 @@ package body Exception_Propagation is
-- Phase identifiers -- Phase identifiers
type Unwind_Action is type Unwind_Action is new Integer;
pragma Convention (C, Unwind_Action);
UA_SEARCH_PHASE : constant Unwind_Action := 1;
UA_CLEANUP_PHASE : constant Unwind_Action := 2;
UA_HANDLER_FRAME : constant Unwind_Action := 4;
UA_FORCE_UNWIND : constant Unwind_Action := 8;
UA_END_OF_STACK : constant Unwind_Action := 16; -- GCC extension ?
pragma Unreferenced
(UA_SEARCH_PHASE, (UA_SEARCH_PHASE,
UA_CLEANUP_PHASE, UA_CLEANUP_PHASE,
UA_HANDLER_FRAME, UA_HANDLER_FRAME,
UA_FORCE_UNWIND); UA_FORCE_UNWIND);
for Unwind_Action use
(UA_SEARCH_PHASE => 1,
UA_CLEANUP_PHASE => 2,
UA_HANDLER_FRAME => 4,
UA_FORCE_UNWIND => 8);
pragma Convention (C, Unwind_Action);
-- Mandatory common header for any exception object handled by the -- Mandatory common header for any exception object handled by the
-- GCC unwinding runtime. -- GCC unwinding runtime.
...@@ -132,13 +133,6 @@ package body Exception_Propagation is ...@@ -132,13 +133,6 @@ package body Exception_Propagation is
-- and then used by the personality routine to determine if the context -- and then used by the personality routine to determine if the context
-- it examines contains a handler for the exception being propagated. -- it examines contains a handler for the exception being propagated.
N_Cleanups_To_Trigger : Integer;
-- Number of cleanup only frames encountered in SEARCH phase. This is
-- initialized to 0 by Propagate_Exception and maintained by the
-- personality routine to control a forced unwinding phase triggering
-- all the cleanups before calling Unhandled_Exception_Terminate when
-- an exception is not handled.
Next_Exception : EOA; Next_Exception : EOA;
-- Used to create a linked list of exception occurrences -- Used to create a linked list of exception occurrences
end record; end record;
...@@ -264,11 +258,6 @@ package body Exception_Propagation is ...@@ -264,11 +258,6 @@ package body Exception_Propagation is
return Exception_Id; return Exception_Id;
pragma Export (C, EID_For, "__gnat_eid_for"); pragma Export (C, EID_For, "__gnat_eid_for");
procedure Adjust_N_Cleanups_For
(GNAT_Exception : GNAT_GCC_Exception_Access;
Adjustment : Integer);
pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
-- Objects to materialize "others" and "all others" in the GCC EH tables -- -- Objects to materialize "others" and "all others" in the GCC EH tables --
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
...@@ -357,19 +346,18 @@ package body Exception_Propagation is ...@@ -357,19 +346,18 @@ package body Exception_Propagation is
UW_Argument : System.Address) return Unwind_Reason_Code UW_Argument : System.Address) return Unwind_Reason_Code
is is
pragma Unreferenced pragma Unreferenced
(UW_Version, UW_Phases, UW_Eclass, UW_Context, UW_Argument); (UW_Version, UW_Eclass, UW_Exception, UW_Context, UW_Argument);
begin begin
-- Terminate as soon as we know there is nothing more to run. The -- Terminate when the end of the stack is reached
-- count is maintained by the personality routine.
if UW_Exception.N_Cleanups_To_Trigger = 0 then if UW_Phases >= UA_END_OF_STACK then
Unhandled_Exception_Terminate; Unhandled_Exception_Terminate;
end if; end if;
-- We know there is at least one cleanup further up. Return so that it -- We know there is at least one cleanup further up. Return so that it
-- is searched and entered, after which Unwind_Resume will be called -- is searched and entered, after which Unwind_Resume will be called
-- and this hook will gain control (with an updated count) again. -- and this hook will gain control again.
return URC_NO_REASON; return URC_NO_REASON;
end CleanupUnwind_Handler; end CleanupUnwind_Handler;
...@@ -553,7 +541,6 @@ package body Exception_Propagation is ...@@ -553,7 +541,6 @@ package body Exception_Propagation is
Clear_Setup_And_Not_Propagated (Excep); Clear_Setup_And_Not_Propagated (Excep);
GCC_Exception.Id := Excep.Id; GCC_Exception.Id := Excep.Id;
GCC_Exception.N_Cleanups_To_Trigger := 0;
-- Compute the backtrace for this occurrence if the corresponding -- Compute the backtrace for this occurrence if the corresponding
-- binder option has been set. Call_Chain takes care of the reraise -- binder option has been set. Call_Chain takes care of the reraise
...@@ -581,8 +568,7 @@ package body Exception_Propagation is ...@@ -581,8 +568,7 @@ package body Exception_Propagation is
-- Perform a standard raise first. If a regular handler is found, it -- Perform a standard raise first. If a regular handler is found, it
-- will be entered after all the intermediate cleanups have run. If -- will be entered after all the intermediate cleanups have run. If
-- there is no regular handler, control will get back to after the -- there is no regular handler, control will get back to after the
-- call, with N_Cleanups_To_Trigger set to the number of frames with -- call.
-- cleanups found on the way up, and none of these already run.
Unwind_RaiseException (GCC_Exception); Unwind_RaiseException (GCC_Exception);
...@@ -593,36 +579,21 @@ package body Exception_Propagation is ...@@ -593,36 +579,21 @@ package body Exception_Propagation is
Notify_Unhandled_Exception; Notify_Unhandled_Exception;
-- Now, if cleanups have been found, run a forced unwind to trigger -- Now, un a forced unwind to trigger cleanups. Control should not
-- them. Control should not resume there, as the unwinding hook calls -- resume there, if there are cleanups and in any cases as the
-- Unhandled_Exception_Terminate as soon as the last cleanup has been -- unwinding hook calls Unhandled_Exception_Terminate when end of stack
-- triggered. -- is reached.
if GCC_Exception.N_Cleanups_To_Trigger /= 0 then Unwind_ForcedUnwind (GCC_Exception,
Unwind_ForcedUnwind (GCC_Exception, CleanupUnwind_Handler'Address,
CleanupUnwind_Handler'Address, System.Null_Address);
System.Null_Address);
end if;
-- We get here when there is no handler or cleanup to be run at all. -- We get here in case of error.
-- The debugger has been notified before the second step above. -- The debugger has been notified before the second step above.
Unhandled_Exception_Terminate; Unhandled_Exception_Terminate;
end Propagate_Exception; end Propagate_Exception;
---------------------------
-- Adjust_N_Cleanups_For --
---------------------------
procedure Adjust_N_Cleanups_For
(GNAT_Exception : GNAT_GCC_Exception_Access;
Adjustment : Integer)
is
begin
GNAT_Exception.N_Cleanups_To_Trigger :=
GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
end Adjust_N_Cleanups_For;
------------- -------------
-- EID_For -- -- EID_For --
------------- -------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* 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 * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -128,7 +128,7 @@ typedef struct ...@@ -128,7 +128,7 @@ typedef struct
char * description; char * description;
} phase_descriptor; } phase_descriptor;
static phase_descriptor phase_descriptors[] static const phase_descriptor phase_descriptors[]
= {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" }, = {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
{ _UA_CLEANUP_PHASE, "CLEANUP_PHASE" }, { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
{ _UA_HANDLER_FRAME, "HANDLER_FRAME" }, { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
...@@ -622,7 +622,7 @@ typedef enum ...@@ -622,7 +622,7 @@ typedef enum
} action_kind; } action_kind;
/* filter value for cleanup actions. */ /* filter value for cleanup actions. */
const int cleanup_filter = 0; static const int cleanup_filter = 0;
typedef struct typedef struct
{ {
...@@ -842,7 +842,6 @@ get_call_site_action_for (_Unwind_Context *uw_context, ...@@ -842,7 +842,6 @@ get_call_site_action_for (_Unwind_Context *uw_context,
#define Language_For __gnat_language_for #define Language_For __gnat_language_for
#define Import_Code_For __gnat_import_code_for #define Import_Code_For __gnat_import_code_for
#define EID_For __gnat_eid_for #define EID_For __gnat_eid_for
#define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
extern bool Is_Handled_By_Others (_Unwind_Ptr eid); extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
extern char Language_For (_Unwind_Ptr eid); extern char Language_For (_Unwind_Ptr eid);
...@@ -850,7 +849,6 @@ extern char Language_For (_Unwind_Ptr eid); ...@@ -850,7 +849,6 @@ extern char Language_For (_Unwind_Ptr eid);
extern Exception_Code Import_Code_For (_Unwind_Ptr eid); extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
extern Exception_Id EID_For (_GNAT_Exception * e); extern Exception_Id EID_For (_GNAT_Exception * e);
extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
static int static int
is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception) is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
...@@ -1142,7 +1140,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, ...@@ -1142,7 +1140,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
{ {
if (action.kind == cleanup) if (action.kind == cleanup)
{ {
Adjust_N_Cleanups_For (gnat_exception, 1);
return _URC_CONTINUE_UNWIND; return _URC_CONTINUE_UNWIND;
} }
else else
...@@ -1160,14 +1157,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, ...@@ -1160,14 +1157,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
occurrence (we are in a FORCED_UNWIND phase in this case). Install the occurrence (we are in a FORCED_UNWIND phase in this case). Install the
context to get there. */ context to get there. */
/* If we are going to install a cleanup context, decrement the cleanup
count. This is required in a FORCED_UNWINDing phase (for an unhandled
exception), as this is used from the forced unwinding handler in
Ada.Exceptions.Exception_Propagation to decide whether unwinding should
proceed further or Unhandled_Exception_Terminate should be called. */
if (action.kind == cleanup)
Adjust_N_Cleanups_For (gnat_exception, -1);
setup_to_install setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter); (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
......
...@@ -814,7 +814,7 @@ package body Sem_Ch8 is ...@@ -814,7 +814,7 @@ package body Sem_Ch8 is
if Nkind (Nam) = N_Function_Call if Nkind (Nam) = N_Function_Call
and then Is_Immutably_Limited_Type (Etype (Nam)) and then Is_Immutably_Limited_Type (Etype (Nam))
and then not Is_Constrained (T) and then not Is_Constrained (Etype (Nam))
and then Comes_From_Source (N) and then Comes_From_Source (N)
then then
Set_Etype (Id, T); Set_Etype (Id, T);
...@@ -823,7 +823,7 @@ package body Sem_Ch8 is ...@@ -823,7 +823,7 @@ package body Sem_Ch8 is
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Id, Defining_Identifier => Id,
Constant_Present => True, Constant_Present => True,
Object_Definition => New_Occurrence_Of (T, Loc), Object_Definition => New_Occurrence_Of (Etype (Nam), Loc),
Expression => Relocate_Node (Nam))); Expression => Relocate_Node (Nam)));
return; return;
end if; end if;
...@@ -851,9 +851,9 @@ package body Sem_Ch8 is ...@@ -851,9 +851,9 @@ package body Sem_Ch8 is
-- Ada 2005 AI05-105: if the declaration has an anonymous access -- Ada 2005 AI05-105: if the declaration has an anonymous access
-- type, the renamed object must also have an anonymous type, and -- type, the renamed object must also have an anonymous type, and
-- this is a name resolution rule. This was implicit in the last -- this is a name resolution rule. This was implicit in the last part
-- part of the first sentence in 8.5.1.(3/2), and is made explicit -- of the first sentence in 8.5.1(3/2), and is made explicit by this
-- by this recent AI. -- recent AI.
if not Is_Overloaded (Nam) then if not Is_Overloaded (Nam) then
if Ekind (Etype (Nam)) /= Ekind (T) then if Ekind (Etype (Nam)) /= Ekind (T) then
...@@ -994,7 +994,7 @@ package body Sem_Ch8 is ...@@ -994,7 +994,7 @@ package body Sem_Ch8 is
T2 := Etype (Nam); T2 := Etype (Nam);
-- (Ada 2005: AI-326): Handle wrong use of incomplete type -- Ada 2005 (AI-326): Handle wrong use of incomplete type
if Nkind (Nam) = N_Explicit_Dereference if Nkind (Nam) = N_Explicit_Dereference
and then Ekind (Etype (T2)) = E_Incomplete_Type and then Ekind (Etype (T2)) = E_Incomplete_Type
......
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