gigi.h: (tree_code_for_record_type): Declare.

2006-10-31  Eric Botcazou  <ebotcazou@adacore.com>
	    Nicolas Setton  <setton@adacore.com>
	    Olivier Hainque  <hainque@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* gigi.h: (tree_code_for_record_type): Declare.
	(add_global_renaming_pointer): Rename to record_global_renaming_pointer.
	(get_global_renaming_pointers): Rename to
	invalidate_global_renaming_pointers.
	(static_ctors): Delete.
	(static_dtors): Likewise.
	(gnat_write_global_declarations): Declare.
	(create_var_decl): Adjust descriptive comment to indicate that the
	subprogram may return a CONST_DECL node.
	(create_true_var_decl): Declare new function, similar to
	create_var_decl but forcing the creation of a VAR_DECL node.
	(get_global_renaming_pointers): Declare.
	(add_global_renaming_pointer): Likewise.

	* ada-tree.h (DECL_READONLY_ONCE_ELAB): New macro.

	* decl.c (gnat_to_gnu_entity) <case E_Function>: Don't copy the type
	tree before setting TREE_ADDRESSABLE for by-reference return mechanism
	processing.
	(gnat_to_gnu_entity): Remove From_With_Type from computation for
	imported_p.
	<E_Access_Type>: Use the Non_Limited_View as the full view of the
	designated type if the pointer comes from a limited_with clause.  Make
	incomplete designated type if it is in the main unit and has a freeze
	node.
	<E_Incomplete_Type>: Rework to treat Non_Limited_View, Full_View, and
	Underlying_Full_View similarly.  Return earlier if the full view already
	has an associated tree.
	(gnat_to_gnu_entity) <E_Record_Type>: Restore comment.
	(gnat_to_gnu_entity) <E_Record_Type>: Do not use a dummy type.
	(gnat_to_gnu_entity) <E_Variable>: Set TYPE_REF_CAN_ALIAS_ALL on the
	reference type built for objects with an address clause.
	Use create_true_var_decl with const_flag set for
	DECL_CONST_CORRESPONDING_VARs, ensuring a VAR_DECL is created with
	TREE_READONLY set.
	(gnat_to_gnu_entity, case E_Enumeration_Type): Set TYPE_NAME
	for Character and Wide_Character types. This info is read by the
	dwarf-2 writer, and is needed to be able to use the command "ptype
	character" in the debugger.
	(gnat_to_gnu_entity): When generating a type representing
	a Character or Wide_Character type, set the flag TYPE_STRING_FLAG,
	so that debug writers can distinguish it from ordinary integers.
	(elaborate_expression_1): Test the DECL_READONLY_ONCE_ELAB flag in
	addition to TREE_READONLY to assert the constantness of variables for
	elaboration purposes.
	(gnat_to_gnu_entity, subprogram cases): Change loops on formal
	parameters to call new Einfo function First_Formal_With_Extras.
	(gnat_to_gnu_entity): In type_annotate mode, replace a discriminant of a
	protected type with its corresponding discriminant, to obtain a usable
	declaration
	(gnat_to_gnu_entity) <E_Access_Protected_Subprogram_Type>: Be prepared
	for a multiple elaboration of the "equivalent" type.
	(gnat_to_gnu_entity): Adjust for renaming of add_global_renaming_pointer
	into record_global_renaming_pointer.
	(gnat_to_gnu_entity) <E_Array_Type>: Do not force
	TYPE_NONALIASED_COMPONENT to 0 if the element type is an aggregate.
	<E_Array_Subtype>: Likewise.
	(gnat_to_gnu_entity) <E_Incomplete_Subtype>: Add support for regular
	incomplete subtypes and incomplete subtypes of incomplete types visible
	through a limited with clause.
	(gnat_to_gnu_entity) <E_Array_Subtype>: Take into account the bounds of
	the base index type for the maximum size of the array only if they are
	constant.
	(gnat_to_gnu_entity, renaming object case): Do not wrap up the
	expression into a SAVE_EXPR if stabilization failed.

	* utils.c (create_subprog_decl): Turn TREE_ADDRESSABLE on the type of
	a result decl into DECL_BY_REFERENCE on this decl, now what is expected
	by lower level compilation passes.
	(gnat_genericize): New function, lowering a function body to GENERIC.
	Turn the type of RESULT_DECL into a real reference type if the decl
	has been marked DECL_BY_REFERENCE, and adjust references to the latter
	accordingly.
	(gnat_genericize_r): New function. Tree walking callback for
	gnat_genericize.
	(convert_from_reference, is_byref_result): New functions. Helpers for
	gnat_genericize_r.
	(create_type_decl): Call gnat_pushdecl before calling
	rest_of_decl_compilation, to make sure that field TYPE_NAME of
	type_decl is properly set before calling the debug information writers.
	(write_record_type_debug_info): The heuristics which compute the
	alignment of a field in a variant record might not be accurate. Add a
	safety test to make sure no alignment is set to a smaller value than
	the alignment of the field type.
	(make_dummy_type): Use the Non_Limited_View as the underlying type if
	the type comes from a limited_with clause. Do not loop on the full view.
	(GET_GNU_TREE, SET_GNU_TREE, PRESENT_GNU_TREE): New macros.
	(dummy_node_table): New global variable, moved from decl.c.
	(GET_DUMMY_NODE, SET_DUMMY_NODE, PRESENT_DUMMY_NODE): New macros.
	(save_gnu_tree): Use above macros.
	(get_gnu_tree): Likewise.
	(present_gnu_tree): Likewise.
	(init_dummy_type): New function, moved from decl.c. Use above macros.
	(make_dummy_type): Likewise.
	(tree_code_for_record_type): New function extracted from make_dummy_type
	(init_gigi_decls): Set DECL_IS_MALLOC on gnat_malloc.
	(static_ctors): Change it to a vector, make static.
	(static_dtors): Likewise.
	(end_subprog_body): Adjust for above change.
	(build_global_cdtor): Moved from trans.c.
	(gnat_write_global_declarations): Emit global constructor and
	destructor, and call cgraph_optimize before emitting debug info for
	global declarations.
	(global_decls): New global variable.
	(gnat_pushdecl): Store the global declarations in global_decls, for
	later use.
	(gnat_write_global_declarations): Emit debug information for global
	 declarations.
	(create_var_decl_1): Former create_var_decl, with an extra argument to
	 state whether the creation of a CONST_DECL is allowed.
	(create_var_decl): Behavior unchanged. Now a wrapper around
	create_var_decl_1 allowing CONST_DECL creation.
	(create_true_var_decl): New function, similar to create_var_decl but
	forcing the creation of a VAR_DECL node (CONST_DECL not allowed).
	(create_field_decl): Do not always mark the field as addressable
	if its type is an aggregate.
	(global_renaming_pointers): New static variable.
	(add_global_renaming_pointer): New function.
	(get_global_renaming_pointers): Likewise.

	* misc.c (gnat_dwarf_name): New function.
	(LANG_HOOKS_DWARF_NAME): Define to gnat_dwarf_name.
	(gnat_post_options): Add comment about structural alias analysis.
	(gnat_parse_file): Do not call cgraph_optimize here.
	(LANG_HOOKS_WRITE_GLOBALS): Define to gnat_write_global_declarations.

	* trans.c (process_freeze_entity): Don't abort if we already have a
	non dummy GCC tree for a Concurrent_Record_Type, as it might
	legitimately have been elaborated while processing the associated
	Concurrent_Type prior to this explicit freeze node.
	(Identifier_to_gnu): Do not make a variable referenced in a SJLJ
	exception handler volatile if it is of variable size.
	(process_type): Remove bypass for types coming from a limited_with
	clause.
	(call_to_gnu): When processing the copy-out of a N_Type_Conversion GNAT
	actual, convert the corresponding gnu_actual to the real destination
	type when necessary.
	(add_decl_expr): Set the DECL_READONLY_ONCE_ELAB flag on variables
	originally TREE_READONLY but whose elaboration cannot be performed
	statically.
	Part of fix for F504-021.
	(tree_transform, subprogram cases): Change loops on formal parameters to
	call new Einfo function First_Formal_With_Extras.
	(gnat_to_gnu) <N_Op_Shift_Right_Arithmetic>: Ignore constant overflow
	stemming from type conversion for the lhs.
	(Attribute_to_gnu) <Attr_Alignment>: Also divide the alignment by the
	number of bits per unit for components of records.
	(gnat_to_gnu) <N_Code_Statement>: Mark operands addressable if needed.
	(Handled_Sequence_Of_Statements_to_gnu): Register the cleanup associated
	with At_End_Proc after the SJLJ EH cleanup.
	(Compilation_Unit_to_gnu): Call elaborate_all_entities only on the main
	compilation unit.
	(elaborate_all_entities): Do not retest type_annotate_only.
	(tree_transform) <N_Abstract_Subprogram_Declaration>: Process the
	result type of an abstract subprogram, which may be an itype associated
	with an anonymous access result (related to AI-318-02).
	(build_global_cdtor): Move to utils.c.
	(Case_Statement_to_gnu): Avoid adding the choice of a when statement if
	this choice is not a null tree nor an integer constant.
	(gigi): Run unshare_save_expr via walk_tree_without_duplicates
	on the body of elaboration routines instead of mark_unvisited.
	(add_stmt): Do not mark the tree.
	(add_decl_expr): Tweak comment.
	(mark_unvisited): Delete.
	(unshare_save_expr): New static function.
	(call_to_gnu): Issue an error when making a temporary around a
	procedure call because of non-addressable actual parameter if the
	type of the formal is by_reference.
	(Compilation_Unit_to_gnu): Invalidate the global renaming pointers
	after building the elaboration routine.

