2004-09-09 Vincent Celier <celier@gnat.com>

	* a-direct.ads: Add pragma Ada_05
	(Directory_Entry_Type): Give default value to component Kind to avoid
	not initialized warnings.

	* a-direct.adb (Current_Directory): Remove directory separator at the
	end.
	(Delete_Directory, Delete_Tree): Raise Name_Error if Directory is not
	an existing directory.
	(Fetch_Next_Entry): Give default value to variable Kind to avoid warning
	(Size (String)): Function C_Size returns Long_Integer, not File_Size.
	Convert the result to File_Size.

	* prj.ads: (Project_Error): New exception

	* prj-attr.adb: Except in procedure Initialize, Fail comes from
	Prj.Com, not from Osint.
	(Attrs, Package_Attributes): Tables moved to private part of spec
	(Add_Attribute, Add_Unknown_Package): Moved to new child package
	Prj.Attr.PM.
	(Register_New_Package (Name, Attributes), Register_New_Attribute): Raise
	Prj.Project_Error after call to Fail.
	(Register_New_Package (Name, Id)): Set Id to Empty_Package after calling
	Fail. Check that package name is not already in use.

	* prj-attr.ads: Comment updates to indicate that all subprograms may be
	used by tools, not only by the project manager, and to indicate that
	exception Prj.Prj_Error may be raised in case of problem.
	(Add_Unknown_Package, Add_Attribute): Moved to new child package
	Prj.Attr.PM.
	(Attrs, Package_Attributes): Table instantiations moved from the body to
	the private part to be accessible from Prj.Attr.PM body.

	* prj-dect.adb (Parse_Package_Declaration): Call Add_Unknown_Package
	from new package Prj.Attr.PM.
	(Parse_Attribute_Declaration): Call Add_Attribute from new package
	Prj.Attr.PM.

	* Makefile.in: Add prj-attr-pm.o to gnatmake object list

	* gnatbind.adb (Gnatbind): Correct warning message (Elaboration_Check
	instead of Elaboration_Checks).

	* a-calend.adb: Minor reformatting

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

	* gigi.h (maybe_pad_type): New declaration.
	(create_subprog_type): New arg RETURNS_BY_TARGET_PTR.

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

	* cuintp.c: Convert to use buildN.

	* decl.c (maybe_pad_type): No longer static.
	(gnat_to_gnu_entity, case E_Function): Handle case of returning by
	target pointer.
	Convert to use buildN.

	* trans.c (call_to_gnu): Add arg GNU_TARGET; support
	TYPE_RETURNS_BY_TARGET_PTR_P.  All callers changed.
	(gnat_to_gnu, case N_Assignment_Statement): Call call_to_gnu if call on
	RHS.
	(gnat_to_gnu, case N_Return): Handle TYPE_RETURN_BY_TARGET_PTR_P.
	(gnat_gimplify_expr, case ADDR_EXPR): New case.
	Convert to use buildN.

	* utils2.c (gnat_build_constructor): Also set TREE_INVARIANT and
	TREE_READONLY for const.
	Convert to use buildN.

	* utils.c (create_subprog_type): New operand RETURNS_BY_TARGET_PTR.
	(create_var_decl): Refine when TREE_STATIC is set.
	Convert to use buildN.

