2004-07-20 Olivier Hainque <hainque@act-europe.fr>

	* a-elchha.adb (Last_Chance_Handler): Remove the bogus buffer dynamic
	allocation and potentially overflowing update with
	Tailored_Exception_Information. Use the sec-stack free procedural
	interface to output Exception_Information instead.

	* a-except.adb (To_Stderr): New subprogram for character, and string
	version moved from a-exextr to be visible from other separate units.
	(Tailored_Exception_Information): Remove the procedural version,
	previously used by the default Last_Chance_Handler and not any more.
	Adjust various comments.

	* a-exexda.adb: Generalize the exception information procedural
	interface, to minimize the use of secondary stack and the need for
	local buffers when the info is to be output to stderr:
	(Address_Image): Removed.
	(Append_Info_Character): New subprogram, checking for overflows and
	outputing to stderr if buffer to fill is of length 0.
	(Append_Info_String): Output to stderr if buffer to fill is of length 0.
	(Append_Info_Address, Append_Info_Exception_Name,
	Append_Info_Exception_Message, Append_Info_Basic_Exception_Information,
	Append_Info_Basic_Exception_Traceback,
	Append_Info_Exception_Information): New subprograms.
	(Append_Info_Nat, Append_Info_NL): Use Append_Info_Character.
	(Basic_Exception_Info_Maxlength, Basic_Exception_Tback_Maxlength,
	Exception_Info_Maxlength, Exception_Name_Length,
	Exception_Message_Length): New subprograms.
	(Exception_Information): Use Append_Info_Exception_Information.
	(Tailored_Exception_Information): Use
	Append_Info_Basic_Exception_Information.
	Export services for the default Last_Chance_Handler.

	* a-exextr.adb (To_Stderr): Remove. Now in a-except to be usable by
	other separate units.

2004-07-20  Vincent Celier  <celier@gnat.com>

	* clean.adb, mlib-utl.adb, osint.adb, makegpr.adb: Minor reformatting.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	* freeze.adb (Freeze_Entity): If entity is a discriminated record type,
	emit itype references for the designated types of component types that
	are declared outside of the full record declaration, and that may
	denote a partial view of that record type.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15607
	* sem_ch3.adb (Build_Discriminated_Subtype): Do not attach a subtype
	which is the designated type in an access component declaration, to the
	list of incomplete dependents of the parent type, to avoid elaboration
	issues with out-of-scope subtypes.
	(Complete_Private_Subtype): Recompute Has_Unknown_Discriminants from the
	full view of the parent.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15610
	* sem_ch8.adb (Find_Expanded_Name): If name is overloaded, reject
	entities that are hidden, such as references to generic actuals
	outside an instance.

2004-07-20  Javier Miranda  <miranda@gnat.com>

	* sem_ch4.adb (Try_Object_Operation): New subprogram that gives
	support to the new notation.
	(Analyze_Selected_Component): Add call to Try_Object_Operation.

2004-07-20  Jose Ruiz  <ruiz@act-europe.fr>

	* s-taprob.adb: Adding the elaboration code required for initializing
	the tasking soft links that are common to the full and the restricted
	run times.

	* s-tarest.adb (Init_RTS): Tasking soft links that are shared with the
	restricted run time has been moved to the package
	System.Soft_Links.Tasking.

	* s-tasini.adb (Init_RTS): Tasking soft links that are shared with the
	restricted run time has been moved to the package
	System.Soft_Links.Tasking.

	* Makefile.rtl: Add entry for s-solita.o in run-time library list.

	* s-solita.ads, s-solita.adb: New files.

