Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 247320)
+++ exp_ch7.adb	(working copy)
@@ -4176,37 +4176,37 @@
    procedure Expand_Cleanup_Actions (N : Node_Id) is
       Scop : constant Entity_Id := Current_Scope;
 
-      Is_Asynchronous_Call : constant Boolean :=
-                               Nkind (N) = N_Block_Statement
-                                 and then Is_Asynchronous_Call_Block (N);
-      Is_Master            : constant Boolean :=
-                               Nkind (N) /= N_Entry_Body
-                                 and then Is_Task_Master (N);
-      Is_Protected_Body    : constant Boolean :=
-                               Nkind (N) = N_Subprogram_Body
-                                 and then Is_Protected_Subprogram_Body (N);
-      Is_Task_Allocation   : constant Boolean :=
-                               Nkind (N) = N_Block_Statement
-                                 and then Is_Task_Allocation_Block (N);
-      Is_Task_Body         : constant Boolean :=
-                               Nkind (Original_Node (N)) = N_Task_Body;
-      Needs_Sec_Stack_Mark : constant Boolean :=
-                               Uses_Sec_Stack (Scop)
-                                 and then
-                                   not Sec_Stack_Needed_For_Return (Scop);
-      Needs_Custom_Cleanup : constant Boolean :=
-                               Nkind (N) = N_Block_Statement
-                                 and then Present (Cleanup_Actions (N));
+      Is_Asynchronous_Call   : constant Boolean :=
+                                 Nkind (N) = N_Block_Statement
+                                   and then Is_Asynchronous_Call_Block (N);
+      Is_Master              : constant Boolean :=
+                                 Nkind (N) /= N_Entry_Body
+                                   and then Is_Task_Master (N);
+      Is_Protected_Subp_Body : constant Boolean :=
+                                 Nkind (N) = N_Subprogram_Body
+                                   and then Is_Protected_Subprogram_Body (N);
+      Is_Task_Allocation     : constant Boolean :=
+                                 Nkind (N) = N_Block_Statement
+                                   and then Is_Task_Allocation_Block (N);
+      Is_Task_Body           : constant Boolean :=
+                                 Nkind (Original_Node (N)) = N_Task_Body;
+      Needs_Sec_Stack_Mark   : constant Boolean :=
+                                 Uses_Sec_Stack (Scop)
+                                   and then
+                                     not Sec_Stack_Needed_For_Return (Scop);
+      Needs_Custom_Cleanup   : constant Boolean :=
+                                 Nkind (N) = N_Block_Statement
+                                   and then Present (Cleanup_Actions (N));
 
-      Actions_Required     : constant Boolean :=
-                               Requires_Cleanup_Actions (N, True)
-                                 or else Is_Asynchronous_Call
-                                 or else Is_Master
-                                 or else Is_Protected_Body
-                                 or else Is_Task_Allocation
-                                 or else Is_Task_Body
-                                 or else Needs_Sec_Stack_Mark
-                                 or else Needs_Custom_Cleanup;
+      Actions_Required       : constant Boolean :=
+                                 Requires_Cleanup_Actions (N, True)
+                                   or else Is_Asynchronous_Call
+                                   or else Is_Master
+                                   or else Is_Protected_Subp_Body
+                                   or else Is_Task_Allocation
+                                   or else Is_Task_Body
+                                   or else Needs_Sec_Stack_Mark
+                                   or else Needs_Custom_Cleanup;
 
       HSS : Node_Id := Handled_Statement_Sequence (N);
       Loc : Source_Ptr;
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 247385)
+++ exp_ch9.adb	(working copy)
@@ -24,7 +24,6 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
-with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
@@ -421,9 +420,6 @@
    --  the Task_Body_Procedure of Spec_Id. The returned entity denotes formal
    --  parameter _E.
 