2004-09-09  Gary Dismukes  <dismukes@gnat.com>

	* gnat_ugn.texi: Delete text relating to checking of ali and object
	consistency.

	* a-except.adb (Rcheck_*): Add pragmas No_Return for each of these
	routines.

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

	* gnat_ugn.texi: Add Detect_Blocking to the list of configuration
	pragmas recognized by GNAT.

	* gnat_rm.texi: Document pragma Detect_Blocking.

	* s-solita.adb (Timed_Delay_T): When pragma Detect_Blocking is active,
	raise Program_Error if called from a protected operation.

	* s-taprob.adb (Lock): When pragma Detect_Blocking is active increase
	the protected action nesting level.
	(Lock_Read_Only): When pragma Detect_Blocking is active increase the
	protected action nesting level.
	(Unlock): When pragma Detect_Blocking is active decrease the protected
	action nesting level.

	* s-taskin.adb (Initialize_ATCB): Initialize to 0 the
	Protected_Action_Nesting.

	* s-taskin.ads: Adding the field Protected_Action_Nesting to the
	Common_ATCB record. It contains the dynamic level of protected action
	nesting for each task. It is needed for checking whether potentially
	blocking operations are called from protected operations.
	(Detect_Blocking): Adding a Boolean constant reflecting whether pragma
	Detect_Blocking is active or not in the partition.

	* s-tasren.adb (Call_Simple): When pragma Detect_Blocking is active,
	raise Program_Error if called from a protected operation.
	(Task_Entry_Call): When pragma Detect_Blocking is active, raise
	Program_Error if called from a protected operation.
	(Timed_Task_Entry_Call): When pragma Detect_Blocking is active, raise
	Program_Error if called from a protected operation.

	* s-tassta.adb (Abort_Tasks): When pragma Detect_Blocking is active,
	raise Program_Error if called from a protected operation.

	* s-tpoben.adb (Lock_Entries): When pragma Detect_Blocking is active,
	raise Program_Error if called from a protected operation, and increase
	the protected action nesting level.
	(Lock_Read_Only_Entries): When pragma Detect_Blocking is active, raise
	Program_Error if called from a protected operation, and increase the
	protected action nesting level.
	(Unlock_Entries): When pragma Detect_Blocking is active decrease the
	protected action nesting level.

	* s-tposen.adb (Lock_Entry): When pragma Detect_Blocking is active,
	raise Program_Error if called from a protected operation, and increase
	the protected action nesting level.
	(Lock_Read_Only_Entry): When pragma Detect_Blocking is active, raise
	Program_Error if called from a protected operation, and increase the
	protected action nesting level.
	(Protected_Single_Entry_Call): When pragma Detect_Blocking is active,
	raise Program_Error if called from a protected operation.
	(Timed_Protected_Single_Entry_Call): When pragma Detect_Blocking is
	active, raise Program_Error if called from a protected operation.
	(Unlock_Entry): When pragma Detect_Blocking is active decrease the
	protected action nesting level.

	* sem_util.adb (Check_Potentially_Blocking_Operation): Remove the
	insertion of the statement raising Program_Error. The run time
	contains the required machinery for handling that.

	* sem_util.ads: Change comment associated to procedure
	Check_Potentially_Blocking_Operation.
	This procedure does not insert a call for raising the exception because
	that is currently done by the run time.

	* raise.h (__gnat_set_globals): Pass the detect_blocking parameter.

	* init.c: Add the global variable __gl_detect_blocking that indicates
	whether pragma Detect_Blocking is active (1) or not (0). Needed for
	making the pragma available at run time.
	(__gnat_set_globals): Pass and update the detect_blocking parameter.

	* lib-writ.adb (Write_ALI): Set the DB flag in the ali file if
	pragma Detect_Blocking is active.

	* lib-writ.ads: Document the Detect_Blocking flag (DB) in ali files.

	* ali.adb (Scan_ALI): Set the Detect_Blocking value to true if the flag
	DB is found in the ali file. Any unit compiled with pragma
	Detect_Blocking active forces its effect in the whole partition.

	* a-retide.adb (Delay_Until): Raise Program_Error if pragma
	Detect_Blocking is active and delay is called from a protected
	operation.

	* bindgen.adb (Gen_Adainit_Ada): When generating the call to
	__gnat_set_globals, pass 1 as Detect_Blocking parameter if pragma
	Detect_Blocking is active (0 otherwise).
	(Gen_Adainit_C): When generating the call to __gnat_set_globals, pass 1
	as Detect_Blocking parameter if pragma Detect_Blocking is active (0
	otherwise).

2004-09-09  Thomas Quinot  <quinot@act-europe.fr>

	* gnat_rm.texi: Rename GNAT.Perfect_Hash.Generators to
	GNAT.Perfect_Hash_Generators, and remove the empty GNAT.Perfect_Hash
	package.

	* s-parint.ads, s-parint.adb (Get_RAS_Info): New subprogram.
	(Register_Receiving_Stub): Add Subp_Info formal parameter.
	Update API in placeholder implemetation of s-parint to reflect changes
	in distribution runtime library.

	* sem_ch3.adb (Expand_Derived_Record): Rename to
	Expand_Record_Extension.

	* sem_disp.adb (Check_Controlling_Formals): Improve error message for
	primitive operations of potentially distributed object types that have
	non-controlling anonymous access formals.

	* sem_dist.ads, sem_dist.adb (Build_RAS_Primitive_Specification): New
	subprogram.
	New implementation of expansion for remote access-to-subprogram types,
	based on the RACW infrastructure.
	This version of sem_dist is compatible with PolyORB/DSA as well as
	GLADE.

	* sem_prag.adb (Analyze_Pragma, case Pragma_Asynchronous): For a pragma
	Asynchrronous that applies to a remote access-to-subprogram type, mark
	the underlying RACW type as asynchronous.

	* link.c: FreeBSD uses GNU ld: set __gnat_objlist_file_supported and
	 __gnat_using_gnu_linker to 1.

	* Makefile.rtl, impunit.adb, g-perhas.ads, g-pehage.ads,
	g-pehage.adb: Rename GNAT.Perfect_Hash.Generators to
	GNAT.Perfect_Hash_Generators, and remove the empty
	GNAT.Perfect_Hash package.

	* atree.adb: Minor reformatting

	* exp_ch3.adb (Expand_Derived_Record): Rename to
	Expand_Record_Extension.
	(Build_Record_Init_Proc.Build_Assignment): The default expression in
	a component declaration must remain attached at that point in the
	tree so New_Copy_Tree copies it if the enclosing record type is derived.
	It is therefore necessary to take a copy of the expression when building
	the corresponding assignment statement in the init proc.
	As a side effect, in the case of a derived record type, we now see the
	original expression, without any rewriting that could have occurred
	during expansion of the ancestor type's init proc, and we do not need
	to go back to Original_Node.

	* exp_ch3.ads (Expand_Derived_Record): Rename to
	Expand_Record_Extension.

	* exp_dist.ads, exp_dist.adb (Underlying_RACW_Type): New subprogram.
	Returns the RACW type used to implement a remote access-to-subprogram
	type.
	(Add_RAS_Proxy_And_Analyze, Build_Remote_Subprogram_Proxy_Type):
	New subprograms. Used to create a proxy tagged object for a remote
	subprogram. The proxy object is used as the designated object
	for RAS values on the same partition (unless All_Calls_Remote applies).
	(Build_Get_Unique_RP_Call): New subprogram. Build a call to
	System.Partition_Interface.Get_Unique_Remote_Pointer.
	(Add_RAS_Access_TSS, Add_RAS_Dereference_TSS):
	Renamed from Add_RAS_*_Attribute.
	(Add_Receiving_Stubs_To_Declarations): Generate a table of local
	subprograms.
	New implementation of expansion for remote access-to-subprogram types,
	based on the RACW infrastructure.

	* exp_dist.ads (Copy_Specification): Update comment to note that this
	function can copy the specification from either a subprogram
	specification or an access-to-subprogram type definition.