2004-07-20  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (Identifier_to_gnu, Pragma_to_gnu, Attribute_to_gnu,
	Case_Statement_to_gnu): Split off from gnat_to_gnu.
	(Loop_Statement_to_gnu, Subprogram_Body_to_gnu, call_to_gnu,
	Handled_Sequence_Of_Statements_to_gnu, Exception_Handler_to_gnu_sjlj,
	Exception_Handler_to_gnu_zcx): Likewise.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@84948 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 2043 insertions, 2056 deletions

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 903b314477a..6b7a174c369 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -297,6 +297,2036 @@ gnat_init_stmt_group ()
   REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2);
 }
 
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
+   to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer to
+   where we should place the result type.  */
+
+static tree
+Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
+{
+  tree gnu_result_type;
+  tree gnu_result;
+  Node_Id gnat_temp, gnat_temp_type;
+
+  /* If the Etype of this node does not equal the Etype of the Entity,
+     something is wrong with the entity map, probably in generic
+     instantiation. However, this does not apply to types. Since we sometime
+     have strange Ekind's, just do this test for objects. Also, if the Etype of
+     the Entity is private, the Etype of the N_Identifier is allowed to be the
+     full type and also we consider a packed array type to be the same as the
+     original type. Similarly, a class-wide type is equivalent to a subtype of
+     itself. Finally, if the types are Itypes, one may be a copy of the other,
+     which is also legal.  */
+  gnat_temp = (Nkind (gnat_node) == N_Defining_Identifier
+	       ? gnat_node : Entity (gnat_node));
+  gnat_temp_type = Etype (gnat_temp);
+
+  if (Etype (gnat_node) != gnat_temp_type
+      && ! (Is_Packed (gnat_temp_type)
+	    && Etype (gnat_node) == Packed_Array_Type (gnat_temp_type))
+      && ! (Is_Class_Wide_Type (Etype (gnat_node)))
+      && ! (IN (Ekind (gnat_temp_type), Private_Kind)
+	    && Present (Full_View (gnat_temp_type))
+	    && ((Etype (gnat_node) == Full_View (gnat_temp_type))
+		|| (Is_Packed (Full_View (gnat_temp_type))
+		    && (Etype (gnat_node)
+			== Packed_Array_Type (Full_View (gnat_temp_type))))))
+      && (!Is_Itype (Etype (gnat_node)) || !Is_Itype (gnat_temp_type))
+      && (Ekind (gnat_temp) == E_Variable
+	  || Ekind (gnat_temp) == E_Component
+	  || Ekind (gnat_temp) == E_Constant
+	  || Ekind (gnat_temp) == E_Loop_Parameter
+	  || IN (Ekind (gnat_temp), Formal_Kind)))
+    gigi_abort (304);
+
+  /* If this is a reference to a deferred constant whose partial view is an
+     unconstrained private type, the proper type is on the full view of the
+     constant, not on the full view of the type, which may be unconstrained.
+
+     This may be a reference to a type, for example in the prefix of the
+     attribute Position, generated for dispatching code (see Make_DT in
+     exp_disp,adb). In that case we need the type itself, not is parent,
+     in particular if it is a derived type  */
+  if (Is_Private_Type (gnat_temp_type)
+      && Has_Unknown_Discriminants (gnat_temp_type)
+      && Present (Full_View (gnat_temp))
+      && ! Is_Type (gnat_temp))
+    {
+      gnat_temp = Full_View (gnat_temp);
+      gnat_temp_type = Etype (gnat_temp);
+      gnu_result_type = get_unpadded_type (gnat_temp_type);
+    }
+  else
+    {
+      /* Expand the type of this identitier first, in case it is an enumeral
+	 literal, which only get made when the type is expanded.  There is no
+	 order-of-elaboration issue here.  We want to use the Actual_Subtype if
+	 it has already been elaborated, otherwise the Etype.  Avoid using
+	 Actual_Subtype for packed arrays to simplify things.  */
+      if ((Ekind (gnat_temp) == E_Constant
+	   || Ekind (gnat_temp) == E_Variable || Is_Formal (gnat_temp))
+	  && ! (Is_Array_Type (Etype (gnat_temp))
+		&& Present (Packed_Array_Type (Etype (gnat_temp))))
+	  && Present (Actual_Subtype (gnat_temp))
+	  && present_gnu_tree (Actual_Subtype (gnat_temp)))
+	gnat_temp_type = Actual_Subtype (gnat_temp);
+      else
+	gnat_temp_type = Etype (gnat_node);
+
+      gnu_result_type = get_unpadded_type (gnat_temp_type);
+    }
+
+  gnu_result = gnat_to_gnu_entity (gnat_temp, NULL_TREE, 0);
+
+  /* If we are in an exception handler, force this variable into memory to
+     ensure optimization does not remove stores that appear redundant but are
+     actually needed in case an exception occurs.
+
+     ??? Note that we need not do this if the variable is declared within the
+     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.  */
+  if (TREE_VALUE (gnu_except_ptr_stack) != 0
+      && TREE_CODE (gnu_result) == VAR_DECL)
+    TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1;
+
+  /* Some objects (such as parameters passed by reference, globals of
+     variable size, and renamed objects) actually represent the address
+     of the object.  In that case, we must do the dereference.  Likewise,
+     deal with parameters to foreign convention subprograms.  Call fold
+     here since GNU_RESULT may be a CONST_DECL.  */
+  if (DECL_P (gnu_result)
+      && (DECL_BY_REF_P (gnu_result)
+	  || (TREE_CODE (gnu_result) == PARM_DECL
+	      && DECL_BY_COMPONENT_PTR_P (gnu_result))))
+    {
+      int ro = DECL_POINTS_TO_READONLY_P (gnu_result);
+      tree initial;
+
+      if (TREE_CODE (gnu_result) == PARM_DECL
+	  && DECL_BY_COMPONENT_PTR_P (gnu_result))
+	gnu_result
+	  = build_unary_op (INDIRECT_REF, NULL_TREE,
+			    convert (build_pointer_type (gnu_result_type),
+				     gnu_result));
+
+      /* If the object is constant, we try to do the dereference directly
+	 through the DECL_INITIAL.  This is actually required in order to get
+	 correct aliasing information for renamed objects that are components
+	 of non-aliased aggregates, because the type of the renamed object and
+	 that of the aggregate don't alias.
+
+	 Note that we expect the initial value to have been stabilized.
+	 If it contains e.g. a variable reference, we certainly don't want
+	 to re-evaluate the variable each time the renaming is used.
+
+	 Stabilization is currently not performed at the global level but
+	 create_var_decl avoids setting DECL_INITIAL if the value is not
+	 constant then, and we get to the pointer dereference below.
+
+	 ??? Couldn't the aliasing issue show up again in this case ?
+	 There is no obvious reason why not.  */
+      else if (TREE_READONLY (gnu_result)
+	       && DECL_INITIAL (gnu_result)
+	       /* Strip possible conversion to reference type.  */
+	       && ((initial = TREE_CODE (DECL_INITIAL (gnu_result))
+		    == NOP_EXPR
+		    ? TREE_OPERAND (DECL_INITIAL (gnu_result), 0)
+		    : DECL_INITIAL (gnu_result), 1))
+	       && TREE_CODE (initial) == ADDR_EXPR
+	       && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF
+		   || (TREE_CODE (TREE_OPERAND (initial, 0))
+		       == COMPONENT_REF)))
+	gnu_result = TREE_OPERAND (initial, 0);
+      else
+	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
+				     fold (gnu_result));
+
+      TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result) = ro;
+    }
+
+  /* The GNAT tree has the type of a function as the type of its result.  Also
+     use the type of the result if the Etype is a subtype which is nominally
+     unconstrained.  But remove any padding from the resulting type.  */
+  if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
+      || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type))
+    {
+      gnu_result_type = TREE_TYPE (gnu_result);
+      if (TREE_CODE (gnu_result_type) == RECORD_TYPE
+	  && TYPE_IS_PADDING_P (gnu_result_type))
+	gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
+    }
+
+  /* We always want to return the underlying INTEGER_CST for an enumeration
+     literal to avoid the need to call fold in lots of places.  But don't do
+     this is the parent will be taking the address of this object.  */
+  if (TREE_CODE (gnu_result) == CONST_DECL)
+    {
+      gnat_temp = Parent (gnat_node);
+      if (DECL_CONST_CORRESPONDING_VAR (gnu_result) == 0
+	  || (Nkind (gnat_temp) != N_Reference
+	      && ! (Nkind (gnat_temp) == N_Attribute_Reference
+		    && ((Get_Attribute_Id (Attribute_Name (gnat_temp))
+			 == Attr_Address)
+			|| (Get_Attribute_Id (Attribute_Name (gnat_temp))
+			    == Attr_Access)
+			|| (Get_Attribute_Id (Attribute_Name (gnat_temp))
+			    == Attr_Unchecked_Access)
+			|| (Get_Attribute_Id (Attribute_Name (gnat_temp))
+			    == Attr_Unrestricted_Access)))))
+	gnu_result = DECL_INITIAL (gnu_result);
+    }
+
+  *gnu_result_type_p = gnu_result_type;
+  return gnu_result;
+}
+
+/* Subroutine of gnat_to_gnu to process gnat_node, an N_Pragma.  We don't
+   return anything.  */
+
+static void
+Pragma_to_gnu (Node_Id gnat_node)
+{
+  Node_Id gnat_temp;
+
+  /* Check for (and ignore) unrecognized pragma and do nothing if we are just
+     annotating types.  */
+  if (type_annotate_only
+      || ! Is_Pragma_Name (Chars (gnat_node)))
+    return;
+
+  switch (Get_Pragma_Id (Chars (gnat_node)))
+    {
+    case Pragma_Inspection_Point:
+      /* Do nothing at top level: all such variables are already viewable.  */
+      if (global_bindings_p ())
+	break;
+
+      for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
+	   Present (gnat_temp);
+	   gnat_temp = Next (gnat_temp))
+	{
+	  tree gnu_expr = gnat_to_gnu (Expression (gnat_temp));
+
+	  if (TREE_CODE (gnu_expr) == UNCONSTRAINED_ARRAY_REF)
+	    gnu_expr = TREE_OPERAND (gnu_expr, 0);
+
+	  gnu_expr = build1 (USE_STMT, void_type_node, gnu_expr);
+	  add_stmt (gnu_expr);
+	}
+      break;
+
+    case Pragma_Optimize:
+      switch (Chars (Expression
+		     (First (Pragma_Argument_Associations (gnat_node)))))
+	{
+	case Name_Time:  case Name_Space:
+	  if (optimize == 0)
+	    post_error ("insufficient -O value?", gnat_node);
+	  break;
+
+	case Name_Off:
+	  if (optimize != 0)
+	    post_error ("must specify -O0?", gnat_node);
+	  break;
+
+	default:
+	  gigi_abort (331);
+	  break;
+	}
+      break;
+
+    case Pragma_Reviewable:
+      if (write_symbols == NO_DEBUG)
+	post_error ("must specify -g?", gnat_node);
+      break;
+    }
+}
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Attribute,
+   to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer to
+   where we should place the result type.  ATTRIBUTE is the attribute ID.  */
+
+static tree
+Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
+{
+  tree gnu_result = error_mark_node;
+  tree gnu_result_type;
+  tree gnu_expr;
+  bool prefix_unused = false;
+  tree gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
+  tree gnu_type = TREE_TYPE (gnu_prefix);
+
+  /* If the input is a NULL_EXPR, make a new one.  */
+  if (TREE_CODE (gnu_prefix) == NULL_EXPR)
+    {
+      *gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
+      return build1 (NULL_EXPR, *gnu_result_type_p,
+		     TREE_OPERAND (gnu_prefix, 0));
+    }
+
+  switch (attribute)
+    {
+    case Attr_Pos:
+    case Attr_Val:
+      /* These are just conversions until since representation clauses for
+	 enumerations are handled in the front end.  */
+      {
+	int check_p = Do_Range_Check (First (Expressions (gnat_node)));
+
+	gnu_result = gnat_to_gnu (First (Expressions (gnat_node)));
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+	gnu_result = convert_with_check (Etype (gnat_node), gnu_result,
+					 check_p, check_p, 1);
+      }
+      break;
+
+    case Attr_Pred:
+    case Attr_Succ:
+      /* These just add or subject the constant 1.  Representation clauses for
+	 enumerations are handled in the front-end.  */
+      gnu_expr = gnat_to_gnu (First (Expressions (gnat_node)));
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+      if (Do_Range_Check (First (Expressions (gnat_node))))
+	{
+	  gnu_expr = protect_multiple_eval (gnu_expr);
+	  gnu_expr
+	    = emit_check
+	      (build_binary_op (EQ_EXPR, integer_type_node,
+				gnu_expr,
+				attribute == Attr_Pred
+				? TYPE_MIN_VALUE (gnu_result_type)
+				: TYPE_MAX_VALUE (gnu_result_type)),
+	       gnu_expr, CE_Range_Check_Failed);
+	}
+
+      gnu_result
+	= build_binary_op (attribute == Attr_Pred
+			   ? MINUS_EXPR : PLUS_EXPR,
+			   gnu_result_type, gnu_expr,
+			   convert (gnu_result_type, integer_one_node));
+      break;
+
+    case Attr_Address:
+    case Attr_Unrestricted_Access:
+      /* Conversions don't change something's address but can cause us to miss
+	 the COMPONENT_REF case below, so strip them off.  */
+      gnu_prefix = remove_conversions (gnu_prefix,
+				       ! Must_Be_Byte_Aligned (gnat_node));
+
+      /* If we are taking 'Address of an unconstrained object, this is the
+	 pointer to the underlying array.  */
+      gnu_prefix = maybe_unconstrained_array (gnu_prefix);
+
+      /* ... fall through ... */
+
+    case Attr_Access:
+    case Attr_Unchecked_Access:
+    case Attr_Code_Address:
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      gnu_result
+	= build_unary_op (((attribute == Attr_Address
+			    || attribute == Attr_Unrestricted_Access)
+			   && ! Must_Be_Byte_Aligned (gnat_node))
+			  ? ATTR_ADDR_EXPR : ADDR_EXPR,
+			  gnu_result_type, gnu_prefix);
+
+      /* For 'Code_Address, find an inner ADDR_EXPR and mark it so that we
+	 don't try to build a trampoline.  */
+      if (attribute == Attr_Code_Address)
+	{
+	  for (gnu_expr = gnu_result;
+	       TREE_CODE (gnu_expr) == NOP_EXPR
+	       || TREE_CODE (gnu_expr) == CONVERT_EXPR;
+	       gnu_expr = TREE_OPERAND (gnu_expr, 0))
+	    TREE_CONSTANT (gnu_expr) = 1;
+
+	  if (TREE_CODE (gnu_expr) == ADDR_EXPR)
+	    TREE_STATIC (gnu_expr) = TREE_CONSTANT (gnu_expr) = 1;
+	}
+      break;
+
+    case Attr_Pool_Address:
+      {
+	tree gnu_obj_type;
+	tree gnu_ptr = gnu_prefix;
+
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+	/* If this is an unconstrained array, we know the object must have been
+	   allocated with the template in front of the object.  So compute the
+	   template address.*/
+	if (TYPE_FAT_POINTER_P (TREE_TYPE (gnu_ptr)))
+	  gnu_ptr
+	    = convert (build_pointer_type
+		       (TYPE_OBJECT_RECORD_TYPE
+			(TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (gnu_ptr)))),
+		       gnu_ptr);
+
+	gnu_obj_type = TREE_TYPE (TREE_TYPE (gnu_ptr));
+	if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
+	    && TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
+	  {
+	    tree gnu_char_ptr_type = build_pointer_type (char_type_node);
+	    tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
+	    tree gnu_byte_offset
+	      = convert (gnu_char_ptr_type,
+			 size_diffop (size_zero_node, gnu_pos));
+
+	    gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
+	    gnu_ptr = build_binary_op (MINUS_EXPR, gnu_char_ptr_type,
+				       gnu_ptr, gnu_byte_offset);
+	  }
+
+	gnu_result = convert (gnu_result_type, gnu_ptr);
+      }
+      break;
+
+    case Attr_Size:
+    case Attr_Object_Size:
+    case Attr_Value_Size:
+    case Attr_Max_Size_In_Storage_Elements:
+      gnu_expr = gnu_prefix;
+
+      /* Remove NOPS from gnu_expr and conversions from gnu_prefix.
+	 We only use GNU_EXPR to see if a COMPONENT_REF was involved. */
+      while (TREE_CODE (gnu_expr) == NOP_EXPR)
+	gnu_expr = TREE_OPERAND (gnu_expr, 0)
+	  ;
+
+      gnu_prefix = remove_conversions (gnu_prefix, 1);
+      prefix_unused = true;
+      gnu_type = TREE_TYPE (gnu_prefix);
+
+      /* Replace an unconstrained array type with the type of the underlying
+	 array.  We can't do this with a call to maybe_unconstrained_array
+	 since we may have a TYPE_DECL.  For 'Max_Size_In_Storage_Elements,
+	 use the record type that will be used to allocate the object and its
+	 template.  */
+      if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE)
+	{
+	  gnu_type = TYPE_OBJECT_RECORD_TYPE (gnu_type);
+	  if (attribute != Attr_Max_Size_In_Storage_Elements)
+	    gnu_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
+	}
+
+      /* If we're looking for the size of a field, return the field size.
+	 Otherwise, if the prefix is an object, or if 'Object_Size or
+	 'Max_Size_In_Storage_Elements has been specified, the result is the
+	 GCC size of the type. Otherwise, the result is the RM_Size of the
+	 type.  */
+      if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
+	gnu_result = DECL_SIZE (TREE_OPERAND (gnu_prefix, 1));
+      else if (TREE_CODE (gnu_prefix) != TYPE_DECL
+	       || attribute == Attr_Object_Size
+	       || attribute == Attr_Max_Size_In_Storage_Elements)
+	{
+	  /* If this is a padded type, the GCC size isn't relevant to the
+	     programmer.  Normally, what we want is the RM_Size, which was set
+	     from the specified size, but if it was not set, we want the size
+	     of the relevant field.  Using the MAX of those two produces the
+	     right result in all case.  Don't use the size of the field if it's
+	     a self-referential type, since that's never what's wanted.  */
+	  if (TREE_CODE (gnu_type) == RECORD_TYPE
+	      && TYPE_IS_PADDING_P (gnu_type)
+	      && TREE_CODE (gnu_expr) == COMPONENT_REF)
+	    {
+	      gnu_result = rm_size (gnu_type);
+	      if (! (CONTAINS_PLACEHOLDER_P
+		     (DECL_SIZE (TREE_OPERAND (gnu_expr, 1)))))
+		gnu_result
+		  = size_binop (MAX_EXPR, gnu_result,
+				DECL_SIZE (TREE_OPERAND (gnu_expr, 1)));
+	    }
+	  else
+	    gnu_result = TYPE_SIZE (gnu_type);
+	}
+      else
+	gnu_result = rm_size (gnu_type);
+
+      if (gnu_result == 0)
+	gigi_abort (325);
+
+      /* Deal with a self-referential size by returning the maximum size for a
+	 type and by qualifying the size with the object for 'Size of an
+	 object.  */
+      if (CONTAINS_PLACEHOLDER_P (gnu_result))
+	{
+	  if (TREE_CODE (gnu_prefix) != TYPE_DECL)
+	    gnu_result = substitute_placeholder_in_expr (gnu_result,
+							 gnu_expr);
+	  else
+	    gnu_result = max_size (gnu_result, 1);
+	}
+
+      /* If the type contains a template, subtract its size.  */
+      if (TREE_CODE (gnu_type) == RECORD_TYPE
+	  && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
+	gnu_result = size_binop (MINUS_EXPR, gnu_result,
+				 DECL_SIZE (TYPE_FIELDS (gnu_type)));
+
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+      /* Always perform division using unsigned arithmetic as the size cannot
+	 be negative, but may be an overflowed positive value. This provides
+	 correct results for sizes up to 512 MB.
+
+	 ??? Size should be calculated in storage elements directly.  */
+
+      if (attribute == Attr_Max_Size_In_Storage_Elements)
+	gnu_result = convert (sizetype,
+			      fold (build (CEIL_DIV_EXPR, bitsizetype,
+					   gnu_result, bitsize_unit_node)));
+      break;
+
+    case Attr_Alignment:
+      if (TREE_CODE (gnu_prefix) == COMPONENT_REF
+	  && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
+	      == RECORD_TYPE)
+	  && (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
+	gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
+
+      gnu_type = TREE_TYPE (gnu_prefix);
+      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);
+      break;
+
+    case Attr_First:
+    case Attr_Last:
+    case Attr_Range_Length:
+      prefix_unused = true;
+
+      if (INTEGRAL_TYPE_P (gnu_type) || TREE_CODE (gnu_type) == REAL_TYPE)
+	{
+	  gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+	  if (attribute == Attr_First)
+	    gnu_result = TYPE_MIN_VALUE (gnu_type);
+	  else if (attribute == Attr_Last)
+	    gnu_result = TYPE_MAX_VALUE (gnu_type);
+	  else
+	    gnu_result
+	      = build_binary_op
+		(MAX_EXPR, get_base_type (gnu_result_type),
+		 build_binary_op
+		 (PLUS_EXPR, get_base_type (gnu_result_type),
+		  build_binary_op (MINUS_EXPR,
+				   get_base_type (gnu_result_type),
+				   convert (gnu_result_type,
+					    TYPE_MAX_VALUE (gnu_type)),
+				   convert (gnu_result_type,
+					    TYPE_MIN_VALUE (gnu_type))),
+		  convert (gnu_result_type, integer_one_node)),
+		 convert (gnu_result_type, integer_zero_node));
+
+	  break;
+	}
+
+      /* ... fall through ... */
+
+    case Attr_Length:
+      {
+	int Dimension = (Present (Expressions (gnat_node))
+			 ? UI_To_Int (Intval (First (Expressions (gnat_node))))
+			 : 1);
+
+	/* Make sure any implicit dereference gets done.  */
+	gnu_prefix = maybe_implicit_deref (gnu_prefix);
+	gnu_prefix = maybe_unconstrained_array (gnu_prefix);
+	gnu_type = TREE_TYPE (gnu_prefix);
+	prefix_unused = true;
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+	if (TYPE_CONVENTION_FORTRAN_P (gnu_type))
+	  {
+	    int ndim;
+	    tree gnu_type_temp;
+
+	    for (ndim = 1, gnu_type_temp = gnu_type;
+		 TREE_CODE (TREE_TYPE (gnu_type_temp)) == ARRAY_TYPE
+		 && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type_temp));
+		 ndim++, gnu_type_temp = TREE_TYPE (gnu_type_temp))
+	      ;
+
+	    Dimension = ndim + 1 - Dimension;
+	  }
+
+	for (; Dimension > 1; Dimension--)
+	  gnu_type = TREE_TYPE (gnu_type);
+
+	if (TREE_CODE (gnu_type) != ARRAY_TYPE)
+	  gigi_abort (309);
+
+	if (attribute == Attr_First)
+	  gnu_result
+	    = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
+	else if (attribute == Attr_Last)
+	  gnu_result
+	    = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
+	else
+	  /* 'Length or 'Range_Length.  */
+	  {
+	    tree gnu_compute_type
+	      = gnat_signed_or_unsigned_type (0,
+					      get_base_type (gnu_result_type));
+
+	    gnu_result
+	      = build_binary_op
+		(MAX_EXPR, gnu_compute_type,
+		 build_binary_op
+		 (PLUS_EXPR, gnu_compute_type,
+		  build_binary_op
+		  (MINUS_EXPR, gnu_compute_type,
+		   convert (gnu_compute_type,
+			    TYPE_MAX_VALUE
+			    (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)))),
+		   convert (gnu_compute_type,
+			    TYPE_MIN_VALUE
+			    (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))))),
+		  convert (gnu_compute_type, integer_one_node)),
+		 convert (gnu_compute_type, integer_zero_node));
+	  }
+
+	/* If this has a PLACEHOLDER_EXPR, qualify it by the object we are
+	   handling.  Note that these attributes could not have been used on
+	   an unconstrained array type.  */
+	gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result,
+						     gnu_prefix);
+	break;
+      }
+
+    case Attr_Bit_Position:
+    case Attr_Position:
+    case Attr_First_Bit:
+    case Attr_Last_Bit:
+    case Attr_Bit:
+      {
+	HOST_WIDE_INT bitsize;
+	HOST_WIDE_INT bitpos;
+	tree gnu_offset;
+	tree gnu_field_bitpos;
+	tree gnu_field_offset;
+	tree gnu_inner;
+	enum machine_mode mode;
+	int unsignedp, volatilep;
+
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+	gnu_prefix = remove_conversions (gnu_prefix, 1);
+	prefix_unused = true;
+
+	/* We can have 'Bit on any object, but if it isn't a COMPONENT_REF,
+	   the result is 0.  Don't allow 'Bit on a bare component, though. */
+	if (attribute == Attr_Bit
+	    && TREE_CODE (gnu_prefix) != COMPONENT_REF
+	    && TREE_CODE (gnu_prefix) != FIELD_DECL)
+	  {
+	    gnu_result = integer_zero_node;
+	    break;
+	  }
+
+	else if (TREE_CODE (gnu_prefix) != COMPONENT_REF
+		 && ! (attribute == Attr_Bit_Position
+		       && TREE_CODE (gnu_prefix) == FIELD_DECL))
+	  gigi_abort (310);
+
+	get_inner_reference (gnu_prefix, &bitsize, &bitpos, &gnu_offset,
+			     &mode, &unsignedp, &volatilep);
+
+	if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
+	  {
+	    gnu_field_bitpos = bit_position (TREE_OPERAND (gnu_prefix, 1));
+	    gnu_field_offset = byte_position (TREE_OPERAND (gnu_prefix, 1));
+
+	    for (gnu_inner = TREE_OPERAND (gnu_prefix, 0);
+		 TREE_CODE (gnu_inner) == COMPONENT_REF
+		 && DECL_INTERNAL_P (TREE_OPERAND (gnu_inner, 1));
+		 gnu_inner = TREE_OPERAND (gnu_inner, 0))
+	      {
+		gnu_field_bitpos
+		  = size_binop (PLUS_EXPR, gnu_field_bitpos,
+				bit_position (TREE_OPERAND (gnu_inner, 1)));
+		gnu_field_offset
+		  = size_binop (PLUS_EXPR, gnu_field_offset,
+				byte_position (TREE_OPERAND (gnu_inner, 1)));
+	      }
+	  }
+	else if (TREE_CODE (gnu_prefix) == FIELD_DECL)
+	  {
+	    gnu_field_bitpos = bit_position (gnu_prefix);
+	    gnu_field_offset = byte_position (gnu_prefix);
+	  }
+	else
+	  {
+	    gnu_field_bitpos = bitsize_zero_node;
+	    gnu_field_offset = size_zero_node;
+	  }
+
+	switch (attribute)
+	  {
+	  case Attr_Position:
+	    gnu_result = gnu_field_offset;
+	    break;
+
+	  case Attr_First_Bit:
+	  case Attr_Bit:
+	    gnu_result = size_int (bitpos % BITS_PER_UNIT);
+	    break;
+
+	  case Attr_Last_Bit:
+	    gnu_result = bitsize_int (bitpos % BITS_PER_UNIT);
+	    gnu_result = size_binop (PLUS_EXPR, gnu_result,
+				     TYPE_SIZE (TREE_TYPE (gnu_prefix)));
+	    gnu_result = size_binop (MINUS_EXPR, gnu_result,
+				     bitsize_one_node);
+	    break;
+
+	  case Attr_Bit_Position:
+	    gnu_result = gnu_field_bitpos;
+	    break;
+		}
+
+	/* If this has a PLACEHOLDER_EXPR, qualify it by the object
+	   we are handling. */
+	gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix);
+	break;
+      }
+
+    case Attr_Min:
+    case Attr_Max:
+      {
+	tree gnu_lhs = gnat_to_gnu (First (Expressions (gnat_node)));
+	tree gnu_rhs = gnat_to_gnu (Next (First (Expressions (gnat_node))));
+
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+	gnu_result = build_binary_op (attribute == Attr_Min
+				      ? MIN_EXPR : MAX_EXPR,
+				      gnu_result_type, gnu_lhs, gnu_rhs);
+      }
+      break;
+
+    case Attr_Passed_By_Reference:
+      gnu_result = size_int (default_pass_by_ref (gnu_type)
+			     || must_pass_by_ref (gnu_type));
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      break;
+
+    case Attr_Component_Size:
+      if (TREE_CODE (gnu_prefix) == COMPONENT_REF
+	  && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
+	      == RECORD_TYPE)
+	  && (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
+	gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
+
+      gnu_prefix = maybe_implicit_deref (gnu_prefix);
+      gnu_type = TREE_TYPE (gnu_prefix);
+
+      if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE)
+	gnu_type = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_type))));
+
+      while (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
+	     && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
+	gnu_type = TREE_TYPE (gnu_type);
+
+      if (TREE_CODE (gnu_type) != ARRAY_TYPE)
+	gigi_abort (330);
+
+      /* Note this size cannot be self-referential.  */
+      gnu_result = TYPE_SIZE (TREE_TYPE (gnu_type));
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      prefix_unused = true;
+      break;
+
+    case Attr_Null_Parameter:
+      /* This is just a zero cast to the pointer type for
+	 our prefix and dereferenced.  */
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      gnu_result
+	= build_unary_op (INDIRECT_REF, NULL_TREE,
+			  convert (build_pointer_type (gnu_result_type),
+				   integer_zero_node));
+      TREE_PRIVATE (gnu_result) = 1;
+      break;
+
+    case Attr_Mechanism_Code:
+      {
+	int code;
+	Entity_Id gnat_obj = Entity (Prefix (gnat_node));
+
+	prefix_unused = true;
+	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+	if (Present (Expressions (gnat_node)))
+	  {
+	    int i = UI_To_Int (Intval (First (Expressions (gnat_node))));
+
+	    for (gnat_obj = First_Formal (gnat_obj); i > 1;
+		 i--, gnat_obj = Next_Formal (gnat_obj))
+	      ;
+	  }
+
+	code = Mechanism (gnat_obj);
+	if (code == Default)
+	  code = ((present_gnu_tree (gnat_obj)
+		   && (DECL_BY_REF_P (get_gnu_tree (gnat_obj))
+		       || ((TREE_CODE (get_gnu_tree (gnat_obj))
+			    == PARM_DECL)
+			   && (DECL_BY_COMPONENT_PTR_P
+			       (get_gnu_tree (gnat_obj))))))
+		  ? By_Reference : By_Copy);
+	gnu_result = convert (gnu_result_type, size_int (- code));
+      }
+      break;
+
+    default:
+      /* Say we have an unimplemented attribute.  Then set the value to be
+	 returned to be a zero and hope that's something we can convert to the
+	 type of this attribute.  */
+      post_error ("unimplemented attribute", gnat_node);
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      gnu_result = integer_zero_node;
+      break;
+    }
+
+  /* If this is an attribute where the prefix was unused, force a use of it if
+     it has a side-effect.  But don't do it if the prefix is just an entity
+     name.  However, if an access check is needed, we must do it.  See second
+     example in AARM 11.6(5.e). */
+  if (prefix_unused && TREE_SIDE_EFFECTS (gnu_prefix)
+      && ! Is_Entity_Name (Prefix (gnat_node)))
+    gnu_result = fold (build (COMPOUND_EXPR, TREE_TYPE (gnu_result),
+			      gnu_prefix, gnu_result));
+
+  *gnu_result_type_p = gnu_result_type;
+  return gnu_result;
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Case_Statement,
+   to a GCC tree, which is returned.  */
+
+static tree
+Case_Statement_to_gnu (Node_Id gnat_node)
+{
+  tree gnu_result;
+  tree gnu_expr;
+  Node_Id gnat_when;
+
+  gnu_expr = gnat_to_gnu (Expression (gnat_node));
+  gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
+
+  /*  The range of values in a case statement is determined by the rules in
+      RM 5.4(7-9). In almost all cases, this range is represented by the Etype
+      of the expression. One exception arises in the case of a simple name that
+      is parenthesized. This still has the Etype of the name, but since it is
+      not a name, para 7 does not apply, and we need to go to the base type.
+      This is the only case where parenthesization affects the dynamic
+      semantics (i.e. the range of possible values at runtime that is covered
+      by the others alternative.
+
+      Another exception is if the subtype of the expression is non-static.  In
+      that case, we also have to use the base type.  */
+  if (Paren_Count (Expression (gnat_node)) != 0
+      || !Is_OK_Static_Subtype (Underlying_Type
+				(Etype (Expression (gnat_node)))))
+    gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
+
+  /* We build a SWITCH_EXPR that contains the code with interspersed
+     CASE_LABEL_EXPRs for each label.  */
+
+  push_stack (&gnu_switch_label_stack, NULL_TREE, create_artificial_label ());
+  start_stmt_group ();
+  for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
+       Present (gnat_when);
+       gnat_when = Next_Non_Pragma (gnat_when))
+    {
+      Node_Id gnat_choice;
+
+      /* First compile all the different case choices for the current WHEN
+	 alternative.  */
+      for (gnat_choice = First (Discrete_Choices (gnat_when));
+	   Present (gnat_choice); gnat_choice = Next (gnat_choice))
+	{
+	  tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
+
+	  switch (Nkind (gnat_choice))
+	    {
+	    case N_Range:
+	      gnu_low = gnat_to_gnu (Low_Bound (gnat_choice));
+	      gnu_high = gnat_to_gnu (High_Bound (gnat_choice));
+	      break;
+
+	    case N_Subtype_Indication:
+	      gnu_low = gnat_to_gnu (Low_Bound (Range_Expression
+						(Constraint (gnat_choice))));
+	      gnu_high = gnat_to_gnu (High_Bound (Range_Expression
+						  (Constraint (gnat_choice))));
+	      break;
+
+	    case N_Identifier:
+	    case N_Expanded_Name:
+	      /* This represents either a subtype range or a static value of
+		 some kind; Ekind says which.  If a static value, fall through
+		 to the next case.  */
+	      if (IN (Ekind (Entity (gnat_choice)), Type_Kind))
+		{
+		  tree gnu_type = get_unpadded_type (Entity (gnat_choice));
+
+		  gnu_low = fold (TYPE_MIN_VALUE (gnu_type));
+		  gnu_high = fold (TYPE_MAX_VALUE (gnu_type));
+		  break;
+		}
+
+	      /* ... fall through ... */
+
+	    case N_Character_Literal:
+	    case N_Integer_Literal:
+	      gnu_low = gnat_to_gnu (gnat_choice);
+	      break;
+
+	    case N_Others_Choice:
+	      break;
+
+	    default:
+	      gigi_abort (316);
+	    }
+
+	  add_stmt_with_node (build (CASE_LABEL_EXPR, void_type_node,
+				     gnu_low, gnu_high,
+				     create_artificial_label ()),
+			      gnat_choice);
+	}
+
+      /* 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)));
+    }
+
+  /* Now emit a definition of the label all the cases branched to. */
+  add_stmt (build1 (LABEL_EXPR, void_type_node,
+		    TREE_VALUE (gnu_switch_label_stack)));
+  gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
+		      end_stmt_group (), NULL_TREE);
+  pop_stack (&gnu_switch_label_stack);
+
+  return gnu_result;
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement,
+   to a GCC tree, which is returned.  */
+
+static tree
+Loop_Statement_to_gnu (Node_Id gnat_node)
+{
+  /* ??? It would be nice to use "build" here, but there's no build5.  */
+  tree gnu_loop_stmt = build_nt (LOOP_STMT, NULL_TREE, NULL_TREE,
+				 NULL_TREE, NULL_TREE, NULL_TREE);
+  tree gnu_loop_var = NULL_TREE;
+  Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
+  tree gnu_cond_expr = NULL_TREE;
+  tree gnu_result;
+
+  TREE_TYPE (gnu_loop_stmt) = void_type_node;
+  TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
+  LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label ();
+  annotate_with_node (gnu_loop_stmt, gnat_node);
+
+  /* Save the end label of this LOOP_STMT in a stack so that the corresponding
+     N_Exit_Statement can find it.  */
+  push_stack (&gnu_loop_label_stack, NULL_TREE,
+	      LOOP_STMT_LABEL (gnu_loop_stmt));
+
+  /* Set the condition that under which the loop should continue.
+     For "LOOP .... END LOOP;" the condition is always true.  */
+  if (No (gnat_iter_scheme))
+    ;
+  /* The case "WHILE condition LOOP ..... END LOOP;" */
+  else if (Present (Condition (gnat_iter_scheme)))
+    LOOP_STMT_TOP_COND (gnu_loop_stmt)
+      = gnat_to_gnu (Condition (gnat_iter_scheme));
+  else
+    {
+      /* We have an iteration scheme.  */
+      Node_Id gnat_loop_spec = Loop_Parameter_Specification (gnat_iter_scheme);
+      Entity_Id gnat_loop_var = Defining_Entity (gnat_loop_spec);
+      Entity_Id gnat_type = Etype (gnat_loop_var);
+      tree gnu_type = get_unpadded_type (gnat_type);
+      tree gnu_low = TYPE_MIN_VALUE (gnu_type);
+      tree gnu_high = TYPE_MAX_VALUE (gnu_type);
+      bool reversep = Reverse_Present (gnat_loop_spec);
+      tree gnu_first = reversep ? gnu_high : gnu_low;
+      tree gnu_last = reversep ? gnu_low : gnu_high;
+      enum tree_code end_code = reversep ? GE_EXPR : LE_EXPR;
+      tree gnu_base_type = get_base_type (gnu_type);
+      tree gnu_limit = (reversep ? TYPE_MIN_VALUE (gnu_base_type)
+			: TYPE_MAX_VALUE (gnu_base_type));
+
+      /* We know the loop variable will not overflow if GNU_LAST is a constant
+	 and is not equal to GNU_LIMIT.  If it might overflow, we have to move
+	 the limit test to the end of the loop.  In that case, we have to test
+	 for an empty loop outside the loop.  */
+      if (TREE_CODE (gnu_last) != INTEGER_CST
+	  || TREE_CODE (gnu_limit) != INTEGER_CST
+	  || tree_int_cst_equal (gnu_last, gnu_limit))
+	{
+	  gnu_cond_expr
+	    = build (COND_EXPR, void_type_node,
+		     build_binary_op (LE_EXPR, integer_type_node,
+				      gnu_low, gnu_high),
+		     NULL_TREE, alloc_stmt_list ());
+	  annotate_with_node (gnu_cond_expr, gnat_loop_spec);
+	}
+
+      /* Open a new nesting level that will surround the loop to declare the
+	 loop index variable.  */
+      start_stmt_group ();
+      gnat_pushlevel ();
+
+      /* Declare the loop index and set it to its initial value.  */
+      gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
+      if (DECL_BY_REF_P (gnu_loop_var))
+	gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var);
+
+      /* The loop variable might be a padded type, so use `convert' to get a
+	 reference to the inner variable if so.  */
+      gnu_loop_var = convert (get_base_type (gnu_type), gnu_loop_var);
+
+      /* Set either the top or bottom exit condition as appropriate depending
+	 on whether or not we know an overflow cannot occur. */
+      if (gnu_cond_expr)
+	LOOP_STMT_BOT_COND (gnu_loop_stmt)
+	  = build_binary_op (NE_EXPR, integer_type_node,
+			     gnu_loop_var, gnu_last);
+      else
+	LOOP_STMT_TOP_COND (gnu_loop_stmt)
+	  = build_binary_op (end_code, integer_type_node,
+			     gnu_loop_var, gnu_last);
+
+      LOOP_STMT_UPDATE (gnu_loop_stmt)
+	= build_binary_op (reversep ? PREDECREMENT_EXPR
+			   : PREINCREMENT_EXPR,
+			   TREE_TYPE (gnu_loop_var),
+			   gnu_loop_var,
+			   convert (TREE_TYPE (gnu_loop_var),
+				    integer_one_node));
+      annotate_with_node (LOOP_STMT_UPDATE (gnu_loop_stmt),
+			  gnat_iter_scheme);
+    }
+
+  /* If the loop was named, have the name point to this loop.  In this case,
+     the association is not a ..._DECL node, but the end label from this
+     LOOP_STMT. */
+  if (Present (Identifier (gnat_node)))
+    save_gnu_tree (Entity (Identifier (gnat_node)),
+		   LOOP_STMT_LABEL (gnu_loop_stmt), 1);
+
+  /* Make the loop body into its own block, so any allocated storage will be
+     released every iteration.  This is needed for stack allocation.  */
+  LOOP_STMT_BODY (gnu_loop_stmt)
+    = build_stmt_group (Statements (gnat_node), true);
+
+  /* If we declared a variable, then we are in a statement group for that
+     declaration.  Add the LOOP_STMT to it and make that the "loop".  */
+  if (gnu_loop_var)
+    {
+      add_stmt (gnu_loop_stmt);
+      gnat_poplevel ();
+      gnu_loop_stmt = end_stmt_group ();
+    }
+
+  /* If we have an outer COND_EXPR, that's our result and this loop is its
+     "true" statement.  Otherwise, the result is the LOOP_STMT. */
+  if (gnu_cond_expr)
+    {
+      COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt;
+      gnu_result = gnu_cond_expr;
+      recalculate_side_effects (gnu_cond_expr);
+    }
+  else
+    gnu_result = gnu_loop_stmt;
+
+  pop_stack (&gnu_loop_label_stack);
+
+  return gnu_result;
+}
+
+/* Subroutine of gnat_to_gnu to process gnat_node, an N_Subprogram_Body.  We
+   don't return anything.  */
+
+static void
+Subprogram_Body_to_gnu (Node_Id gnat_node)
+{
+  /* Save debug output mode in case it is reset.  */
+  enum debug_info_type save_write_symbols = write_symbols;
+  const struct gcc_debug_hooks *const save_debug_hooks = debug_hooks;
+  /* Definining identifier of a parameter to the subprogram.  */
+  Entity_Id gnat_param;
+  /* The defining identifier for the subprogram body. Note that if a
+     specification has appeared before for this body, then the identifier
+     occurring in that specification will also be a defining identifier and all
+     the calls to this subprogram will point to that specification.  */
+  Entity_Id gnat_subprog_id
+    = (Present (Corresponding_Spec (gnat_node))
+       ? Corresponding_Spec (gnat_node) : Defining_Entity (gnat_node));
+  /* The FUNCTION_DECL node corresponding to the subprogram spec.   */
+  tree gnu_subprog_decl;
+  /* The FUNCTION_TYPE node corresponding to the subprogram spec.  */
+  tree gnu_subprog_type;
+  tree gnu_cico_list;
+  tree gnu_result;
+
+  /* If this is a generic object or if it has been eliminated,
+     ignore it.  */
+  if (Ekind (gnat_subprog_id) == E_Generic_Procedure
+      || Ekind (gnat_subprog_id) == E_Generic_Function
+      || Is_Eliminated (gnat_subprog_id))
+    return;
+
+  /* If debug information is suppressed for the subprogram, turn debug
+     mode off for the duration of processing.  */
+  if (!Needs_Debug_Info (gnat_subprog_id))
+    {
+      write_symbols = NO_DEBUG;
+      debug_hooks = &do_nothing_debug_hooks;
+    }
+
+  /* If this subprogram acts as its own spec, define it.  Otherwise, just get
+     the already-elaborated tree node.  However, if this subprogram had its
+     elaboration deferred, we will already have made a tree node for it.  So
+     treat it as not being defined in that case.  Such a subprogram cannot
+     have an address clause or a freeze node, so this test is safe, though it
+     does disable some otherwise-useful error checking.  */
+  gnu_subprog_decl
+    = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
+			  Acts_As_Spec (gnat_node)
+			  && ! present_gnu_tree (gnat_subprog_id));
+
+  gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
+
+  /* Set the line number in the decl to correspond to that of the body so that
+     the line number notes are written
+     correctly.  */
+  Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_subprog_decl));
+
+  begin_subprog_body (gnu_subprog_decl);
+  gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
+
+  /* If there are OUT parameters, we need to ensure that the return statement
+     properly copies them out.  We do this by making a new block and converting
+     any inner return into a goto to a label at the end of the block.  */
+  push_stack (&gnu_return_label_stack, NULL_TREE,
+	      gnu_cico_list ? create_artificial_label () : NULL_TREE);
+
+  /* Get a tree corresponding to the code for the subprogram.  */
+  start_stmt_group ();
+  gnat_pushlevel ();
+
+  /* See if there are any parameters for which we don't yet have GCC entities.
+     These must be for OUT parameters for which we will be making VAR_DECL
+     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);
+       Present (gnat_param);
+       gnat_param = Next_Formal_With_Extras (gnat_param))
+    if (!present_gnu_tree (gnat_param))
+      {
+	/* Skip any entries that have been already filled in; they must
+	   correspond to IN OUT parameters.  */
+	for (; gnu_cico_list != 0 && TREE_VALUE (gnu_cico_list) != 0;
+	     gnu_cico_list = TREE_CHAIN (gnu_cico_list))
+	  ;
+
+	/* Do any needed references for padded types.  */
+	TREE_VALUE (gnu_cico_list)
+	  = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)),
+		     gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
+      }
+
+  process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
+
+  /* Generate the code of the subprogram itself.  A return statement will be
+     present and any OUT parameters will be handled there.  */
+  add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
+  gnat_poplevel ();
+  gnu_result = end_stmt_group ();
+
+  /* If we made a special return label, we need to make a block that contains
+     the definition of that label and the copying to the return value.  That
+     block first contains the function, then the label and copy statement.  */
+  if (TREE_VALUE (gnu_return_label_stack) != 0)
+    {
+      tree gnu_retval;
+
+      start_stmt_group ();
+      gnat_pushlevel ();
+      add_stmt (gnu_result);
+      add_stmt (build1 (LABEL_EXPR, void_type_node,
+			TREE_VALUE (gnu_return_label_stack)));
+
+      gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
+      if (list_length (gnu_cico_list) == 1)
+	gnu_retval = TREE_VALUE (gnu_cico_list);
+      else
+	gnu_retval = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
+					     gnu_cico_list);
+
+      if (DECL_P (gnu_retval) && DECL_BY_REF_P (gnu_retval))
+	gnu_retval = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
+
+      add_stmt_with_node
+	(build1 (RETURN_EXPR, void_type_node,
+		 build (MODIFY_EXPR, TREE_TYPE (gnu_retval),
+			DECL_RESULT (current_function_decl), gnu_retval)),
+	 gnat_node);
+      gnat_poplevel ();
+      gnu_result = end_stmt_group ();
+    }
+
+  pop_stack (&gnu_return_label_stack);
+
+  /* Initialize the information node for the function and set the
+     end location.  */
+  allocate_struct_function (current_function_decl);
+  Sloc_to_locus
+    ((Present (End_Label (Handled_Statement_Sequence (gnat_node)))
+      ? Sloc (End_Label (Handled_Statement_Sequence (gnat_node)))
+      : Sloc (gnat_node)),
+     &cfun->function_end_locus);
+
+  end_subprog_body (gnu_result);
+
+  /* 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);
+       Present (gnat_param);
+       gnat_param = Next_Formal_With_Extras (gnat_param))
+    if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL)
+      save_gnu_tree (gnat_param, NULL_TREE, 0);
+
+  mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
+  write_symbols = save_write_symbols;
+  debug_hooks = save_debug_hooks;
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call
+   or an N_Procedure_Call_Statement, to a GCC tree, which is returned.
+   GNU_RESULT_TYPE_P is a pointer to where we should place the result type.  */
+
+static tree
+call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
+{
+  tree gnu_result;
+  /* The GCC node corresponding to the GNAT subprogram name.  This can either
+     be a FUNCTION_DECL node if we are dealing with a standard subprogram call,
+     or an indirect reference expression (an INDIRECT_REF node) pointing to a
+     subprogram.  */
+  tree gnu_subprog_node = gnat_to_gnu (Name (gnat_node));
+  /* The FUNCTION_TYPE node giving the GCC type of the subprogram.  */
+  tree gnu_subprog_type = TREE_TYPE (gnu_subprog_node);
+  tree gnu_subprog_addr = build_unary_op (ADDR_EXPR, NULL_TREE,
+					  gnu_subprog_node);
+  Entity_Id gnat_formal;
+  Node_Id gnat_actual;
+  tree gnu_actual_list = NULL_TREE;
+  tree gnu_name_list = NULL_TREE;
+  tree gnu_before_list = NULL_TREE;
+  tree gnu_after_list = NULL_TREE;
+  tree gnu_subprog_call;
+
+  switch (Nkind (Name (gnat_node)))
+    {
+    case N_Identifier:
+    case N_Operator_Symbol:
+    case N_Expanded_Name:
+    case N_Attribute_Reference:
+      if (Is_Eliminated (Entity (Name (gnat_node))))
+	Eliminate_Error_Msg (gnat_node, Entity (Name (gnat_node)));
+    }
+
+  if (TREE_CODE (gnu_subprog_type) != FUNCTION_TYPE)
+    gigi_abort (317);
+
+  /* If we are calling a stubbed function, make this into a raise of
+     Program_Error.  Elaborate all our args first.  */
+  if (TREE_CODE (gnu_subprog_node) == FUNCTION_DECL
+      && DECL_STUBBED_P (gnu_subprog_node))
+    {
+      for (gnat_actual = First_Actual (gnat_node);
+	   Present (gnat_actual);
+	   gnat_actual = Next_Actual (gnat_actual))
+	add_stmt (gnat_to_gnu (gnat_actual));
+
+      if (Nkind (gnat_node) == N_Function_Call)
+	{
+	  *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
+	  return build1 (NULL_EXPR, *gnu_result_type_p,
+			 build_call_raise (PE_Stubbed_Subprogram_Called));
+	}
+      else
+	return build_call_raise (PE_Stubbed_Subprogram_Called);
+    }
+
+  /* The only way we can be making a call via an access type is if Name is an
+     explicit dereference.  In that case, get the list of formal args from the
+     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)));
+  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)));
+
+  /* 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
+     parameter-expression and the TREE_PURPOSE field is null.  Skip OUT
+     parameters not passed by reference and don't need to be copied in.  */
+  for (gnat_actual = First_Actual (gnat_node);
+       Present (gnat_actual);
+       gnat_formal = Next_Formal_With_Extras (gnat_formal),
+       gnat_actual = Next_Actual (gnat_actual))
+    {
+      tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
+      /* We treat a conversion between aggregate types as if it is an
+	 unchecked conversion.  */
+      bool unchecked_convert_p
+	= (Nkind (gnat_actual) == N_Unchecked_Type_Conversion
+	   || (Nkind (gnat_actual) == N_Type_Conversion
+	       && Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
+      Node_Id gnat_name = (unchecked_convert_p
+			   ? Expression (gnat_actual) : gnat_actual);
+      tree gnu_name = gnat_to_gnu (gnat_name);
+      tree gnu_name_type = gnat_to_gnu_type (Etype (gnat_name));
+      tree gnu_actual;
+
+      /* If it's possible we may need to use this expression twice, make sure
+	 than any side-effects are handled via SAVE_EXPRs. Likewise if we need
+	 to force side-effects before the call.
+
+	 ??? This is more conservative than we need since we don't need to do
+	 this for pass-by-ref with no conversion. If we are passing a
+	 non-addressable Out or In Out parameter by reference, pass the address
+	 of a copy and set up to copy back out after the call.  */
+      if (Ekind (gnat_formal) != E_In_Parameter)
+	{
+	  gnu_name = gnat_stabilize_reference (gnu_name, 1);
+	  if (! addressable_p (gnu_name)
+	      && present_gnu_tree (gnat_formal)
+	      && (DECL_BY_REF_P (get_gnu_tree (gnat_formal))
+		  || (TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
+		      && (DECL_BY_COMPONENT_PTR_P (get_gnu_tree (gnat_formal))
+			  || (DECL_BY_DESCRIPTOR_P
+			      (get_gnu_tree (gnat_formal)))))))
+	    {
+	      tree gnu_copy = gnu_name;
+	      tree gnu_temp;
+
+	      /* Remove any unpadding on the actual and make a copy.  But if
+		 the actual is a left-justified modular type, first convert
+		 to it.  */
+	      if (TREE_CODE (gnu_name) == COMPONENT_REF
+		  && ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
+		       == RECORD_TYPE)
+		      && (TYPE_IS_PADDING_P
+			  (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
+		gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
+	      else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
+		       && (TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_name_type)))
+		gnu_name = convert (gnu_name_type, gnu_name);
+
+	      gnu_actual = save_expr (gnu_name);
+
+	      /* Since we're going to take the address of the SAVE_EXPR, we
+		 don't want it to be marked as unchanging. So set
+		 TREE_ADDRESSABLE.  */
+	      gnu_temp = skip_simple_arithmetic (gnu_actual);
+	      if (TREE_CODE (gnu_temp) == SAVE_EXPR)
+		{
+		  TREE_ADDRESSABLE (gnu_temp) = 1;
+		  TREE_READONLY (gnu_temp) = 0;
+		}
+
+	      /* Set up to move the copy back to the original.  */
+	      gnu_temp = build (MODIFY_EXPR, TREE_TYPE (gnu_copy),
+				gnu_copy, gnu_actual);
+	      annotate_with_node (gnu_temp, gnat_actual);
+	      append_to_statement_list (gnu_temp, &gnu_after_list);
+	    }
+	}
+
+      /* If this was a procedure call, we may not have removed any padding.
+	 So do it here for the part we will use as an input, if any.  */
+      gnu_actual = gnu_name;
+      if (Ekind (gnat_formal) != E_Out_Parameter
+	  && TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
+	  && TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual)))
+	gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)),
+			      gnu_actual);
+
+      /* Unless this is an In parameter, we must remove any LJM building
+	 from GNU_NAME.  */
+      if (Ekind (gnat_formal) != E_In_Parameter
+	  && TREE_CODE (gnu_name) == CONSTRUCTOR
+	  && TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE
+	  && TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name)))
+	gnu_name = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))),
+			    gnu_name);
+
+      if (Ekind (gnat_formal) != E_Out_Parameter
+	  && ! unchecked_convert_p
+	  && Do_Range_Check (gnat_actual))
+	gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal));
+
+      /* Do any needed conversions.  We need only check for unchecked
+	 conversion since normal conversions will be handled by just
+	 converting to the formal type.  */
+      if (unchecked_convert_p)
+	{
+	  gnu_actual
+	    = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)),
+				 gnu_actual,
+				 (Nkind (gnat_actual)
+				  == N_Unchecked_Type_Conversion)
+				 && No_Truncation (gnat_actual));
+
+	  /* One we've done the unchecked conversion, we still must ensure that
+	     the object is in range of the formal's type.  */
+	  if (Ekind (gnat_formal) != E_Out_Parameter
+	      && Do_Range_Check (gnat_actual))
+	    gnu_actual = emit_range_check (gnu_actual,
+					   Etype (gnat_formal));
+	}
+      else if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+	/* We may have suppressed a conversion to the Etype of the actual since
+	   the parent is a procedure call.  So add the conversion here.  */
+	gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
+			      gnu_actual);
+
+      if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+	gnu_actual = convert (gnu_formal_type, gnu_actual);
+
+      /* If we have not saved a GCC object for the formal, it means it is an
+	 OUT parameter not passed by reference and that does not need to be
+	 copied in. Otherwise, look at the PARM_DECL to see if it is passed by
+	 reference. */
+      if (present_gnu_tree (gnat_formal)
+	  && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
+	  && DECL_BY_REF_P (get_gnu_tree (gnat_formal)))
+	{
+	  if (Ekind (gnat_formal) != E_In_Parameter)
+	    {
+	      gnu_actual = gnu_name;
+
+	      /* If we have a padded type, be sure we've removed padding.  */
+	      if (TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
+		  && TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual))
+		  && TREE_CODE (gnu_actual) != SAVE_EXPR)
+		gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)),
+				      gnu_actual);
+	    }
+
+	  /* Otherwise, if we have a non-addressable COMPONENT_REF of a
+	     variable-size type see if it's doing a unpadding operation.  If
+	     so, remove that operation since we have no way of allocating the
+	     required temporary.  */
+	  if (TREE_CODE (gnu_actual) == COMPONENT_REF
+	      && ! TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
+	      && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_actual, 0)))
+		  == RECORD_TYPE)
+	      && TYPE_IS_PADDING_P (TREE_TYPE
+				    (TREE_OPERAND (gnu_actual, 0)))
+	      && !addressable_p (gnu_actual))
+	    gnu_actual = TREE_OPERAND (gnu_actual, 0);
+
+	  /* 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));
+	  gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
+	}
+      else if (present_gnu_tree (gnat_formal)
+	       && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
+	       && DECL_BY_COMPONENT_PTR_P (get_gnu_tree (gnat_formal)))
+	{
+	  gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
+	  gnu_actual = maybe_implicit_deref (gnu_actual);
+	  gnu_actual = maybe_unconstrained_array (gnu_actual);
+
+	  if (TREE_CODE (gnu_formal_type) == RECORD_TYPE
+	      && TYPE_IS_PADDING_P (gnu_formal_type))
+	    {
+	      gnu_formal_type = TREE_TYPE (TYPE_FIELDS (gnu_formal_type));
+	      gnu_actual = convert (gnu_formal_type, gnu_actual);
+	    }
+
+	  /* Take the address of the object and convert to the proper pointer
+	     type.  We'd like to actually compute the address of the beginning
+	     of the array using an ADDR_EXPR of an ARRAY_REF, but there's a
+	     possibility that the ARRAY_REF might return a constant and we'd be
+	     getting the wrong address.  Neither approach is exactly correct,
+	     but this is the most likely to work in all cases.  */
+	  gnu_actual = convert (gnu_formal_type,
+				build_unary_op (ADDR_EXPR, NULL_TREE,
+						gnu_actual));
+	}
+      else if (present_gnu_tree (gnat_formal)
+	       && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
+	       && DECL_BY_DESCRIPTOR_P (get_gnu_tree (gnat_formal)))
+	{
+	  /* If arg is 'Null_Parameter, pass zero descriptor.  */
+	  if ((TREE_CODE (gnu_actual) == INDIRECT_REF
+	       || TREE_CODE (gnu_actual) == UNCONSTRAINED_ARRAY_REF)
+	      && TREE_PRIVATE (gnu_actual))
+	    gnu_actual = convert (DECL_ARG_TYPE (get_gnu_tree (gnat_formal)),
+				  integer_zero_node);
+	  else
+	    gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
+					 fill_vms_descriptor (gnu_actual,
+							      gnat_formal));
+	}
+      else
+	{
+	  tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual));
+	  
+	  if (Ekind (gnat_formal) != E_In_Parameter)
+	    gnu_name_list = chainon (gnu_name_list,
+				     build_tree_list (NULL_TREE, gnu_name));
+
+	  if (! present_gnu_tree (gnat_formal)
+	      || TREE_CODE (get_gnu_tree (gnat_formal)) != PARM_DECL)
+	    continue;
+
+	  /* If this is 'Null_Parameter, pass a zero even though we are
+	     dereferencing it.  */
+	  else if (TREE_CODE (gnu_actual) == INDIRECT_REF
+		   && TREE_PRIVATE (gnu_actual)
+		   && host_integerp (gnu_actual_size, 1)
+		   && 0 >= compare_tree_int (gnu_actual_size,
+						   BITS_PER_WORD))
+	    gnu_actual
+	      = unchecked_convert
+		(DECL_ARG_TYPE (get_gnu_tree (gnat_formal)),
+		 convert (gnat_type_for_size
+			  (tree_low_cst (gnu_actual_size, 1), 1),
+			  integer_zero_node), 0);
+	  else
+	    gnu_actual = convert (TYPE_MAIN_VARIANT
+				  (DECL_ARG_TYPE (get_gnu_tree (gnat_formal))),
+				  gnu_actual);
+	}
+
+      gnu_actual_list = chainon (gnu_actual_list,
+				 build_tree_list (NULL_TREE, gnu_actual));
+    }
+
+  gnu_subprog_call = build (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
+			    gnu_subprog_addr, gnu_actual_list, NULL_TREE);
+  TREE_SIDE_EFFECTS (gnu_subprog_call) = 1;
+
+  /* If it is a function call, the result is the call expression.  */
+  if (Nkind (gnat_node) == N_Function_Call)
+    {
+      gnu_result = gnu_subprog_call;
+
+      /* If the function returns an unconstrained array or by reference,
+	 we have to de-dereference the pointer.  */
+      if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type)
+	  || TYPE_RETURNS_BY_REF_P (gnu_subprog_type))
+	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+
+      *gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
+      return gnu_result;
+    }
+
+  /* If this is the case where the GNAT tree contains a procedure call
+     but the Ada procedure has copy in copy out parameters, the special
+     parameter passing mechanism must be used.  */
+  else if (TYPE_CI_CO_LIST (gnu_subprog_type) != NULL_TREE)
+    {
+      /* List of FIELD_DECLs associated with the PARM_DECLs of the copy
+	 in copy out parameters.  */
+      tree scalar_return_list = TYPE_CI_CO_LIST (gnu_subprog_type);
+      int length = list_length (scalar_return_list);
+
+      if (length > 1)
+	{
+	  tree gnu_name;
+
+	  gnu_subprog_call = protect_multiple_eval (gnu_subprog_call);
+
+	  /* If any of the names had side-effects, ensure they are all
+	     evaluated before the call.  */
+	  for (gnu_name = gnu_name_list; gnu_name;
+	       gnu_name = TREE_CHAIN (gnu_name))
+	    if (TREE_SIDE_EFFECTS (TREE_VALUE (gnu_name)))
+	      add_stmt (TREE_VALUE (gnu_name));
+	}
+
+      if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
+	gnat_formal = First_Formal (Etype (Name (gnat_node)));
+      else
+	gnat_formal = First_Formal (Entity (Name (gnat_node)));
+
+      for (gnat_actual = First_Actual (gnat_node);
+	   Present (gnat_actual);
+	   gnat_formal = Next_Formal_With_Extras (gnat_formal),
+	   gnat_actual = Next_Actual (gnat_actual))
+	/* If we are dealing with a copy in copy out parameter, we must
+	   retrieve its value from the record returned in the call.  */
+	if (! (present_gnu_tree (gnat_formal)
+	       && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
+	       && (DECL_BY_REF_P (get_gnu_tree (gnat_formal))
+		   || (TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
+		       && ((DECL_BY_COMPONENT_PTR_P
+			    (get_gnu_tree (gnat_formal))
+			    || (DECL_BY_DESCRIPTOR_P
+				(get_gnu_tree (gnat_formal))))))))
+	    && Ekind (gnat_formal) != E_In_Parameter)
+	  {
+	    /* Get the value to assign to this OUT or IN OUT parameter.  It is
+	       either the result of the function if there is only a single such
+	       parameter or the appropriate field from the record returned.  */
+	    tree gnu_result
+	      = length == 1 ? gnu_subprog_call
+		: build_component_ref (gnu_subprog_call, NULL_TREE,
+				       TREE_PURPOSE (scalar_return_list), 0);
+	    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.  */
+	    tree gnu_actual
+	      = maybe_unconstrained_array (TREE_VALUE (gnu_name_list));
+
+	    /* If the result is a padded type, remove the padding.  */
+	    if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
+		&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
+	      gnu_result = convert (TREE_TYPE (TYPE_FIELDS
+					       (TREE_TYPE (gnu_result))),
+				    gnu_result);
+
+	    /* If the result is a type conversion, do it.  */
+	    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));
+
+	    else if (unchecked_conversion)
+	      gnu_result = unchecked_convert (TREE_TYPE (gnu_actual),
+					      gnu_result,
+					      No_Truncation (gnat_actual));
+	    else
+	      {
+		if (Do_Range_Check (gnat_actual))
+		  gnu_result = emit_range_check (gnu_result,
+						 Etype (gnat_actual));
+
+		if (! (! TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
+		       && TREE_CONSTANT (TYPE_SIZE
+					 (TREE_TYPE (gnu_result)))))
+		  gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
+	      }
+		
+	    gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+					  gnu_actual, gnu_result);
+	    annotate_with_node (gnu_result, gnat_actual);
+	    append_to_statement_list (gnu_result, &gnu_before_list);
+	    scalar_return_list = TREE_CHAIN (scalar_return_list);
+	    gnu_name_list = TREE_CHAIN (gnu_name_list);
+	  }
+	}
+  else
+    {
+      annotate_with_node (gnu_subprog_call, gnat_node);
+      append_to_statement_list (gnu_subprog_call, &gnu_before_list);
+    }
+
+  append_to_statement_list (gnu_after_list, &gnu_before_list);
+  return gnu_before_list;
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, an
+   N_Handled_Sequence_Of_Statements, to a GCC tree, which is returned.  */
+
+static tree
+Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
+{
+  tree gnu_jmpsave_decl = NULL_TREE;
+  tree gnu_jmpbuf_decl = NULL_TREE;
+  /* If just annotating, ignore all EH and cleanups.  */
+  bool gcc_zcx = (!type_annotate_only
+		  && Present (Exception_Handlers (gnat_node))
+		  && Exception_Mechanism == GCC_ZCX);
+  bool setjmp_longjmp
+    = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
+       && Exception_Mechanism == Setjmp_Longjmp);
+  bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
+  bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
+  tree gnu_inner_block; /* The statement(s) for the block itself.  */
+  tree gnu_result;
+  tree gnu_expr;
+  Node_Id gnat_temp;
+
+  /* The GCC exception handling mechanism can handle both ZCX and SJLJ schemes
+     and we have our own SJLJ mechanism.  To call the GCC mechanism, we call
+     add_cleanup, and when we leave the binding, end_stmt_group will create
+     the TRY_FINALLY_EXPR.
+
+     ??? The region level calls down there have been specifically put in place
+     for a ZCX context and currently the order in which things are emitted
+     (region/handlers) is different from the SJLJ case. Instead of putting
+     other calls with different conditions at other places for the SJLJ case,
+     it seems cleaner to reorder things for the SJLJ case and generalize the
+     condition to make it not ZCX specific.
+
+     If there are any exceptions or cleanup processing involved, we need an
+     outer statement group (for Setjmp_Longjmp) and binding level.  */
+  if (binding_for_block)
+    {
+      start_stmt_group ();
+      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.  */
+  if (setjmp_longjmp)
+    {
+      gnu_jmpsave_decl = create_var_decl (get_identifier ("JMPBUF_SAVE"),
+					  NULL_TREE, jmpbuf_ptr_type,
+					  build_call_0_expr (get_jmpbuf_decl),
+					  0, 0, 0, 0, 0, gnat_node);
+      gnu_jmpbuf_decl = create_var_decl (get_identifier ("JMP_BUF"),
+					 NULL_TREE, jmpbuf_type,
+					 NULL_TREE, 0, 0, 0, 0, 0, gnat_node);
+
+      set_block_jmpbuf_decl (gnu_jmpbuf_decl);
+
+      /* When we exit this block, restore the saved value.  */
+      add_cleanup (build_call_1_expr (set_jmpbuf_decl, gnu_jmpsave_decl));
+    }
+
+  /* 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 ();
+
+  if (setjmp_longjmp)
+    add_stmt (build_call_1_expr (set_jmpbuf_decl,
+				 build_unary_op (ADDR_EXPR, NULL_TREE,
+						 gnu_jmpbuf_decl)));
+
+
+  if (Present (First_Real_Statement (gnat_node)))
+    process_decls (Statements (gnat_node), Empty,
+		   First_Real_Statement (gnat_node), 1, 1);
+
+  /* Generate code for each statement in the block.  */
+  for (gnat_temp = (Present (First_Real_Statement (gnat_node))
+		    ? First_Real_Statement (gnat_node)
+		    : First (Statements (gnat_node)));
+       Present (gnat_temp); gnat_temp = Next (gnat_temp))
+    add_stmt (gnat_to_gnu (gnat_temp));
+  gnu_inner_block = end_stmt_group ();
+
+  /* Now generate code for the two exception models, if either is relevant for
+     this block.  */
+  if (setjmp_longjmp)
+    {
+      tree *gnu_else_ptr = 0;
+      tree gnu_handler;
+
+      /* Make a binding level for the exception handling declarations and code
+	 and set up gnu_except_ptr_stack for the handlers to use.  */
+      start_stmt_group ();
+      gnat_pushlevel ();
+
+      push_stack (&gnu_except_ptr_stack, NULL_TREE,
+		  create_var_decl (get_identifier ("EXCEPT_PTR"),
+				   NULL_TREE,
+				   build_pointer_type (except_type_node),
+				   build_call_0_expr (get_excptr_decl),
+				   0, 0, 0, 0, 0, gnat_node));
+
+      /* Generate code for each handler. The N_Exception_Handler case does the
+	 real work and returns a COND_EXPR for each handler, which we chain
+	 together here.  */
+      for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
+	   Present (gnat_temp); gnat_temp = Next_Non_Pragma (gnat_temp))
+	{
+	  gnu_expr = gnat_to_gnu (gnat_temp);
+
+	  /* If this is the first one, set it as the outer one. Otherwise,
+	     point the "else" part of the previous handler to us. Then point
+	     to our "else" part.  */
+	  if (!gnu_else_ptr)
+	    add_stmt (gnu_expr);
+	  else
+	    *gnu_else_ptr = gnu_expr;
+
+	  gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr);
+	}
+
+      /* If none of the exception handlers did anything, re-raise but do not
+	 defer abortion.  */
+      gnu_expr = build_call_1_expr (raise_nodefer_decl,
+				    TREE_VALUE (gnu_except_ptr_stack));
+      annotate_with_node (gnu_expr, gnat_node);
+
+      if (gnu_else_ptr)
+	*gnu_else_ptr = gnu_expr;
+      else
+	add_stmt (gnu_expr);
+
+      /* End the binding level dedicated to the exception handlers and get the
+	 whole statement group.  */
+      pop_stack (&gnu_except_ptr_stack);
+      gnat_poplevel ();
+      gnu_handler = end_stmt_group ();
+
+      /* If the setjmp returns 1, we restore our incoming longjmp value and
+	 then check the handlers.  */
+      start_stmt_group ();
+      add_stmt_with_node (build_call_1_expr (set_jmpbuf_decl,
+					     gnu_jmpsave_decl),
+			  gnat_node);
+      add_stmt (gnu_handler);
+      gnu_handler = end_stmt_group ();
+
+      /* This block is now "if (setjmp) ... <handlers> else <block>".  */
+      gnu_result = build (COND_EXPR, void_type_node,
+			  (build_call_1_expr
+			   (setjmp_decl,
+			    build_unary_op (ADDR_EXPR, NULL_TREE,
+					    gnu_jmpbuf_decl))),
+			  gnu_handler, gnu_inner_block);
+    }
+  else if (gcc_zcx)
+    {
+      tree gnu_handlers;
+
+      /* First make a block containing the handlers.  */
+      start_stmt_group ();
+      for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
+	   Present (gnat_temp);
+	   gnat_temp = Next_Non_Pragma (gnat_temp))
+	add_stmt (gnat_to_gnu (gnat_temp));
+      gnu_handlers = end_stmt_group ();
+
+      /* Now make the TRY_CATCH_EXPR for the block.  */
+      gnu_result = build (TRY_CATCH_EXPR, void_type_node,
+			  gnu_inner_block, gnu_handlers);
+    }
+  else
+    gnu_result = gnu_inner_block;
+
+  /* Now close our outer block, if we had to make one.  */
+  if (binding_for_block)
+    {
+      add_stmt (gnu_result);
+      gnat_poplevel ();
+      gnu_result = end_stmt_group ();
+    }
+
+  return gnu_result;
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler,
+   to a GCC tree, which is returned.  This is the variant for Setjmp_Longjmp
+   exception handling.  */
+
+static tree
+Exception_Handler_to_gnu_sjlj (Node_Id gnat_node)
+{
+  /* Unless this is "Others" or the special "Non-Ada" exception for Ada, make
+     an "if" statement to select the proper exceptions.  For "Others", exclude
+     exceptions where Handled_By_Others is nonzero unless the All_Others flag
+     is set. For "Non-ada", accept an exception if "Lang" is 'V'.  */
+  tree gnu_choice = integer_zero_node;
+  tree gnu_body = build_stmt_group (Statements (gnat_node), false);
+  Node_Id gnat_temp;
+
+  for (gnat_temp = First (Exception_Choices (gnat_node));
+       gnat_temp; gnat_temp = Next (gnat_temp))
+    {
+      tree this_choice;
+
+      if (Nkind (gnat_temp) == N_Others_Choice)
+	{
+	  if (All_Others (gnat_temp))
+	    this_choice = integer_one_node;
+	  else
+	    this_choice
+	      = build_binary_op
+		(EQ_EXPR, integer_type_node,
+		 convert
+		 (integer_type_node,
+		  build_component_ref
+		  (build_unary_op
+		   (INDIRECT_REF, NULL_TREE,
+		    TREE_VALUE (gnu_except_ptr_stack)),
+		   get_identifier ("not_handled_by_others"), NULL_TREE,
+		   0)),
+		 integer_zero_node);
+	}
+
+      else if (Nkind (gnat_temp) == N_Identifier
+	       || Nkind (gnat_temp) == N_Expanded_Name)
+	{
+	  tree gnu_expr
+	    = gnat_to_gnu_entity (Entity (gnat_temp), NULL_TREE, 0);
+
+	  this_choice
+	    = build_binary_op
+	      (EQ_EXPR, integer_type_node, TREE_VALUE (gnu_except_ptr_stack),
+	       convert (TREE_TYPE (TREE_VALUE (gnu_except_ptr_stack)),
+			build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr)));
+
+	  /* If this is the distinguished exception "Non_Ada_Error" (and we are
+	     in VMS mode), also allow a non-Ada exception (a VMS condition) t
+	     match.  */
+	  if (Is_Non_Ada_Error (Entity (gnat_temp)))
+	    {
+	      tree gnu_comp
+		= build_component_ref
+		  (build_unary_op (INDIRECT_REF, NULL_TREE,
+				   TREE_VALUE (gnu_except_ptr_stack)),
+		   get_identifier ("lang"), NULL_TREE, 0);
+
+	      this_choice
+		= build_binary_op
+		  (TRUTH_ORIF_EXPR, integer_type_node,
+		   build_binary_op (EQ_EXPR, integer_type_node, gnu_comp,
+				    convert (TREE_TYPE (gnu_comp),
+					     build_int_2 ('V', 0))),
+		   this_choice);
+	    }
+	}
+      else
+	gigi_abort (318);
+
+      gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+				    gnu_choice, this_choice);
+    }
+
+  return build (COND_EXPR, void_type_node, gnu_choice, gnu_body, NULL_TREE);
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler,
+   to a GCC tree, which is returned.  This is the variant for ZCX.  */
+
+static tree
+Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
+{
+  tree gnu_etypes_list = NULL_TREE;
+  tree gnu_expr;
+  tree gnu_etype;
+  tree gnu_current_exc_ptr;
+  tree gnu_incoming_exc_ptr;
+  Node_Id gnat_temp;
+
+  /* We build a TREE_LIST of nodes representing what exception types this
+     handler can catch, with special cases for others and all others cases.
+
+     Each exception type is actually identified by a pointer to the exception
+     id, with special value zero for "others" and one for "all others". Beware
+     that these special values are known and used by the personality routine to
+     identify the corresponding specific kinds of handlers.
+
+     ??? For initial time frame reasons, the others and all_others cases have
+     been handled using specific type trees, but this somehow hides information
+     from the back-end, which expects NULL to be passed for catch all and
+     end_cleanup to be used for cleanups.
+
+     Care should be taken to ensure that the control flow impact of such
+     clauses is rendered in some way. lang_eh_type_covers is doing the trick
+     currently.  */
+  for (gnat_temp = First (Exception_Choices (gnat_node));
+       gnat_temp; gnat_temp = Next (gnat_temp))
+    {
+      if (Nkind (gnat_temp) == N_Others_Choice)
+	gnu_etype = (All_Others (gnat_temp) ? integer_one_node
+		     : integer_zero_node);
+      else if (Nkind (gnat_temp) == N_Identifier
+	       || Nkind (gnat_temp) == N_Expanded_Name)
+	{
+	  Entity_Id gnat_ex_id = Entity (gnat_temp);
+
+	  /* Exception may be a renaming. Recover original exception which is
+	     the one elaborated and registered.  */
+	  if (Present (Renamed_Object (gnat_ex_id)))
+	    gnat_ex_id = Renamed_Object (gnat_ex_id);
+
+	  gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0);
+	  gnu_etype = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
+
+	  /* The Non_Ada_Error case for VMS exceptions is handled
+	     by the personality routine.  */
+	}
+      else
+	gigi_abort (337);
+
+      /* The GCC interface expects NULL to be passed for catch all handlers, so
+	 it would be quite tempting to set gnu_etypes_list to NULL if gnu_etype
+	 is integer_zero_node.  It would not work, however, because GCC's
+	 notion of "catch all" is stronger than our notion of "others".  Until
+	 we correctly use the cleanup interface as well, doing that would
+	 prevent the "all others" handlers from beeing seen, because nothing
+	 can be caught beyond a catch all from GCC's point of view.  */
+      gnu_etypes_list = tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list);
+    }
+
+  start_stmt_group ();
+  gnat_pushlevel ();
+
+  /* Expand a call to the begin_handler hook at the beginning of the handler,
+     and arrange for a call to the end_handler hook to occur on every possible
+     exit path.
+
+     The hooks expect a pointer to the low level occurrence. This is required
+     for our stack management scheme because a raise inside the handler pushes
+     a new occurrence on top of the stack, which means that this top does not
+     necessarily match the occurrence this handler was dealing with.
+
+     The EXC_PTR_EXPR object references the exception occurrence being
+     propagated. Upon handler entry, this is the exception for which the
+     handler is triggered. This might not be the case upon handler exit,
+     however, as we might have a new occurrence propagated by the handler's
+     body, and the end_handler hook called as a cleanup in this context.
+
+     We use a local variable to retrieve the incoming value at handler entry
+     time, and reuse it to feed the end_handler hook's argument at exit.  */
+  gnu_current_exc_ptr = build (EXC_PTR_EXPR, ptr_type_node);
+  gnu_incoming_exc_ptr = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
+					  ptr_type_node, gnu_current_exc_ptr,
+					  0, 0, 0, 0, 0, gnat_node);
+
+  add_stmt_with_node (build_call_1_expr (begin_handler_decl,
+					 gnu_incoming_exc_ptr),
+		      gnat_node);
+  add_cleanup (build_call_1_expr (end_handler_decl, gnu_incoming_exc_ptr));
+  add_stmt_list (Statements (gnat_node));
+  gnat_poplevel ();
+
+  return build (CATCH_EXPR, void_type_node, gnu_etypes_list,
+		end_stmt_group ());
+}
+
 /* This function is the driver of the GNAT to GCC tree transformation
    process.  It is the entry point of the tree transformer.  GNAT_NODE is the
    root of some GNAT tree.  Return the root of the corresponding GCC tree.
@@ -315,7 +2345,6 @@ gnat_to_gnu (Node_Id gnat_node)
   tree gnu_expr;
   tree gnu_lhs, gnu_rhs;
   Node_Id gnat_temp;
-  Entity_Id gnat_temp_type;
 
   /* Save node number for error message and set location information.  */
   error_gnat_node = gnat_node;