From-SVN: r118331

1 files changed, 272 insertions, 181 deletions

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index fe820bf..eaa6fc6 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -149,7 +149,7 @@ static void insert_code_for (Node_Id);
 static void start_stmt_group (void);
 static void add_cleanup (tree);
 static tree mark_visited (tree *, int *, void *);
-static tree mark_unvisited (tree *, int *, void *);
+static tree unshare_save_expr (tree *, int *, void *);
 static tree end_stmt_group (void);
 static void add_stmt_list (List_Id);
 static tree build_stmt_group (List_Id, bool);
@@ -171,7 +171,6 @@ static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
 static tree gnat_stabilize_reference_1 (tree, bool);
 static void annotate_with_node (tree, Node_Id);
-static void build_global_cdtor (int, tree *);
 
 
 /* This is the main program of the back-end.  It sets up all the table
@@ -252,8 +251,15 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
       tree gnu_body = DECL_SAVED_TREE (info->elab_proc);
       tree gnu_stmts;
 
-      /* Mark everything we have as not visited.  */
-      walk_tree_without_duplicates (&gnu_body, mark_unvisited, NULL);
+      /* Unshare SAVE_EXPRs between subprograms.  These are not unshared by
+	 the gimplifier for obvious reasons, but it turns out that we need to
+	 unshare them for the global level because of SAVE_EXPRs made around
+	 checks for global objects and around allocators for global objects
+	 of variable size, in order to prevent node sharing in the underlying
+	 expression.  Note that this implicitly assumes that the SAVE_EXPR
+	 nodes themselves are not shared between subprograms, which would be
+	 an upstream bug for which we would not change the outcome.  */
+      walk_tree_without_duplicates (&gnu_body, unshare_save_expr, NULL);
 
       /* Set the current function to be the elaboration procedure and gimplify
 	 what we have.  */