2004-09-09  Ed Schonberg  <schonberg@gnat.com>

	* sem_type.adb (Disambiguate): Handle properly an accidental ambiguity
	in an instance, between an explicit subprogram an one inherited from a
	type derived from an actual.

	* exp_ch6.adb (Expand_N_Subprogram_Body): If polling is enabled, do not
	add a polling call if the subprogram is to be inlined by the back-end,
	to avoid repeated calls with multiple inlinings.

	* checks.adb (Apply_Alignment_Check): If the expression in the address
	clause is a call whose name is not a static entity (e.g. a dispatching
	call), treat as dynamic.

2004-09-09  Robert Dewar  <dewar@gnat.com>

	* g-trasym.ads: Minor reformatting

	* exp_ch3.adb (Component_Needs_Simple_Initialization): Don't except
	packed arrays, since unused bits are expected to be zero for a
	comparison.

2004-09-09  Eric Botcazou  <ebotcazou@act-europe.fr>

	* exp_pakd.ads: Fix an inacurracy and a couple of typos in the head
	comment.

2004-09-09  Pascal Obry  <obry@gnat.com>

	* mdll.ads, mdll.adb (Build_Dynamic_Library): New parameter Map_File to
	enable map file generation. Add the right option to generate the map
	file if Map_File is set to True.

	* gnatdll.adb (Gen_Map_File): New variable.
	(Syntax): Add info about new -m (Map_File) option.
	(Parse_Command_Line): Add support for -m option.
	(gnatdll): Pass Gen_Map_File to Build_Dynamic_Library calls.
	Minor reformatting.

2004-09-09  Laurent Pautet  <pautet@act-europe.fr>

	* gnatls.adb: Add a very verbose mode -V. Such mode is required by the
	new gnatdist implementation.
	Define a subpackage isolating the output routines specific to this
	verbose mode.

2004-09-09  Joel Brobecker  <brobecker@gnat.com>

	* Makefile.rtl: (GNATRTL_NONTASKING_OBJS): Add g-dynhta.

	* gnat_ugn.texi (Main Subprograms): Fix typo. Deduced, not deducted.

2004-09-09  Cyrille Comar  <comar@act-europe.fr>

	* opt.adb (Set_Opt_Config_Switches): Use Ada_Version_Runtime to compile
	internal unit.

	* opt.ads: Add Ada_Version_Runtime constant used to decide which
	version of the language is used to compile the run time.

2004-09-09  Arnaud Charlet  <charlet@act-europe.fr>

	* sem_util.adb (Requires_Transient_Scope): Re-enable handling
	of variable length temporaries for function return now that the
	back-end and gigi support it.


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

1 files changed, 285 insertions, 181 deletions

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index c22c192da08..eb25be383f9 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -779,8 +779,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 
       if (attribute == Attr_Max_Size_In_Storage_Elements)
 	gnu_result = convert (sizetype,
-			      fold (build (CEIL_DIV_EXPR, bitsizetype,
-					   gnu_result, bitsize_unit_node)));
+			      fold (build2 (CEIL_DIV_EXPR, bitsizetype,
+					    gnu_result, bitsize_unit_node)));
       break;
 
     case Attr_Alignment:
@@ -1101,8 +1101,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
      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 = fold (build2 (COMPOUND_EXPR, TREE_TYPE (gnu_result),
+			       gnu_prefix, gnu_result));
 
   *gnu_result_type_p = gnu_result_type;
   return gnu_result;
@@ -1197,9 +1197,9 @@ Case_Statement_to_gnu (Node_Id gnat_node)
 	      abort ();
 	    }
 
-	  add_stmt_with_node (build (CASE_LABEL_EXPR, void_type_node,
-				     gnu_low, gnu_high,
-				     create_artificial_label ()),
+	  add_stmt_with_node (build3 (CASE_LABEL_EXPR, void_type_node,
+				      gnu_low, gnu_high,
+				      create_artificial_label ()),
 			      gnat_choice);
 	}
 
@@ -1214,8 +1214,8 @@ Case_Statement_to_gnu (Node_Id gnat_node)
   /* 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);
+  gnu_result = build3 (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
+		       end_stmt_group (), NULL_TREE);
   pop_stack (&gnu_switch_label_stack);
 
   return gnu_result;
@@ -1279,10 +1279,10 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 	  || 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 ());
+	    = build3 (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);
 	}
 
@@ -1485,8 +1485,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
       add_stmt_with_node
 	(build1 (RETURN_EXPR, void_type_node,
-		 build (MODIFY_EXPR, TREE_TYPE (gnu_retval),
-			DECL_RESULT (current_function_decl), gnu_retval)),
+		 build2 (MODIFY_EXPR, TREE_TYPE (gnu_retval),
+			 DECL_RESULT (current_function_decl), gnu_retval)),
 	 gnat_node);
       gnat_poplevel ();
       gnu_result = end_stmt_group ();
@@ -1520,10 +1520,12 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
 /* 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.  */
+   GNU_RESULT_TYPE_P is a pointer to where we should place the result type.
+   If GNU_TARGET is non-null, this must be a function call and the result
+   of the call is to be placed into that object.  */
 
 static tree