@@ -354,7 +2383,6 @@ gnat_to_gnu (Node_Id gnat_node)
       went_into_elab_proc = true;
     }
 
-
   switch (Nkind (gnat_node))
     {
       /********************************/
@@ -365,182 +2393,7 @@ gnat_to_gnu (Node_Id gnat_node)
     case N_Expanded_Name:
     case N_Operator_Symbol:
     case N_Defining_Identifier:
-
-      /* If the Etype of this node does not equal the Etype of the Entity,
-         something is wrong with the entity map, probably in generic
-         instantiation. However, this does not apply to types. Since we
-         sometime have strange Ekind's, just do this test for objects. Also,
-         if the Etype of the Entity is private, the Etype of the N_Identifier
-         is allowed to be the full type and also we consider a packed array
-         type to be the same as the original type. Similarly, a class-wide
-         type is equivalent to a subtype of itself. Finally, if the types are
-         Itypes, one may be a copy of the other, which is also legal.  */
-      gnat_temp = (Nkind (gnat_node) == N_Defining_Identifier
-		   ? gnat_node : Entity (gnat_node));
-      gnat_temp_type = Etype (gnat_temp);
-
-      if (Etype (gnat_node) != gnat_temp_type
-          && ! (Is_Packed (gnat_temp_type)
-                && Etype (gnat_node) == Packed_Array_Type (gnat_temp_type))
-          && ! (Is_Class_Wide_Type (Etype (gnat_node)))
-          && ! (IN (Ekind (gnat_temp_type), Private_Kind)
-                && Present (Full_View (gnat_temp_type))
-                && ((Etype (gnat_node) == Full_View (gnat_temp_type))
-                    || (Is_Packed (Full_View (gnat_temp_type))
-                        && Etype (gnat_node) ==
-                             Packed_Array_Type (Full_View (gnat_temp_type)))))
-          && (!Is_Itype (Etype (gnat_node)) || !Is_Itype (gnat_temp_type))
-          && (Ekind (gnat_temp) == E_Variable
-	      || Ekind (gnat_temp) == E_Component
-	      || Ekind (gnat_temp) == E_Constant
-	      || Ekind (gnat_temp) == E_Loop_Parameter
-	      || IN (Ekind (gnat_temp), Formal_Kind)))
-	gigi_abort (304);
-
-      /* If this is a reference to a deferred constant whose partial view
-         is an unconstrained private type, the proper type is on the full
-         view of the constant, not on the full view of the type, which may
-         be unconstrained.
-
-         This may be a reference to a type, for example in the prefix of the
-         attribute Position, generated for dispatching code (see Make_DT in
-         exp_disp,adb). In that case we need the type itself, not is parent,
-         in particular if it is a derived type  */
-      if (Is_Private_Type (gnat_temp_type)
-	  && Has_Unknown_Discriminants (gnat_temp_type)
-	  && Present (Full_View (gnat_temp))
-          && ! Is_Type (gnat_temp))
-	{
-	  gnat_temp = Full_View (gnat_temp);
-	  gnat_temp_type = Etype (gnat_temp);
-	  gnu_result_type = get_unpadded_type (gnat_temp_type);
-	}
-      else
-	{
-	  /* Expand the type of this identitier first, in case it is
-	     an enumeral literal, which only get made when the type
-	     is expanded.  There is no order-of-elaboration issue here.
-	     We want to use the Actual_Subtype if it has already been
-	     elaborated, otherwise the Etype.  Avoid using Actual_Subtype
-	     for packed arrays to simplify things.  */
-	  if ((Ekind (gnat_temp) == E_Constant
-	       || Ekind (gnat_temp) == E_Variable || Is_Formal (gnat_temp))
-	      && ! (Is_Array_Type (Etype (gnat_temp))
-		    && Present (Packed_Array_Type (Etype (gnat_temp))))
-	      && Present (Actual_Subtype (gnat_temp))
-	      && present_gnu_tree (Actual_Subtype (gnat_temp)))
-	    gnat_temp_type = Actual_Subtype (gnat_temp);
-	  else
-	    gnat_temp_type = Etype (gnat_node);
-
-	  gnu_result_type = get_unpadded_type (gnat_temp_type);
-	}
-
-      gnu_result = gnat_to_gnu_entity (gnat_temp, NULL_TREE, 0);
-
-      /* If we are in an exception handler, force this variable into memory
-	 to ensure optimization does not remove stores that appear
-	 redundant but are actually needed in case an exception occurs.
-
-	 ??? Note that we need not do this if the variable is declared within
-	 the 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.  */
-      if (TREE_VALUE (gnu_except_ptr_stack) != 0
-	  && TREE_CODE (gnu_result) == VAR_DECL)
-       TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1;
-
-      /* Some objects (such as parameters passed by reference, globals of
-	 variable size, and renamed objects) actually represent the address
-	 of the object.  In that case, we must do the dereference.  Likewise,
-	 deal with parameters to foreign convention subprograms.  Call fold
-	 here since GNU_RESULT may be a CONST_DECL.  */
-      if (DECL_P (gnu_result)
-	  && (DECL_BY_REF_P (gnu_result)
-	      || (TREE_CODE (gnu_result) == PARM_DECL
-		  && DECL_BY_COMPONENT_PTR_P (gnu_result))))
-	{
-	  int ro = DECL_POINTS_TO_READONLY_P (gnu_result);
-	  tree initial;
-
-	  if (TREE_CODE (gnu_result) == PARM_DECL
-	      && DECL_BY_COMPONENT_PTR_P (gnu_result))
-	    gnu_result
-	      = build_unary_op (INDIRECT_REF, NULL_TREE,
-				convert (build_pointer_type (gnu_result_type),
-					 gnu_result));
-
-	  /* If the object is constant, we try to do the dereference directly
-	     through the DECL_INITIAL.  This is actually required in order to
-	     get correct aliasing information for renamed objects that are
-	     components of non-aliased aggregates, because the type of the
-	     renamed object and that of the aggregate don't alias.
-
-	     Note that we expect the initial value to have been stabilized.
-	     If it contains e.g. a variable reference, we certainly don't want
-	     to re-evaluate the variable each time the renaming is used.
-
-	     Stabilization is currently not performed at the global level but
-	     create_var_decl avoids setting DECL_INITIAL if the value is not
-	     constant then, and we get to the pointer dereference below.
-
-	     ??? Couldn't the aliasing issue show up again in this case ?
-	     There is no obvious reason why not.  */
-	  else if (TREE_READONLY (gnu_result)
-		   && DECL_INITIAL (gnu_result)
-		   /* Strip possible conversion to reference type.  */
-		   && ((initial = TREE_CODE (DECL_INITIAL (gnu_result))
-			== NOP_EXPR
-			? TREE_OPERAND (DECL_INITIAL (gnu_result), 0)
-			: DECL_INITIAL (gnu_result), 1))
-		   && TREE_CODE (initial) == ADDR_EXPR
-		   && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF
-		       || (TREE_CODE (TREE_OPERAND (initial, 0))
-			   == COMPONENT_REF)))
-	    gnu_result = TREE_OPERAND (initial, 0);
-	  else
-	    gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
-				 	 fold (gnu_result));
-
-	  TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result) = ro;
-	}
-
-      /* The GNAT tree has the type of a function as the type of its result.
-	 Also use the type of the result if the Etype is a subtype which
-	 is nominally unconstrained.  But remove any padding from the
-	 resulting type.  */
-      if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
-	  || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type))
-	{
-	  gnu_result_type = TREE_TYPE (gnu_result);
-	  if (TREE_CODE (gnu_result_type) == RECORD_TYPE
-	      && TYPE_IS_PADDING_P (gnu_result_type))
-	    gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
-	}
-
-      /* We always want to return the underlying INTEGER_CST for an
-	 enumeration literal to avoid the need to call fold in lots
-	 of places.  But don't do this is the parent will be taking
-	 the address of this object.  */
-      if (TREE_CODE (gnu_result) == CONST_DECL)
-	{
-	  gnat_temp = Parent (gnat_node);
-	  if (DECL_CONST_CORRESPONDING_VAR (gnu_result) == 0
-	      || (Nkind (gnat_temp) != N_Reference
-		  && ! (Nkind (gnat_temp) == N_Attribute_Reference
-			&& ((Get_Attribute_Id (Attribute_Name (gnat_temp))
-			     == Attr_Address)
-			    || (Get_Attribute_Id (Attribute_Name (gnat_temp))
-				== Attr_Access)
-			    || (Get_Attribute_Id (Attribute_Name (gnat_temp))
-				== Attr_Unchecked_Access)
-			    || (Get_Attribute_Id (Attribute_Name (gnat_temp))
-				== Attr_Unrestricted_Access)))))
-	    gnu_result = DECL_INITIAL (gnu_result);
-	}
+      gnu_result = Identifier_to_gnu (gnat_node, &gnu_result_type);
       break;
 
     case N_Integer_Literal:
@@ -657,9 +2510,6 @@ gnat_to_gnu (Node_Id gnat_node)
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
       if (TYPE_PRECISION (TREE_TYPE (gnu_result_type)) == HOST_BITS_PER_CHAR)
 	{
-	  /* We assume here that all strings are of type standard.string.
-	     "Weird" types of string have been converted to an aggregate
-	     by the expander. */
 	  String_Id gnat_string = Strval (gnat_node);
 	  int length = String_Length (gnat_string);
 	  char *string = (char *) alloca (length + 1);
@@ -711,58 +2561,7 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Pragma:
       gnu_result = alloc_stmt_list ();
-      /* Check for (and ignore) unrecognized pragma and do nothing if
-	 we are just annotating types.  */
-      if (type_annotate_only
-	  || ! Is_Pragma_Name (Chars (gnat_node)))
-        break;
-
-      switch (Get_Pragma_Id (Chars (gnat_node)))
-	{
-	case Pragma_Inspection_Point:
-	  /* Do nothing at top level: all such variables are already
-	     viewable.  */
-	  if (global_bindings_p ())
-	    break;
-
-	  for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
-	       Present (gnat_temp);
-	       gnat_temp = Next (gnat_temp))
-	    {
-	      gnu_expr = gnat_to_gnu (Expression (gnat_temp));
-	      if (TREE_CODE (gnu_expr) == UNCONSTRAINED_ARRAY_REF)
-		gnu_expr = TREE_OPERAND (gnu_expr, 0);
-
-	      gnu_expr = build1 (USE_STMT, void_type_node, gnu_expr);
-	      add_stmt (gnu_expr);
-	    }
-	  break;
-
-	case Pragma_Optimize:
-	  switch (Chars (Expression
-			 (First (Pragma_Argument_Associations (gnat_node)))))
-	    {
-	    case Name_Time:  case Name_Space:
-	      if (optimize == 0)
-		post_error ("insufficient -O value?", gnat_node);
-	      break;
-
-	    case Name_Off:
-	      if (optimize != 0)
-		post_error ("must specify -O0?", gnat_node);
-	      break;
-
-	    default:
-	      gigi_abort (331);
-	      break;
-	    }
-	  break;
-
-	case Pragma_Reviewable:
-	  if (write_symbols == NO_DEBUG)
-	    post_error ("must specify -g?", gnat_node);
-	  break;
-	}
+      Pragma_to_gnu (gnat_node);
       break;
 
     /**************************************/