@@ -382,10 +388,17 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      handler, only if it is referenced in the handler and declared in an
      enclosing block, but we have no way of testing that right now.
 
-     ??? Also, for now all we can do is make it volatile.  But we only
-     do this for SJLJ.  */
+     ??? We used to essentially set the TREE_ADDRESSABLE flag on the variable
+     here, but it can now be removed by the Tree aliasing machinery if the
+     address of the variable is never taken.  All we can do is to make the
+     variable volatile, which might incur the generation of temporaries just
+     to access the memory in some circumstances.  This can be avoided for
+     variables of non-constant size because they are automatically allocated
+     to memory.  There might be no way of allocating a proper temporary for
+     them in any case.  We only do this for SJLJ though.  */
   if (TREE_VALUE (gnu_except_ptr_stack)
-      && TREE_CODE (gnu_result) == VAR_DECL)
+      && TREE_CODE (gnu_result) == VAR_DECL
+      && TREE_CODE (DECL_SIZE_UNIT (gnu_result)) == INTEGER_CST)
     TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1;
 
   /* Some objects (such as parameters passed by reference, globals of
@@ -452,18 +465,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 			    == Attr_Unchecked_Access)
 		       || (Get_Attribute_Id (Attribute_Name (gnat_temp))
 			   == Attr_Unrestricted_Access)))))
-	{
-	  gnu_result = DECL_INITIAL (gnu_result);
-	  /* ??? The mark/unmark mechanism implemented in Gigi to prevent tree
-	     sharing between global level and subprogram level doesn't apply
-	     to elaboration routines.  As a result, the DECL_INITIAL tree may
-	     be shared between the static initializer of a global object and
-	     the elaboration routine, thus wreaking havoc if a local temporary
-	     is created in place during gimplification of the latter and the
-	     former is emitted afterwards.  Manually unshare for now.  */
-	  if (TREE_VISITED (gnu_result))
-	    gnu_result = unshare_expr (gnu_result);
-	}
+	gnu_result = DECL_INITIAL (gnu_result);
     }
 
   *gnu_result_type_p = gnu_result_type;
@@ -795,10 +797,9 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
       prefix_unused = true;
 
-      if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
-	gnu_result = size_int (DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1)));
-      else
-	gnu_result = size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT);
+      gnu_result = size_int ((TREE_CODE (gnu_prefix) == COMPONENT_REF
+			      ? DECL_ALIGN (TREE_OPERAND (gnu_prefix, 1))
+			      : TYPE_ALIGN (gnu_type)) / BITS_PER_UNIT);
       break;
 
     case Attr_First:
@@ -1145,6 +1146,7 @@ Case_Statement_to_gnu (Node_Id gnat_node)
        gnat_when = Next_Non_Pragma (gnat_when))
     {
       Node_Id gnat_choice;
+      int choices_added = 0;
 
       /* First compile all the different case choices for the current WHEN
 	 alternative.  */
@@ -1195,18 +1197,33 @@ Case_Statement_to_gnu (Node_Id gnat_node)
 	      gcc_unreachable ();
 	    }
 
-	  add_stmt_with_node (build3 (CASE_LABEL_EXPR, void_type_node,
-				      gnu_low, gnu_high,
-				      create_artificial_label ()),
-			      gnat_choice);
+         /* If the case value is a subtype that raises Constraint_Error at
+             run-time because of a wrong bound, then gnu_low or gnu_high
+             is not transtaleted into an INTEGER_CST.  In such a case, we need
+             to ensure that the when statement is not added in the tree,
+             otherwise it will crash the gimplifier.  */
+         if ((!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST)
+              && (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST))
+          {
+
+             add_stmt_with_node (build3 (CASE_LABEL_EXPR, void_type_node,
+                                         gnu_low, gnu_high,
+                                         create_artificial_label ()),
+                                 gnat_choice);
+             choices_added++;
+          }
 	}
 
       /* Push a binding level here in case variables are declared since we want
-	 them to be local to this set of statements instead of the block
-	 containing the Case statement.  */
-      add_stmt (build_stmt_group (Statements (gnat_when), true));
-      add_stmt (build1 (GOTO_EXPR, void_type_node,
-			TREE_VALUE (gnu_switch_label_stack)));
+         them to be local to this set of statements instead of the block
+         containing the Case statement.  */
+
+       if (choices_added > 0)
+       {
+         add_stmt (build_stmt_group (Statements (gnat_when), true));
+         add_stmt (build1 (GOTO_EXPR, void_type_node,
+                           TREE_VALUE (gnu_switch_label_stack)));
+       }
     }
 
   /* Now emit a definition of the label all the cases branched to. */
@@ -1484,7 +1501,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
      nodes here.  Fill them in to TYPE_CI_CO_LIST, which must contain the empty
      entry as well.  We can match up the entries because TYPE_CI_CO_LIST is in
      the order of the parameters.  */
