This change marks Exceptional_Complete_Rendezvous No_Return, which can be useful for code generation purposes, and can also help static analyzers.
Tested on x86_64-pc-linux-gnu, committed on trunk 2012-02-08 Arnaud Charlet <char...@adacore.com> * s-tasren.adb, s-tasren.ads (Internal_Complete_Rendezvous): New function. (Complete_Rendezvous): Now call Internal_Complete_Rendezvous. (Exceptional_Complete_Rendezvous): Mark No_Return.
Index: s-tasren.adb =================================================================== --- s-tasren.adb (revision 183996) +++ s-tasren.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -107,6 +107,12 @@ -- debugging it may be wise to modify the above renamings to the -- non-nestable forms. + procedure Local_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id); + -- Internal version of Complete_Rendezvous, used to implement + -- Complete_Rendezvous and Exceptional_Complete_Rendezvous. + -- Should be called holding no locks, generally with abort not yet + -- deferred. + procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id); pragma Inline (Boost_Priority); -- Call this only with abort deferred and holding lock of Acceptor @@ -498,7 +504,7 @@ procedure Complete_Rendezvous is begin - Exceptional_Complete_Rendezvous (Ada.Exceptions.Null_Id); + Local_Complete_Rendezvous (Ada.Exceptions.Null_Id); end Complete_Rendezvous; ------------------------------------- @@ -508,19 +514,33 @@ procedure Exceptional_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id) is + procedure Internal_Reraise; + pragma No_Return (Internal_Reraise); + pragma Import (C, Internal_Reraise, "__gnat_reraise"); + + begin + Local_Complete_Rendezvous (Ex); + Internal_Reraise; + + -- ??? Do we need to give precedence to Program_Error that might be + -- raised due to failure of finalization, over Tasking_Error from + -- failure of requeue? + end Exceptional_Complete_Rendezvous; + + ------------------------------- + -- Local_Complete_Rendezvous -- + ------------------------------- + + procedure Local_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id) is Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link := Self_Id.Common.Call; Caller : Task_Id; Called_PO : STPE.Protection_Entries_Access; Acceptor_Prev_Priority : Integer; - Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex; Ceiling_Violation : Boolean; use type Ada.Exceptions.Exception_Id; - procedure Internal_Reraise; - pragma Import (C, Internal_Reraise, "__gnat_reraise"); - procedure Transfer_Occurrence (Target : Ada.Exceptions.Exception_Occurrence_Access; Source : Ada.Exceptions.Exception_Occurrence); @@ -529,18 +549,12 @@ use type STPE.Protection_Entries_Access; begin - -- Consider phasing out Complete_Rendezvous in favor of direct call to - -- this with Ada.Exceptions.Null_ID. See code expansion examples for - -- Accept_Call and Selective_Wait. Also consider putting an explicit - -- re-raise after this call, in the generated code. That way we could - -- eliminate the code here that reraises the exception. - -- The deferral level is critical here, since we want to raise an -- exception or allow abort to take place, if there is an exception or -- abort pending. pragma Debug - (Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R')); + (Debug.Trace (Self_Id, "Local_Complete_Rendezvous", 'R')); if Ex = Ada.Exceptions.Null_Id then @@ -632,10 +646,8 @@ if Ceiling_Violation then pragma Assert (Ex = Ada.Exceptions.Null_Id); + Entry_Call.Exception_To_Raise := Program_Error'Identity; - Exception_To_Raise := Program_Error'Identity; - Entry_Call.Exception_To_Raise := Exception_To_Raise; - if Single_Lock then Lock_RTS; end if; @@ -692,17 +704,8 @@ end if; Initialization.Undefer_Abort (Self_Id); + end Local_Complete_Rendezvous; - if Exception_To_Raise /= Ada.Exceptions.Null_Id then - Internal_Reraise; - end if; - - -- ??? Do we need to give precedence to Program_Error that might be - -- raised due to failure of finalization, over Tasking_Error from - -- failure of requeue? - - end Exceptional_Complete_Rendezvous; - ------------------------------------- -- Requeue_Protected_To_Task_Entry -- ------------------------------------- Index: s-tasren.ads =================================================================== --- s-tasren.ads (revision 183996) +++ s-tasren.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -308,6 +308,7 @@ procedure Exceptional_Complete_Rendezvous (Ex : Ada.Exceptions.Exception_Id); + pragma No_Return (Exceptional_Complete_Rendezvous); -- Called by acceptor to mark the end of the current rendezvous and -- propagate an exception to the caller.