-   function Is_Exception_Safe (Subprogram : Node_Id) return Boolean;
-   --  Tell whether a given subprogram cannot raise an exception
-
    function Is_Potentially_Large_Family
      (Base_Index : Entity_Id;
       Conctyp    : Entity_Id;
@@ -3889,30 +3885,28 @@
       Pid       : Node_Id;
       N_Op_Spec : Node_Id) return Node_Id
    is
-      Loc         : constant Source_Ptr := Sloc (N);
-      Op_Spec     : Node_Id;
-      P_Op_Spec   : Node_Id;
-      Uactuals    : List_Id;
-      Pformal     : Node_Id;
-      Unprot_Call : Node_Id;
-      Sub_Body    : Node_Id;
+      Exc_Safe : constant Boolean := not Might_Raise (N);
+      --  True if N cannot raise an exception
+
+      Loc       : constant Source_Ptr := Sloc (N);
+      Op_Spec   : constant Node_Id := Specification (N);
+      P_Op_Spec : constant Node_Id :=
+                    Build_Protected_Sub_Specification (N, Pid, Protected_Mode);
+
+      Lock_Kind   : RE_Id;
       Lock_Name   : Node_Id;
       Lock_Stmt   : Node_Id;
+      Object_Parm : Node_Id;
+      Pformal     : Node_Id;
       R           : Node_Id;
       Return_Stmt : Node_Id := Empty;    -- init to avoid gcc 3 warning
       Pre_Stmts   : List_Id := No_List;  -- init to avoid gcc 3 warning
       Stmts       : List_Id;
-      Object_Parm : Node_Id;
-      Exc_Safe    : Boolean;
-      Lock_Kind   : RE_Id;
+      Sub_Body    : Node_Id;
+      Uactuals    : List_Id;
+      Unprot_Call : Node_Id;
 
    begin
-      Op_Spec := Specification (N);
-      Exc_Safe := Is_Exception_Safe (N);
-
-      P_Op_Spec :=
-        Build_Protected_Sub_Specification (N, Pid, Protected_Mode);
-
       --  Build a list of the formal parameters of the protected version of
       --  the subprogram to use as the actual parameters of the unprotected
       --  version.
@@ -13545,103 +13539,6 @@
       end if;
    end Install_Private_Data_Declarations;
 
-   -----------------------
-   -- Is_Exception_Safe --
-   -----------------------
-
-   function Is_Exception_Safe (Subprogram : Node_Id) return Boolean is
-
-      function Has_Side_Effect (N : Node_Id) return Boolean;
-      --  Return True whenever encountering a subprogram call or raise
-      --  statement of any kind in the sequence of statements
-
-      ---------------------
-      -- Has_Side_Effect --
-      ---------------------
-
-      --  What is this doing buried two levels down in exp_ch9. It seems like a
-      --  generally useful function, and indeed there may be code duplication
-      --  going on here ???
-
-      function Has_Side_Effect (N : Node_Id) return Boolean is
-         Stmt : Node_Id;
-         Expr : Node_Id;
-
-         function Is_Call_Or_Raise (N : Node_Id) return Boolean;
-         --  Indicate whether N is a subprogram call or a raise statement
-
-         ----------------------
-         -- Is_Call_Or_Raise --
-         ----------------------
-
-         function Is_Call_Or_Raise (N : Node_Id) return Boolean is
-         begin
-            return Nkind_In (N, N_Procedure_Call_Statement,
-                                N_Function_Call,
-                                N_Raise_Statement,
-                                N_Raise_Constraint_Error,
-                                N_Raise_Program_Error,
-                                N_Raise_Storage_Error);
-         end Is_Call_Or_Raise;
-
-      --  Start of processing for Has_Side_Effect
-
-      begin
-         Stmt := N;
-         while Present (Stmt) loop
-            if Is_Call_Or_Raise (Stmt) then
-               return True;
-            end if;
-
-            --  An object declaration can also contain a function call or a
-            --  raise statement.
-
-            if Nkind (Stmt) = N_Object_Declaration then
-               Expr := Expression (Stmt);
-
-               if Present (Expr) and then Is_Call_Or_Raise (Expr) then
-                  return True;
-               end if;
-            end if;
-
-            Next (Stmt);
-         end loop;
-
-         return False;
-      end Has_Side_Effect;
-
-   --  Start of processing for Is_Exception_Safe
-
-   begin
-      --  When exceptions can't be propagated, the subprogram returns normally
-
-      if No_Exception_Handlers_Set then
-         return True;
-      end if;
-
-      --  If the checks handled by the back end are not disabled, we cannot
-      --  ensure that no exception will be raised.
-
-      if not Access_Checks_Suppressed (Empty)
-        or else not Discriminant_Checks_Suppressed (Empty)
-        or else not Range_Checks_Suppressed (Empty)
-        or else not Index_Checks_Suppressed (Empty)
-        or else Opt.Stack_Checking_Enabled
-      then
-         return False;
-      end if;
-
-      if Has_Side_Effect (First (Declarations (Subprogram)))
-        or else
-          Has_Side_Effect
-            (First (Statements (Handled_Statement_Sequence (Subprogram))))
-      then
-         return False;
-      else
-         return True;
-      end if;
-   end Is_Exception_Safe;
-
    ---------------------------------
    -- Is_Potentially_Large_Family --
    ---------------------------------
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 247386)
+++ sem_util.adb	(working copy)
@@ -16869,6 +16869,63 @@
       Mark_Allocators (Root_Nod);
    end Mark_Coextensions;
 
