decl.c (gnat_to_gnu_entity): Do not set "const" flag on "pure" Ada subprograms…

decl.c (gnat_to_gnu_entity): Do not set "const" flag on "pure" Ada subprograms if SJLJ exceptions are used.

	* decl.c (gnat_to_gnu_entity) <E_Procedure>: Do not set "const" flag
	on "pure" Ada subprograms if SJLJ exceptions are used.
	* trans.c (Handled_Sequence_Of_Statements_to_gnu): Set TREE_NO_WARNING
	on the declaration node of JMPBUF_SAVE.
	* utils.c (init_gigi_decls): Set DECL_IS_PURE on the declaration nodes
	of Get_Jmpbuf_Address_Soft and Get_GNAT_Exception.
	* utils2.c (build_call_0_expr): Do not set TREE_SIDE_EFFECTS.

From-SVN: r117299

gcc/ada/ChangeLog

+2006-09-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* decl.c (gnat_to_gnu_entity) <E_Procedure>: Do not set "const" flag
+	on "pure" Ada subprograms if SJLJ exceptions are used.
+	* trans.c (Handled_Sequence_Of_Statements_to_gnu): Set TREE_NO_WARNING
+	on the declaration node of JMPBUF_SAVE.
+	* utils.c (init_gigi_decls): Set DECL_IS_PURE on the declaration nodes
+	of Get_Jmpbuf_Address_Soft and Get_GNAT_Exception.
+	* utils2.c (build_call_0_expr): Do not set TREE_SIDE_EFFECTS.
+
 2006-08-20  Laurent GUERBY  <laurent@guerby.net>
 
         PR ada/28716

gcc/ada/decl.c

@@ -3768,11 +3768,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (TREE_CODE (gnu_return_type) == VOID_TYPE)
 	  pure_flag = false;
 
+	/* The semantics of "pure" in Ada essentially matches that of "const"
+	   in the back-end.  In particular, both properties are orthogonal to
+	   the "nothrow" property.  But this is true only if the EH circuitry
+	   is explicit in the internal representation of the back-end.  If we
+	   are to completely hide the EH circuitry from it, we need to declare
+	   that calls to pure Ada subprograms that can throw have side effects
+	   since they can trigger an "abnormal" transfer of control flow; thus
+	   they can be neither "const" nor "pure" in the back-end sense.  */
 	gnu_type
 	  = build_qualified_type (gnu_type,
-				  (TYPE_QUALS (gnu_type)
-				   | (TYPE_QUAL_CONST * pure_flag)
-				   | (TYPE_QUAL_VOLATILE * volatile_flag)));
+				  TYPE_QUALS (gnu_type)
+				  | (Exception_Mechanism == Back_End_Exceptions
+				     ? TYPE_QUAL_CONST * pure_flag : 0)
+				  | (TYPE_QUAL_VOLATILE * volatile_flag));
 
 	Sloc_to_locus (Sloc (gnat_entity), &input_location);
 
@@ -3841,6 +3850,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 					    inline_flag, public_flag,
 					    extern_flag, attr_list,
 					    gnat_entity);
+
 	    DECL_STUBBED_P (gnu_decl)
 	      = Convention (gnat_entity) == Convention_Stubbed;
 	  }

gcc/ada/trans.c

@@ -2167,6 +2167,11 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
 					  build_call_0_expr (get_jmpbuf_decl),
 					  false, false, false, false, NULL,
 					  gnat_node);
+      /* The __builtin_setjmp receivers will immediately reinstall it.  Now
+	 because of the unstructured form of EH used by setjmp_longjmp, there
+	 might be forward edges going to __builtin_setjmp receivers on which
+	 it is uninitialized, although they will never be actually taken.  */
+      TREE_NO_WARNING (gnu_jmpsave_decl) = 1;
       gnu_jmpbuf_decl = create_var_decl (get_identifier ("JMP_BUF"),
 					 NULL_TREE, jmpbuf_type,
 					 NULL_TREE, false, false, false, false,

gcc/ada/utils.c

@@ -518,6 +518,8 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
     (get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
      NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
      NULL_TREE, false, true, true, NULL, Empty);
+  /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
+  DECL_IS_PURE (get_jmpbuf_decl) = 1;
 
   set_jmpbuf_decl
     = create_subprog_decl
@@ -534,6 +536,8 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
      NULL_TREE,
      build_function_type (build_pointer_type (except_type_node), NULL_TREE),
      NULL_TREE, false, true, true, NULL, Empty);
+  /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
+  DECL_IS_PURE (get_excptr_decl) = 1;
 
   /* Functions that raise exceptions. */
   raise_nodefer_decl

gcc/ada/utils2.c

@@ -1431,7 +1431,8 @@ build_call_0_expr (tree fundecl)
 		      build_unary_op (ADDR_EXPR, NULL_TREE, fundecl),
 		      NULL_TREE, NULL_TREE);
 
-  TREE_SIDE_EFFECTS (call) = 1;
+  /* We rely on build3 to compute TREE_SIDE_EFFECTS.  This makes it possible
+     to propagate the DECL_IS_PURE flag on parameterless functions.  */
 
   return call;
 }