From patchwork Mon Jul 16 12:56:14 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 171183 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 715DF2C00BE for ; Mon, 16 Jul 2012 22:57:00 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1343048220; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=FjQzvURA4YFzwVR7wwd4 Wem2XW8=; b=YMQaMIMUGE49y8lmGf3lm9/5slVSdlraDEEPM8s82ZbH1JXK2D7Q +jg4wsaVRR6gMfw/GExS0GAT1CMmBZwsfdbf70ON7Lvj3vgJQwMnQTvbDgwXaMsn wS5ilJUXiPJSjJvkcYD0CkwNRaX0FEH3Xzdr0e4pAPHhkihdwDAECBU= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=LhLS205CDwrUpG3t7806ZZKn2Nsp6JsUoKbomo5pDOvaWsMLQlJkxAHJ6gTq8z XT5gJw2pcGo8SMEKn6qQjjfYBYrWYCv9pB/wesmt/CxwyZh8eesDH/KLfKX5yPpW Qhob3RhHNlTHQZk8dMOJLo/UVO8lkpj9KoAVr4Kq1TJ6w=; Received: (qmail 945 invoked by alias); 16 Jul 2012 12:56:46 -0000 Received: (qmail 851 invoked by uid 22791); 16 Jul 2012 12:56:36 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 16 Jul 2012 12:56:15 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id D58821C723D; Mon, 16 Jul 2012 08:56:14 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id DH3qOwiIQmoD; Mon, 16 Jul 2012 08:56:14 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id B967C1C71E1; Mon, 16 Jul 2012 08:56:14 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id B2AEB3FF09; Mon, 16 Jul 2012 08:56:14 -0400 (EDT) Date: Mon, 16 Jul 2012 08:56:14 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Tristan Gingold Subject: [Ada] Explicitly pass exception occurrence to notifiers Message-ID: <20120716125614.GA25428@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This is an internal cleanup and preliminary to removal of useless ada occurrence copy. No functional change. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-07-16 Tristan Gingold * a-exexpr.adb (Propagate_Exception): Adjust call to Exception_Traces procedures. * a-exexpr-gcc.adb (Setup_Current_Excep): Now a function that returns an access to the Ada occurrence. (Propagate_GCC_Exception): Adjust calls. * raise.h (struct Exception_Occurrence): Declare. * a-exextr.adb: Remove useless pragma. (Notify_Handled_Exception, Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add Excep parameter. * a-except.adb (Notify_Handled_Exception, Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add Excep parameter. (Process_Raise_Exception): Adjust calls. * a-except-2005.adb (Notify_Handled_Exception, Notify_Unhandled_Exception) (Unhandled_Exception_Terminate): Add Excep parameter. (Raise_Exception): Calls Raise_Exception_Always. * raise-gcc.c (__gnat_setup_current_excep, __gnat_notify_handled_exception) (__gnat_notify_unhandled_exception): Adjust declarations. (PERSONALITY_FUNCTION): Adjust calls. (__gnat_personality_seh0): Remove warning. Index: a-exexpr.adb =================================================================== --- a-exexpr.adb (revision 189530) +++ a-exexpr.adb (working copy) @@ -43,7 +43,7 @@ pragma No_Return (builtin_longjmp); pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp"); - procedure Propagate_Continue (Excep : EOA); + procedure Propagate_Continue (E : Exception_Id); pragma No_Return (Propagate_Continue); pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg"); -- A call to this procedure is inserted automatically by GIGI, in order @@ -74,14 +74,14 @@ if Jumpbuf_Ptr /= Null_Address then if not Excep.Exception_Raised then Excep.Exception_Raised := True; - Exception_Traces.Notify_Handled_Exception; + Exception_Traces.Notify_Handled_Exception (Excep); end if; builtin_longjmp (Jumpbuf_Ptr, 1); else - Exception_Traces.Notify_Unhandled_Exception; - Exception_Traces.Unhandled_Exception_Terminate; + Exception_Traces.Notify_Unhandled_Exception (Excep); + Exception_Traces.Unhandled_Exception_Terminate (Excep); end if; end Propagate_Exception; @@ -89,9 +89,10 @@ -- Propagate_Continue -- ------------------------ - procedure Propagate_Continue (Excep : EOA) is + procedure Propagate_Continue (E : Exception_Id) is + pragma Unreferenced (E); begin - Propagate_Exception (Excep); + Propagate_Exception (Get_Current_Excep.all); end Propagate_Continue; end Exception_Propagation; Index: raise.h =================================================================== --- raise.h (revision 189524) +++ raise.h (working copy) @@ -49,6 +49,8 @@ typedef struct Exception_Data *Exception_Id; +struct Exception_Occurrence; + extern void _gnat_builtin_longjmp (void *, int); extern void __gnat_unhandled_terminate (void); extern void *__gnat_malloc (__SIZE_TYPE__); Index: a-exexpr-gcc.adb =================================================================== --- a-exexpr-gcc.adb (revision 189530) +++ a-exexpr-gcc.adb (working copy) @@ -202,8 +202,9 @@ -- Called to implement raise without exception, ie reraise. Called -- directly from gigi. - procedure Setup_Current_Excep - (GCC_Exception : not null GCC_Exception_Access); + function Setup_Current_Excep + (GCC_Exception : not null GCC_Exception_Access) + return EOA; pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); -- Write Get_Current_Excep.all from GCC_Exception @@ -342,8 +343,9 @@ -- Setup_Current_Excep -- ------------------------- - procedure Setup_Current_Excep + function Setup_Current_Excep (GCC_Exception : not null GCC_Exception_Access) + return EOA is Excep : constant EOA := Get_Current_Excep.all; @@ -359,6 +361,8 @@ To_GNAT_GCC_Exception (GCC_Exception); begin Excep.all := GNAT_Occurrence.Occurrence; + + return GNAT_Occurrence.Occurrence'Access; end; else @@ -370,6 +374,8 @@ Excep.Exception_Raised := True; Excep.Pid := Local_Partition_ID; Excep.Num_Tracebacks := 0; + + return Excep; end if; end Setup_Current_Excep; @@ -420,6 +426,7 @@ procedure Propagate_GCC_Exception (GCC_Exception : not null GCC_Exception_Access) is + Excep : EOA; begin -- Perform a standard raise first. If a regular handler is found, it -- will be entered after all the intermediate cleanups have run. If @@ -432,8 +439,8 @@ -- the necessary steps to enable the debugger to gain control while the -- stack is still intact. - Setup_Current_Excep (GCC_Exception); - Notify_Unhandled_Exception; + Excep := Setup_Current_Excep (GCC_Exception); + Notify_Unhandled_Exception (Excep); -- Now, un a forced unwind to trigger cleanups. Control should not -- resume there, if there are cleanups and in any cases as the @@ -466,9 +473,10 @@ procedure Unhandled_Except_Handler (GCC_Exception : not null GCC_Exception_Access) is + Excep : EOA; begin - Setup_Current_Excep (GCC_Exception); - Unhandled_Exception_Terminate; + Excep := Setup_Current_Excep (GCC_Exception); + Unhandled_Exception_Terminate (Excep); end Unhandled_Except_Handler; ------------- Index: a-exextr.adb =================================================================== --- a-exextr.adb (revision 189524) +++ a-exextr.adb (working copy) @@ -72,17 +72,6 @@ -- latter case because Notify_Handled_Exception may be called for an -- actually unhandled occurrence in the Front-End-SJLJ case. - -------------------------------- - -- Import Run-Time C Routines -- - -------------------------------- - - -- The purpose of the following pragma Import is to ensure that we - -- generate appropriate subprogram descriptors for all C routines in - -- the standard GNAT library that can raise exceptions. This ensures - -- that the exception propagation can properly find these routines - - pragma Propagate_Exceptions; - ---------------------- -- Notify_Exception -- ---------------------- @@ -132,18 +121,16 @@ -- Notify_Handled_Exception -- ------------------------------ - procedure Notify_Handled_Exception is + procedure Notify_Handled_Exception (Excep : EOA) is begin - Notify_Exception (Get_Current_Excep.all, Is_Unhandled => False); + Notify_Exception (Excep, Is_Unhandled => False); end Notify_Handled_Exception; -------------------------------- -- Notify_Unhandled_Exception -- -------------------------------- - procedure Notify_Unhandled_Exception is - Excep : constant EOA := Get_Current_Excep.all; - + procedure Notify_Unhandled_Exception (Excep : EOA) is begin -- Check whether there is any termination handler to be executed for -- the environment task, and execute it if needed. Here we handle both @@ -161,8 +148,8 @@ -- Unhandled_Exception_Terminate -- ----------------------------------- - procedure Unhandled_Exception_Terminate is - Excep : Exception_Occurrence; + procedure Unhandled_Exception_Terminate (Excep : EOA) is + Occ : Exception_Occurrence; -- This occurrence will be used to display a message after finalization. -- It is necessary to save a copy here, or else the designated value -- could be overwritten if an exception is raised during finalization @@ -172,8 +159,8 @@ -- that there is enough room on the stack however. begin - Save_Occurrence (Excep, Get_Current_Excep.all.all); - Last_Chance_Handler (Excep); + Save_Occurrence (Occ, Excep.all); + Last_Chance_Handler (Occ); end Unhandled_Exception_Terminate; ------------------------------------ Index: a-except.adb =================================================================== --- a-except.adb (revision 189530) +++ a-except.adb (working copy) @@ -189,19 +189,19 @@ -- exported to be usable by the Ada exception handling personality -- routine when the GCC 3 mechanism is used. - procedure Notify_Handled_Exception; + procedure Notify_Handled_Exception (Excep : EOA); pragma Export (C, Notify_Handled_Exception, "__gnat_notify_handled_exception"); -- This routine is called for a handled occurrence is about to be -- propagated. - procedure Notify_Unhandled_Exception; + procedure Notify_Unhandled_Exception (Excep : EOA); pragma Export (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception"); -- This routine is called when an unhandled occurrence is about to be -- propagated. - procedure Unhandled_Exception_Terminate; + procedure Unhandled_Exception_Terminate (Excep : EOA); pragma No_Return (Unhandled_Exception_Terminate); -- This procedure is called to terminate program execution following an -- unhandled exception. The exception information, including traceback @@ -895,14 +895,14 @@ if Jumpbuf_Ptr /= Null_Address then if not Excep.Exception_Raised then Excep.Exception_Raised := True; - Exception_Traces.Notify_Handled_Exception; + Exception_Traces.Notify_Handled_Exception (Excep); end if; builtin_longjmp (Jumpbuf_Ptr, 1); else - Exception_Traces.Notify_Unhandled_Exception; - Exception_Traces.Unhandled_Exception_Terminate; + Exception_Traces.Notify_Unhandled_Exception (Excep); + Exception_Traces.Unhandled_Exception_Terminate (Excep); end if; end Process_Raise_Exception; Index: a-except-2005.adb =================================================================== --- a-except-2005.adb (revision 189530) +++ a-except-2005.adb (working copy) @@ -209,19 +209,19 @@ -- exported to be usable by the Ada exception handling personality -- routine when the GCC 3 mechanism is used. - procedure Notify_Handled_Exception; + procedure Notify_Handled_Exception (Excep : EOA); pragma Export (C, Notify_Handled_Exception, "__gnat_notify_handled_exception"); -- This routine is called for a handled occurrence is about to be -- propagated. - procedure Notify_Unhandled_Exception; + procedure Notify_Unhandled_Exception (Excep : EOA); pragma Export (C, Notify_Unhandled_Exception, "__gnat_notify_unhandled_exception"); -- This routine is called when an unhandled occurrence is about to be -- propagated. - procedure Unhandled_Exception_Terminate; + procedure Unhandled_Exception_Terminate (Excep : EOA); pragma No_Return (Unhandled_Exception_Terminate); -- This procedure is called to terminate execution following an -- unhandled exception. The exception information, including @@ -395,15 +395,16 @@ -- Reraises the exception referenced by the Current_Excep field of -- the TSD (all fields of this exception occurrence are set). Abort -- is deferred before the reraise operation. + -- Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous procedure Transfer_Occurrence (Target : Exception_Occurrence_Access; Source : Exception_Occurrence); pragma Export (C, Transfer_Occurrence, "__gnat_transfer_occurrence"); - -- Called from System.Tasking.RendezVous.Exceptional_Complete_RendezVous - -- to setup Target from Source as an exception to be propagated in the - -- caller task. Target is expected to be a pointer to the fixed TSD - -- occurrence for this task. + -- Called from s-tasren.adb:Local_Complete_RendezVous and + -- s-tpobop.adb:Exceptional_Complete_Entry_Body to setup Target from + -- Source as an exception to be propagated in the caller task. Target is + -- expected to be a pointer to the fixed TSD occurrence for this task. ----------------------------- -- Run-Time Check Routines -- @@ -953,8 +954,6 @@ Message : String := "") is EF : Exception_Id := E; - X : constant EOA := Exception_Propagation.Allocate_Occurrence; - begin -- Raise CE if E = Null_ID (AI-446) @@ -964,14 +963,7 @@ -- Go ahead and raise appropriate exception - Exception_Data.Set_Exception_Msg (X, EF, Message); - - if not ZCX_By_Default then - Abort_Defer.all; - end if; - - Complete_Occurrence (X); - Exception_Propagation.Propagate_Exception (X); + Raise_Exception_Always (EF, Message); end Raise_Exception; ---------------------------- Index: raise-gcc.c =================================================================== --- raise-gcc.c (revision 189530) +++ raise-gcc.c (working copy) @@ -77,7 +77,8 @@ _Unwind_Reason_Code __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *); -extern void __gnat_setup_current_excep (_Unwind_Exception *); +extern struct Exception_Occurrence *__gnat_setup_current_excep + (_Unwind_Exception *); extern void __gnat_unhandled_except_handler (_Unwind_Exception *); #include "dwarf2.h" @@ -1001,8 +1002,8 @@ /* The following is defined from a-except.adb. Its purpose is to enable automatic backtraces upon exception raise, as provided through the GNAT.Traceback facilities. */ -extern void __gnat_notify_handled_exception (void); -extern void __gnat_notify_unhandled_exception (void); +extern void __gnat_notify_handled_exception (struct Exception_Occurrence *); +extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *); /* Below is the eh personality routine per se. We currently assume that only GNU-Ada exceptions are met. */ @@ -1131,14 +1132,16 @@ } else { + struct Exception_Occurrence *excep; + /* Trigger the appropriate notification routines before the second phase starts, which ensures the stack is still intact. First, setup the Ada occurrence. */ - __gnat_setup_current_excep (uw_exception); + excep = __gnat_setup_current_excep (uw_exception); if (action.kind == unhandler) - __gnat_notify_unhandled_exception (); + __gnat_notify_unhandled_exception (excep); else - __gnat_notify_handled_exception (); + __gnat_notify_handled_exception (excep); return _URC_HANDLER_FOUND; } @@ -1324,7 +1327,7 @@ CONTEXT context; PRUNTIME_FUNCTION mf_func = NULL; ULONG64 mf_imagebase; - ULONG64 mf_rsp; + ULONG64 mf_rsp = 0; /* Get the context. */ RtlCaptureContext (&context);