@@ -1073,9 +2872,6 @@ gnat_to_gnu (Node_Id gnat_node)
       {
         /* The attribute designator (like an enumeration value). */
         int attribute = Get_Attribute_Id (Attribute_Name (gnat_node));
-	int prefix_unused = 0;
-	tree gnu_prefix;
-	tree gnu_type;
 
 	/* The Elab_Spec and Elab_Body attributes are special in that
 	   Prefix is a unit, not an object with a GCC equivalent.  Similarly
@@ -1087,575 +2883,7 @@ gnat_to_gnu (Node_Id gnat_node)
 				       ? "elabb" : "elabs"),
 		   NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0, gnat_node));
 
-	gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
-	gnu_type = TREE_TYPE (gnu_prefix);
-
-	/* If the input is a NULL_EXPR, make a new one.  */
-	if (TREE_CODE (gnu_prefix) == NULL_EXPR)
-	  {
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    gnu_result = build1 (NULL_EXPR, gnu_result_type,
-				 TREE_OPERAND (gnu_prefix, 0));
-	    break;
-	  }
-
-        switch (attribute)
-          {
-	  case Attr_Pos:
-	  case Attr_Val:
-	    /* These are just conversions until since representation
-	       clauses for enumerations are handled in the front end.  */
-	    {
-	      int check_p = Do_Range_Check (First (Expressions (gnat_node)));
-
-	      gnu_result = gnat_to_gnu (First (Expressions (gnat_node)));
-	      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	      gnu_result = convert_with_check (Etype (gnat_node), gnu_result,
-					       check_p, check_p, 1);
-	    }
-	    break;
-
-	  case Attr_Pred:
-	  case Attr_Succ:
-	    /* These just add or subject the constant 1.  Representation
-	       clauses for enumerations are handled in the front-end.  */
-	    gnu_expr = gnat_to_gnu (First (Expressions (gnat_node)));
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
-	    if (Do_Range_Check (First (Expressions (gnat_node))))
-	      {
-		gnu_expr = protect_multiple_eval (gnu_expr);
-		gnu_expr
-		  = emit_check
-		    (build_binary_op (EQ_EXPR, integer_type_node,
-				      gnu_expr,
-				      attribute == Attr_Pred
-				      ? TYPE_MIN_VALUE (gnu_result_type)
-				      : TYPE_MAX_VALUE (gnu_result_type)),
-		     gnu_expr, CE_Range_Check_Failed);
-	      }
-
-	    gnu_result
-	      = build_binary_op (attribute == Attr_Pred
-				 ? MINUS_EXPR : PLUS_EXPR,
-				 gnu_result_type, gnu_expr,
-				 convert (gnu_result_type, integer_one_node));
-	    break;
-
-	  case Attr_Address:
-	  case Attr_Unrestricted_Access:
-
-	    /* Conversions don't change something's address but can cause
-	       us to miss the COMPONENT_REF case below, so strip them off.  */
-	    gnu_prefix
-	      = remove_conversions (gnu_prefix,
-				    ! Must_Be_Byte_Aligned (gnat_node));
-
-	    /* If we are taking 'Address of an unconstrained object,
-	       this is the pointer to the underlying array.  */
-	    gnu_prefix = maybe_unconstrained_array (gnu_prefix);
-
-	    /* ... fall through ... */
-
-	  case Attr_Access:
-	  case Attr_Unchecked_Access:
-	  case Attr_Code_Address:
-
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    gnu_result
-	      = build_unary_op (((attribute == Attr_Address
-				  || attribute == Attr_Unrestricted_Access)
-				 && ! Must_Be_Byte_Aligned (gnat_node))
-				? ATTR_ADDR_EXPR : ADDR_EXPR,
-				gnu_result_type, gnu_prefix);
-
-	    /* For 'Code_Address, find an inner ADDR_EXPR and mark it
-	       so that we don't try to build a trampoline.  */
-	    if (attribute == Attr_Code_Address)
-	      {
-		for (gnu_expr = gnu_result;
-		     TREE_CODE (gnu_expr) == NOP_EXPR
-		     || TREE_CODE (gnu_expr) == CONVERT_EXPR;
-		     gnu_expr = TREE_OPERAND (gnu_expr, 0))
-		  TREE_CONSTANT (gnu_expr) = 1;
-		  ;
-
-		if (TREE_CODE (gnu_expr) == ADDR_EXPR)
-		  TREE_STATIC (gnu_expr) = TREE_CONSTANT (gnu_expr) = 1;
-	      }
-
-	    break;
-
-          case Attr_Pool_Address:
-            {
-	     tree gnu_obj_type;
-             tree gnu_ptr = gnu_prefix;
-
-	     gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
-	     /* If this is an unconstrained array, we know the object must
-	        have been allocated with the template in front of the object.
-	        So compute the template address.*/
-
-	     if (TYPE_FAT_POINTER_P (TREE_TYPE (gnu_ptr)))
-	       gnu_ptr
-	         = convert (build_pointer_type
-		    (TYPE_OBJECT_RECORD_TYPE
-		      (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (gnu_ptr)))),
-		        gnu_ptr);
-
-	     gnu_obj_type = TREE_TYPE (TREE_TYPE (gnu_ptr));
-	     if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
-	         && TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
-	       {
-	         tree gnu_char_ptr_type = build_pointer_type (char_type_node);
-	         tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
-	         tree gnu_byte_offset
-		   = convert (gnu_char_ptr_type,
-			      size_diffop (size_zero_node, gnu_pos));
-
-	         gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
-	         gnu_ptr = build_binary_op (MINUS_EXPR, gnu_char_ptr_type,
-					    gnu_ptr, gnu_byte_offset);
-               }
-
-             gnu_result = convert (gnu_result_type, gnu_ptr);
-            }
-            break;
-
-	  case Attr_Size:
-	  case Attr_Object_Size:
-	  case Attr_Value_Size:
-	  case Attr_Max_Size_In_Storage_Elements:
-
-	    gnu_expr = gnu_prefix;
-
-	    /* Remove NOPS from gnu_expr and conversions from gnu_prefix.
-	       We only use GNU_EXPR to see if a COMPONENT_REF was involved. */
-	    while (TREE_CODE (gnu_expr) == NOP_EXPR)
-	      gnu_expr = TREE_OPERAND (gnu_expr, 0);
-
-	    gnu_prefix = remove_conversions (gnu_prefix, 1);
-	    prefix_unused = 1;
-	    gnu_type = TREE_TYPE (gnu_prefix);
-
-	    /* Replace an unconstrained array type with the type of the
-	       underlying array.  We can't do this with a call to
-	       maybe_unconstrained_array since we may have a TYPE_DECL.
-	       For 'Max_Size_In_Storage_Elements, use the record type
-	       that will be used to allocate the object and its template.  */
-
-	    if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE)
-	      {
-		gnu_type = TYPE_OBJECT_RECORD_TYPE (gnu_type);
-		if (attribute != Attr_Max_Size_In_Storage_Elements)
-		  gnu_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
-	      }
-
-	    /* If we are looking for the size of a field, return the
-	       field size.  Otherwise, if the prefix is an object,
-	       or if 'Object_Size or 'Max_Size_In_Storage_Elements has
-	       been specified, the result is the GCC size of the type.
-	       Otherwise, the result is the RM_Size of the type.  */
-	    if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
-	      gnu_result = DECL_SIZE (TREE_OPERAND (gnu_prefix, 1));
-	    else if (TREE_CODE (gnu_prefix) != TYPE_DECL
-		     || attribute == Attr_Object_Size
-		     || attribute == Attr_Max_Size_In_Storage_Elements)
-	      {
-		/* If this is a padded type, the GCC size isn't relevant
-		   to the programmer.  Normally, what we want is the RM_Size,
-		   which was set from the specified size, but if it was not
-		   set, we want the size of the relevant field.  Using the MAX
-		   of those two produces the right result in all case.  Don't
-		   use the size of the field if it's a self-referential type,
-		   since that's never what's wanted.  */
-		if (TREE_CODE (gnu_type) == RECORD_TYPE
-		    && TYPE_IS_PADDING_P (gnu_type)
-		    && TREE_CODE (gnu_expr) == COMPONENT_REF)
-		  {
-		    gnu_result = rm_size (gnu_type);
-		    if (! (CONTAINS_PLACEHOLDER_P
-			   (DECL_SIZE (TREE_OPERAND (gnu_expr, 1)))))
-		      gnu_result
-			= size_binop (MAX_EXPR, gnu_result,
-				      DECL_SIZE (TREE_OPERAND (gnu_expr, 1)));
-		  }
-		else
-		  gnu_result = TYPE_SIZE (gnu_type);
-	      }
-	    else
-	      gnu_result = rm_size (gnu_type);
-
-	    if (gnu_result == 0)
-	      gigi_abort (325);
-
-	    /* Deal with a self-referential size by returning the maximum
-	       size for a type and by qualifying the size with
-	       the object for 'Size of an object.  */
-
-	    if (CONTAINS_PLACEHOLDER_P (gnu_result))
-	      {
-		if (TREE_CODE (gnu_prefix) != TYPE_DECL)
-		  gnu_result = substitute_placeholder_in_expr (gnu_result,
-							       gnu_expr);
-		else
-		  gnu_result = max_size (gnu_result, 1);
-	      }
-
-	    /* If the type contains a template, subtract the size of the
-	       template.  */
-	    if (TREE_CODE (gnu_type) == RECORD_TYPE
-		&& TYPE_CONTAINS_TEMPLATE_P (gnu_type))
-	      gnu_result = size_binop (MINUS_EXPR, gnu_result,
-				       DECL_SIZE (TYPE_FIELDS (gnu_type)));
-
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
-            /* Always perform division using unsigned arithmetic as the
-	       size cannot be negative, but may be an overflowed positive
-	       value. This provides correct results for sizes up to 512 MB.
-	       ??? Size should be calculated in storage elements directly.  */
-
-	    if (attribute == Attr_Max_Size_In_Storage_Elements)
-	      gnu_result = convert (sizetype,
-				    fold (build (CEIL_DIV_EXPR, bitsizetype,
-						 gnu_result,
-						 bitsize_unit_node)));
-	    break;
-
-	  case Attr_Alignment:
-	    if (TREE_CODE (gnu_prefix) == COMPONENT_REF
-		&& (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
-		    == RECORD_TYPE)
-		&& (TYPE_IS_PADDING_P
-		    (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
-	      gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
-
-	    gnu_type = TREE_TYPE (gnu_prefix);
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    prefix_unused = 1;
-
-	    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);
-	    break;
-
-	  case Attr_First:
-	  case Attr_Last:
-	  case Attr_Range_Length:
-	    prefix_unused = 1;
-
-	    if (INTEGRAL_TYPE_P (gnu_type)
-		|| TREE_CODE (gnu_type) == REAL_TYPE)
-	      {
-		gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
-		if (attribute == Attr_First)
-		  gnu_result = TYPE_MIN_VALUE (gnu_type);
-		else if (attribute == Attr_Last)
-		  gnu_result = TYPE_MAX_VALUE (gnu_type);
-		else
-		  gnu_result
-		    = build_binary_op
-		      (MAX_EXPR, get_base_type (gnu_result_type),
-		       build_binary_op
-		       (PLUS_EXPR, get_base_type (gnu_result_type),
-			build_binary_op (MINUS_EXPR,
-					 get_base_type (gnu_result_type),
-					 convert (gnu_result_type,
-						  TYPE_MAX_VALUE (gnu_type)),
-					 convert (gnu_result_type,
-						  TYPE_MIN_VALUE (gnu_type))),
-			convert (gnu_result_type, integer_one_node)),
-		       convert (gnu_result_type, integer_zero_node));
-
-		break;
-	      }
-	    /* ... fall through ... */
-	  case Attr_Length:
-	    {
-	      int Dimension
-		= (Present (Expressions (gnat_node))
-		   ? UI_To_Int (Intval (First (Expressions (gnat_node))))
-		   : 1);
-
-	      /* Make sure any implicit dereference gets done.  */
-	      gnu_prefix = maybe_implicit_deref (gnu_prefix);
-	      gnu_prefix = maybe_unconstrained_array (gnu_prefix);
-	      gnu_type = TREE_TYPE (gnu_prefix);
-	      prefix_unused = 1;
-	      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
-	      if (TYPE_CONVENTION_FORTRAN_P (gnu_type))
-		{
-		  int ndim;
-		  tree gnu_type_temp;
-
-		  for (ndim = 1, gnu_type_temp = gnu_type;
-		       TREE_CODE (TREE_TYPE (gnu_type_temp)) == ARRAY_TYPE
-		       && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type_temp));
-		       ndim++, gnu_type_temp = TREE_TYPE (gnu_type_temp))
-		    ;
-
-		  Dimension = ndim + 1 - Dimension;
-		}
-
-	      for (; Dimension > 1; Dimension--)
-		gnu_type = TREE_TYPE (gnu_type);
-
-	      if (TREE_CODE (gnu_type) != ARRAY_TYPE)
-		gigi_abort (309);
-
-	      if (attribute == Attr_First)
-		gnu_result
-		  = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
-	      else if (attribute == Attr_Last)
-		gnu_result
-		  = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
-	      else
-		/* 'Length or 'Range_Length.  */
-		{
-		  tree gnu_compute_type
-		    = gnat_signed_or_unsigned_type
-		      (0, get_base_type (gnu_result_type));
-
-		  gnu_result
-		  = build_binary_op
-		    (MAX_EXPR, gnu_compute_type,
-		     build_binary_op
-		     (PLUS_EXPR, gnu_compute_type,
-		      build_binary_op
-                      (MINUS_EXPR, gnu_compute_type,
-		       convert (gnu_compute_type,
-				TYPE_MAX_VALUE
-				(TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)))),
-		       convert (gnu_compute_type,
-				TYPE_MIN_VALUE
-				(TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))))),
-		      convert (gnu_compute_type, integer_one_node)),
-		     convert (gnu_compute_type, integer_zero_node));
-		}
-
-	      /* If this has a PLACEHOLDER_EXPR, qualify it by the object
-		 we are handling.  Note that these attributes could not
-		 have been used on an unconstrained array type.  */
-	      gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result,
-							   gnu_prefix);
-
-	      break;
-	    }
-
-          case Attr_Bit_Position:
-	  case Attr_Position:
-	  case Attr_First_Bit:
-	  case Attr_Last_Bit:
-	  case Attr_Bit:
-	    {
-	      HOST_WIDE_INT bitsize;
-	      HOST_WIDE_INT bitpos;
-	      tree gnu_offset;
-	      tree gnu_field_bitpos;
-	      tree gnu_field_offset;
-	      tree gnu_inner;
-	      enum machine_mode mode;
-	      int unsignedp, volatilep;
-
-	      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	      gnu_prefix = remove_conversions (gnu_prefix, 1);
-	      prefix_unused = 1;
-
-	      /* We can have 'Bit on any object, but if it isn't a
-		 COMPONENT_REF, the result is zero.  Do not allow
-		 'Bit on a bare component, though.  */
-	      if (attribute == Attr_Bit
-		  && TREE_CODE (gnu_prefix) != COMPONENT_REF
-		  && TREE_CODE (gnu_prefix) != FIELD_DECL)
-		{
-		  gnu_result = integer_zero_node;
-		  break;
-		}
-
-	      else if (TREE_CODE (gnu_prefix) != COMPONENT_REF
-		       && ! (attribute == Attr_Bit_Position
-			     && TREE_CODE (gnu_prefix) == FIELD_DECL))
-		gigi_abort (310);
-
-	      get_inner_reference (gnu_prefix, &bitsize, &bitpos, &gnu_offset,
-				   &mode, &unsignedp, &volatilep);
-
-	      if (TREE_CODE (gnu_prefix) == COMPONENT_REF)
-		{
-		  gnu_field_bitpos
-		    = bit_position (TREE_OPERAND (gnu_prefix, 1));
-		  gnu_field_offset
-		    = byte_position (TREE_OPERAND (gnu_prefix, 1));
-
-		  for (gnu_inner = TREE_OPERAND (gnu_prefix, 0);
-		       TREE_CODE (gnu_inner) == COMPONENT_REF
-		       && DECL_INTERNAL_P (TREE_OPERAND (gnu_inner, 1));
-		       gnu_inner = TREE_OPERAND (gnu_inner, 0))
-		    {
-		      gnu_field_bitpos
-			= size_binop (PLUS_EXPR, gnu_field_bitpos,
-				      bit_position (TREE_OPERAND (gnu_inner,
-								  1)));
-		      gnu_field_offset
-			= size_binop (PLUS_EXPR, gnu_field_offset,
-				      byte_position (TREE_OPERAND (gnu_inner,
-								   1)));
-		    }
-		}
-	      else if (TREE_CODE (gnu_prefix) == FIELD_DECL)
-		{
-		  gnu_field_bitpos = bit_position (gnu_prefix);
-		  gnu_field_offset = byte_position (gnu_prefix);
-		}
-	      else
-		{
-		  gnu_field_bitpos = bitsize_zero_node;
-		  gnu_field_offset = size_zero_node;
-		}
-
-	      switch (attribute)
-		{
-		case Attr_Position:
-		  gnu_result = gnu_field_offset;
-		  break;
-
-		case Attr_First_Bit:
-		case Attr_Bit:
-		  gnu_result = size_int (bitpos % BITS_PER_UNIT);
-		  break;
-
-		case Attr_Last_Bit:
-		  gnu_result = bitsize_int (bitpos % BITS_PER_UNIT);
-		  gnu_result
-		    = size_binop (PLUS_EXPR, gnu_result,
-				  TYPE_SIZE (TREE_TYPE (gnu_prefix)));
-		  gnu_result = size_binop (MINUS_EXPR, gnu_result,
-					   bitsize_one_node);
-		  break;
-
-		case Attr_Bit_Position:
-		  gnu_result = gnu_field_bitpos;
-		  break;
-		}
-
-	      /* If this has a PLACEHOLDER_EXPR, qualify it by the object
-		 we are handling. */
-	      gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result,
-							   gnu_prefix);
-
-	      break;
-	    }
-
-	  case Attr_Min:
-	  case Attr_Max:
-	    gnu_lhs = gnat_to_gnu (First (Expressions (gnat_node)));
-	    gnu_rhs = gnat_to_gnu (Next (First (Expressions (gnat_node))));
-
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    gnu_result = build_binary_op (attribute == Attr_Min
-					  ? MIN_EXPR : MAX_EXPR,
-					  gnu_result_type, gnu_lhs, gnu_rhs);
-	    break;
-
-	  case Attr_Passed_By_Reference:
-	    gnu_result = size_int (default_pass_by_ref (gnu_type)
-	                           || must_pass_by_ref (gnu_type));
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    break;
-
-	  case Attr_Component_Size:
-	    if (TREE_CODE (gnu_prefix) == COMPONENT_REF
-		&& (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))
-		    == RECORD_TYPE)
-		&& (TYPE_IS_PADDING_P
-		    (TREE_TYPE (TREE_OPERAND (gnu_prefix, 0)))))
-	      gnu_prefix = TREE_OPERAND (gnu_prefix, 0);
-
-	    gnu_prefix = maybe_implicit_deref (gnu_prefix);
-	    gnu_type = TREE_TYPE (gnu_prefix);
-
-	    if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE)
-	      gnu_type
-		= TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_type))));
-
-	    while (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
-		   && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
-	      gnu_type = TREE_TYPE (gnu_type);
-
-	    if (TREE_CODE (gnu_type) != ARRAY_TYPE)
-	      gigi_abort (330);
-
-	    /* Note this size cannot be self-referential.  */
-	    gnu_result = TYPE_SIZE (TREE_TYPE (gnu_type));
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    prefix_unused = 1;
-	    break;
-
-	  case Attr_Null_Parameter:
-	    /* This is just a zero cast to the pointer type for
-	       our prefix and dereferenced.  */
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    gnu_result
-	      = build_unary_op (INDIRECT_REF, NULL_TREE,
-				convert (build_pointer_type (gnu_result_type),
-					 integer_zero_node));
-	    TREE_PRIVATE (gnu_result) = 1;
-	    break;
-
-	  case Attr_Mechanism_Code:
-	    {
-	      int code;
-	      Entity_Id gnat_obj = Entity (Prefix (gnat_node));
-
-	      prefix_unused = 1;
-	      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	      if (Present (Expressions (gnat_node)))
-		{
-		  int i = UI_To_Int (Intval (First (Expressions (gnat_node))));
-
-		  for (gnat_obj = First_Formal (gnat_obj); i > 1;
-		       i--, gnat_obj = Next_Formal (gnat_obj))
-		    ;
-		}
-
-	      code = Mechanism (gnat_obj);
-	      if (code == Default)
-		code = ((present_gnu_tree (gnat_obj)
-			 && (DECL_BY_REF_P (get_gnu_tree (gnat_obj))
-			     || ((TREE_CODE (get_gnu_tree (gnat_obj))
-				  == PARM_DECL)
-				 && (DECL_BY_COMPONENT_PTR_P
-				     (get_gnu_tree (gnat_obj))))))
-			? By_Reference : By_Copy);
-	      gnu_result = convert (gnu_result_type, size_int (- code));
-	    }
-	  break;
-
-          default:
-	    /* Say we have an unimplemented attribute.  Then set the
-	       value to be returned to be a zero and hope that's something
-	       we can convert to the type of this attribute.  */
-
-	    post_error ("unimplemented attribute", gnat_node);
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    gnu_result = integer_zero_node;
-	    break;
-          }
-
-	/* If this is an attribute where the prefix was unused,
-	   force a use of it if it has a side-effect.  But don't do it if
-	   the prefix is just an entity name.  However, if an access check
-	   is needed, we must do it.  See second example in AARM 11.6(5.e). */
-	if (prefix_unused && TREE_SIDE_EFFECTS (gnu_prefix)
-	    && ! Is_Entity_Name (Prefix (gnat_node)))
-	  gnu_result = fold (build (COMPOUND_EXPR, TREE_TYPE (gnu_result),
-				    gnu_prefix, gnu_result));
+	gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attribute);
       }
       break;
 