-call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
+call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 {
   tree gnu_result;
   /* The GCC node corresponding to the GNAT subprogram name.  This can either
@@ -1566,7 +1568,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	   gnat_actual = Next_Actual (gnat_actual))
 	add_stmt (gnat_to_gnu (gnat_actual));
 
-      if (Nkind (gnat_node) == N_Function_Call)
+      if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
 	{
 	  *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
 	  return build1 (NULL_EXPR, *gnu_result_type_p,
@@ -1576,6 +1578,37 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	return build_call_raise (PE_Stubbed_Subprogram_Called);
     }
 
+  /* If we are calling by supplying a pointer to a target, set up that
+     pointer as the first argument.  Use GNU_TARGET if one was passed;
+     otherwise, make a target by building a variable of the maximum size
+     of the type.  */
+  if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
+    {
+      tree gnu_real_ret_type
+	= TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type)));
+
+      if (!gnu_target)
+	{
+	  tree gnu_obj_type
+	    = maybe_pad_type (gnu_real_ret_type,
+			      max_size (TYPE_SIZE (gnu_real_ret_type), true),
+			      0, Etype (Name (gnat_node)), "PAD", false,
+			      false, false);
+
+	  gnu_target = create_tmp_var_raw (gnu_obj_type, "LR");
+	  gnat_pushdecl (gnu_target, gnat_node);
+	}
+
+      gnu_actual_list
+	= tree_cons (NULL_TREE,
+		     build_unary_op (ADDR_EXPR, NULL_TREE,
+				     unchecked_convert (gnu_real_ret_type,
+							gnu_target,
+							false)),
+		     NULL_TREE);
+						   
+    }
+
   /* 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
@@ -1660,8 +1693,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 		}
 
 	      /* Set up to move the copy back to the original.  */
-	      gnu_temp = build (MODIFY_EXPR, TREE_TYPE (gnu_copy),
-				gnu_copy, gnu_actual);
+	      gnu_temp = build2 (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);
 	    }
@@ -1826,12 +1859,24 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
       gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
     }
 
-  gnu_subprog_call = build (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
-			    gnu_subprog_addr, nreverse (gnu_actual_list),
-			    NULL_TREE);
+  gnu_subprog_call = build3 (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
+			     gnu_subprog_addr, nreverse (gnu_actual_list),
+			     NULL_TREE);
 
-  /* If it is a function call, the result is the call expression.  */
-  if (Nkind (gnat_node) == N_Function_Call)
+  /* If we return by passing a target, we emit the call and return the target
+     as our result.  */
+  if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
+    {
+      add_stmt_with_node (gnu_subprog_call, gnat_node);
+      *gnu_result_type_p
+	= TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type)));
+      return unchecked_convert (*gnu_result_type_p, gnu_target, false);
+    }
+
+  /* If it is a function call, the result is the call expression unless
+     a target is specified, in which case we copy the result into the target
+     and return the assignment statement.  */
+  else if (Nkind (gnat_node) == N_Function_Call)
     {
       gnu_result = gnu_subprog_call;
 
@@ -1841,7 +1886,12 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	  || 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));
+      if (gnu_target)
+	gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+				      gnu_target, gnu_result);
+      else
+	*gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
+
       return gnu_result;
     }
 
@@ -2111,12 +2161,12 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
       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);
+      gnu_result = build3 (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)
     {
@@ -2131,8 +2181,8 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node)
       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);
+      gnu_result = build2 (TRY_CATCH_EXPR, void_type_node,
+			   gnu_inner_block, gnu_handlers);
     }
   else
     gnu_result = gnu_inner_block;
@@ -2225,7 +2275,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node)
 				    gnu_choice, this_choice);
     }
 
-  return build (COND_EXPR, void_type_node, gnu_choice, gnu_body, NULL_TREE);
+  return build3 (COND_EXPR, void_type_node, gnu_choice, gnu_body, NULL_TREE);
 }
 
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler,
@@ -2312,7 +2362,7 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
 
      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_current_exc_ptr = build0 (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,
 					  false, false, false, false, NULL,
@@ -2325,8 +2375,8 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   add_stmt_list (Statements (gnat_node));
   gnat_poplevel ();
 
-  return build (CATCH_EXPR, void_type_node, gnu_etypes_list,
-		end_stmt_group ());
+  return build2 (CATCH_EXPR, void_type_node, gnu_etypes_list,
+		 end_stmt_group ());
 }
 
 /* Subroutine of gnat_to_gnu to generate code for an N_Compilation unit.  */
@@ -2857,13 +2907,13 @@ gnat_to_gnu (Node_Id gnat_node)
                expression if the slice range is not null (max >= min) or
                returns the min if the slice range is null */
             gnu_expr
-              = fold (build (COND_EXPR, gnu_expr_type,
-			     build_binary_op (GE_EXPR, gnu_expr_type,
-					      convert (gnu_expr_type,
-						       gnu_max_expr),
-					      convert (gnu_expr_type,
-						       gnu_min_expr)),
-			     gnu_expr, gnu_min_expr));
+              = fold (build3 (COND_EXPR, gnu_expr_type,
+			      build_binary_op (GE_EXPR, gnu_expr_type,
+					       convert (gnu_expr_type,
+							gnu_max_expr),
+					       convert (gnu_expr_type,
+							gnu_min_expr)),
+			      gnu_expr, gnu_min_expr));
           }
         else
           gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