-  for (gnat_param = First_Formal (gnat_subprog_id);
+  for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
        Present (gnat_param);
        gnat_param = Next_Formal_With_Extras (gnat_param))
     if (!present_gnu_tree (gnat_param))
@@ -1570,7 +1587,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
   /* Disconnect the trees for parameters that we made variables for from the
      GNAT entities since these are unusable after we end the function.  */
-  for (gnat_param = First_Formal (gnat_subprog_id);
+  for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
        Present (gnat_param);
        gnat_param = Next_Formal_With_Extras (gnat_param))
     if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL)
@@ -1687,12 +1704,12 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
      type the access type is pointing to.  Otherwise, get the formals from
      entity being called.  */
   if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
-    gnat_formal = First_Formal (Etype (Name (gnat_node)));
+    gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
   else if (Nkind (Name (gnat_node)) == N_Attribute_Reference)
     /* Assume here that this must be 'Elab_Body or 'Elab_Spec.  */
     gnat_formal = 0;
   else
-    gnat_formal = First_Formal (Entity (Name (gnat_node)));
+    gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
 
   /* Create the list of the actual parameters as GCC expects it, namely a chain
      of TREE_LIST nodes in which the TREE_VALUE field of each node is a
@@ -1741,6 +1758,11 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	      tree gnu_copy = gnu_name;
 	      tree gnu_temp;
 
+	      /* If the type is by_reference, a copy is not allowed.  */
+	      if (Is_By_Reference_Type (Etype (gnat_formal)))
+		post_error
+		  ("misaligned & cannot be passed by reference", gnat_actual);
+
 	      /* For users of Starlet we issue a warning because the
 		 interface apparently assumes that by-ref parameters
 		 outlive the procedure invocation.  The code still
@@ -1749,7 +1771,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 		 would allocate temporaries at will because of the
 		 misalignment if we did not do so here.  */
 
-	      if (Is_Valued_Procedure (Entity (Name (gnat_node))))
+	      else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
 		{
 		  post_error
 		    ("?possible violation of implicit assumption",
@@ -1889,6 +1911,13 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	      && !addressable_p (gnu_actual))
 	    gnu_actual = TREE_OPERAND (gnu_actual, 0);
 
+	  /* For In parameters, gnu_actual might still not be addressable at
+	     this point and we need the creation of a temporary copy since
+	     this is to be passed by ref.  Resorting to save_expr to force a
+	     SAVE_EXPR temporary creation here is not guaranteed to work
+	     because the actual might be invariant or readonly without side
+	     effects, so we let the gimplifier process this case.  */
+
 	  /* The symmetry of the paths to the type of an entity is broken here
 	     since arguments don't know that they will be passed by ref. */
 	  gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
@@ -2026,9 +2055,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	}
 
       if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
-	gnat_formal = First_Formal (Etype (Name (gnat_node)));
+	gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
       else
-	gnat_formal = First_Formal (Entity (Name (gnat_node)));
+	gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
 
       for (gnat_actual = First_Actual (gnat_node);
 	   Present (gnat_actual);
@@ -2053,8 +2082,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 		: build_component_ref (gnu_subprog_call, NULL_TREE,
 				       TREE_PURPOSE (scalar_return_list),
 				       false);
-	    bool unchecked_conversion = (Nkind (gnat_actual)
-					 == N_Unchecked_Type_Conversion);
+
 	    /* If the actual is a conversion, get the inner expression, which
 	       will be the real destination, and convert the result to the
 	       type of the actual parameter.  */
@@ -2068,16 +2096,33 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 					       (TREE_TYPE (gnu_result))),
 				    gnu_result);
 
-	    /* If the result is a type conversion, do it.  */
+	    /* If the actual is a type conversion, the real target object is
+	       denoted by the inner Expression and we need to convert the
+	       result to the associated type.
+
+	       We also need to convert our gnu assignment target to this type
+	       if the corresponding gnu_name was constructed from the GNAT
+	       conversion node and not from the inner Expression.  */
 	    if (Nkind (gnat_actual) == N_Type_Conversion)
-	      gnu_result
-		= convert_with_check
-		  (Etype (Expression (gnat_actual)), gnu_result,
-		   Do_Overflow_Check (gnat_actual),
-		   Do_Range_Check (Expression (gnat_actual)),
-		   Float_Truncate (gnat_actual));
+	      {
+		gnu_result
+		  = convert_with_check
+		    (Etype (Expression (gnat_actual)), gnu_result,
+		     Do_Overflow_Check (gnat_actual),
+		     Do_Range_Check (Expression (gnat_actual)),
+		     Float_Truncate (gnat_actual));
+
+		if (!Is_Composite_Type
+		     (Underlying_Type (Etype (gnat_formal))))
+		  gnu_actual
+		    = convert (TREE_TYPE (gnu_result), gnu_actual);
+	      }
 
-	    else if (unchecked_conversion)
+	    /* Unchecked conversions as actuals for out parameters are not
+	       allowed in user code because they are not variables, but do
+	       occur in front-end expansions.  The associated gnu_name is
+	       always obtained from the inner expression in such cases.  */
+	    else if (Nkind (gnat_actual) == N_Unchecked_Type_Conversion)
 	      gnu_result = unchecked_convert (TREE_TYPE (gnu_actual),
 					      gnu_result,
 					      No_Truncation (gnat_actual));
@@ -2152,11 +2197,6 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
       gnat_pushlevel ();
     }
 