@@ -2114,253 +3342,11 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Case_Statement:
-      {
-	Node_Id gnat_when;
-
-	gnu_expr = gnat_to_gnu (Expression (gnat_node));
-	gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
-
-	/*  The range of values in a case statement is determined by the
-	    rules in RM 5.4(7-9). In almost all cases, this range is
-	    represented by the Etype of the expression. One exception arises
-	    in the case of a simple name that is parenthesized. This still
-	    has the Etype of the name, but since it is not a name, para 7
-	    does not apply, and we need to go to the base type. This is the
-	    only case where parenthesization affects the dynamic semantics
-	    (i.e. the range of possible values at runtime that is covered by
-	    the others alternative.
-
-	    Another exception is if the subtype of the expression is
-	    non-static.  In that case, we also have to use the base type.  */
-	if (Paren_Count (Expression (gnat_node)) != 0
-	    || !Is_OK_Static_Subtype (Underlying_Type
-				      (Etype (Expression (gnat_node)))))
-	  gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
-
-	/* We build a SWITCH_EXPR that contains the code with interspersed
-	   CASE_LABEL_EXPRs for each label.  */
-
-	push_stack (&gnu_switch_label_stack, NULL_TREE,
-		    create_artificial_label ());
-	start_stmt_group ();
-	for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
-	     Present (gnat_when);
-	     gnat_when = Next_Non_Pragma (gnat_when))
-	  {
-	    Node_Id gnat_choice;
-
-	    /* First compile all the different case choices for the current
-	       WHEN alternative.  */
-	    for (gnat_choice = First (Discrete_Choices (gnat_when));
-		 Present (gnat_choice); gnat_choice = Next (gnat_choice))
-	      {
-		tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
-
-		switch (Nkind (gnat_choice))
-		  {
-		  case N_Range:
-		    gnu_low = gnat_to_gnu (Low_Bound (gnat_choice));
-		    gnu_high = gnat_to_gnu (High_Bound (gnat_choice));
-		    break;
-
-		  case N_Subtype_Indication:
-		    gnu_low = gnat_to_gnu (Low_Bound
-					   (Range_Expression
-					    (Constraint (gnat_choice))));
-		    gnu_high = gnat_to_gnu (High_Bound
-					    (Range_Expression
-					     (Constraint (gnat_choice))));
-		    break;
-
-		  case N_Identifier:
-		  case N_Expanded_Name:
-		    /* This represents either a subtype range or a static value
-		       of some kind; Ekind says which.  If a static value,
-		       fall through to the next case.  */
-		    if (IN (Ekind (Entity (gnat_choice)), Type_Kind))
-		      {
-			tree gnu_type
-			  = get_unpadded_type (Entity (gnat_choice));
-
-			gnu_low = fold (TYPE_MIN_VALUE (gnu_type));
-			gnu_high = fold (TYPE_MAX_VALUE (gnu_type));
-			break;
-		      }
-
-		    /* ... fall through ... */
-		  case N_Character_Literal:
-		  case N_Integer_Literal:
-		    gnu_low = gnat_to_gnu (gnat_choice);
-		    break;
-
-		  case N_Others_Choice:
-		    break;
-
-		  default:
-		    gigi_abort (316);
-		  }
-
-		add_stmt_with_node (build (CASE_LABEL_EXPR, void_type_node,
-					   gnu_low, gnu_high,
-					   create_artificial_label ()),
-				    gnat_choice);
-	      }
-
-	    /* 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)));
-
-	  }
-
-	/* Now emit a definition of the label all the cases branched to. */
-	add_stmt (build1 (LABEL_EXPR, void_type_node,
-			  TREE_VALUE (gnu_switch_label_stack)));
-	gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
-			    end_stmt_group (), NULL_TREE);
-	pop_stack (&gnu_switch_label_stack);
-	break;
-      }
+      gnu_result = Case_Statement_to_gnu (gnat_node);
+      break;
 
     case N_Loop_Statement:
-      {
-	/* ??? It would be nice to use "build" here, but there's no build5.  */
-	tree gnu_loop_stmt = build_nt (LOOP_STMT, NULL_TREE, NULL_TREE,
-				       NULL_TREE, NULL_TREE, NULL_TREE);
-	tree gnu_loop_var = NULL_TREE;
-	Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
-	tree gnu_cond_expr = NULL_TREE;
-
-	TREE_TYPE (gnu_loop_stmt) = void_type_node;
-	TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
-	LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label ();
-	annotate_with_node (gnu_loop_stmt, gnat_node);
-
-	/* Save the end label of this LOOP_STMT in a stack so that the
-	   corresponding N_Exit_Statement can find it.  */
-	push_stack (&gnu_loop_label_stack, NULL_TREE,
-		    LOOP_STMT_LABEL (gnu_loop_stmt));
-
-	/* Set the condition that under which the loop should continue.
-	   For "LOOP .... END LOOP;" the condition is always true.  */
-	if (No (gnat_iter_scheme))
-	  ;
-	/* The case "WHILE condition LOOP ..... END LOOP;" */
-	else if (Present (Condition (gnat_iter_scheme)))
-	  LOOP_STMT_TOP_COND (gnu_loop_stmt)
-	    = gnat_to_gnu (Condition (gnat_iter_scheme));
-        else
-	  {
-	    /* We have an iteration scheme.  */
-	    Node_Id gnat_loop_spec
-	      = Loop_Parameter_Specification (gnat_iter_scheme);
-	    Entity_Id gnat_loop_var = Defining_Entity (gnat_loop_spec);
-	    Entity_Id gnat_type = Etype (gnat_loop_var);
-	    tree gnu_type = get_unpadded_type (gnat_type);
-	    tree gnu_low = TYPE_MIN_VALUE (gnu_type);
-	    tree gnu_high = TYPE_MAX_VALUE (gnu_type);
-	    int reversep = Reverse_Present (gnat_loop_spec);
-	    tree gnu_first = reversep ? gnu_high : gnu_low;
-	    tree gnu_last = reversep ? gnu_low : gnu_high;
-	    enum tree_code end_code = reversep ? GE_EXPR : LE_EXPR;
-	    tree gnu_base_type = get_base_type (gnu_type);
-	    tree gnu_limit
-	      = (reversep ? TYPE_MIN_VALUE (gnu_base_type)
-		 : TYPE_MAX_VALUE (gnu_base_type));
-
-	    /* We know the loop variable will not overflow if GNU_LAST is
-	       a constant and is not equal to GNU_LIMIT.  If it might
-	       overflow, we have to move the limit test to the end of
-	       the loop.  In that case, we have to test for an
-	       empty loop outside the loop.  */
-	    if (TREE_CODE (gnu_last) != INTEGER_CST
-		|| TREE_CODE (gnu_limit) != INTEGER_CST
-		|| tree_int_cst_equal (gnu_last, gnu_limit))
-	      {
-		gnu_cond_expr
-		  = build (COND_EXPR, void_type_node,
-			   build_binary_op (LE_EXPR, integer_type_node,
-					    gnu_low, gnu_high),
-			   NULL_TREE, alloc_stmt_list ());
-		annotate_with_node (gnu_cond_expr, gnat_loop_spec);
-	      }
-
-	    /* Open a new nesting level that will surround the loop to declare
-	       the loop index variable.  */
-	    start_stmt_group ();
-	    gnat_pushlevel ();
-
-	    /* Declare the loop index and set it to its initial value.  */
-	    gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
-	    if (DECL_BY_REF_P (gnu_loop_var))
-	      gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE,
-					     gnu_loop_var);
-
-	    /* The loop variable might be a padded type, so use `convert' to
-	       get a reference to the inner variable if so.  */
-	    gnu_loop_var = convert (get_base_type (gnu_type), gnu_loop_var);
-
-	    /* Set either the top or bottom exit condition as
-	       appropriate depending on whether we know an overflow
-	       cannot occur or not. */
-	    if (gnu_cond_expr)
-	      LOOP_STMT_BOT_COND (gnu_loop_stmt)
-		= build_binary_op (NE_EXPR, integer_type_node,
-				   gnu_loop_var, gnu_last);
-	    else
-	      LOOP_STMT_TOP_COND (gnu_loop_stmt)
-		= build_binary_op (end_code, integer_type_node,
-				   gnu_loop_var, gnu_last);
-
-	    LOOP_STMT_UPDATE (gnu_loop_stmt)
-	      = build_binary_op (reversep ? PREDECREMENT_EXPR
-				 : PREINCREMENT_EXPR,
-				 TREE_TYPE (gnu_loop_var),
-				 gnu_loop_var,
-				 convert (TREE_TYPE (gnu_loop_var),
-					  integer_one_node));
-	    annotate_with_node (LOOP_STMT_UPDATE (gnu_loop_stmt),
-				gnat_iter_scheme);
-	  }
-
-	/* If the loop was named, have the name point to this loop.  In this case,
-	   the association is not a ..._DECL node, but the end label from this
-	   LOOP_STMT. */
-        if (Present (Identifier (gnat_node)))
-	  save_gnu_tree (Entity (Identifier (gnat_node)),
-			 LOOP_STMT_LABEL (gnu_loop_stmt), 1);
-
-        /* Make the loop body into its own block, so any allocated storage
-           will be released every iteration.  This is needed for stack
-           allocation.  */
-	LOOP_STMT_BODY (gnu_loop_stmt)
-	  = build_stmt_group (Statements (gnat_node), true);
-
-	/* If we declared a variable, then we are in a statement group for
-	   that declaration.  Add the LOOP_STMT to it and make that the
-	   "loop".  */
-	if (gnu_loop_var)
-	  {
-	    add_stmt (gnu_loop_stmt);
-	    gnat_poplevel ();
-	    gnu_loop_stmt = end_stmt_group ();
-	  }
-
-	/* If we have an outer COND_EXPR, that's our result and this loop
-	   is its "true" statement.  Otherwise, the result is the LOOP_STMT. */
-	if (gnu_cond_expr)
-	  {
-	    COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt;
-	    gnu_result = gnu_cond_expr;
-	    recalculate_side_effects (gnu_cond_expr);
-	  }
-	else
-	  gnu_result = gnu_loop_stmt;
-
-	pop_stack (&gnu_loop_label_stack);
-      }
+      gnu_result = Loop_Statement_to_gnu (gnat_node);
       break;
 
     case N_Block_Statement:
@@ -2522,643 +3508,13 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Subprogram_Body:
-      {
-        /* Save debug output mode in case it is reset.  */
-        enum debug_info_type save_write_symbols = write_symbols;
-	const struct gcc_debug_hooks *const save_debug_hooks = debug_hooks;
-	/* Definining identifier of a parameter to the subprogram.  */
-        Entity_Id gnat_param;
-	/* The defining identifier for the subprogram body. Note that if a
-	   specification has appeared before for this body, then the identifier
-	   occurring in that specification will also be a defining identifier
-	   and all the calls to this subprogram will point to that
-	   specification.  */
-	Entity_Id gnat_subprog_id
-	  = (Present (Corresponding_Spec (gnat_node))
-	     ? Corresponding_Spec (gnat_node) : Defining_Entity (gnat_node));
-
-	/* The FUNCTION_DECL node corresponding to the subprogram spec.   */
-	tree gnu_subprog_decl;
-	/* The FUNCTION_TYPE node corresponding to the subprogram spec.  */
-	tree gnu_subprog_type;
-	tree gnu_cico_list;
-
-	/* If this is a generic object or if it has been eliminated,
-	   ignore it.  */
-	if (Ekind (gnat_subprog_id) == E_Generic_Procedure
-	    || Ekind (gnat_subprog_id) == E_Generic_Function
-	    || Is_Eliminated (gnat_subprog_id))
-	  return alloc_stmt_list ();
-
-        /* If debug information is suppressed for the subprogram, turn debug
-           mode off for the duration of processing.  */
-        if (!Needs_Debug_Info (gnat_subprog_id))
-	  {
-	    write_symbols = NO_DEBUG;
-	    debug_hooks = &do_nothing_debug_hooks;
-	  }
-
-	/* If this subprogram acts as its own spec, define it.  Otherwise,
-	   just get the already-elaborated tree node.  However, if this
-	   subprogram had its elaboration deferred, we will already have made
-	   a tree node for it.  So treat it as not being defined in that
-	   case.  Such a subprogram cannot have an address clause or a freeze
-	   node, so this test is safe, though it does disable some
-	   otherwise-useful error checking.  */
-	gnu_subprog_decl
-	  = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
-				Acts_As_Spec (gnat_node)
-				&& ! present_gnu_tree (gnat_subprog_id));
-
-	gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
-
-	/* Set the line number in the decl to correspond to that of
-	   the body so that the line number notes are written
-	   correctly.  */
-	Sloc_to_locus (Sloc (gnat_node),
-		       &DECL_SOURCE_LOCATION (gnu_subprog_decl));
-
-	begin_subprog_body (gnu_subprog_decl);
-
-	gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
-
-	/* If there are OUT parameters, we need to ensure that the return
-	   statement properly copies them out.  We do this by making a new
-	   block and converting any inner return into a goto to a label at
-	   the end of the block.  */
-	push_stack (&gnu_return_label_stack, NULL_TREE,
-		    gnu_cico_list ? create_artificial_label () : NULL_TREE);
-
-	/* Get a tree corresponding to the code for the subprogram.  */
-	start_stmt_group ();
-	gnat_pushlevel ();
-
-	/* See if there are any parameters for which we don't yet have
-	   GCC entities.  These must be for OUT parameters for which we
-	   will be making VAR_DECL 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);
-	     Present (gnat_param);
-	     gnat_param = Next_Formal_With_Extras (gnat_param))
-	  if (!present_gnu_tree (gnat_param))
-	    {
-	      /* Skip any entries that have been already filled in; they
-		 must correspond to IN OUT parameters.  */
-	      for (; gnu_cico_list != 0 && TREE_VALUE (gnu_cico_list) != 0;
-		   gnu_cico_list = TREE_CHAIN (gnu_cico_list))
-		;
-
-	      /* Do any needed references for padded types.  */
-	      TREE_VALUE (gnu_cico_list)
-		= convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)),
-			   gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
-	    }
-
-	process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
-
-	/* Generate the code of the subprogram itself.  A return statement
-	   will be present and any OUT parameters will be handled there.  */
-	add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
-	gnat_poplevel ();
-	gnu_result = end_stmt_group ();
-
-	/* If we made a special return label, we need to make a block that
-	   contains the definition of that label and the copying to the
-	   return value.  That block first contains the function, then
-	   the label and copy statement.  */
-	if (TREE_VALUE (gnu_return_label_stack) != 0)
-	  {
-	    tree gnu_retval;
-
-	    start_stmt_group ();
-	    gnat_pushlevel ();
-	    add_stmt (gnu_result);
-	    add_stmt (build1 (LABEL_EXPR, void_type_node,
-			      TREE_VALUE (gnu_return_label_stack)));
-
-	    gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
-	    if (list_length (gnu_cico_list) == 1)
-	      gnu_retval = TREE_VALUE (gnu_cico_list);
-	    else
-	      gnu_retval
-		= gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
-					  gnu_cico_list);
-
-	    if (DECL_P (gnu_retval) && DECL_BY_REF_P (gnu_retval))
-	      gnu_retval
-		= build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
-
-	    add_stmt_with_node
-	      (build1 (RETURN_EXPR, void_type_node,
-		       build (MODIFY_EXPR, TREE_TYPE (gnu_retval),
-			      DECL_RESULT (current_function_decl),
-			      gnu_retval)),
-	       gnat_node);
-	    gnat_poplevel ();
-	    gnu_result = end_stmt_group ();
-	  }
-
-	pop_stack (&gnu_return_label_stack);
-
-	/* Initialize the information node for the function and set the
-	   end location.  */
-	allocate_struct_function (current_function_decl);
-	Sloc_to_locus
-	  ((Present (End_Label (Handled_Statement_Sequence (gnat_node)))
-	    ? Sloc (End_Label (Handled_Statement_Sequence (gnat_node)))
-	    : Sloc (gnat_node)),
-	   &cfun->function_end_locus);
-
-	end_subprog_body (gnu_result);
-
-	/* Disconnect the trees for parameters that we made variables for
-	   from the GNAT entities since these will become unusable after
-	   we end the function.  */
-	for (gnat_param = First_Formal (gnat_subprog_id);
-	     Present (gnat_param);
-	     gnat_param = Next_Formal_With_Extras (gnat_param))
-	  if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL)
-	    save_gnu_tree (gnat_param, NULL_TREE, 0);
-
-	mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
-	write_symbols = save_write_symbols;
-	debug_hooks = save_debug_hooks;
-	gnu_result = alloc_stmt_list ();
-      }
+      Subprogram_Body_to_gnu (gnat_node);
+      gnu_result = alloc_stmt_list ();
       break;
 
     case N_Function_Call:
     case N_Procedure_Call_Statement:
-      {
-	/* The GCC node corresponding to the GNAT subprogram name.  This can
-	   either be a FUNCTION_DECL node if we are dealing with a standard
-	   subprogram call, or an indirect reference expression (an
-	   INDIRECT_REF node) pointing to a subprogram.  */
-	tree gnu_subprog_node = gnat_to_gnu (Name (gnat_node));
-	/* The FUNCTION_TYPE node giving the GCC type of the subprogram.  */
-	tree gnu_subprog_type = TREE_TYPE (gnu_subprog_node);
-	tree gnu_subprog_addr
-	  = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog_node);
-	Entity_Id gnat_formal;
-	Node_Id gnat_actual;
-	tree gnu_actual_list = NULL_TREE;
-	tree gnu_name_list = NULL_TREE;
-	tree gnu_before_list = NULL_TREE;
-	tree gnu_after_list = NULL_TREE;
-	tree gnu_subprog_call;
-
-	switch (Nkind (Name (gnat_node)))
-	  {
-	  case N_Identifier:
-	  case N_Operator_Symbol:
-	  case N_Expanded_Name:
-	  case N_Attribute_Reference:
-	    if (Is_Eliminated (Entity (Name (gnat_node))))
-	      Eliminate_Error_Msg (gnat_node, Entity (Name (gnat_node)));
-          }
-
-	if (TREE_CODE (gnu_subprog_type) != FUNCTION_TYPE)
-	  gigi_abort (317);
-
-	/* If we are calling a stubbed function, make this into a
-	   raise of Program_Error.  Elaborate all our args first.  */
-
-	if (TREE_CODE (gnu_subprog_node) == FUNCTION_DECL
-	    && DECL_STUBBED_P (gnu_subprog_node))
-	  {
-	    for (gnat_actual = First_Actual (gnat_node);
-		 Present (gnat_actual);
-		 gnat_actual = Next_Actual (gnat_actual))
-	      add_stmt (gnat_to_gnu (gnat_actual));
-
-	    if (Nkind (gnat_node) == N_Function_Call)
-	      {
-		gnu_result_type = TREE_TYPE (gnu_subprog_type);
-		gnu_result
-		  = build1 (NULL_EXPR, gnu_result_type,
-			    build_call_raise (PE_Stubbed_Subprogram_Called));
-	      }
-	    else
-	      gnu_result = build_call_raise (PE_Stubbed_Subprogram_Called);
-	    break;
-	  }
-
-	/* The only way we can be making a call via an access type is
-	   if Name is an explicit dereference.  In that case, get the
-	   list of formal args from the 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)));
-	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)));
-
-	/* 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 parameter-expression and the TREE_PURPOSE field is
-	   null.  Skip OUT parameters that are not passed by reference and
-	   don't need to be copied in.  */
-
-        for (gnat_actual = First_Actual (gnat_node);
-             Present (gnat_actual);
-             gnat_formal = Next_Formal_With_Extras (gnat_formal),
-             gnat_actual = Next_Actual (gnat_actual))
-	  {
-	    tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
-	    /* We treat a conversion between aggregate types as if it
-	       is an unchecked conversion.  */
-	    int unchecked_convert_p
-	      = (Nkind (gnat_actual) == N_Unchecked_Type_Conversion
-		 || (Nkind (gnat_actual) == N_Type_Conversion
-		     && Is_Composite_Type (Underlying_Type
-					   (Etype (gnat_formal)))));
-	    Node_Id gnat_name
-	      = unchecked_convert_p ? Expression (gnat_actual) : gnat_actual;
-	    tree gnu_name = gnat_to_gnu (gnat_name);
-	    tree gnu_name_type = gnat_to_gnu_type (Etype (gnat_name));
-	    tree gnu_actual;
-
-	    /* If it's possible we may need to use this expression twice,
-	       make sure than any side-effects are handled via SAVE_EXPRs.
-	       Likewise if we need to force side-effects before the call.
-	       ??? This is more conservative than we need since we don't
-	       need to do this for pass-by-ref with no conversion.
-	       If we are passing a non-addressable Out or In Out parameter by
-	       reference, pass the address of a copy and set up to copy back
-	       out after the call.  */
-
-	    if (Ekind (gnat_formal) != E_In_Parameter)
-	      {
-		gnu_name = gnat_stabilize_reference (gnu_name, 1);
-		if (! addressable_p (gnu_name)
-		    && present_gnu_tree (gnat_formal)
-		    && (DECL_BY_REF_P (get_gnu_tree (gnat_formal))
-			|| (TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
-			    && (DECL_BY_COMPONENT_PTR_P
-				(get_gnu_tree (gnat_formal))
-				|| DECL_BY_DESCRIPTOR_P
-				(get_gnu_tree (gnat_formal))))))
-		  {
-		    tree gnu_copy = gnu_name;
-		    tree gnu_temp;
-
-		    /* Remove any unpadding on the actual and make a copy.
-		       But if the actual is a left-justified modular type,
-		       first convert to it.  */
-		    if (TREE_CODE (gnu_name) == COMPONENT_REF
-			&& ((TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_name, 0)))
-			     == RECORD_TYPE)
-			    && (TYPE_IS_PADDING_P
-				(TREE_TYPE (TREE_OPERAND (gnu_name, 0))))))
-		      gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
-		    else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
-			     && (TYPE_LEFT_JUSTIFIED_MODULAR_P
-				 (gnu_name_type)))
-		      gnu_name = convert (gnu_name_type, gnu_name);
-
-		    gnu_actual = save_expr (gnu_name);
-
-		    /* Since we're going to take the address of the SAVE_EXPR,
-		       we don't want it to be marked as unchanging.
-		       So set TREE_ADDRESSABLE.  */
-		    gnu_temp = skip_simple_arithmetic (gnu_actual);
-		    if (TREE_CODE (gnu_temp) == SAVE_EXPR)
-		      {
-			TREE_ADDRESSABLE (gnu_temp) = 1;
-			TREE_READONLY (gnu_temp) = 0;
-		      }
-
-		    /* Set up to move the copy back to the original.  */
-		    gnu_temp = build (MODIFY_EXPR, TREE_TYPE (gnu_copy),
-				      gnu_copy, gnu_actual);
-		    annotate_with_node (gnu_temp, gnat_actual);
-		    append_to_statement_list (gnu_temp, &gnu_after_list);
-		  }
-	      }
-
-	    /* If this was a procedure call, we may not have removed any
-	       padding.  So do it here for the part we will use as an
-	       input, if any.  */
-	    gnu_actual = gnu_name;
-	    if (Ekind (gnat_formal) != E_Out_Parameter
-		&& TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
-		&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual)))
-	      gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)),
-				    gnu_actual);
-
-	    /* Unless this is an In parameter, we must remove any LJM building
-	       from GNU_NAME.  */
-	    if (Ekind (gnat_formal) != E_In_Parameter
-		&& TREE_CODE (gnu_name) == CONSTRUCTOR
-		&& TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE
-		&& TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name)))
-	      gnu_name
-		= convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))),
-			   gnu_name);
-
-	    if (Ekind (gnat_formal) != E_Out_Parameter
-		&& ! unchecked_convert_p
-		&& Do_Range_Check (gnat_actual))
-	      gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal));
-
-	    /* Do any needed conversions.  We need only check for
-	       unchecked conversion since normal conversions will be handled
-	       by just converting to the formal type.  */
-	    if (unchecked_convert_p)
-	      {
-		gnu_actual
-		  = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)),
-				       gnu_actual,
-				       (Nkind (gnat_actual)
-					== N_Unchecked_Type_Conversion)
-				       && No_Truncation (gnat_actual));
-
-		/* One we've done the unchecked conversion, we still
-		   must ensure that the object is in range of the formal's
-		   type.  */
-		if (Ekind (gnat_formal) != E_Out_Parameter
-		    && Do_Range_Check (gnat_actual))
-		  gnu_actual = emit_range_check (gnu_actual,
-						 Etype (gnat_formal));
-	      }
-	    else if (TREE_CODE (gnu_actual) != SAVE_EXPR)
-	      /* We may have suppressed a conversion to the Etype of the
-		 actual since the parent is a procedure call.  So add the
-		 conversion here.  */
-	      gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
-				    gnu_actual);
-
-	    if (TREE_CODE (gnu_actual) != SAVE_EXPR)
-	      gnu_actual = convert (gnu_formal_type, gnu_actual);
-
-	    /* If we have not saved a GCC object for the formal, it means it
-	       is an OUT parameter not passed by reference and that does not
-	       need to be copied in. Otherwise, look at the PARM_DECL to see
-	       if it is passed by reference. */
-	    if (present_gnu_tree (gnat_formal)
-		&& TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
-		&& DECL_BY_REF_P (get_gnu_tree (gnat_formal)))
-	      {
-		if (Ekind (gnat_formal) != E_In_Parameter)
-		  {
-		    gnu_actual = gnu_name;
-
-		    /* If we have a padded type, be sure we've removed the
-		       padding.  */
-		    if (TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
-			&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual))
-			&& TREE_CODE (gnu_actual) != SAVE_EXPR)
-		      gnu_actual
-			= convert (get_unpadded_type (Etype (gnat_actual)),
-				   gnu_actual);
-		  }
-
-		/* Otherwise, if we have a non-addressable COMPONENT_REF of a
-		   variable-size type see if it's doing a unpadding operation.
-		   If so, remove that operation since we have no way of
-		   allocating the required temporary.  */
-		if (TREE_CODE (gnu_actual) == COMPONENT_REF
-		    && ! TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
-		    && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_actual, 0)))
-			== RECORD_TYPE)
-		    && TYPE_IS_PADDING_P (TREE_TYPE
-					  (TREE_OPERAND (gnu_actual, 0)))
-		    && !addressable_p (gnu_actual))
-		  gnu_actual = TREE_OPERAND (gnu_actual, 0);
-
-		/* 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));
-		gnu_actual = build_unary_op (ADDR_EXPR, gnu_formal_type,
-					     gnu_actual);
-	      }
-	    else if (present_gnu_tree (gnat_formal)
-		     && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
-		     && DECL_BY_COMPONENT_PTR_P (get_gnu_tree (gnat_formal)))
-	      {
-		gnu_formal_type = TREE_TYPE (get_gnu_tree (gnat_formal));
-		gnu_actual = maybe_implicit_deref (gnu_actual);
-		gnu_actual = maybe_unconstrained_array (gnu_actual);
-
-		if (TREE_CODE (gnu_formal_type) == RECORD_TYPE
-		    && TYPE_IS_PADDING_P (gnu_formal_type))
-		  {
-		    gnu_formal_type
-		      = TREE_TYPE (TYPE_FIELDS (gnu_formal_type));
-		    gnu_actual = convert (gnu_formal_type, gnu_actual);
-		  }
-
-		/* Take the address of the object and convert to the
-		   proper pointer type.  We'd like to actually compute
-		   the address of the beginning of the array using
-		   an ADDR_EXPR of an ARRAY_REF, but there's a possibility
-		   that the ARRAY_REF might return a constant and we'd
-		   be getting the wrong address.  Neither approach is
-		   exactly correct, but this is the most likely to work
-		   in all cases.  */
-		gnu_actual = convert (gnu_formal_type,
-				      build_unary_op (ADDR_EXPR, NULL_TREE,
-						      gnu_actual));
-	      }
-	    else if (present_gnu_tree (gnat_formal)
-		     && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
-		     && DECL_BY_DESCRIPTOR_P (get_gnu_tree (gnat_formal)))
-	      {
-		/* If arg is 'Null_Parameter, pass zero descriptor.  */
-		if ((TREE_CODE (gnu_actual) == INDIRECT_REF
-		     || TREE_CODE (gnu_actual) == UNCONSTRAINED_ARRAY_REF)
-		    && TREE_PRIVATE (gnu_actual))
-		  gnu_actual
-		    = convert (DECL_ARG_TYPE (get_gnu_tree (gnat_formal)),
-			       integer_zero_node);
-		else
-		  gnu_actual
-		    = build_unary_op (ADDR_EXPR, NULL_TREE,
-				      fill_vms_descriptor (gnu_actual,
-							   gnat_formal));
-	      }
-	    else
-	      {
-		tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual));
-
-		if (Ekind (gnat_formal) != E_In_Parameter)
-		  gnu_name_list
-		    = chainon (gnu_name_list,
-			       build_tree_list (NULL_TREE, gnu_name));
-
-		if (! present_gnu_tree (gnat_formal)
-		    || TREE_CODE (get_gnu_tree (gnat_formal)) != PARM_DECL)
-		  continue;
-
-		/* If this is 'Null_Parameter, pass a zero even though we are
-		   dereferencing it.  */
-		else if (TREE_CODE (gnu_actual) == INDIRECT_REF
-			 && TREE_PRIVATE (gnu_actual)
-			 && host_integerp (gnu_actual_size, 1)
-			 && 0 >= compare_tree_int (gnu_actual_size,
-						   BITS_PER_WORD))
-		  gnu_actual
-		    = unchecked_convert
-		      (DECL_ARG_TYPE (get_gnu_tree (gnat_formal)),
-		       convert (gnat_type_for_size
-				(tree_low_cst (gnu_actual_size, 1), 1),
-				integer_zero_node), 0);
-		else
-		  gnu_actual
-		    = convert (TYPE_MAIN_VARIANT
-			       (DECL_ARG_TYPE (get_gnu_tree (gnat_formal))),
-			       gnu_actual);
-	      }
-
-	    gnu_actual_list
-	      = chainon (gnu_actual_list,
-			 build_tree_list (NULL_TREE, gnu_actual));
-	  }
-
-	gnu_subprog_call = build (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
-				  gnu_subprog_addr, gnu_actual_list,
-				  NULL_TREE);
-	TREE_SIDE_EFFECTS (gnu_subprog_call) = 1;
-
-	/* If it is a function call, the result is the call expression.  */
-	if (Nkind (gnat_node) == N_Function_Call)
-	  {
-	    gnu_result = gnu_subprog_call;
-
-	    /* If the function returns an unconstrained array or by reference,
-	       we have to de-dereference the pointer.  */
-	    if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type)
-		|| TYPE_RETURNS_BY_REF_P (gnu_subprog_type))
-	      gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
-					   gnu_result);
-
-	    gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	    break;
-	  }
-
-	/* If this is the case where the GNAT tree contains a procedure call
-	   but the Ada procedure has copy in copy out parameters, the special
-	   parameter passing mechanism must be used.  */
-	else if (TYPE_CI_CO_LIST (gnu_subprog_type) != NULL_TREE)
-	  {
-	    /* List of FIELD_DECLs associated with the PARM_DECLs of the copy
-	       in copy out parameters.  */
-	    tree scalar_return_list = TYPE_CI_CO_LIST (gnu_subprog_type);
-	    int length = list_length (scalar_return_list);
-
-	    if (length > 1)
-	      {
-		tree gnu_name;
-
-		gnu_subprog_call = protect_multiple_eval (gnu_subprog_call);
-
-		/* If any of the names had side-effects, ensure they are
-		   all evaluated before the call.  */
-		for (gnu_name = gnu_name_list; gnu_name;
-		     gnu_name = TREE_CHAIN (gnu_name))
-		  if (TREE_SIDE_EFFECTS (TREE_VALUE (gnu_name)))
-		    gnu_subprog_call
-		      = build (COMPOUND_EXPR, TREE_TYPE (gnu_subprog_call),
-			       TREE_VALUE (gnu_name), gnu_subprog_call);
-	      }
-
-	    if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
-	      gnat_formal = First_Formal (Etype (Name (gnat_node)));
-	    else
-	      gnat_formal = First_Formal (Entity (Name (gnat_node)));
-
-	    for (gnat_actual = First_Actual (gnat_node);
-		 Present (gnat_actual);
-		 gnat_formal = Next_Formal_With_Extras (gnat_formal),
-		 gnat_actual = Next_Actual (gnat_actual))
-	      /* If we are dealing with a copy in copy out parameter, we must
-		 retrieve its value from the record returned in the function
-		 call.  */
-	      if (! (present_gnu_tree (gnat_formal)
-		     && TREE_CODE (get_gnu_tree (gnat_formal)) == PARM_DECL
-		     && (DECL_BY_REF_P (get_gnu_tree (gnat_formal))
-			 || ((TREE_CODE (get_gnu_tree (gnat_formal))
-			      == PARM_DECL)
-			     && ((DECL_BY_COMPONENT_PTR_P
-				  (get_gnu_tree (gnat_formal))
-				  || (DECL_BY_DESCRIPTOR_P
-				      (get_gnu_tree (gnat_formal))))))))
-		  && Ekind (gnat_formal) != E_In_Parameter)
-		{
-		  /* Get the value to assign to this OUT or IN OUT
-		     parameter.  It is either the result of the function if
-		     there is only a single such parameter or the appropriate
-		     field from the record returned.  */
-		  tree gnu_result
-		    = length == 1 ? gnu_subprog_call
-		      : build_component_ref
-			(gnu_subprog_call, NULL_TREE,
-			 TREE_PURPOSE (scalar_return_list), 0);
-		  int 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.  */
-		  tree gnu_actual
-		    = maybe_unconstrained_array (TREE_VALUE (gnu_name_list));
-
-		  /* If the result is a padded type, remove the padding.  */
-		  if (TREE_CODE (TREE_TYPE (gnu_result)) == RECORD_TYPE
-		      && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
-		    gnu_result
-		      = convert (TREE_TYPE (TYPE_FIELDS
-					    (TREE_TYPE (gnu_result))),
-				 gnu_result);
-
-		  /* If the result is a type conversion, do it.  */
-		  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));
-
-		  else if (unchecked_conversion)
-		    gnu_result
-		      = unchecked_convert (TREE_TYPE (gnu_actual), gnu_result,
-					   No_Truncation (gnat_actual));
-		  else
-		    {
-		      if (Do_Range_Check (gnat_actual))
-			gnu_result = emit_range_check (gnu_result,
-						       Etype (gnat_actual));
-
-		      if (! (! TREE_CONSTANT (TYPE_SIZE
-					      (TREE_TYPE (gnu_actual)))
-			     && TREE_CONSTANT (TYPE_SIZE
-					       (TREE_TYPE (gnu_result)))))
-			gnu_result = convert (TREE_TYPE (gnu_actual),
-					      gnu_result);
-		    }
-
-		  gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
-						gnu_actual, gnu_result);
-		  annotate_with_node (gnu_result, gnat_actual);
-		  append_to_statement_list (gnu_result, &gnu_before_list);
-		  scalar_return_list = TREE_CHAIN (scalar_return_list);
-		  gnu_name_list = TREE_CHAIN (gnu_name_list);
-		}
-	  }
-	else
-	  {
-	    annotate_with_node (gnu_subprog_call, gnat_node);
-	    append_to_statement_list (gnu_subprog_call, &gnu_before_list);
-	  }
-
-	append_to_statement_list (gnu_after_list, &gnu_before_list);
-	gnu_result = gnu_before_list;
-      }
+      gnu_result = call_to_gnu (gnat_node, &gnu_result_type);
       break;
 
     /*************************/