@@ -3354,26 +3404,32 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Assignment_Statement:
       /* Get the LHS and RHS of the statement and convert any reference to an
-	 unconstrained array into a reference to the underlying array.  */
+	 unconstrained array into a reference to the underlying array.
+	 If we are not to do range checking and the RHS is an N_Function_Call,
+	 pass the LHS to the call function.  */
       gnu_lhs = maybe_unconstrained_array (gnat_to_gnu (Name (gnat_node)));
-      gnu_rhs
-	= maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node)));
-
-      /* If range check is needed, emit code to generate it */
-      if (Do_Range_Check (Expression (gnat_node)))
-	gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)));
 
-      /* If either side's type has a size that overflows, convert this
-	 into raise of Storage_Error: execution shouldn't have gotten
-	 here anyway.  */
-      if ((TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_lhs))) == INTEGER_CST
+      /* If the type has a size that overflows, convert this into raise of
+	 Storage_Error: execution shouldn't have gotten here anyway.  */
+      if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_lhs))) == INTEGER_CST
 	   && TREE_OVERFLOW (TYPE_SIZE (TREE_TYPE (gnu_lhs))))
-	  || (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_rhs))) == INTEGER_CST
-	      && TREE_OVERFLOW (TYPE_SIZE (TREE_TYPE (gnu_rhs)))))
 	gnu_result = build_call_raise (SE_Object_Too_Large);
+      else if (Nkind (Expression (gnat_node)) == N_Function_Call
+	       && !Do_Range_Check (Expression (gnat_node)))
+	gnu_result = call_to_gnu (Expression (gnat_node),
+				  &gnu_result_type, gnu_lhs);
       else
-	gnu_result
-	  = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
+	{
+	  gnu_rhs
+	    = maybe_unconstrained_array (gnat_to_gnu (Expression (gnat_node)));
+
+	  /* If range check is needed, emit code to generate it */
+	  if (Do_Range_Check (Expression (gnat_node)))
+	    gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)));
+
+	  gnu_result
+	    = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
+	}
       break;
 
     case N_If_Statement:
@@ -3381,9 +3437,9 @@ gnat_to_gnu (Node_Id gnat_node)
 	tree *gnu_else_ptr;	/* Point to put next "else if" or "else". */
 
 	/* Make the outer COND_EXPR.  Avoid non-determinism.  */
-	gnu_result = build (COND_EXPR, void_type_node,
-			    gnat_to_gnu (Condition (gnat_node)),
-			    NULL_TREE, NULL_TREE);
+	gnu_result = build3 (COND_EXPR, void_type_node,
+			     gnat_to_gnu (Condition (gnat_node)),
+			     NULL_TREE, NULL_TREE);
 	COND_EXPR_THEN (gnu_result)
 	  = build_stmt_group (Then_Statements (gnat_node), false);
 	TREE_SIDE_EFFECTS (gnu_result) = 1;
@@ -3396,9 +3452,9 @@ gnat_to_gnu (Node_Id gnat_node)
 	  for (gnat_temp = First (Elsif_Parts (gnat_node));
 	       Present (gnat_temp); gnat_temp = Next (gnat_temp))
 	    {
-	      gnu_expr = build (COND_EXPR, void_type_node,
-				gnat_to_gnu (Condition (gnat_temp)),
-				NULL_TREE, NULL_TREE);
+	      gnu_expr = build3 (COND_EXPR, void_type_node,
+				 gnat_to_gnu (Condition (gnat_temp)),
+				 NULL_TREE, NULL_TREE);
 	      COND_EXPR_THEN (gnu_expr)
 		= build_stmt_group (Then_Statements (gnat_temp), false);
 	      TREE_SIDE_EFFECTS (gnu_expr) = 1;
@@ -3433,12 +3489,12 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Exit_Statement:
       gnu_result
-	= build (EXIT_STMT, void_type_node,
-		 (Present (Condition (gnat_node))
-		  ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
-		 (Present (Name (gnat_node))
-		  ? get_gnu_tree (Entity (Name (gnat_node)))
-		  : TREE_VALUE (gnu_loop_label_stack)));
+	= build2 (EXIT_STMT, void_type_node,
+		  (Present (Condition (gnat_node))
+		   ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
+		  (Present (Name (gnat_node))
+		   ? get_gnu_tree (Entity (Name (gnat_node)))
+		   : TREE_VALUE (gnu_loop_label_stack)));
       break;
 
     case N_Return_Statement:
@@ -3446,7 +3502,13 @@ gnat_to_gnu (Node_Id gnat_node)
 	/* The gnu function type of the subprogram currently processed.  */
 	tree gnu_subprog_type = TREE_TYPE (current_function_decl);
 	/* The return value from the subprogram.  */
-	tree gnu_ret_val = 0;
+	tree gnu_ret_val = NULL_TREE;
+	/* The place to put the return value.  */
+	tree gnu_lhs
+	  = (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type)
+	     ? build_unary_op (INDIRECT_REF, NULL_TREE,
+			       DECL_ARGUMENTS (current_function_decl))
+	     : DECL_RESULT (current_function_decl));
 
 	/* If we are dealing with a "return;" from an Ada procedure with
 	   parameters passed by copy in copy out, we need to return a record
@@ -3484,53 +3546,71 @@ gnat_to_gnu (Node_Id gnat_node)
 
 	else if (Present (Expression (gnat_node)))
 	  {
-	    gnu_ret_val = gnat_to_gnu (Expression (gnat_node));
-
-	    /* Do not remove the padding from GNU_RET_VAL if the inner
-	       type is self-referential since we want to allocate the fixed
-	       size in that case.  */
-	    if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
-		&& (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))
-		    == RECORD_TYPE)
-		&& (TYPE_IS_PADDING_P
-		    (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0))))
-		&& (CONTAINS_PLACEHOLDER_P
-		    (TYPE_SIZE (TREE_TYPE (gnu_ret_val)))))
-	      gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
-
-	    if (TYPE_RETURNS_BY_REF_P (gnu_subprog_type)
-		|| By_Ref (gnat_node))
-	      gnu_ret_val = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
-
-	    else if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type))
+	    /* If the current function returns by target pointer and we
+	       are doing a call, pass that target to the call.  */
+	    if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type)
+		&& Nkind (Expression (gnat_node)) == N_Function_Call)
+	      gnu_result = call_to_gnu (Expression (gnat_node),
+					&gnu_result_type, gnu_lhs);
+
+	    else
 	      {
-		gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
-
-		/* We have two cases: either the function returns with
-		   depressed stack or not.  If not, we allocate on the
-		   secondary stack.  If so, we allocate in the stack frame.
-		   if no copy is needed, the front end will set By_Ref,
-		   which we handle in the case above.  */
-		if (TYPE_RETURNS_STACK_DEPRESSED (gnu_subprog_type))
-		  gnu_ret_val
-		    = build_allocator (TREE_TYPE (gnu_ret_val), gnu_ret_val,
-				       TREE_TYPE (gnu_subprog_type), 0, -1,
-				       gnat_node);
-		else
+		gnu_ret_val = gnat_to_gnu (Expression (gnat_node));
+
+		/* Do not remove the padding from GNU_RET_VAL if the inner
+		   type is self-referential since we want to allocate the fixed
+		   size in that case.  */
+		if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
+		    && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))
+			== RECORD_TYPE)
+		    && (TYPE_IS_PADDING_P
+			(TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0))))
+		    && (CONTAINS_PLACEHOLDER_P
+			(TYPE_SIZE (TREE_TYPE (gnu_ret_val)))))
+		  gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
+
+		if (TYPE_RETURNS_BY_REF_P (gnu_subprog_type)
+		    || By_Ref (gnat_node))
 		  gnu_ret_val