+   -----------------
+   -- Might_Raise --
+   -----------------
+
+   function Might_Raise (N : Node_Id) return Boolean is
+      Result : Boolean := False;
+
+      function Process (N : Node_Id) return Traverse_Result;
+      --  Set Result to True if we find something that could raise an exception
+
+      -------------
+      -- Process --
+      -------------
+
+      function Process (N : Node_Id) return Traverse_Result is
+      begin
+         if Nkind_In (N, N_Procedure_Call_Statement,
+                         N_Function_Call,
+                         N_Raise_Statement,
+                         N_Raise_Constraint_Error,
+                         N_Raise_Program_Error,
+                         N_Raise_Storage_Error)
+         then
+            Result := True;
+            return Abandon;
+         else
+            return OK;
+         end if;
+      end Process;
+
+      procedure Set_Result is new Traverse_Proc (Process);
+
+   --  Start of processing for Might_Raise
+
+   begin
+      --  False if exceptions can't be propagated
+
+      if No_Exception_Handlers_Set then
+         return False;
+      end if;
+
+      --  If the checks handled by the back end are not disabled, we cannot
+      --  ensure that no exception will be raised.
+
+      if not Access_Checks_Suppressed (Empty)
+        or else not Discriminant_Checks_Suppressed (Empty)
+        or else not Range_Checks_Suppressed (Empty)
+        or else not Index_Checks_Suppressed (Empty)
+        or else Opt.Stack_Checking_Enabled
+      then
+         return True;
+      end if;
+
+      Set_Result (N);
+      return Result;
+   end Might_Raise;
+
    --------------------------------
    -- Nearest_Enclosing_Instance --
    --------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 247335)
+++ sem_util.ads	(working copy)
@@ -1984,6 +1984,11 @@
    --  to guarantee this in all cases. Note that it is more possible to give
    --  correct answer if the tree is fully analyzed.
 
+   function Might_Raise (N : Node_Id) return Boolean;
+   --  True if evaluation of N might raise an exception. This is conservative;
+   --  if we're not sure, we return True. If N is a subprogram body, this is
+   --  about whether execution of that body can raise.
+
    function Nearest_Enclosing_Instance (E : Entity_Id) return Entity_Id;
    --  Return the entity of the nearest enclosing instance which encapsulates
    --  entity E. If no such instance exits, return Empty.