-  /* If we are to call a function when exiting this block add a cleanup
-     to the binding level we made above.  */
-  if (at_end)
-    add_cleanup (build_call_0_expr (gnat_to_gnu (At_End_Proc (gnat_node))));
-
   /* If using setjmp_longjmp, make the variables for the setjmp buffer and save
      area for address of previous buffer.  Do this first since we need to have
      the setjmp buf known for any decls in this block.  */
@@ -2183,6 +2223,12 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
       add_cleanup (build_call_1_expr (set_jmpbuf_decl, gnu_jmpsave_decl));
     }
 
+  /* If we are to call a function when exiting this block, add a cleanup
+     to the binding level we made above.  Note that add_cleanup is FIFO
+     so we must register this cleanup after the EH cleanup just above.  */
+  if (at_end)
+    add_cleanup (build_call_0_expr (gnat_to_gnu (At_End_Proc (gnat_node))));
+
   /* Now build the tree for the declarations and statements inside this block.
      If this is SJLJ, set our jmp_buf as the current buffer.  */
   start_stmt_group ();
@@ -2525,7 +2571,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
 
   process_inlined_subprograms (gnat_node);
 
-  if (type_annotate_only)
+  if (type_annotate_only && gnat_node == Cunit (Main_Unit))
     {
       elaborate_all_entities (gnat_node);
 
@@ -2558,14 +2604,10 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
      we did or not.  */
   pop_stack (&gnu_elab_proc_stack);
 
-  /* Generate functions to call static constructors and destructors
-     for targets that do not support .ctors/.dtors sections.  These
-     functions have magic names which are detected by collect2.  */
-  if (static_ctors)
-    build_global_cdtor ('I', &static_ctors);
-
-  if (static_dtors)
-    build_global_cdtor ('D', &static_dtors);
+  /* Invalidate the global renaming pointers.  This is necessary because
+     stabilization of the renamed entities may create SAVE_EXPRs which
+     have been tied to a specific elaboration routine just above.  */
+  invalidate_global_renaming_pointers ();
 }
 
 /* This function is the driver of the GNAT to GCC tree transformation
@@ -3330,6 +3372,7 @@ gnat_to_gnu (Node_Id gnat_node)
     case N_And_Then: case N_Or_Else:
       {
 	enum tree_code code = gnu_codes[Nkind (gnat_node)];
+	bool ignore_lhs_overflow = false;
 	tree gnu_type;
 
 	gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
@@ -3378,17 +3421,32 @@ gnat_to_gnu (Node_Id gnat_node)
 	  }
 
 	/* For right shifts, the type says what kind of shift to do,
-	   so we may need to choose a different type.  */
+	   so we may need to choose a different type.  In this case,
+	   we have to ignore integer overflow lest it propagates all
+	   the way down and causes a CE to be explicitly raised.  */
 	if (Nkind (gnat_node) == N_Op_Shift_Right
 	    && !TYPE_UNSIGNED (gnu_type))
-	  gnu_type = gnat_unsigned_type (gnu_type);
+	  {
+	    gnu_type = gnat_unsigned_type (gnu_type);
+	    ignore_lhs_overflow = true;
+	  }
 	else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic
 		 && TYPE_UNSIGNED (gnu_type))
-	  gnu_type = gnat_signed_type (gnu_type);
+	  {
+	    gnu_type = gnat_signed_type (gnu_type);
+	    ignore_lhs_overflow = true;
+	  }
 
 	if (gnu_type != gnu_result_type)
 	  {
+	    tree gnu_old_lhs = gnu_lhs;
 	    gnu_lhs = convert (gnu_type, gnu_lhs);
+	    if (TREE_CODE (gnu_lhs) == INTEGER_CST && ignore_lhs_overflow)
+	      {
+		TREE_OVERFLOW (gnu_lhs) = TREE_OVERFLOW (gnu_old_lhs);
+		TREE_CONSTANT_OVERFLOW (gnu_lhs)
+		  = TREE_CONSTANT_OVERFLOW (gnu_old_lhs);
+	      }
 	    gnu_rhs = convert (gnu_type, gnu_rhs);
 	  }
 
@@ -3773,16 +3831,31 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Abstract_Subprogram_Declaration:
       /* This subprogram doesn't exist for code generation purposes, but we
-	 have to elaborate the types of any parameters, unless they are
-	 imported types (nothing to generate in this case).  */
+	 have to elaborate the types of any parameters and result, unless
+	 they are imported types (nothing to generate in this case).  */
+
+      /* Process the parameter types first.  */
+
       for (gnat_temp
-	   = First_Formal (Defining_Entity (Specification (gnat_node)));
+	   = First_Formal_With_Extras
+	       (Defining_Entity (Specification (gnat_node)));
 	   Present (gnat_temp);
 	   gnat_temp = Next_Formal_With_Extras (gnat_temp))
 	if (Is_Itype (Etype (gnat_temp))
 	    && !From_With_Type (Etype (gnat_temp)))
 	  gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
 
+
+      /* Then the result type, set to Standard_Void_Type for procedures.  */
+
+      {
+	Entity_Id gnat_temp_type
+	  = Etype (Defining_Entity (Specification (gnat_node)));
+
+	if (Is_Itype (gnat_temp_type) && !From_With_Type (gnat_temp_type))
+	  gnat_to_gnu_entity (Etype (gnat_temp_type), NULL_TREE, 0);
+      }
+
       gnu_result = alloc_stmt_list ();
       break;
 