-		    = build_allocator (TREE_TYPE (gnu_ret_val), gnu_ret_val,
-				       TREE_TYPE (gnu_subprog_type),
-				       Procedure_To_Call (gnat_node),
-				       Storage_Pool (gnat_node), gnat_node);
+		    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
+
+		else if (TYPE_RETURNS_UNCONSTRAINED_P (gnu_subprog_type))
+		  {
+		    gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
+
+		    /* We have two cases: either the function returns with
+		       depressed stack or not.  If not, we allocate on the
+		       secondary stack.  If so, we allocate in the stack frame.
+		       if no copy is needed, the front end will set By_Ref,
+		       which we handle in the case above.  */
+		    if (TYPE_RETURNS_STACK_DEPRESSED (gnu_subprog_type))
+		      gnu_ret_val
+			= build_allocator (TREE_TYPE (gnu_ret_val),
+					   gnu_ret_val,
+					   TREE_TYPE (gnu_subprog_type),
+					   0, -1, gnat_node);
+		    else
+		      gnu_ret_val
+			= build_allocator (TREE_TYPE (gnu_ret_val),
+					   gnu_ret_val,
+					   TREE_TYPE (gnu_subprog_type),
+					   Procedure_To_Call (gnat_node),
+					   Storage_Pool (gnat_node),
+					   gnat_node);
+		  }
+	      }
+
+	    gnu_result = build2 (MODIFY_EXPR, TREE_TYPE (gnu_ret_val),
+				 gnu_lhs, gnu_ret_val);
+	    if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
+	      {
+		add_stmt_with_node (gnu_result, gnat_node);
+		gnu_ret_val = NULL_TREE;
 	      }
 	  }
 
 	gnu_result =  build1 (RETURN_EXPR, void_type_node,
-			      (gnu_ret_val
-			       ? build (MODIFY_EXPR, TREE_TYPE (gnu_ret_val),
-					DECL_RESULT (current_function_decl),
-					gnu_ret_val)
-			       : NULL_TREE));
+			      gnu_ret_val ? gnu_result : gnu_ret_val);
       }
       break;
 
@@ -3584,7 +3664,7 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Function_Call:
     case N_Procedure_Call_Statement:
-      gnu_result = call_to_gnu (gnat_node, &gnu_result_type);
+      gnu_result = call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE);
       break;
 
     /*************************/
@@ -3788,9 +3868,9 @@ gnat_to_gnu (Node_Id gnat_node)
 
 	  gnu_input_list = nreverse (gnu_input_list);
 	  gnu_output_list = nreverse (gnu_output_list);
-	  gnu_result = build (ASM_EXPR,  void_type_node,
-			      gnu_template, gnu_output_list,
-			      gnu_input_list, gnu_clobber_list);
+	  gnu_result = build4 (ASM_EXPR,  void_type_node,
+			       gnu_template, gnu_output_list,
+			       gnu_input_list, gnu_clobber_list);
 	  ASM_VOLATILE_P (gnu_result) = Is_Asm_Volatile (gnat_node);
 	}
       else
@@ -3889,9 +3969,9 @@ gnat_to_gnu (Node_Id gnat_node)
 	  annotate_with_node (gnu_result, gnat_node);
 
 	  if (Present (Condition (gnat_node)))