@@ -3264,20 +3620,7 @@ gnat_to_gnu (Node_Id gnat_node)
     /***************************/
 
     case N_Handled_Sequence_Of_Statements:
-
-      /* The GCC exception handling mechanism can handle both ZCX and SJLJ
-	 schemes and we have our own SJLJ mechanism.  To call the GCC
-	 mechanism, we call add_cleanup, and when we leave the binding,
-	 end_stmt_group will create the TRY_FINALLY_EXPR.
-
-	 ??? The region level calls down there have been specifically put in
-	 place for a ZCX context and currently the order in which things are
-	 emitted (region/handlers) is different from the SJLJ case. Instead of
-	 putting other calls with different conditions at other places for the
-	 SJLJ case, it seems cleaner to reorder things for the SJLJ case and
-	 generalize the condition to make it not ZCX specific. */
-
-      /* If there is an At_End procedure attached to this node, and the eh
+      /* If there is an At_End procedure attached to this node, and the EH
 	 mechanism is SJLJ, we must have at least a corresponding At_End
 	 handler, unless the No_Exception_Handlers restriction is set.  */
       if (! type_annotate_only
@@ -3287,370 +3630,14 @@ gnat_to_gnu (Node_Id gnat_node)
 	  && ! No_Exception_Handlers_Set())
 	gigi_abort (335);
 
-      {
-	tree gnu_jmpsave_decl = NULL_TREE;
-	tree gnu_jmpbuf_decl = NULL_TREE;
-	/* If just annotating, ignore all EH and cleanups.  */
-	bool gcc_zcx
-	  = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
-	     && Exception_Mechanism == GCC_ZCX);
-	bool setjmp_longjmp
-	  = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
-	     && Exception_Mechanism == Setjmp_Longjmp);
-	bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
-	bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
-	tree gnu_inner_block; /* The statement(s) for the block itself.  */
-
-	/* If there are any exceptions or cleanup processing involved, we need
-	   an outer statement group (for Setjmp_Longjmp) and binding level.  */
-	if (binding_for_block)
-	  {
-	    start_stmt_group ();
-	    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.  */
-	if (setjmp_longjmp)
-	  {
-	    gnu_jmpsave_decl
-	      = create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE,
-				 jmpbuf_ptr_type,
-				 build_call_0_expr (get_jmpbuf_decl),
-				 0, 0, 0, 0, 0, gnat_node);
-	    gnu_jmpbuf_decl
-	      = create_var_decl (get_identifier ("JMP_BUF"),
-				 NULL_TREE, jmpbuf_type,
-				 NULL_TREE, 0, 0, 0, 0, 0, gnat_node);
-
-	    set_block_jmpbuf_decl (gnu_jmpbuf_decl);
-
-	    /* When we exit this block, restore the saved value.  */
-	    add_cleanup (build_call_1_expr (set_jmpbuf_decl,
-					    gnu_jmpsave_decl));
-	  }
-
-	/* 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 ();
-
-	if (setjmp_longjmp)
-	  add_stmt (build_call_1_expr
-		    (set_jmpbuf_decl,
-		     build_unary_op (ADDR_EXPR, NULL_TREE, gnu_jmpbuf_decl)));
-
-
-	if (Present (First_Real_Statement (gnat_node)))
-	  process_decls (Statements (gnat_node), Empty,
-			 First_Real_Statement (gnat_node), 1, 1);
-
-	/* Generate code for each statement in the block.  */
-	for (gnat_temp = (Present (First_Real_Statement (gnat_node))
-			  ? First_Real_Statement (gnat_node)
-			  : First (Statements (gnat_node)));
-	     Present (gnat_temp); gnat_temp = Next (gnat_temp))
-	  add_stmt (gnat_to_gnu (gnat_temp));
-	gnu_inner_block = end_stmt_group ();
-
-	/* Now generate code for the two exception models, if either is
-	   relevant for this block.  */
-	if (setjmp_longjmp)
-	  {
-	    tree *gnu_else_ptr = 0;
-	    tree gnu_handler;
-
-	    /* Make a binding level for the exception handling declarations
-	       and code and set up gnu_except_ptr_stack for the handlers
-	       to use.  */
-	    start_stmt_group ();
-	    gnat_pushlevel ();
-
-	    push_stack (&gnu_except_ptr_stack, NULL_TREE,
-			create_var_decl (get_identifier ("EXCEPT_PTR"),
-					 NULL_TREE,
-					 build_pointer_type (except_type_node),
-					 build_call_0_expr (get_excptr_decl),
-					 0, 0, 0, 0, 0, gnat_node));
-
-	    /* Generate code for each handler. The N_Exception_Handler case
-	       below does the real work and returns a COND_EXPR for each
-	       handler, which we chain together here.  */
-	    for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
-		 Present (gnat_temp);
-		 gnat_temp = Next_Non_Pragma (gnat_temp))
-	      {
-		gnu_expr = gnat_to_gnu (gnat_temp);
-
-		/* If this is the first one, set it as the outer one.
-		   Otherwise, point the "else" part of the previous handler
-		   to us. Then point to our "else" part.  */
-		if (!gnu_else_ptr)
-		  add_stmt (gnu_expr);
-		else
-		  *gnu_else_ptr = gnu_expr;
-
-		gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr);
-	      }
-
-	    /* If none of the exception handlers did anything, re-raise but
-	       do not defer abortion.  */
-	    gnu_expr = build_call_1_expr (raise_nodefer_decl,
-					  TREE_VALUE (gnu_except_ptr_stack));
-	    annotate_with_node (gnu_expr, gnat_node);
-
-	    if (gnu_else_ptr)
-	      *gnu_else_ptr = gnu_expr;
-	    else
-	      add_stmt (gnu_expr);
-
-	    /* End the binding level dedicated to the exception handlers
-	       and get the whole statement group.  */
-	    pop_stack (&gnu_except_ptr_stack);
-	    gnat_poplevel ();
-	    gnu_handler = end_stmt_group ();
-
-	    /* If the setjmp returns 1, we restore our incoming longjmp value
-	       and then check the handlers.  */
-	    start_stmt_group ();
-	    add_stmt_with_node (build_call_1_expr (set_jmpbuf_decl,
-						   gnu_jmpsave_decl),
-				gnat_node);
-	    add_stmt (gnu_handler);
-	    gnu_handler = end_stmt_group ();
-
-	    /* This block is now "if (setjmp) ... <handlers> else <block>".  */
-	    gnu_result = build (COND_EXPR, void_type_node,
-				(build_call_1_expr
-				 (setjmp_decl,
-				  build_unary_op (ADDR_EXPR, NULL_TREE,
-						  gnu_jmpbuf_decl))),
-				gnu_handler, gnu_inner_block);
-	  }
-	else if (gcc_zcx)
-	  {
-	    tree gnu_handlers;
-
-	    /* First make a block containing the handlers.  */
-	    start_stmt_group ();
-	    for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
-		 Present (gnat_temp);
-		 gnat_temp = Next_Non_Pragma (gnat_temp))
-	      add_stmt (gnat_to_gnu (gnat_temp));
-	    gnu_handlers = end_stmt_group ();
-
-	    /* Now make the TRY_CATCH_EXPR for the block.  */
-	    gnu_result = build (TRY_CATCH_EXPR, void_type_node,
-				gnu_inner_block, gnu_handlers);
-	  }
-	else
-	  gnu_result = gnu_inner_block;
-
-	/* Now close our outer block, if we had to make one.  */
-	if (binding_for_block)
-	  {
-	    add_stmt (gnu_result);
-	    gnat_poplevel ();
-	    gnu_result = end_stmt_group ();
-	  }
-      }
+      gnu_result = Handled_Sequence_Of_Statements_to_gnu (gnat_node);
       break;
 
     case N_Exception_Handler:
       if (Exception_Mechanism == Setjmp_Longjmp)
-	{
-	  /* Unless this is "Others" or the special "Non-Ada" exception
-	     for Ada, make an "if" statement to select the proper
-	     exceptions.  For "Others", exclude exceptions where
-	     Handled_By_Others is nonzero unless the All_Others flag is set.
-	     For "Non-ada", accept an exception if "Lang" is 'V'.  */
-	  tree gnu_choice = integer_zero_node;
-	  tree gnu_body = build_stmt_group (Statements (gnat_node), false);
-
-	  for (gnat_temp = First (Exception_Choices (gnat_node));
-	       gnat_temp; gnat_temp = Next (gnat_temp))
-	    {
-	      tree this_choice;
-
-	      if (Nkind (gnat_temp) == N_Others_Choice)
-		{
-		  if (All_Others (gnat_temp))
-		    this_choice = integer_one_node;
-		  else
-		    this_choice
-		      = build_binary_op
-			(EQ_EXPR, integer_type_node,
-		       convert
-		       (integer_type_node,
-			build_component_ref
-			(build_unary_op
-			 (INDIRECT_REF, NULL_TREE,
-			  TREE_VALUE (gnu_except_ptr_stack)),
-			 get_identifier ("not_handled_by_others"), NULL_TREE,
-			 0)),
-			 integer_zero_node);
-		}
-
-	      else if (Nkind (gnat_temp) == N_Identifier
-		       || Nkind (gnat_temp) == N_Expanded_Name)
-		{
-		  gnu_expr
-		    = gnat_to_gnu_entity (Entity (gnat_temp), NULL_TREE, 0);
-
-		  this_choice
-		    = build_binary_op
-		      (EQ_EXPR, integer_type_node,
-		       TREE_VALUE (gnu_except_ptr_stack),
-		       convert
-		         (TREE_TYPE (TREE_VALUE (gnu_except_ptr_stack)),
-			  build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr)));
-
-		  /* If this is the distinguished exception "Non_Ada_Error"
-		     (and we are in VMS mode), also allow a non-Ada
-		     exception (a VMS condition) to match.  */
-		  if (Is_Non_Ada_Error (Entity (gnat_temp)))
-		    {
-		      tree gnu_comp
-			= build_component_ref
-			  (build_unary_op
-			   (INDIRECT_REF, NULL_TREE,
-			    TREE_VALUE (gnu_except_ptr_stack)),
-			   get_identifier ("lang"), NULL_TREE, 0);
-
-		      this_choice
-			= build_binary_op
-			(TRUTH_ORIF_EXPR, integer_type_node,
-			 build_binary_op
-			 (EQ_EXPR, integer_type_node, gnu_comp,
-			  convert (TREE_TYPE (gnu_comp),
-				   build_int_2 ('V', 0))),
-			 this_choice);
-		    }
-		}
-	      else
-		gigi_abort (318);
-
-	      gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
-					    gnu_choice, this_choice);
-	    }
-
-	  gnu_result = build (COND_EXPR, void_type_node, gnu_choice, gnu_body,
-			      NULL_TREE);
-	}
-
-      /* Tell the back end that we start an exception handler if necessary.  */
+	gnu_result = Exception_Handler_to_gnu_sjlj (gnat_node);
       else if (Exception_Mechanism == GCC_ZCX)
-	{
-	  /* We build a TREE_LIST of nodes representing what exception
-	     types this handler is able to catch, with special cases
-	     for others and all others cases.
-
-	     Each exception type is actually identified by a pointer to the
-	     exception id, with special value zero for "others" and one for
-	     "all others". Beware that these special values are known and used
-	     by the personality routine to identify the corresponding specific
-	     kinds of handlers.
-
-	     ??? For initial time frame reasons, the others and all_others
-	     cases have been handled using specific type trees, but this
-	     somehow hides information to the back-end, which expects NULL to
-	     be passed for catch all and end_cleanup to be used for cleanups.
-
-	     Care should be taken to ensure that the control flow impact of
-	     such clauses is rendered in some way. lang_eh_type_covers is
-	     doing the trick currently.  */
-
- 	  tree gnu_etypes_list = NULL_TREE;
-	  tree gnu_etype;
-	  tree gnu_current_exc_ptr;
-	  tree gnu_incoming_exc_ptr;
-
- 	  for (gnat_temp = First (Exception_Choices (gnat_node));
- 	       gnat_temp; gnat_temp = Next (gnat_temp))
- 	    {
- 	      if (Nkind (gnat_temp) == N_Others_Choice)
-		gnu_etype
-		  = All_Others (gnat_temp) ? integer_one_node
-		    : integer_zero_node;
- 	      else if (Nkind (gnat_temp) == N_Identifier
- 		       || Nkind (gnat_temp) == N_Expanded_Name)
- 		{
-                  Entity_Id gnat_ex_id = Entity (gnat_temp);
-
-		  /* Exception may be a renaming. Recover original exception
-		     which is the one elaborated and registered.  */
-		  if (Present (Renamed_Object (gnat_ex_id)))
-		    gnat_ex_id = Renamed_Object (gnat_ex_id);
-
- 		  gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0);
-
- 		  gnu_etype
-		    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
-
-		  /* The Non_Ada_Error case for VMS exceptions is handled
-		     by the personality routine.  */
- 		}
- 	      else
- 		gigi_abort (337);
-
-	      /* The GCC interface expects NULL to be passed for catch all
-		 handlers, so it would be quite tempting to set gnu_etypes_list
-		 to NULL if gnu_etype is integer_zero_node.  It would not work,
-		 however, because GCC's notion of "catch all" is stronger than
-		 our notion of "others".  Until we correctly use the cleanup
-		 interface as well, the doing tht would prevent the "all
-		 others" handlers from beeing seen, because nothing can be
-		 caught beyond a catch all from GCC's point of view.  */
- 	      gnu_etypes_list
-		= tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list);
- 	    }
-
-	  start_stmt_group ();
-	  gnat_pushlevel ();
-
-	  /* Expand a call to the begin_handler hook at the beginning of the
-	     handler, and arrange for a call to the end_handler hook to occur
-	     on every possible exit path.
-
-	     The hooks expect a pointer to the low level occurrence. This is
-	     required for our stack management scheme because a raise inside
-	     the handler pushes a new occurrence on top of the stack, which
-	     means that this top does not necessarily match the occurrence
-	     this handler was dealing with.
-
-	     The EXC_PTR_EXPR object references the exception occurrence
-	     beeing propagated. Upon handler entry, this is the exception for
-	     which the handler is triggered. This might not be the case upon
-	     handler exit, however, as we might have a new occurrence
-	     propagated by the handler's body, and the end_handler hook
-	     called as a cleanup in this context.
-
-	     We use a local variable to retrieve the incoming value at
-	     handler entry time, and reuse it to feed the end_handler hook's
-	     argument at exit time.  */
-	  gnu_current_exc_ptr = build (EXC_PTR_EXPR, ptr_type_node);
-	  gnu_incoming_exc_ptr
-	    = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
-			       ptr_type_node, gnu_current_exc_ptr,
-			       0, 0, 0, 0, 0, gnat_node);
-
-	  add_stmt_with_node (build_call_1_expr (begin_handler_decl,
-						 gnu_incoming_exc_ptr),
-			      gnat_node);
-	  add_cleanup (build_call_1_expr (end_handler_decl,
-					  gnu_incoming_exc_ptr));
-	  add_stmt_list (Statements (gnat_node));
-	  gnat_poplevel ();
-	  gnu_result = build (CATCH_EXPR, void_type_node,
-			      gnu_etypes_list, end_stmt_group ());
-	}
+	gnu_result = Exception_Handler_to_gnu_zcx (gnat_node);
       else
 	abort ();