@@ -3965,47 +4038,102 @@ gnat_to_gnu (Node_Id gnat_node)
       if (!type_annotate_only)
 	{
 	  tree gnu_template = gnat_to_gnu (Asm_Template (gnat_node));
-	  tree gnu_input_list = NULL_TREE, gnu_output_list = NULL_TREE;
-	  tree gnu_clobber_list = NULL_TREE;
+	  tree gnu_inputs = NULL_TREE, gnu_outputs = NULL_TREE;
+	  tree gnu_clobbers = NULL_TREE, tail;
+	  bool allows_mem, allows_reg, fake;
+	  int ninputs, noutputs, i;
+	  const char **oconstraints;
+	  const char *constraint;
 	  char *clobber;
 
-	  /* First process inputs, then outputs, then clobbers.  */
-	  Setup_Asm_Inputs (gnat_node);
-	  while (Present (gnat_temp = Asm_Input_Value ()))
+	  /* First retrieve the 3 operand lists built by the front-end.  */
+	  Setup_Asm_Outputs (gnat_node);
+	  while (Present (gnat_temp = Asm_Output_Variable ()))
 	    {
 	      tree gnu_value = gnat_to_gnu (gnat_temp);
 	      tree gnu_constr = build_tree_list (NULL_TREE, gnat_to_gnu
-						 (Asm_Input_Constraint ()));
+						 (Asm_Output_Constraint ()));
 
-	      gnu_input_list
-		= tree_cons (gnu_constr, gnu_value, gnu_input_list);
-	      Next_Asm_Input ();
+	      gnu_outputs = tree_cons (gnu_constr, gnu_value, gnu_outputs);
+	      Next_Asm_Output ();
 	    }
 
-	  Setup_Asm_Outputs (gnat_node);
-	  while (Present (gnat_temp = Asm_Output_Variable ()))
+	  Setup_Asm_Inputs (gnat_node);
+	  while (Present (gnat_temp = Asm_Input_Value ()))
 	    {
 	      tree gnu_value = gnat_to_gnu (gnat_temp);
 	      tree gnu_constr = build_tree_list (NULL_TREE, gnat_to_gnu
-						 (Asm_Output_Constraint ()));
+						 (Asm_Input_Constraint ()));
 
-	      gnu_output_list
-		= tree_cons (gnu_constr, gnu_value, gnu_output_list);
-	      Next_Asm_Output ();
+	      gnu_inputs = tree_cons (gnu_constr, gnu_value, gnu_inputs);
+	      Next_Asm_Input ();
 	    }
 
 	  Clobber_Setup (gnat_node);
 	  while ((clobber = Clobber_Get_Next ()))
-	    gnu_clobber_list
+	    gnu_clobbers
 	      = tree_cons (NULL_TREE,
 			   build_string (strlen (clobber) + 1, clobber),
-			   gnu_clobber_list);
+			   gnu_clobbers);
+
+          /* Then perform some standard checking and processing on the
+	     operands.  In particular, mark them addressable if needed.  */
+	  gnu_outputs = nreverse (gnu_outputs);
+	  noutputs = list_length (gnu_outputs);
+	  gnu_inputs = nreverse (gnu_inputs);
+	  ninputs = list_length (gnu_inputs);
+	  oconstraints
+	    = (const char **) alloca (noutputs * sizeof (const char *));
+
+	  for (i = 0, tail = gnu_outputs; tail; ++i, tail = TREE_CHAIN (tail))
+	    {
+	      tree output = TREE_VALUE (tail);
+	      constraint
+		= TREE_STRING_POINTER (TREE_VALUE (TREE_PURPOSE (tail)));
+	      oconstraints[i] = constraint;
+
+	      if (parse_output_constraint (&constraint, i, ninputs, noutputs,
+					   &allows_mem, &allows_reg, &fake))
+		{
+		  /* If the operand is going to end up in memory,
+		     mark it addressable.  Note that we don't test
+		     allows_mem like in the input case below; this
+		     is modelled on the C front-end.  */
+		  if (!allows_reg
+		      && !gnat_mark_addressable (output))
+		    output = error_mark_node;
+		}
+	      else
+		output = error_mark_node;
+
+	      TREE_VALUE (tail) = output;
+	    }
+
+	  for (i = 0, tail = gnu_inputs; tail; ++i, tail = TREE_CHAIN (tail))
+	    {
+	      tree input = TREE_VALUE (tail);
+	      constraint
+		= TREE_STRING_POINTER (TREE_VALUE (TREE_PURPOSE (tail)));
+
+	      if (parse_input_constraint (&constraint, i, ninputs, noutputs,
+					  0, oconstraints,
+					  &allows_mem, &allows_reg))
+		{
+		  /* If the operand is going to end up in memory,
+		     mark it addressable.  */
+		  if (!allows_reg && allows_mem
+		      && !gnat_mark_addressable (input))
+		    input = error_mark_node;
+		}
+	      else
+		input = error_mark_node;
+
+	      TREE_VALUE (tail) = input;
+	    }
 
-	  gnu_input_list = nreverse (gnu_input_list);
-	  gnu_output_list = nreverse (gnu_output_list);
 	  gnu_result = build4 (ASM_EXPR,  void_type_node,
-			       gnu_template, gnu_output_list,
-			       gnu_input_list, gnu_clobber_list);
+			       gnu_template, gnu_outputs,
+			       gnu_inputs, gnu_clobbers);
 	  ASM_VOLATILE_P (gnu_result) = Is_Asm_Volatile (gnat_node);
 	}
       else