-	    gnu_result = build (COND_EXPR, void_type_node,
-				gnat_to_gnu (Condition (gnat_node)),
-				gnu_result, alloc_stmt_list ());
+	    gnu_result = build3 (COND_EXPR, void_type_node,
+				 gnat_to_gnu (Condition (gnat_node)),
+				 gnu_result, alloc_stmt_list ());
 	}
       else
 	gnu_result = build1 (NULL_EXPR, gnu_result_type, gnu_result);
@@ -4079,7 +4159,7 @@ gnat_to_gnu (Node_Id gnat_node)
 static void
 record_code_position (Node_Id gnat_node)
 {
-  tree stmt_stmt = build (STMT_STMT, void_type_node, NULL_TREE);
+  tree stmt_stmt = build1 (STMT_STMT, void_type_node, NULL_TREE);
 
   add_stmt_with_node (stmt_stmt, gnat_node);
   save_gnu_tree (gnat_node, stmt_stmt, true);
@@ -4157,7 +4237,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
      this decl since we already have evaluated the expressions in the
      sizes and positions as globals and doing it again would be wrong.
      But we do have to mark everything as used.  */
-  gnu_stmt = build (DECL_EXPR, void_type_node, gnu_decl);
+  gnu_stmt = build1 (DECL_EXPR, void_type_node, gnu_decl);
   if (!global_bindings_p ())
     add_stmt_with_node (gnu_stmt, gnat_entity);
   else
@@ -4276,12 +4356,12 @@ end_stmt_group ()
     gnu_retval = alloc_stmt_list ();
 
   if (group->cleanups)
-    gnu_retval = build (TRY_FINALLY_EXPR, void_type_node, gnu_retval,
-			group->cleanups);
+    gnu_retval = build2 (TRY_FINALLY_EXPR, void_type_node, gnu_retval,
+			 group->cleanups);
 
   if (current_stmt_group->block)
-    gnu_retval = build (BIND_EXPR, void_type_node, BLOCK_VARS (group->block),
-			gnu_retval, group->block);
+    gnu_retval = build3 (BIND_EXPR, void_type_node, BLOCK_VARS (group->block),
+			 gnu_retval, group->block);
 
   /* Remove this group from the stack and add it to the free list.  */
   current_stmt_group = group->previous;
@@ -4418,10 +4498,33 @@ gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED)
       *expr_p = TREE_OPERAND (*expr_p, 0);
       return GS_OK;
 
+    case ADDR_EXPR:
+      /* If we're taking the address of a constant CONSTRUCTOR, force it to
+	 be put into static memory.  We know it's going to be readonly given
+	 the semantics we have and it's required to be static memory in
+	 the case when the reference is in an elaboration procedure.  */
+      if (TREE_CODE (TREE_OPERAND (expr, 0)) == CONSTRUCTOR
+	  && TREE_CONSTANT (TREE_OPERAND (expr, 0)))
+	{
+	  tree new_var
+	    = create_tmp_var (TREE_TYPE (TREE_OPERAND (expr, 0)), "C");
+
+	  TREE_READONLY (new_var) = 1;
+	  TREE_STATIC (new_var) = 1;
+	  TREE_ADDRESSABLE (new_var) = 1;
+
+	  gimplify_and_add (build2 (MODIFY_EXPR, TREE_TYPE (new_var),
+				    new_var, TREE_OPERAND (expr, 0)),
+			    pre_p);
+
+	  TREE_OPERAND (expr, 0) = new_var;
+	  return GS_ALL_DONE;
+	}
+      return GS_UNHANDLED;
+	 
     case COMPONENT_REF:
-      /* We have a kludge here.  If the FIELD_DECL is from a fat pointer
-	 and is from an early dummy type, replace it with the proper
-	 FIELD_DECL.  */
+      /* We have a kludge here.  If the FIELD_DECL is from a fat pointer and is
+	 from an early dummy type, replace it with the proper FIELD_DECL.  */
       if (TYPE_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (*expr_p, 0)))
 	  && DECL_ORIGINAL_FIELD (TREE_OPERAND (*expr_p, 1)))
 	{
@@ -4472,23 +4575,23 @@ gnat_gimplify_stmt (tree *stmt_p)
 				  stmt_p);
 
 	if (LOOP_STMT_TOP_COND (stmt))
