[Ada] Mark Exceptional_Complete_Rendezvous No_Return
Arnaud Charlet
charlet@adacore.com
Wed Feb 8 10:05:00 GMT 2012
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 <charlet@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.
-------------- next part --------------
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.
More information about the Gcc-patches
mailing list