@@ -4372,12 +4500,6 @@ void
 add_stmt (tree gnu_stmt)
 {
   append_to_statement_list (gnu_stmt, &current_stmt_group->stmt_list);
-
-  /* If we're at top level, show everything in here is in use in case
-     any of it is shared by a subprogram.  */
-  if (global_bindings_p ())
-    walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
-
 }
 
 /* Similar, but set the location of GNU_STMT to that of GNAT_NODE.  */
@@ -4407,15 +4529,16 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
 	  && TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE))
     return;
 
+  gnu_stmt = build1 (DECL_EXPR, void_type_node, gnu_decl);
+
   /* If we are global, we don't want to actually output the DECL_EXPR for
      this decl since we already have evaluated the expressions in the
-     sizes and positions as globals and doing it again would be wrong.
-     But we do have to mark everything as used.  */
-  gnu_stmt = build1 (DECL_EXPR, void_type_node, gnu_decl);
-  if (!global_bindings_p ())
-    add_stmt_with_node (gnu_stmt, gnat_entity);
-  else
+     sizes and positions as globals and doing it again would be wrong.  */
+  if (global_bindings_p ())
     {
+      /* Mark everything as used to prevent node sharing with subprograms.
+	 Note that walk_tree knows how to handle TYPE_DECL, but neither
+	 VAR_DECL nor CONST_DECL.  This appears to be somewhat arbitrary.  */
       walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
       if (TREE_CODE (gnu_decl) == VAR_DECL
 	  || TREE_CODE (gnu_decl) == CONST_DECL)
@@ -4425,6 +4548,8 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
 	  walk_tree (&DECL_INITIAL (gnu_decl), mark_visited, NULL, NULL);
 	}
     }
+  else
+    add_stmt_with_node (gnu_stmt, gnat_entity);
 
   /* If this is a DECL_EXPR for a variable with DECL_INITIAL set,
      there are two cases we need to handle here.  */
@@ -4455,8 +4580,12 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
 	    = build_binary_op (MODIFY_EXPR, NULL_TREE,
 			       gnu_lhs, DECL_INITIAL (gnu_decl));
 
-	  DECL_INITIAL (gnu_decl) = 0;
-	  TREE_READONLY (gnu_decl) = 0;
+	  DECL_INITIAL (gnu_decl) = NULL_TREE;
+	  if (TREE_READONLY (gnu_decl))
+	    {
+	      TREE_READONLY (gnu_decl) = 0;
+	      DECL_READONLY_ONCE_ELAB (gnu_decl) = 1;
+	    }
 	  annotate_with_locus (gnu_assign_stmt,
 			       DECL_SOURCE_LOCATION (gnu_decl));
 	  add_stmt (gnu_assign_stmt);
@@ -4486,13 +4615,16 @@ mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
   return NULL_TREE;
 }
 
-/* Likewise, but to mark as unvisited.  */
+/* Utility function to unshare expressions wrapped up in a SAVE_EXPR.  */
 
 static tree
-mark_unvisited (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
-		void *data ATTRIBUTE_UNUSED)
+unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
+		   void *data ATTRIBUTE_UNUSED)
 {
-  TREE_VISITED (*tp) = 0;
+  tree t = *tp;
+
+  if (TREE_CODE (t) == SAVE_EXPR)
+    TREE_OPERAND (t, 0) = unshare_expr (TREE_OPERAND (t, 0));
 
   return NULL_TREE;
 }
@@ -4833,48 +4965,33 @@ gnat_gimplify_stmt (tree *stmt_p)
     }
 }
 
-/* Force references to each of the entities in packages GNAT_NODE with's
-   so that the debugging information for all of them are identical
-   in all clients.  Operate recursively on anything it with's, but check
-   that we aren't elaborating something more than once.  */
-
-/* The reason for this routine's existence is two-fold.
-   First, with some debugging formats, notably MDEBUG on SGI
-   IRIX, the linker will remove duplicate debugging information if two
-   clients have identical debugging information.  With the normal scheme
-   of elaboration, this does not usually occur, since entities in with'ed
-   packages are elaborated on demand, and if clients have different usage
-   patterns, the normal case, then the order and selection of entities
-   will differ.  In most cases however, it seems that linkers do not know
-   how to eliminate duplicate debugging information, even if it is
-   identical, so the use of this routine would increase the total amount
-   of debugging information in the final executable.
-
-   Second, this routine is called in type_annotate mode, to compute DDA
-   information for types in withed units, for ASIS use  */
+/* Force references to each of the entities in packages withed by GNAT_NODE.
+   Operate recursively but check that we aren't elaborating something more
+   than once.
+
+   This routine is exclusively called in type_annotate mode, to compute DDA
+   information for types in withed units, for ASIS use.  */
 
 static void
 elaborate_all_entities (Node_Id gnat_node)
 {
   Entity_Id gnat_with_clause, gnat_entity;
 
-  /* Process each unit only once. As we trace the context of all relevant
+  /* Process each unit only once.  As we trace the context of all relevant
      units transitively, including generic bodies, we may encounter the
-     same generic unit repeatedly */
-
+     same generic unit repeatedly.  */
   if (!present_gnu_tree (gnat_node))
      save_gnu_tree (gnat_node, integer_zero_node, true);
 
-  /* Save entities in all context units. A body may have an implicit_with
+  /* Save entities in all context units.  A body may have an implicit_with
      on its own spec, if the context includes a child unit, so don't save
      the spec twice.  */
-
   for (gnat_with_clause = First (Context_Items (gnat_node));
        Present (gnat_with_clause);
        gnat_with_clause = Next (gnat_with_clause))
     if (Nkind (gnat_with_clause) == N_With_Clause
 	&& !present_gnu_tree (Library_Unit (gnat_with_clause))
-        && Library_Unit (gnat_with_clause) != Library_Unit (Cunit (Main_Unit)))
+	&& Library_Unit (gnat_with_clause) != Library_Unit (Cunit (Main_Unit)))
       {
 	elaborate_all_entities (Library_Unit (gnat_with_clause));
 
@@ -4897,23 +5014,23 @@ elaborate_all_entities (Node_Id gnat_node)
 		  && !IN (Ekind (gnat_entity), Generic_Unit_Kind))
 		gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
           }