-	  append_to_statement_list (build (COND_EXPR, void_type_node,
-					   LOOP_STMT_TOP_COND (stmt),
-					   alloc_stmt_list (),
-					   build1 (GOTO_EXPR,
-						   void_type_node,
-						   gnu_end_label)),
+	  append_to_statement_list (build3 (COND_EXPR, void_type_node,
+					    LOOP_STMT_TOP_COND (stmt),
+					    alloc_stmt_list (),
+					    build1 (GOTO_EXPR,
+						    void_type_node,
+						    gnu_end_label)),
 				    stmt_p);
 
 	append_to_statement_list (LOOP_STMT_BODY (stmt), stmt_p);
 
 	if (LOOP_STMT_BOT_COND (stmt))
-	  append_to_statement_list (build (COND_EXPR, void_type_node,
-					   LOOP_STMT_BOT_COND (stmt),
-					   alloc_stmt_list (),
-					   build1 (GOTO_EXPR,
-						   void_type_node,
-						   gnu_end_label)),
+	  append_to_statement_list (build3 (COND_EXPR, void_type_node,
+					    LOOP_STMT_BOT_COND (stmt),
+					    alloc_stmt_list (),
+					    build1 (GOTO_EXPR,
+						    void_type_node,
+						    gnu_end_label)),
 				    stmt_p);
 
 	if (LOOP_STMT_UPDATE (stmt))
@@ -4508,8 +4611,8 @@ gnat_gimplify_stmt (tree *stmt_p)
 	 see if it needs to be conditional.  */
       *stmt_p = build1 (GOTO_EXPR, void_type_node, EXIT_STMT_LABEL (stmt));
       if (EXIT_STMT_COND (stmt))
-	*stmt_p = build (COND_EXPR, void_type_node,
-			 EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ());
+	*stmt_p = build3 (COND_EXPR, void_type_node,
+			  EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ());
       return GS_OK;
 
     default:
@@ -4974,17 +5077,17 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason)
      in front of the comparison in case it ends up being a SAVE_EXPR.  Put the
      whole thing inside its own SAVE_EXPR so the inner SAVE_EXPR doesn't leak
      out.  */
-  gnu_result = fold (build (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond,
-			    build (COMPOUND_EXPR, TREE_TYPE (gnu_expr),
-				   gnu_call, gnu_expr),
-			    gnu_expr));
+  gnu_result = fold (build3 (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond,
+			     build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr),
+				     gnu_call, gnu_expr),
+			     gnu_expr));
 
   /* If GNU_EXPR has side effects, make the outer COMPOUND_EXPR and
      protect it.  Otherwise, show GNU_RESULT has no side effects: we
      don't need to evaluate it just for the check.  */
   if (TREE_SIDE_EFFECTS (gnu_expr))
     gnu_result
-      = build (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_expr, gnu_result);
+      = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_expr, gnu_result);
   else
     TREE_SIDE_EFFECTS (gnu_result) = 0;
 
@@ -5107,13 +5210,13 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
       tree gnu_minus_point_5 = build_real (gnu_in_basetype, dconstmp5);
       tree gnu_zero = convert (gnu_in_basetype, integer_zero_node);
       tree gnu_saved_result = save_expr (gnu_result);
-      tree gnu_comp = build (GE_EXPR, integer_type_node,
-			     gnu_saved_result, gnu_zero);
-      tree gnu_adjust = build (COND_EXPR, gnu_in_basetype, gnu_comp,
-			       gnu_point_5, gnu_minus_point_5);
+      tree gnu_comp = build2 (GE_EXPR, integer_type_node,
+			      gnu_saved_result, gnu_zero);
+      tree gnu_adjust = build3 (COND_EXPR, gnu_in_basetype, gnu_comp,
+				gnu_point_5, gnu_minus_point_5);
 
       gnu_result
-	= build (PLUS_EXPR, gnu_in_basetype, gnu_saved_result, gnu_adjust);
+	= build2 (PLUS_EXPR, gnu_in_basetype, gnu_saved_result, gnu_adjust);
     }
 
   if (TREE_CODE (gnu_ada_base_type) == INTEGER_TYPE
@@ -5531,36 +5634,36 @@ gnat_stabilize_reference (tree ref, bool force)
       break;
 
     case COMPONENT_REF:
-      result = build (COMPONENT_REF, type,
-		      gnat_stabilize_reference (TREE_OPERAND (ref, 0),
-						force),
-		      TREE_OPERAND (ref, 1), NULL_TREE);
+      result = build3 (COMPONENT_REF, type,
+		       gnat_stabilize_reference (TREE_OPERAND (ref, 0),
+						 force),
+		       TREE_OPERAND (ref, 1), NULL_TREE);
       break;
 
     case BIT_FIELD_REF:
-      result = build (BIT_FIELD_REF, type,
-		      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
-		      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-						     force),
-		      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
-						  force));
+      result = build3 (BIT_FIELD_REF, type,
+		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
+		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+						   force),
+		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
+						   force));
       break;
 
     case ARRAY_REF:
     case ARRAY_RANGE_REF:
-      result = build (code, type,
-		      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
-		      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-						  force),
-		      NULL_TREE, NULL_TREE);
+      result = build4 (code, type,
+		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
+		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+						   force),
+		       NULL_TREE, NULL_TREE);
       break;
 
     case COMPOUND_EXPR:
-      result = build (COMPOUND_EXPR, type,
-		      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
-						  force),
-		      gnat_stabilize_reference (TREE_OPERAND (ref, 1),
-						force));
+      result = build2 (COMPOUND_EXPR, type,
+		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
+						   force),
+		       gnat_stabilize_reference (TREE_OPERAND (ref, 1),
+						 force));
       break;
 
       /* If arg isn't a kind of lvalue we recognize, make no change.
@@ -5621,10 +5724,10 @@ gnat_stabilize_reference_1 (tree e, bool force)
 	 us to more easily find the match for the PLACEHOLDER_EXPR.  */
       if (code == COMPONENT_REF
 	  && TYPE_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
-	result = build (COMPONENT_REF, type,
-			gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
-						    force),
-			TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+	result = build3 (COMPONENT_REF, type,
+			 gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
+						     force),
+			 TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
       else if (TREE_SIDE_EFFECTS (e) || force)
 	return save_expr (e);
       else
@@ -5638,9 +5741,10 @@ gnat_stabilize_reference_1 (tree e, bool force)
 
     case '2':
       /* Recursively stabilize each operand.  */
-      result = build (code, type,
-		      gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
-		      gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
+      result = build2 (code, type,
+		       gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+		       gnat_stabilize_reference_1 (TREE_OPERAND (e, 1),
+						   force));
       break;
 
     case '1':