-        else if (Ekind (Entity (Name (gnat_with_clause))) == E_Generic_Package)
-           {
-            Node_Id gnat_body
+	else if (Ekind (Entity (Name (gnat_with_clause))) == E_Generic_Package)
+	  {
+	    Node_Id gnat_body
 	      = Corresponding_Body (Unit (Library_Unit (gnat_with_clause)));
 
-            /* Retrieve compilation unit node of generic body.  */
-            while (Present (gnat_body)
+	    /* Retrieve compilation unit node of generic body.  */
+	    while (Present (gnat_body)
 		   && Nkind (gnat_body) != N_Compilation_Unit)
 	      gnat_body = Parent (gnat_body);
 
-            /* If body is available, elaborate its context.  */
-            if (Present (gnat_body))
-                elaborate_all_entities (gnat_body);
-           }
+	    /* If body is available, elaborate its context.  */
+	    if (Present (gnat_body))
+	      elaborate_all_entities (gnat_body);
+	  }
       }
 
-  if (Nkind (Unit (gnat_node)) == N_Package_Body && type_annotate_only)
+  if (Nkind (Unit (gnat_node)) == N_Package_Body)
     elaborate_all_entities (Library_Unit (gnat_node));
 }
 
@@ -4969,11 +5086,12 @@ process_freeze_entity (Node_Id gnat_node)
         && Ekind (gnat_entity) == E_Subprogram_Type)))
     return;
 
-  /* If we have a non-dummy type old tree, we have nothing to do.   Unless
-     this is the public view of a private type whose full view was not
-     delayed, this node was never delayed as it should have been.
-     Also allow this to happen for concurrent types since we may have
-     frozen both the Corresponding_Record_Type and this type.  */
+  /* If we have a non-dummy type old tree, we have nothing to do, except
+     aborting if this is the public view of a private type whose full view was
+     not delayed, as this node was never delayed as it should have been.  We
+     let this happen for concurrent types and their Corresponding_Record_Type,
+     however, because each might legitimately be elaborated before it's own
+     freeze node, e.g. while processing the other.  */
   if (gnu_old
       && !(TREE_CODE (gnu_old) == TYPE_DECL
 	   && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old))))
@@ -4981,7 +5099,9 @@ process_freeze_entity (Node_Id gnat_node)
       gcc_assert ((IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
 		   && Present (Full_View (gnat_entity))
 		   && No (Freeze_Node (Full_View (gnat_entity))))
-		  || Is_Concurrent_Type (gnat_entity));
+		  || Is_Concurrent_Type (gnat_entity)
+		  || (IN (Ekind (gnat_entity), Record_Kind)
+		      && Is_Concurrent_Record_Type (gnat_entity)));
       return;
     }
 
@@ -5220,7 +5340,7 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type)
 
   /* There's no good type to use here, so we might as well use
      integer_type_node. Note that the form of the check is
-        (not (expr >= lo)) or (not (expr >= hi))
+        (not (expr >= lo)) or (not (expr <= hi))
       the reason for this slightly convoluted form is that NaN's
       are not considered to be in range in the float case. */
   return emit_check
@@ -5619,15 +5739,8 @@ process_type (Entity_Id gnat_entity)
      pointers.  */
   if (gnu_old)
     {
-      if (TREE_CODE (gnu_old) != TYPE_DECL
-	  || !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old)))
-	{
-	  /* If this was a withed access type, this is not an error
-	     and merely indicates we've already elaborated the type
-	     already. */
-	  gcc_assert (Is_Type (gnat_entity) && From_With_Type (gnat_entity));
-	  return;
-	}
+      gcc_assert (TREE_CODE (gnu_old) == TYPE_DECL
+		  && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old)));
 
       save_gnu_tree (gnat_entity, NULL_TREE, false);
     }
@@ -6085,28 +6198,6 @@ gnat_stabilize_reference_1 (tree e, bool force)
   TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
   return result;
 }
-
-/* Build a global constructor or destructor function.  METHOD_TYPE gives
-   the type of the function and CDTORS points to the list of constructor
-   or destructor functions to be invoked.  FIXME: Migrate into cgraph.  */
-
-static void
-build_global_cdtor (int method_type, tree *cdtors)
-{
-  tree body = 0;
-
-  for (; *cdtors; *cdtors = TREE_CHAIN (*cdtors))
-    {
-      tree fn = TREE_VALUE (*cdtors);
-      tree fntype = TREE_TYPE (fn);
-      tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), fn);
-      tree fncall = build3 (CALL_EXPR, TREE_TYPE (fntype), fnaddr, NULL_TREE,
-			    NULL_TREE);
-      append_to_statement_list (fncall, &body);
-    }
-
-  cgraph_build_static_cdtor (method_type, body, DEFAULT_INIT_PRIORITY);
-}
 
 extern char *__gnat_to_canonical_file_spec (char *);