OSDN Git Service

* gcc-interface/trans.c (call_to_gnu): In the return-by-target-ptr case
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 7 Apr 2010 10:49:53 +0000 (10:49 +0000)
committerMasaki Muranaka <monaka@monami-software.com>
Sun, 23 May 2010 00:48:22 +0000 (09:48 +0900)
do not set the result type if there is a specified target and do not
convert the result in any cases.
(protect_multiple_eval): Make direct SAVE_EXPR for CALL_EXPR.
(maybe_stabilize_reference) <COMPOUND_EXPR>: Merge with CALL_EXPR.

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

gcc/ada/ChangeLog
gcc/ada/gcc-interface/trans.c

index d5aa53a..89f5cad 100644 (file)
@@ -1,671 +1,3 @@
-2010-05-19  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/misc.c (LANG_HOOKS_DEEP_UNSHARING): Redefine.
-       * gcc-interface/trans.c (unshare_save_expr): Delete.
-       (gigi): Do not unshare trees under SAVE_EXPRs here.
-
-2010-05-18  Nathan Froyd  <froydnj@codesourcery.com>
-
-       * gcc-interface/trans.c (call_to_gnu): Use build_call_vec instead of
-       build_call_list.
-       * gcc-interface/utils.c (build_function_stub): Likewise.
-
-2010-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>
-
-       * gcc-interface/misc.c (gnat_handle_option): Remove special logic
-       for Wuninitialized without -O.
-       
-2010-05-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (enum standard_datatypes): Add new value
-       ADT_exception_data_name_id.
-       (exception_data_name_id): New define.
-       * gcc-interface/trans.c (gigi): Initialize it.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use the standard
-       exception type for standard exception definitions.  Do not make them
-       volatile.
-       <E_Record_Type>: Equate fields of types associated with an exception
-       definition to those of the standard exception type.
-
-2010-05-13  Andreas Schwab  <schwab@linux-m68k.org>
-
-       * tracebak.c (__gnat_backtrace): Mark top_stack with ATTRIBUTE_UNUSED.
-
-2010-05-12  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Access_Type>: Tidy up
-       code, improve comments and fix formatting nits.
-
-2010-05-12  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/utils.c (update_pointer_to): Return early if the old
-       pointer already points to the new type.  Chain the old pointer and its
-       variants at the end of new pointer's chain after updating them.
-
-2010-05-10  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables
-       built for interfaces.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Use
-       imported_p instead of Is_Imported when considering constants.
-       Do not promote alignment of exported objects.
-       <E_Record_Subtype>: Strip all suffixes for dispatch table entities.
-
-2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * exp_disp.adb (Make_Tags): Mark the imported view of dispatch tables.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Make imported
-       constants really constant.
-       <E_Record_Subtype>: Strip the suffix for dispatch table entities.
-
-2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (make_aligning_type): Declare the type.
-
-2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
-       expressions of variant part of record types declared at library level.
-
-2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (create_field_decl): Move PACKED parameter.
-       * gcc-interface/utils.c (create_field_decl): Move PACKED parameter.
-       (rest_of_record_type_compilation): Adjust call to create_field_decl.
-       (make_descriptor_field): Likewise and pass correctly typed constants.
-       (build_unc_object_type): Likewise.
-       (unchecked_convert): Likewise.
-       * gcc-interface/decl.c (elaborate_expression_2): New static function.
-       (gnat_to_gnu_entity): Use it to make alignment factors explicit.
-       Adjust call to create_field_decl.
-       (make_aligning_type): Likewise.
-       (make_packable_type): Likewise.
-       (maybe_pad_type): Likewise.
-       (gnat_to_gnu_field): Likewise.
-       (components_to_record): Likewise.
-       (create_field_decl_from): Likewise.
-       (create_variant_part_from): Remove superfluous test.
-       * gcc-interface/trans.c (gigi): Adjust call to create_field_decl.
-
-2010-05-08  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (build_unc_object_type): Add DEBUG_INFO_P param.
-       (build_unc_object_type_from_ptr): Likewise.
-       * gcc-interface/utils.c (build_unc_object_type): Add DEBUG_INFO_P param
-       and pass it to create_type_decl.  Declare the type.  Simplify.
-       (build_unc_object_type_from_ptr): Add DEBUG_INFO_P parameter and pass
-       it to build_unc_object_type.
-       * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust to above change.
-       * gcc-interface/trans.c (Attribute_to_gnu): Likewise.
-       (gnat_to_gnu): Likewise.
-       * gcc-interface/utils2.c (build_allocator): Likewise.
-
-2010-05-07 Eric Botcazou  <ebotcazou@adacore.com>
-
-       PR 40989
-       * gcc-interface/misc.c (gnat_handle_option): Fix long line.
-
-2010-05-06  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
-
-       * gcc-interface/Makefile.in: Removed mips-sgi-irix5* support.
-
-2010-05-06  Manuel López-Ibáñez  <manu@gcc.gnu.org>
-
-       PR 40989
-       * gcc-interface/misc.c (gnat_handle_option): Add argument kind.
-
-2010-05-02  Giuseppe Scrivano  <gscrivano@gnu.org>
-
-       * gnathtml.pl: Use 755 as mask for new directories.
-
-2010-04-28  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (gnat_gimplify_expr) <ADDR_EXPR>: Uniquize
-       constant constructors before taking their address.
-
-2010-04-25  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * exp_dbug.ads: Fix outdated description.  Mention link between XVS
-       and XVZ objects.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: Set
-       XVZ variable as unit size of XVS type.
-       (maybe_pad_type): Likewise.
-
-2010-04-25  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>: Do not
-       use memmove if the array type is bit-packed.
-
-2010-04-18  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/misc.c (gnat_init): Remove second argument in call to
-       build_common_tree_nodes.
-
-2010-04-18  Ozkan Sezer  <sezeroz@gmail.com>
-
-       * gsocket.h: Make sure that winsock2.h is included before windows.h.
-
-2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/utils2.c (build_unary_op) <ATTR_ADDR_EXPR>: Do not
-       issue warning.
-
-2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * uintp.h (UI_Lt): Declare.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size
-       computation in sizetype.
-       <E_Array_Subtype>: Use unified handling for all index types.  Do not
-       generate MAX_EXPR-based expressions, only COND_EXPR-based ones.  Add
-       bypass for PATs.
-       (annotate_value): Change test for negative values.
-       (validate_size): Apply test for negative values on GNAT nodes.
-       (set_rm_size): Likewise.
-       * gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes.
-       * gcc-interface/utils.c (rest_of_record_type_compilation): Change test
-       for negative values.
-       (max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS.
-       (builtin_type_for_size): Adjust definition of signed_size_type_node.
-       * gcc-interface/utils2.c (compare_arrays): Optimize comparison of
-       lengths against zero.
-
-2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * back-end.adb (Call_Back_End): Pass Standard_Character to gigi.
-       * gcc-interface/gigi.h (gigi): Add standard_character parameter.
-       (CHAR_TYPE_SIZE, SHORT_TYPE_SIZE, INT_TYPE_SIZE, LONG_TYPE_SIZE, 
-       LONG_LONG_TYPE_SIZE, FLOAT_TYPE_SIZE, DOUBLE_TYPE_SIZE,
-       LONG_DOUBLE_TYPE_SIZE, SIZE_TYPE): Delete.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Subtype>: Call
-       rm_size.
-       * gcc-interface/misc.c (gnat_init): Set signedness of char as per
-       flag_signed_char.  Tag sizetype with "size_type" moniker.
-       * gcc-interface/trans.c (gigi): Add standard_character parameter.
-       Remove useless built-in types.  Equate unsigned_char_type_node to
-       Standard.Character.  Use it instead of char_type_node throughout.
-       (Attribute_to_gnu): Likewise.
-       (gnat_to_gnu): Likewise.
-       * gcc-interface/utils2.c (build_call_raise): Likewise.
-
-2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (enum standard_datatypes): Add new values
-       ADT_sbitsize_one_node and ADT_sbitsize_unit_node.
-       (sbitsize_one_node): New macro.
-       (sbitsize_unit_node): Likewise.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Subtype>: Fix
-       latent bug in the computation of subrange_p.  Fold wider_p predicate.
-       (cannot_be_superflat_p): Use an explicitly signed 64-bit type to do
-       the final comparison.
-       (make_aligning_type): Build real negation and use sizetype throughout
-       the offset computation.
-       (maybe_pad_type): Do not issue the warning when the new size expression
-       is too complex.
-       (annotate_value) <INTEGER_CST>: Simplify code handling negative values.
-       * gcc-interface/misc.c (gnat_init): Initialize sbitsize_one_node and
-       sbitsize_unit_node.
-       * gcc-interface/trans.c (Attribute_to_gnu) <Attr_Pool_Address>: Fold
-       double negation.
-       (gnat_to_gnu) <N_Free_Statement>: Likewise.
-       * gcc-interface/utils.c (convert): Use sbitsize_unit_node.
-       * gcc-interface/utils2.c (compare_arrays): Compute real lengths and use
-       constants in sizetype.  Remove dead code and tweak comments.  Generate
-       equality instead of inequality comparisons for zero length tests.
-
-2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (gnat_init_decl_processing): Delete.
-       * gcc-interface/decl.c (gnat_to_gnu_entity): Constify a few variables.
-       <object>: Do not create the fake PARM_DECL if no debug info is needed.
-       Do not create the corresponding VAR_DECL of a CONST_DECL for debugging
-       purposes if no debug info is needed.
-       Fix formatting.  Reorder and add comments.
-       * gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Reference>: Constify
-       variable and remove obsolete comment.
-       * gcc-interface/utils.c (convert_vms_descriptor64): Tweak comment.
-       (convert_vms_descriptor32): Likewise.
-       (convert): Remove dead code.
-       <UNCONSTRAINED_ARRAY_REF>: Pass the field instead of its name to build
-       the reference to the P_ARRAY pointer.
-       <POINTER_TYPE>: Likewise.
-       (maybe_unconstrained_array) <UNCONSTRAINED_ARRAY_TYPE>: Likewise.
-       (gnat_init_decl_processing): Delete, move contents to...
-       * gcc-interface/misc.c (gnat_init): ...here.
-
-2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (unchecked_conversion_nop): Handle function
-       calls.  Return true for conversion from a record subtype to its type.
-
-2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (gnat_to_gnu_entity): Use boolean_type_node in
-       lieu of integer_type_node for boolean operations.
-       (choices_to_gnu): Likewise.
-       * gcc-interface/trans.c (Attribute_to_gnu): Likewise.
-       (Loop_Statement_to_gnu): Likewise.
-       (establish_gnat_vms_condition_handler): Likewise.
-       (Exception_Handler_to_gnu_sjlj): Likewise.
-       (gnat_to_gnu): Likewise.
-       (build_unary_op_trapv): Likewise.
-       (build_binary_op_trapv): Likewise.
-       (emit_range_check): Likewise.
-       (emit_index_check): Likewise.
-       (convert_with_check): Likewise.
-       * gcc-interface/utils.c (convert_vms_descriptor64): Likewise.
-       (convert_vms_descriptor32): Likewise.
-       (convert_vms_descriptor): Likewise.
-       * gcc-interface/utils2.c (nonbinary_modular_operation): Likewise.
-       (compare_arrays): Use boolean instead of integer constants.
-       (build_binary_op) <TRUTH_ANDIF_EXPR, TRUTH_ORIF_EXPR, TRUTH_AND_EXPR,
-       TRUTH_OR_EXPR, TRUTH_XOR_EXPR>: New case.  Check that the result type
-       is a boolean type.
-       <GE_EXPR, LE_EXPR, GT_EXPR, LT_EXPR>: Remove obsolete assertion.
-       <EQ_EXPR, NE_EXPR>: Check that the result type is a boolean type.
-       <PREINC/PREDECREMENT_EXPR, POSTINC/POSTDECREMENT_EXPR>: Delete.
-       <TRUTH_NOT_EXPR>: Check that the result type is a boolean type.
-       (build_unary_op): Use boolean_type_node in lieu of integer_type_node
-       for boolean operations.
-       (fill_vms_descriptor): Likewise.  Fix formatting nits.
-
-2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/ada-tree.def (LOOP_STMT): Change to 4-operand nodes.
-       * gcc-interface/ada-tree.h (LOOP_STMT_TOP_COND, LOOP_STMT_BOT_COND):
-       Merge into...
-       (LOOP_STMT_COND): ...this.
-       (LOOP_STMT_BOTTOM_COND_P): New flag.
-       (LOOP_STMT_TOP_UPDATE_P): Likewise.
-       * gcc-interface/trans.c (can_equal_min_or_max_val_p): New function.
-       (can_equal_min_val_p): New static inline function.
-       (can_equal_max_val_p): Likewise.
-       (Loop_Statement_to_gnu): Use build4 in lieu of build5 and adjust to
-       new LOOP_STMT semantics.  Use two different strategies depending on
-       whether optimization is enabled to translate the loop.
-       (gnat_gimplify_stmt) <LOOP_STMT>: Adjust to new LOOP_STMT semantics.
-
-2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * uintp.adb (UI_From_Dint): Remove useless code.
-       (UI_From_Int): Likewise.
-       * uintp.h: Reorder declarations.
-       (UI_From_gnu): Declare.
-       (UI_Base): Likewise.
-       (Vector_Template): Likewise.
-       (Vector_To_Uint): Likewise.
-       (Uint_0): Remove.
-       (Uint_1): Likewise.
-       * gcc-interface/gigi.h: Tweak comments.
-       * gcc-interface/cuintp.c (UI_From_gnu): New global function.
-       * gcc-interface/decl.c (maybe_pad_type): Do not warn if either size
-       overflows.
-       (annotate_value) <INTEGER_CST>: Call UI_From_gnu.
-       * gcc-interface/trans.c (post_error_ne_num): Call post_error_ne.
-       (post_error_ne_tree): Call UI_From_gnu and post_error_ne.
-       * gcc-interface/utils.c (max_size) <tcc_binary>: Do not special-case
-       TYPE_MAX_VALUE.
-
-2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (make_type_from_size) <INTEGER_TYPE>: Just copy
-       TYPE_NAME.
-       * gcc-interface/trans.c (smaller_packable_type_p): Rename into...
-       (smaller_form_type_p): ...this.  Change parameter and variable names.
-       (call_to_gnu): Use the nominal type of the parameter to create the
-       temporary if it's a smaller form of the actual type.
-       (addressable_p): Return false if the actual type is integral and its
-       size is greater than that of the expected type.
-
-2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
-       * gcc-interface/gigi.h (MARK_VISITED): Skip objects of constant class.
-       (process_attributes): Delete.
-       (post_error_ne_num): Change parameter name.
-       * gcc-interface/decl.c (gnat_to_gnu_entity): Do not force debug info
-       with -g3.  Remove a couple of obsolete lines.  Minor tweaks.
-       If type annotating mode, operate on trees to compute the adjustment to
-       the sizes of tagged types.  Fix long line.
-       (cannot_be_superflat_p): Tweak head comment.
-       (annotate_value): Fold local constant.
-       (set_rm_size): Fix long line.
-       * gcc-interface/trans.c (Identifier_to_gnu): Rework comments.
-       (Attribute_to_gnu): Fix long line.
-       <Attr_Size>: Remove useless assertion.
-       Reorder statements.  Use size_binop routine.
-       (Loop_Statement_to_gnu): Use build5 in lieu of build_nt.
-       Create local variables for the label and the test.  Tweak comments.
-       (Subprogram_Body_to_gnu): Reset cfun to NULL.
-       (Compilation_Unit_to_gnu): Use the Sloc of the Unit node.
-       (process_inlined_subprograms): Integrate into...
-       (Compilation_Unit_to_gnu): ...this.
-       (gnat_to_gnu): Fix long line.
-       (post_error_ne_num): Change parameter name.
-       * gcc-interface/utils.c (process_attributes): Static-ify.
-       <ATTR_MACHINE_ATTRIBUTE>: Set input_location before proceeding.
-       (create_type_decl): Add comment.
-       (create_var_decl_1): Process the attributes after adding the VAR_DECL
-       to the current binding level.
-       (create_subprog_decl): Likewise for the FUNCTION_DECL.
-       (end_subprog_body): Do not reset cfun to NULL.
-       (build_vms_descriptor32): Fix long line.
-       (build_vms_descriptor): Likewise.
-       (handle_nonnull_attribute): Likewise.
-       (convert_vms_descriptor64): Likewise.
-       * gcc-interface/utils2.c (fill_vms_descriptor): Fix long line.
-       (gnat_protect_expr): Fix thinko.
-
-2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (gigi): Set DECL_IGNORED_P on EH functions.
-       (gnat_to_gnu) <N_Op_Eq>: Restore the value of input_location
-       before translating the top-level node.
-       (lvalue_required_p) <N_Function_Call>: Return 1 if !constant.
-       <N_Object_Declaration>: Likewise.
-       <N_Assignment_Statement>: Likewise.
-       <N_Unchecked_Type_Conversion>: Likewise.
-       (call_to_gnu): Remove kludge.
-       (gnat_to_gnu) <N_Return_Statement>: When not optimizing, force labels
-       associated with user returns to be preserved.
-       (gnat_to_gnu): Add special code to deal with boolean rvalues.
-       * gcc-interface/utils2.c (compare_arrays): Set input_location on all
-       comparisons.
-       (build_unary_op) <ADDR_EXPR>: Call build_fold_addr_expr.
-       <INDIRECT_REF>: Call build_fold_indirect_ref.
-
-2010-04-15  Joel Sherrill  <joel.sherrill@oarcorp.com>
-
-       * g-socket.adb: A target can have multiple missing errno's.  This
-       will result in multiple errno's being defined as -1.  Because of this
-       we can not use a case but must use a series of if's to avoid 
-       a duplicate case error in GNAT.Sockets.Resolve_Error.
-
-2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (call_to_gnu): Open a nesting level if this is
-       a statement.  Otherwise, if at top-level, push the processing of the
-       elaboration routine.  In the misaligned case, issue the error messages
-       again on entry and create the temporary explicitly.  Do not issue them
-       for CONSTRUCTORs.
-       For a function call, emit the range check if necessary.
-       In the copy-in copy-out case, create the temporary for the return
-       value explicitly.
-       Do not unnecessarily convert by-ref parameters to the formal's type.
-       Remove obsolete guards in conditions.
-       (gnat_to_gnu) <N_Assignment_Statement>: For a function call, pass the
-       target to call_to_gnu in all cases.
-       (gnat_gimplify_expr) <ADDR_EXPR>: Remove handling of SAVE_EXPR.
-       (addressable_p) <CONSTRUCTOR>: Return false if not static.
-       <COMPOUND_EXPR>: New case.
-       * gcc-interface/utils2.c (build_unary_op) <ADDR_EXPR>: Fold a compound
-       expression if it has unconstrained array type.
-       (gnat_mark_addressable) <COMPOUND_EXPR>: New case.
-       (gnat_stabilize_reference) <COMPOUND_EXPR>: Stabilize operands on an
-       individual basis.
-
-2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (gigi): Do not start statement group.
-       (Compilation_Unit_to_gnu): Set current_function_decl to NULL.
-       Start statement group and push binding level here...
-       (gnat_to_gnu) <N_Compilation_Unit>: ...and not here.
-       Do not push fake contexts at top level.  Remove redundant code.
-       (call_to_gnu): Rename a local variable and constify another.
-       * gcc-interface/utils.c (gnat_pushlevel): Fix formatting nits.
-       (set_current_block_context): Set it as the group's block.
-       (gnat_init_decl_processing): Delete unrelated init code.
-       (end_subprog_body): Use NULL_TREE.
-
-2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (call_to_gnu): Do not unnecessarily force
-       side-effects of actual parameters before the call.
-
-2010-04-15  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (validate_size): Reorder, remove obsolete test
-       and warning.
-       (set_rm_size): Reorder and remove obsolete test.
-
-2010-04-14  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h: Reorder declarations and tweak comments.
-       (gigi): Adjust ATTRIBUTE_UNUSED markers.
-       * gcc-interface/gadaint.h: New file.
-       * gcc-interface/trans.c: Include it in lieu of adaint.h.  Reorder.
-       (__gnat_to_canonical_file_spec): Remove declaration.
-       (number_names): Delete.
-       (number_files): Likewise.
-       (gigi): Adjust.
-       * gcc-interface/Make-lang.in (ada/trans.o): Adjust dependencies to
-       above change.
-
-2010-04-14  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Class_Wide_Type>: Fix
-       comment.
-       * gcc-interface/trans.c (process_freeze_entity): Use local copy of
-       Ekind.  Return early for class-wide types.  Do not compute initializer
-       unless necessary.  Reuse the tree for an associated class-wide type
-       only if processing its root type.
-
-2010-04-13  Joel Sherrill  <joel.sherrill@oarcorp.com>
-
-       * gsocket.h: Run-time can no longer be built without network
-       OS headers available.  Changing RTEMS GNAT build procedure to
-       reflect this and letting run-time build use network .h files.
-
-2010-04-13  Duncan Sands  <baldrick@free.fr>
-
-       * gcc-interface/misc.c (gnat_eh_type_covers): Remove.
-       * gcc-interface/trans.c (Exception_Handler_to_gnu_zcx): Update comment.
-
-2010-04-13  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (standard_datatypes): Add ADT_parent_name_id.
-       (parent_name_id): New macro.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: Use it.
-       * gcc-interface/trans.c (gigi): Initialize it.
-       (lvalue_required_p) <N_Type_Conversion>: New case.
-       <N_Qualified_Expression>: Likewise.
-       <N_Allocator>: Likewise.
-       * gcc-interface/utils.c (convert): Try to properly upcast tagged types.
-
-2010-04-13  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/ada-tree.h (TYPE_BY_REFERENCE_P): Delete.
-       (DECL_CONST_ADDRESS_P): New macro.
-       (SET_DECL_ORIGINAL_FIELD_TO_FIELD): Likewise.
-       (SAME_FIELD_P): Likewise.
-       * gcc-interface/decl.c (constructor_address_p): New static function.
-       (gnat_to_gnu_entity) <object>: Set DECL_CONST_ADDRESS_P according to
-       the return value of above function.
-       (gnat_to_gnu_entity) <E_Record_Type>: Force BLKmode for all types
-       passed by reference.
-       <E_Record_Subtype>: Likewise.
-       Set TREE_ADDRESSABLE on the type if it passed by reference.
-       (make_packable_type): Use SET_DECL_ORIGINAL_FIELD_TO_FIELD.
-       (create_field_decl_from): Likewise.
-       (substitute_in_type): Likewise.
-       (purpose_member_field): Use SAME_FIELD_P.
-       * gcc-interface/misc.c (must_pass_by_ref): Test TREE_ADDRESSABLE.
-       * gcc-interface/trans.c (lvalue_required_p): Add ADDRESS_OF_CONSTANT
-       parameter and adjust recursive calls.
-       <N_Explicit_Dereference>: New case.
-       <N_Object_Declaration>: Return 1 if the object is of a class-wide type.
-       Adjust calls to lvalue_required_p.  Do not return the initializer of a
-       DECL_CONST_ADDRESS_P constant if an lvalue is required for it.
-       (call_to_gnu): Delay issuing error message for a misaligned actual and
-       avoid the associated back-end assertion.  Test TREE_ADDRESSABLE.
-       (gnat_gimplify_expr) <ADDR_EXPR>: Handle non-static constructors.
-       * gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the
-       type is passed by reference.
-       (convert) <CONSTRUCTOR>: Convert in-place in more cases.
-       * gcc-interface/utils2.c (build_cond_expr): Drop TYPE_BY_REFERENCE_P.
-       (build_simple_component_ref): Use SAME_FIELD_P.
-
-2010-04-12  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable.
-       (call_to_gnu): Test gigi's flag TYPE_BY_REFERENCE_P instead of calling
-       front-end's predicate Is_By_Reference_Type.  Use consistent order and
-       remove ??? comment.  Use original conversion in all cases, if any.
-       * gcc-interface/utils.c (make_dummy_type): Minor tweak.
-       (convert): Use local copy in more cases.
-       <INDIRECT_REF>: Remove deactivated code.
-       (unchecked_convert): Use a couple of local copies.
-
-2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (lvalue_required_for_attribute_p): New static
-       function.
-       (lvalue_required_p) <N_Attribute_Reference>: Call it.
-       (gnat_to_gnu) <N_Selected_Component>: Prevent build_component_ref from
-       folding the result only if lvalue_required_for_attribute_p is true.
-       * gcc-interface/utils.c (maybe_unconstrained_array): Pass correctly
-       typed constant to build_component_ref.
-       (unchecked_convert): Likewise.
-       * gcc-interface/utils2.c (maybe_wrap_malloc): Likewise.
-       (build_allocator): Likewise.
-
-2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/utils2.c (build_cond_expr): Take the address and
-       dereference if the result type is passed by reference.
-
-2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/trans.c (Case_Statement_to_gnu): Bool-ify variable.
-       (gnat_to_gnu) <N_Null_Statement>: When not optimizing, generate a
-       goto to the next statement.
-
-2010-04-09  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (maybe_variable): Delete.
-       (protect_multiple_eval): Likewise.
-       (maybe_stabilize_reference): Likewise.
-       (gnat_save_expr): Declare.
-       (gnat_protect_expr): Likewise.
-       (gnat_stabilize_reference): Likewise.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
-       gnat_stabilize_reference.
-       (maybe_variable): Delete.
-       (elaborate_expression_1): Use gnat_save_expr.
-       * gcc-interface/trans.c (Attribute_to_gnu): Use gnat_protect_expr.
-       (call_to_gnu): Pass NULL to gnat_stabilize_reference.
-       (gnat_to_gnu) <N_Object_Declaration>: Use gnat_save_expr.
-       <N_Slice>: Use gnat_protect_exp.
-       <N_Selected_Component>: Pass NULL to gnat_stabilize_reference.
-       <N_In>: Use gnat_protect_expr.
-       Pass NULL to gnat_stabilize_reference.
-       (build_unary_op_trapv): Use gnat_protect_expr.
-       (build_binary_op_trapv): Likewise.
-       (emit_range_check): Likewise.
-       (emit_index_check): Likewise.
-       (convert_with_check): Likewise.
-       (protect_multiple_eval): Move to utils2.c file.
-       (maybe_stabilize_reference): Merge into...
-       (gnat_stabilize_reference): ...this.  Move to utils2.c file.
-       (gnat_stabilize_reference_1): Likewise.
-       * gcc-interface/utils.c (convert_to_fat_pointer): Use gnat_protect_expr
-       instead of protect_multiple_eval.
-       * gcc-interface/utils2.c (compare_arrays): Likewise.
-       (nonbinary_modular_operation): Likewise.
-       (maybe_wrap_malloc): Likewise.
-       (build_allocator): Likewise.
-       (gnat_save_expr): New function.
-       (gnat_protect_expr): Rename from protect_multiple_eval.  Early return
-       in common cases.  Propagate TREE_READONLY onto dereferences.
-       (gnat_stabilize_reference_1): Move from trans.c file.
-       (gnat_stabilize_reference): Likewise.
-
-2010-04-09  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.
-       * gcc-interface/decl.c (maybe_variable): Do not set TREE_STATIC on _REF
-       node.  Use the type of the operand to set TREE_READONLY.
-       * gcc-interface/trans.c (Identifier_to_gnu): Do not set TREE_STATIC on
-       _REF node.  Do not overwrite TREE_READONLY.
-       (call_to_gnu): Rename local variable and fix various nits.  In the
-       copy-in/copy-out case, build the SAVE_EXPR manually.
-       (convert_with_check): Call protect_multiple_eval in lieu of save_expr
-       and fold the computations.
-       (protect_multiple_eval): Always save entire fat pointers.
-       (maybe_stabilize_reference): Minor tweaks.
-       (gnat_stabilize_reference_1): Likewise.  Do not deal with tcc_constant,
-       tcc_type and tcc_statement.
-       * gcc-interface/utils.c (convert_to_fat_pointer): Call
-       protect_multiple_eval in lieu of save_expr.
-       (convert): Minor tweaks.
-       (maybe_unconstrained_array): Do not set TREE_STATIC on _REF node.
-       (builtin_type_for_size): Call gnat_type_for_size directly.
-       * gcc-interface/utils2.c (contains_save_expr_p): Delete.
-       (contains_null_expr): Likewise
-       (gnat_build_constructor): Do not call it.
-       (compare_arrays): Deal with all side-effects, use protect_multiple_eval
-       instead of gnat_stabilize_reference to protect the operands.
-       (nonbinary_modular_operation): Call protect_multiple_eval in lieu of
-       save_expr.
-       (maybe_wrap_malloc): Likewise.
-       (build_allocator): Likewise.
-       (build_unary_op) <INDIRECT_REF>: Do not set TREE_STATIC on _REF node.
-       (gnat_mark_addressable): Rename parameter.
-
-2010-04-08  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/ada-tree.h (TYPE_RETURNS_UNCONSTRAINED_P): Rename into.
-       (TYPE_RETURN_UNCONSTRAINED_P): ...this.
-       (TYPE_RETURNS_BY_REF_P): Rename into.
-       (TYPE_RETURN_BY_DIRECT_REF_P): ...this.
-       (TYPE_RETURNS_BY_TARGET_PTR_P): Delete.
-       * gcc-interface/gigi.h (create_subprog_type): Adjust parameter names.
-       (build_return_expr): Likewise.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>:
-       Rename local variables.  If the return Mechanism is By_Reference, pass
-       return_by_invisible_ref_p to create_subprog_type instead of toggling
-       TREE_ADDRESSABLE.  Test return_by_invisible_ref_p in order to annotate
-       the mechanism.  Use regular return for contrained types with non-static
-       size and return by invisible reference for unconstrained return types
-       with default discriminants.  Update comment.
-       * gcc-interface/trans.c (Subprogram_Body_to_gnu): If the function
-       returns by invisible reference, turn the RESULT_DECL into a pointer.
-       Do not handle DECL_BY_REF_P in the CICO case here.
-       (call_to_gnu): Remove code handling return by target pointer.  For a
-       function call, if the return type has non-constant size, generate the
-       assignment with an INIT_EXPR.
-       (gnat_to_gnu) <N_Return_Statement>: Remove dead code in the CICO case.
-       If the function returns by invisible reference, build the copy return
-       operation manually.
-       (add_decl_expr): Initialize the variable with an INIT_EXPR.
-       * gcc-interface/utils.c (create_subprog_type): Adjust parameter names.
-       Adjust for renaming of macros.  Copy the node only when necessary.
-       (create_subprog_decl): Do not toggle TREE_ADDRESSABLE on the return
-       type, only change DECL_BY_REFERENCE on the RETURN_DECL.
-       (convert_from_reference): Delete.
-       (is_byref_result): Likewise.
-       (gnat_genericize_r): Likewise.
-       (gnat_genericize): Likewise.
-       (end_subprog_body): Do not call gnat_genericize.
-       * gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: New case.
-       (build_return_expr): Adjust parameter names, logic and comment.
-
-2010-04-07  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * exp_pakd.adb (Create_Packed_Array_Type): Always use a modular type
-       if the size is small enough.  Propagate the alignment if there is an
-       alignment clause on the original array type.
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Subtype>
-       Deal with under-aligned packed array types.  Copy the size onto the
-       justified modular type and don't lay it out again.  Likewise for the
-       padding type built for other under-aligned subtypes.
-       * gcc-interface/utils.c (finish_record_type): Do not set a default mode
-       on the type.
-
-2010-04-07  Eric Botcazou  <ebotcazou@adacore.com>
-
-       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Procedure>: Set default
-       alignment on the RETURN type built for the Copy-In Copy-Out mechanism.
-
 2010-04-07  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (call_to_gnu): In the return-by-target-ptr case
index b025020..fb770e8 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -49,7 +49,6 @@
 #include "fe.h"
 #include "sinfo.h"
 #include "einfo.h"
-#include "gadaint.h"
 #include "ada-tree.h"
 #include "gigi.h"
 
 #endif
 #endif
 
-/* Pointers to front-end tables accessed through macros.  */
+extern char *__gnat_to_canonical_file_spec (char *);
+
+int max_gnat_nodes;
+int number_names;
+int number_files;
 struct Node *Nodes_Ptr;
 Node_Id *Next_Node_Ptr;
 Node_Id *Prev_Node_Ptr;
@@ -86,20 +89,14 @@ struct String_Entry *Strings_Ptr;
 Char_Code *String_Chars_Ptr;
 struct List_Header *List_Headers_Ptr;
 
-/* Highest number in the front-end node table.  */
-int max_gnat_nodes;
-
-/* Current node being treated, in case abort called.  */
-Node_Id error_gnat_node;
+/* Current filename without path.  */
+const char *ref_filename;
 
 /* True when gigi is being called on an analyzed but unexpanded
    tree, and the only purpose of the call is to properly annotate
    types with representation information.  */
 bool type_annotate_only;
 
-/* Current filename without path.  */
-const char *ref_filename;
-
 /* When not optimizing, we cache the 'First, 'Last and 'Length attributes
    of unconstrained array IN parameters to avoid emitting a great deal of
    redundant instructions to recompute them each time.  */
@@ -186,11 +183,15 @@ static GTY(()) tree gnu_program_error_label_stack;
 /* Map GNAT tree codes to GCC tree codes for simple expressions.  */
 static enum tree_code gnu_codes[Number_Node_Kinds];
 
+/* Current node being treated, in case abort called.  */
+Node_Id error_gnat_node;
+
 static void init_code_table (void);
 static void Compilation_Unit_to_gnu (Node_Id);
 static void record_code_position (Node_Id);
 static void insert_code_for (Node_Id);
 static void add_cleanup (tree, Node_Id);
+static tree unshare_save_expr (tree *, int *, void *);
 static void add_stmt_list (List_Id);
 static void push_exception_label_stack (tree *, Entity_Id);
 static tree build_stmt_group (List_Id, bool);
@@ -199,6 +200,7 @@ static void pop_stack (tree *);
 static enum gimplify_status gnat_gimplify_stmt (tree *);
 static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
+static void process_inlined_subprograms (Node_Id);
 static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
 static tree emit_range_check (tree, Node_Id, Node_Id);
 static tree emit_index_check (tree, tree, tree, tree, Node_Id);
@@ -206,14 +208,16 @@ static tree emit_check (tree, tree, int, Node_Id);
 static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
 static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
 static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
-static bool smaller_form_type_p (tree, tree);
+static bool smaller_packable_type_p (tree, tree);
 static bool addressable_p (tree, tree);
 static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
 static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
+static tree gnat_stabilize_reference (tree, bool);
+static tree gnat_stabilize_reference_1 (tree, bool);
 static void set_expr_location_from_node (tree, Node_Id);
-static int lvalue_required_p (Node_Id, tree, bool, bool, bool);
+static int lvalue_required_p (Node_Id, tree, bool, bool);
 
 /* Hooks for debug info back-ends, only supported and used in a restricted set
    of configurations.  */
@@ -224,14 +228,13 @@ static const char *decode_name (const char *) ATTRIBUTE_UNUSED;
    structures and then generates code.  */
 
 void
-gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
+gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
       struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr,
       struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
       struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
       struct List_Header *list_headers_ptr, Nat number_file,
-      struct File_Info_Type *file_info_ptr,
-      Entity_Id standard_boolean, Entity_Id standard_integer,
-      Entity_Id standard_character, Entity_Id standard_long_long_float,
+      struct File_Info_Type *file_info_ptr, Entity_Id standard_boolean,
+      Entity_Id standard_integer, Entity_Id standard_long_long_float,
       Entity_Id standard_exception_type, Int gigi_operating_mode)
 {
   Entity_Id gnat_literal;
@@ -241,7 +244,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
   int i;
 
   max_gnat_nodes = max_gnat_node;
-
+  number_names = number_name;
+  number_files = number_file;
   Nodes_Ptr = nodes_ptr;
   Next_Node_Ptr = next_node_ptr;
   Prev_Node_Ptr = prev_node_ptr;
@@ -260,7 +264,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
   t = create_concat_name (Defining_Entity (Unit (gnat_root)), NULL);
   first_global_object_name = ggc_strdup (IDENTIFIER_POINTER (t));
 
-  for (i = 0; i < number_file; i++)
+  for (i = 0; i < number_files; i++)
     {
       /* Use the identifier table to make a permanent copy of the filename as
         the name table gets reallocated after Gigi returns but before all the
@@ -317,26 +321,23 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
   double_float_alignment = get_target_double_float_alignment ();
   double_scalar_alignment = get_target_double_scalar_alignment ();
 
-  /* Record the builtin types.  Define `integer' and `character' first so that
-     dbx will output them first.  */
+  /* Record the builtin types.  Define `integer' and `unsigned char' first so
+     that dbx will output them first.  */
   record_builtin_type ("integer", integer_type_node);
-  record_builtin_type ("character", unsigned_char_type_node);
+  record_builtin_type ("unsigned char", char_type_node);
+  record_builtin_type ("long integer", long_integer_type_node);
+  unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
+  record_builtin_type ("unsigned int", unsigned_type_node);
+  record_builtin_type (SIZE_TYPE, sizetype);
   record_builtin_type ("boolean", boolean_type_node);
   record_builtin_type ("void", void_type_node);
 
   /* Save the type we made for integer as the type for Standard.Integer.  */
-  save_gnu_tree (Base_Type (standard_integer),
-                TYPE_NAME (integer_type_node),
-                false);
-
-  /* Likewise for character as the type for Standard.Character.  */
-  save_gnu_tree (Base_Type (standard_character),
-                TYPE_NAME (unsigned_char_type_node),
+  save_gnu_tree (Base_Type (standard_integer), TYPE_NAME (integer_type_node),
                 false);
 
-  /* Likewise for boolean as the type for Standard.Boolean.  */
-  save_gnu_tree (Base_Type (standard_boolean),
-                TYPE_NAME (boolean_type_node),
+  /* Save the type we made for boolean as the type for Standard.Boolean.  */
+  save_gnu_tree (Base_Type (standard_boolean), TYPE_NAME (boolean_type_node),
                 false);
   gnat_literal = First_Literal (Base_Type (standard_boolean));
   t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
@@ -397,13 +398,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
                                                     int64_type, NULL_TREE),
                           NULL_TREE, false, true, true, NULL, Empty);
 
-  /* Name of the _Parent field in tagged record types.  */
-  parent_name_id = get_identifier (Get_Name_String (Name_uParent));
-
-  /* Name of the Exception_Data type defined in System.Standard_Library.  */
-  exception_data_name_id
-    = get_identifier ("system__standard_library__exception_data");
-
   /* Make the types and functions used for exception processing.  */
   jmpbuf_type
     = build_array_type (gnat_type_for_mode (Pmode, 0),
@@ -419,7 +413,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
      NULL_TREE, false, true, true, NULL, Empty);
   /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
   DECL_PURE_P (get_jmpbuf_decl) = 1;
-  DECL_IGNORED_P (get_jmpbuf_decl) = 1;
 
   set_jmpbuf_decl
     = create_subprog_decl
@@ -428,7 +421,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
      build_function_type (void_type_node,
                          tree_cons (NULL_TREE, jmpbuf_ptr_type, t)),
      NULL_TREE, false, true, true, NULL, Empty);
-  DECL_IGNORED_P (set_jmpbuf_decl) = 1;
 
   /* setjmp returns an integer and has one operand, which is a pointer to
      a jmpbuf.  */
@@ -438,6 +430,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
        build_function_type (integer_type_node,
                            tree_cons (NULL_TREE,  jmpbuf_ptr_type, t)),
        NULL_TREE, false, true, true, NULL, Empty);
+
   DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
   DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
 
@@ -449,6 +442,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
        build_function_type (void_type_node,
                            tree_cons (NULL_TREE,  jmpbuf_ptr_type, t)),
        NULL_TREE, false, true, true, NULL, Empty);
+
   DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
   DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
 
@@ -460,7 +454,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
                                                           ptr_void_type_node,
                                                           t)),
                           NULL_TREE, false, true, true, NULL, Empty);
-  DECL_IGNORED_P (begin_handler_decl) = 1;
 
   end_handler_decl
     = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
@@ -469,7 +462,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
                                                           ptr_void_type_node,
                                                           t)),
                           NULL_TREE, false, true, true, NULL, Empty);
-  DECL_IGNORED_P (end_handler_decl) = 1;
 
   /* If in no exception handlers mode, all raise statements are redirected to
      __gnat_last_chance_handler.  No need to redefine raise_nodefer_decl since
@@ -481,8 +473,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
          (get_identifier ("__gnat_last_chance_handler"), NULL_TREE,
           build_function_type (void_type_node,
                                tree_cons (NULL_TREE,
-                                          build_pointer_type
-                                          (unsigned_char_type_node),
+                                          build_pointer_type (char_type_node),
                                           tree_cons (NULL_TREE,
                                                      integer_type_node,
                                                      t))),
@@ -504,7 +495,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
             build_function_type (void_type_node,
                                  tree_cons (NULL_TREE,
                                             build_pointer_type
-                                            (unsigned_char_type_node),
+                                            (char_type_node),
                                             tree_cons (NULL_TREE,
                                                        integer_type_node,
                                                        t))),
@@ -520,7 +511,9 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
                                TYPE_QUAL_VOLATILE);
     }
 
-  /* Set the types that GCC and Gigi use from the front end.  */
+  /* Set the types that GCC and Gigi use from the front end.  We would
+     like to do this for char_type_node, but it needs to correspond to
+     the C char type.  */
   exception_type
     = gnat_to_gnu_entity (Base_Type (standard_exception_type),  NULL_TREE, 0);
   except_type_node = TREE_TYPE (exception_type);
@@ -562,9 +555,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
 
       for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
        {
-         tree field
-           = create_field_decl (NULL_TREE, ptr_void_ftype, fdesc_type_node,
-                                NULL_TREE, NULL_TREE, 0, 1);
+         tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
+                                         fdesc_type_node, 0, 0, 0, 1);
          TREE_CHAIN (field) = field_list;
          field_list = field;
          null_list = tree_cons (field, null_node, null_list);
@@ -628,6 +620,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
     gnat_init_gcc_eh ();
 
   /* Now translate the compilation unit proper.  */
+  start_stmt_group ();
   Compilation_Unit_to_gnu (gnat_root);
 
   /* Finally see if we have any elaboration procedures to deal with.  */
@@ -635,6 +628,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
     {
       tree gnu_body = DECL_SAVED_TREE (info->elab_proc), gnu_stmts;
 
+      /* Unshare SAVE_EXPRs between subprograms.  These are not unshared by
+        the gimplifier for obvious reasons, but it turns out that we need to
+        unshare them for the global level because of SAVE_EXPRs made around
+        checks for global objects and around allocators for global objects
+        of variable size, in order to prevent node sharing in the underlying
+        expression.  Note that this implicitly assumes that the SAVE_EXPR
+        nodes themselves are not shared between subprograms, which would be
+        an upstream bug for which we would not change the outcome.  */
+      walk_tree_without_duplicates (&gnu_body, unshare_save_expr, NULL);
+
       /* We should have a BIND_EXPR but it may not have any statements in it.
         If it doesn't have any, we have nothing to do except for setting the
         flag on the GNAT node.  Otherwise, process the function as others.  */
@@ -654,57 +657,11 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
   error_gnat_node = Empty;
 }
 \f
-/* Return a positive value if an lvalue is required for GNAT_NODE, which is
-   an N_Attribute_Reference.  */
-
-static int
-lvalue_required_for_attribute_p (Node_Id gnat_node)
-{
-  switch (Get_Attribute_Id (Attribute_Name (gnat_node)))
-    {
-    case Attr_Pos:
-    case Attr_Val:
-    case Attr_Pred:
-    case Attr_Succ:
-    case Attr_First:
-    case Attr_Last:
-    case Attr_Range_Length:
-    case Attr_Length:
-    case Attr_Object_Size:
-    case Attr_Value_Size:
-    case Attr_Component_Size:
-    case Attr_Max_Size_In_Storage_Elements:
-    case Attr_Min:
-    case Attr_Max:
-    case Attr_Null_Parameter:
-    case Attr_Passed_By_Reference:
-    case Attr_Mechanism_Code:
-      return 0;
-
-    case Attr_Address:
-    case Attr_Access:
-    case Attr_Unchecked_Access:
-    case Attr_Unrestricted_Access:
-    case Attr_Code_Address:
-    case Attr_Pool_Address:
-    case Attr_Size:
-    case Attr_Alignment:
-    case Attr_Bit_Position:
-    case Attr_Position:
-    case Attr_First_Bit:
-    case Attr_Last_Bit:
-    case Attr_Bit:
-    default:
-      return 1;
-    }
-}
-
 /* Return a positive value if an lvalue is required for GNAT_NODE.  GNU_TYPE
    is the type that will be used for GNAT_NODE in the translated GNU tree.
    CONSTANT indicates whether the underlying object represented by GNAT_NODE
-   is constant in the Ada sense.  If it is, ADDRESS_OF_CONSTANT indicates
-   whether its value is the address of a constant and ALIASED whether it is
-   aliased.  If it isn't, ADDRESS_OF_CONSTANT and ALIASED are ignored.
+   is constant in the Ada sense, ALIASED whether it is aliased (but the latter
+   doesn't affect the outcome if CONSTANT is not true).
 
    The function climbs up the GNAT tree starting from the node and returns 1
    upon encountering a node that effectively requires an lvalue downstream.
@@ -713,7 +670,7 @@ lvalue_required_for_attribute_p (Node_Id gnat_node)
 
 static int
 lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
-                  bool address_of_constant, bool aliased)
+                  bool aliased)
 {
   Node_Id gnat_parent = Parent (gnat_node), gnat_temp;
 
@@ -723,15 +680,23 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
       return 1;
 
     case N_Attribute_Reference:
-      return lvalue_required_for_attribute_p (gnat_parent);
+      {
+       unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_parent));
+       return id == Attr_Address
+              || id == Attr_Access
+              || id == Attr_Unchecked_Access
+              || id == Attr_Unrestricted_Access
+              || id == Attr_Bit_Position
+              || id == Attr_Position
+              || id == Attr_First_Bit
+              || id == Attr_Last_Bit
+              || id == Attr_Bit;
+      }
 
     case N_Parameter_Association:
     case N_Function_Call:
     case N_Procedure_Call_Statement:
-      /* If the parameter is by reference, an lvalue is required.  */
-      return (!constant
-             || must_pass_by_ref (gnu_type)
-             || default_pass_by_ref (gnu_type));
+      return (must_pass_by_ref (gnu_type) || default_pass_by_ref (gnu_type));
 
     case N_Indexed_Component:
       /* Only the array expression can require an lvalue.  */
@@ -756,13 +721,11 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
        return 0;
 
       aliased |= Has_Aliased_Components (Etype (gnat_node));
-      return lvalue_required_p (gnat_parent, gnu_type, constant,
-                               address_of_constant, aliased);
+      return lvalue_required_p (gnat_parent, gnu_type, constant, aliased);
 
     case N_Selected_Component:
       aliased |= Is_Aliased (Entity (Selector_Name (gnat_parent)));
-      return lvalue_required_p (gnat_parent, gnu_type, constant,
-                               address_of_constant, aliased);
+      return lvalue_required_p (gnat_parent, gnu_type, constant, aliased);
 
     case N_Object_Renaming_Declaration:
       /* We need to make a real renaming only if the constant object is
@@ -780,57 +743,22 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
     case N_Object_Declaration:
       /* We cannot use a constructor if this is an atomic object because
         the actual assignment might end up being done component-wise.  */
-      return (!constant
-             ||(Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
-                && Is_Atomic (Defining_Entity (gnat_parent)))
-             /* We don't use a constructor if this is a class-wide object
-                because the effective type of the object is the equivalent
-                type of the class-wide subtype and it smashes most of the
-                data into an array of bytes to which we cannot convert.  */
-             || Ekind ((Etype (Defining_Entity (gnat_parent))))
-                == E_Class_Wide_Subtype);
+      return Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
+            && Is_Atomic (Defining_Entity (gnat_parent));
 
     case N_Assignment_Statement:
       /* We cannot use a constructor if the LHS is an atomic object because
         the actual assignment might end up being done component-wise.  */
-      return (!constant
-             || Name (gnat_parent) == gnat_node
+      return (Name (gnat_parent) == gnat_node
              || (Is_Composite_Type (Underlying_Type (Etype (gnat_node)))
                  && Is_Atomic (Entity (Name (gnat_parent)))));
 
-    case N_Type_Conversion:
-    case N_Qualified_Expression:
-      /* We must look through all conversions for composite types because we
-        may need to bypass an intermediate conversion to a narrower record
-        type that is generated for a formal conversion, e.g. the conversion
-        to the root type of a hierarchy of tagged types generated for the
-        formal conversion to the class-wide type.  */
-      if (!Is_Composite_Type (Underlying_Type (Etype (gnat_node))))
-       return 0;
-
-      /* ... fall through ... */
-
     case N_Unchecked_Type_Conversion:
-      return (!constant
-             || lvalue_required_p (gnat_parent,
-                                   get_unpadded_type (Etype (gnat_parent)),
-                                   constant, address_of_constant, aliased));
-
-    case N_Allocator:
-      /* We should only reach here through the N_Qualified_Expression case
-        and, therefore, only for composite types.  Force an lvalue since
-        a block-copy to the newly allocated area of memory is made.  */
-      return 1;
-
-   case N_Explicit_Dereference:
-      /* We look through dereferences for address of constant because we need
-        to handle the special cases listed above.  */
-      if (constant && address_of_constant)
-       return lvalue_required_p (gnat_parent,
-                                 get_unpadded_type (Etype (gnat_parent)),
-                                 true, false, true);
-
-      /* ... fall through ... */
+      /* Returning 0 is very likely correct but we get better code if we
+        go through the conversion.  */
+      return lvalue_required_p (gnat_parent,
+                               get_unpadded_type (Etype (gnat_parent)),
+                               constant, aliased);
 
     default:
       return 0;
@@ -935,13 +863,12 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      statement alternative or a record discriminant.  There is no possible
      volatile-ness short-circuit here since Volatile constants must bei
      imported per C.6.  */
-  if (Ekind (gnat_temp) == E_Constant
-      && Is_Scalar_Type (gnat_temp_type)
+  if (Ekind (gnat_temp) == E_Constant && Is_Scalar_Type (gnat_temp_type)
       && !Is_Imported (gnat_temp)
       && Present (Address_Clause (gnat_temp)))
     {
       require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true,
-                                         false, Is_Aliased (gnat_temp));
+                                         Is_Aliased (gnat_temp));
       use_constant_initializer = !require_lvalue;
     }
 
@@ -987,7 +914,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
          || (TREE_CODE (gnu_result) == PARM_DECL
              && DECL_BY_COMPONENT_PTR_P (gnu_result))))
     {
-      const bool read_only = DECL_POINTS_TO_READONLY_P (gnu_result);
+      bool ro = DECL_POINTS_TO_READONLY_P (gnu_result);
       tree renamed_obj;
 
       if (TREE_CODE (gnu_result) == PARM_DECL
@@ -1001,8 +928,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
         we can reference the renamed object directly, since the renamed
         expression has been protected against multiple evaluations.  */
       else if (TREE_CODE (gnu_result) == VAR_DECL
-              && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result))
-              && (!DECL_RENAMING_GLOBAL_P (gnu_result)
+              && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result)) != 0
+              && (! DECL_RENAMING_GLOBAL_P (gnu_result)
                   || global_bindings_p ()))
        gnu_result = renamed_obj;
 
@@ -1015,8 +942,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
       else
        gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
 
-      if (read_only)
-       TREE_READONLY (gnu_result) = 1;
+      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
@@ -1030,35 +956,30 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
        gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
     }
 
-  /* If we have a constant declaration and its initializer, try to return the
-     latter to avoid the need to call fold in lots of places and the need for
-     elaboration code if this identifier is used as an initializer itself.  */
+  /* If we have a constant declaration and its initializer at hand,
+     try to return the latter to avoid the need to call fold in lots
+     of places and the need of elaboration code if this Id is used as
+     an initializer itself.  */
   if (TREE_CONSTANT (gnu_result)
       && DECL_P (gnu_result)
       && DECL_INITIAL (gnu_result))
     {
-      bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL
-                           && !DECL_CONST_CORRESPONDING_VAR (gnu_result));
-      bool address_of_constant = (TREE_CODE (gnu_result) == CONST_DECL
-                                 && DECL_CONST_ADDRESS_P (gnu_result));
-
-      /* If there is a (corresponding) variable or this is the address of a
-        constant, we only want to return the initializer if an lvalue isn't
-        required.  Evaluate this now if we have not already done so.  */
-      if ((!constant_only || address_of_constant) && require_lvalue < 0)
-       require_lvalue
-         = lvalue_required_p (gnat_node, gnu_result_type, true,
-                              address_of_constant, Is_Aliased (gnat_temp));
-
-      /* ??? We need to unshare the initializer if the object is external
-        as such objects are not marked for unsharing if we are not at the
-        global level.  This should be fixed in add_decl_expr.  */
-      if ((constant_only && !address_of_constant) || !require_lvalue)
+      tree object
+       = (TREE_CODE (gnu_result) == CONST_DECL
+          ? DECL_CONST_CORRESPONDING_VAR (gnu_result) : gnu_result);
+
+      /* If there is a corresponding variable, we only want to return
+        the CST value if an lvalue is not required.  Evaluate this
+        now if we have not already done so.  */
+      if (object && require_lvalue < 0)
+       require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true,
+                                           Is_Aliased (gnat_temp));
+
+      if (!object || !require_lvalue)
        gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
   *gnu_result_type_p = gnu_result_type;
-
   return gnu_result;
 }
 \f
@@ -1206,10 +1127,10 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 
       if (Do_Range_Check (First (Expressions (gnat_node))))
        {
-         gnu_expr = gnat_protect_expr (gnu_expr);
+         gnu_expr = protect_multiple_eval (gnu_expr);
          gnu_expr
            = emit_check
-             (build_binary_op (EQ_EXPR, boolean_type_node,
+             (build_binary_op (EQ_EXPR, integer_type_node,
                                gnu_expr,
                                attribute == Attr_Pred
                                ? TYPE_MIN_VALUE (gnu_result_type)
@@ -1351,12 +1272,16 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
        if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
            && TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
          {
-           tree gnu_char_ptr_type
-             = build_pointer_type (unsigned_char_type_node);
+           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 (sizetype,
+                        size_diffop (size_zero_node, gnu_pos));
+           gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+
            gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
            gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
-                                      gnu_ptr, gnu_pos);
+                                      gnu_ptr, gnu_byte_offset);
          }
 
        gnu_result = convert (gnu_result_type, gnu_ptr);
@@ -1440,8 +1365,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
                  gnu_type
                    = build_unc_object_type_from_ptr (gnu_ptr_type,
                                                      gnu_actual_obj_type,
-                                                     get_identifier ("SIZE"),
-                                                     false);
+                                                     get_identifier ("SIZE"));
                }
 
              gnu_result = TYPE_SIZE (gnu_type);
@@ -1452,14 +1376,17 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
       else
        gnu_result = rm_size (gnu_type);
 
+      gcc_assert (gnu_result);
+
       /* Deal with a self-referential size by returning the maximum size for
-        a type and by qualifying the size with the object otherwise.  */
+        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 = max_size (gnu_result, true);
-         else
+         if (TREE_CODE (gnu_prefix) != TYPE_DECL)
            gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
+         else
+           gnu_result = max_size (gnu_result, true);
        }
 
       /* If the type contains a template, subtract its size.  */
@@ -1468,11 +1395,11 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
        gnu_result = size_binop (MINUS_EXPR, gnu_result,
                                 DECL_SIZE (TYPE_FIELDS (gnu_type)));
 
-      /* For 'Max_Size_In_Storage_Elements, adjust the unit.  */
-      if (attribute == Attr_Max_Size_In_Storage_Elements)
-       gnu_result = size_binop (CEIL_DIV_EXPR, gnu_result, bitsize_unit_node);
-
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+      if (attribute == Attr_Max_Size_In_Storage_Elements)
+       gnu_result = fold_build2 (CEIL_DIV_EXPR, bitsizetype,
+                                 gnu_result, bitsize_unit_node);
       break;
 
     case Attr_Alignment:
@@ -1670,7 +1597,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
                gnu_result
                  = build_cond_expr (comp_type,
                                     build_binary_op (GE_EXPR,
-                                                     boolean_type_node,
+                                                     integer_type_node,
                                                      hb, lb),
                                     gnu_result,
                                     convert (comp_type, integer_zero_node));
@@ -1950,8 +1877,8 @@ Case_Statement_to_gnu (Node_Id gnat_node)
        Present (gnat_when);
        gnat_when = Next_Non_Pragma (gnat_when))
     {
-      bool choices_added_p = false;
       Node_Id gnat_choice;
+      int choices_added = 0;
 
       /* First compile all the different case choices for the current WHEN
         alternative.  */
@@ -2014,14 +1941,14 @@ Case_Statement_to_gnu (Node_Id gnat_node)
                                   gnu_low, gnu_high,
                                   create_artificial_label (input_location)),
                                  gnat_choice);
-             choices_added_p = true;
+             choices_added++;
            }
        }
 
       /* Push a binding level here in case variables are declared as we want
         them to be local to this set of statements instead of to the block
         containing the Case statement.  */
-      if (choices_added_p)
+      if (choices_added > 0)
        {
          add_stmt (build_stmt_group (Statements (gnat_when), true));
          add_stmt (build1 (GOTO_EXPR, void_type_node,
@@ -2039,68 +1966,31 @@ Case_Statement_to_gnu (Node_Id gnat_node)
   return gnu_result;
 }
 \f
-/* Return true if VAL (of type TYPE) can equal the minimum value if MAX is
-   false, or the maximum value if MAX is true, of TYPE.  */
-
-static bool
-can_equal_min_or_max_val_p (tree val, tree type, bool max)
-{
-  tree min_or_max_val = (max ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
-
-  if (TREE_CODE (min_or_max_val) != INTEGER_CST)
-    return true;
-
-  if (TREE_CODE (val) == NOP_EXPR)
-    val = (max
-          ? TYPE_MAX_VALUE (TREE_TYPE (TREE_OPERAND (val, 0)))
-          : TYPE_MIN_VALUE (TREE_TYPE (TREE_OPERAND (val, 0))));
-
-  if (TREE_CODE (val) != INTEGER_CST)
-    return true;
-
-  return tree_int_cst_equal (val, min_or_max_val) == 1;
-}
-
-/* Return true if VAL (of type TYPE) can equal the minimum value of TYPE.
-   If REVERSE is true, minimum value is taken as maximum value.  */
-
-static inline bool
-can_equal_min_val_p (tree val, tree type, bool reverse)
-{
-  return can_equal_min_or_max_val_p (val, type, reverse);
-}
-
-/* Return true if VAL (of type TYPE) can equal the maximum value of TYPE.
-   If REVERSE is true, maximum value is taken as minimum value.  */
-
-static inline bool
-can_equal_max_val_p (tree val, tree type, bool reverse)
-{
-  return can_equal_min_or_max_val_p (val, type, !reverse);
-}
-
 /* 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)
 {
-  const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
-  tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE,
-                              NULL_TREE, NULL_TREE, NULL_TREE);
-  tree gnu_loop_label = create_artificial_label (input_location);
-  tree gnu_loop_var = NULL_TREE, gnu_cond_expr = NULL_TREE;
+  /* ??? 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;
 
-  /* Set location information for statement and end label.  */
+  TREE_TYPE (gnu_loop_stmt) = void_type_node;
+  TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
+  LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label (input_location);
   set_expr_location_from_node (gnu_loop_stmt, gnat_node);
   Sloc_to_locus (Sloc (End_Label (gnat_node)),
-                &DECL_SOURCE_LOCATION (gnu_loop_label));
-  LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
+                &DECL_SOURCE_LOCATION (LOOP_STMT_LABEL (gnu_loop_stmt)));
 
-  /* Save the end label of this LOOP_STMT in a stack so that a corresponding
+  /* 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, gnu_loop_label);
+  push_stack (&gnu_loop_label_stack, NULL_TREE,
+             LOOP_STMT_LABEL (gnu_loop_stmt));
 
   /* Set the condition under which the loop must keep going.
      For the case "LOOP .... END LOOP;" the condition is always true.  */
@@ -2109,11 +1999,11 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 
   /* For the case "WHILE condition LOOP ..... END LOOP;" it's immediate.  */
   else if (Present (Condition (gnat_iter_scheme)))
-    LOOP_STMT_COND (gnu_loop_stmt)
+    LOOP_STMT_TOP_COND (gnu_loop_stmt)
       = gnat_to_gnu (Condition (gnat_iter_scheme));
 
-  /* Otherwise we have an iteration scheme and the condition is given by the
-     bounds of the subtype of the iteration variable.  */
+  /* Otherwise we have an iteration scheme and the condition is given by
+     the bounds of the subtype of the iteration variable.  */
   else
     {
       Node_Id gnat_loop_spec = Loop_Parameter_Specification (gnat_iter_scheme);
@@ -2122,180 +2012,93 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       tree gnu_type = get_unpadded_type (gnat_type);
       tree gnu_low = TYPE_MIN_VALUE (gnu_type);
       tree gnu_high = TYPE_MAX_VALUE (gnu_type);
+      tree gnu_first, gnu_last, gnu_limit;
+      enum tree_code update_code, end_code;
       tree gnu_base_type = get_base_type (gnu_type);
-      tree gnu_one_node = convert (gnu_base_type, integer_one_node);
-      tree gnu_first, gnu_last;
-      enum tree_code update_code, test_code, shift_code;
-      bool reverse = Reverse_Present (gnat_loop_spec), fallback = false;
 
-      /* We must disable modulo reduction for the iteration variable, if any,
+      /* We must disable modulo reduction for the loop variable, if any,
         in order for the loop comparison to be effective.  */
-      if (reverse)
+      if (Reverse_Present (gnat_loop_spec))
        {
          gnu_first = gnu_high;
          gnu_last = gnu_low;
          update_code = MINUS_NOMOD_EXPR;
-         test_code = GE_EXPR;
-         shift_code = PLUS_NOMOD_EXPR;
+         end_code = GE_EXPR;
+         gnu_limit = TYPE_MIN_VALUE (gnu_base_type);
        }
       else
        {
          gnu_first = gnu_low;
          gnu_last = gnu_high;
          update_code = PLUS_NOMOD_EXPR;
-         test_code = LE_EXPR;
-         shift_code = MINUS_NOMOD_EXPR;
+         end_code = LE_EXPR;
+         gnu_limit = TYPE_MAX_VALUE (gnu_base_type);
        }
 
-      /* We use two different strategies to translate the loop, depending on
-        whether optimization is enabled.
-
-        If it is, we try to generate the canonical form of loop expected by
-        the loop optimizer, which is the do-while form:
-
-            ENTRY_COND
-          loop:
-            TOP_UPDATE
-            BODY
-            BOTTOM_COND
-            GOTO loop
-
-        This makes it possible to bypass loop header copying and to turn the
-        BOTTOM_COND into an inequality test.  This should catch (almost) all
-        loops with constant starting point.  If we cannot, we try to generate
-        the default form, which is:
-
-          loop:
-            TOP_COND
-            BODY
-            BOTTOM_UPDATE
-            GOTO loop
-
-        It will be rotated during loop header copying and an entry test added
-        to yield the do-while form.  This should catch (almost) all loops with
-        constant ending point.  If we cannot, we generate the fallback form:
-
-            ENTRY_COND
-          loop:
-            BODY
-            BOTTOM_COND
-            BOTTOM_UPDATE
-            GOTO loop
-
-        which works in all cases but for which loop header copying will copy
-        the BOTTOM_COND, thus adding a third conditional branch.
-
-        If optimization is disabled, loop header copying doesn't come into
-        play and we try to generate the loop forms with the less conditional
-        branches directly.  First, the default form, it should catch (almost)
-        all loops with constant ending point.  Then, if we cannot, we try to
-        generate the shifted form:
-
-          loop:
-            TOP_COND
-            TOP_UPDATE
-            BODY
-            GOTO loop
-
-        which should catch loops with constant starting point.  Otherwise, if
-        we cannot, we generate the fallback form.  */
-
-      if (optimize)
+      /* 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))
        {
-         /* We can use the do-while form if GNU_FIRST-1 doesn't overflow.  */
-         if (!can_equal_min_val_p (gnu_first, gnu_base_type, reverse))
-           {
-             gnu_first = build_binary_op (shift_code, gnu_base_type,
-                                          gnu_first, gnu_one_node);
-             LOOP_STMT_TOP_UPDATE_P (gnu_loop_stmt) = 1;
-             LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt) = 1;
-           }
-
-         /* Otherwise, we can use the default form if GNU_LAST+1 doesn't.  */
-         else if (!can_equal_max_val_p (gnu_last, gnu_base_type, reverse))
-           ;
-
-         /* Otherwise, use the fallback form.  */
-         else
-           fallback = true;
-       }
-      else
-       {
-         /* We can use the default form if GNU_LAST+1 doesn't overflow.  */
-         if (!can_equal_max_val_p (gnu_last, gnu_base_type, reverse))
-           ;
-
-         /* Otherwise, we can use the shifted form if neither GNU_FIRST-1 nor
-            GNU_LAST-1 does.  */
-         else if (!can_equal_min_val_p (gnu_first, gnu_base_type, reverse)
-                  && !can_equal_min_val_p (gnu_last, gnu_base_type, reverse))
-           {
-             gnu_first = build_binary_op (shift_code, gnu_base_type,
-                                          gnu_first, gnu_one_node);
-             gnu_last = build_binary_op (shift_code, gnu_base_type,
-                                         gnu_last, gnu_one_node);
-             LOOP_STMT_TOP_UPDATE_P (gnu_loop_stmt) = 1;
-           }
-
-         /* Otherwise, use the fallback form.  */
-         else
-           fallback = true;
-       }
-
-      if (fallback)
-       LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt) = 1;
-
-      /* If we use the BOTTOM_COND, we can turn the test into an inequality
-        test but we have to add an ENTRY_COND to protect the empty loop.  */
-      if (LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt))
-       {
-         test_code = NE_EXPR;
          gnu_cond_expr
            = build3 (COND_EXPR, void_type_node,
-                     build_binary_op (LE_EXPR, boolean_type_node,
+                     build_binary_op (LE_EXPR, integer_type_node,
                                       gnu_low, gnu_high),
                      NULL_TREE, alloc_stmt_list ());
          set_expr_location_from_node (gnu_cond_expr, gnat_loop_spec);
        }
 
       /* Open a new nesting level that will surround the loop to declare the
-        iteration variable.  */
+        loop index variable.  */
       start_stmt_group ();
       gnat_pushlevel ();
 
-      /* Declare the iteration variable and set it to its initial value.  */
+      /* 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);
 
-      /* Do all the arithmetics in the base type.  */
-      gnu_loop_var = convert (gnu_base_type, 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.  */
-      LOOP_STMT_COND (gnu_loop_stmt)
-       = build_binary_op (test_code, boolean_type_node, gnu_loop_var,
-                          gnu_last);
+      /* 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);
 
-      /* Set either the top or bottom update statement and give it the source
-        location of the iteration for better coverage info.  */
       LOOP_STMT_UPDATE (gnu_loop_stmt)
-       = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_loop_var,
-                          build_binary_op (update_code, gnu_base_type,
-                                           gnu_loop_var, gnu_one_node));
+       = build_binary_op (MODIFY_EXPR, NULL_TREE,
+                          gnu_loop_var,
+                          build_binary_op (update_code,
+                                           TREE_TYPE (gnu_loop_var),
+                                           gnu_loop_var,
+                                           convert (TREE_TYPE (gnu_loop_var),
+                                                    integer_one_node)));
       set_expr_location_from_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 of the loop.  */
+     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)), gnu_loop_label, true);
+    save_gnu_tree (Entity (Identifier (gnat_node)),
+                  LOOP_STMT_LABEL (gnu_loop_stmt), true);
 
   /* 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);
-  TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
 
   /* 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".  */
@@ -2352,7 +2155,7 @@ establish_gnat_vms_condition_handler (void)
       gnat_vms_condition_handler_decl
        = create_subprog_decl (get_identifier ("__gnat_handle_vms_condition"),
                               NULL_TREE,
-                              build_function_type_list (boolean_type_node,
+                              build_function_type_list (integer_type_node,
                                                         ptr_void_type_node,
                                                         ptr_void_type_node,
                                                         NULL_TREE),
@@ -2393,8 +2196,6 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
        ? Corresponding_Spec (gnat_node) : Defining_Entity (gnat_node));
   /* The FUNCTION_DECL node corresponding to the subprogram spec.   */
   tree gnu_subprog_decl;
-  /* Its RESULT_DECL node.  */
-  tree gnu_result_decl;
   /* The FUNCTION_TYPE node corresponding to the subprogram spec.  */
   tree gnu_subprog_type;
   tree gnu_cico_list;
@@ -2418,17 +2219,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
     = gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
                          Acts_As_Spec (gnat_node)
                          && !present_gnu_tree (gnat_subprog_id));
-  gnu_result_decl = DECL_RESULT (gnu_subprog_decl);
-  gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
 
-  /* If the function returns by invisible reference, make it explicit in the
-     function body.  See gnat_to_gnu_entity, E_Subprogram_Type case.  */
-  if (TREE_ADDRESSABLE (gnu_subprog_type))
-    {
-      TREE_TYPE (gnu_result_decl)
-       = build_reference_type (TREE_TYPE (gnu_result_decl));
-      relayout_decl (gnu_result_decl);
-    }
+  gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
 
   /* Propagate the debug mode.  */
   if (!Needs_Debug_Info (gnat_subprog_id))
@@ -2442,14 +2234,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
   allocate_struct_function (gnu_subprog_decl, false);
   DECL_STRUCT_FUNCTION (gnu_subprog_decl)->language
     = GGC_CNEW (struct language_function);
-  set_cfun (NULL);
 
   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.  */
-  gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
   push_stack (&gnu_return_label_stack, NULL_TREE,
              gnu_cico_list ? create_artificial_label (input_location)
              : NULL_TREE);
@@ -2528,18 +2319,9 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
       gnu_result = end_stmt_group ();
     }
 
-    /* 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 containing the
-       final values of these parameters.  If the list contains only one entry,
-       return just that entry though.
-
-       For a full description of the copy-in/copy-out parameter mechanism, see
-       the part of the gnat_to_gnu_entity routine dealing with the translation
-       of subprograms.
-
-       We need to make a block that contains the definition of that label and
-       the copying of the return value.  It first contains the function, then
-       the label and copy statement.  */
+  /* 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))
     {
       tree gnu_retval;
@@ -2557,8 +2339,12 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
        gnu_retval = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
                                             gnu_cico_list);
 
-      add_stmt_with_node (build_return_expr (gnu_result_decl, gnu_retval),
-                         End_Label (Handled_Statement_Sequence (gnat_node)));
+      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
+       (build_return_expr (DECL_RESULT (gnu_subprog_decl), gnu_retval),
+        End_Label (Handled_Statement_Sequence (gnat_node)));
       gnat_poplevel ();
       gnu_result = end_stmt_group ();
     }
@@ -2596,117 +2382,152 @@ 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.
-   If GNU_TARGET is non-null, this must be a function call on the RHS of a
-   N_Assignment_Statement and the result is to be placed into that object.  */
+   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, tree gnu_target)
 {
+  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 = gnat_to_gnu (Name (gnat_node));
+  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);
-  tree gnu_subprog_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog);
+  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;
-  VEC(tree,gc) *gnu_actual_vec = NULL;
+  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_call;
-  bool went_into_elab_proc = false;
+  tree gnu_subprog_call;
 
   gcc_assert (TREE_CODE (gnu_subprog_type) == FUNCTION_TYPE);
 
-  /* If we are calling a stubbed function, raise Program_Error, but Elaborate
-     all our args first.  */
-  if (TREE_CODE (gnu_subprog) == FUNCTION_DECL && DECL_STUBBED_P (gnu_subprog))
+  /* 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))
     {
-      tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called,
-                                        gnat_node, N_Raise_Program_Error);
-
       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_target)
+      {
+       tree call_expr
+         = build_call_raise (PE_Stubbed_Subprogram_Called, gnat_node,
+                             N_Raise_Program_Error);
+
+       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, call_expr);
+         }
+       else
+         return call_expr;
+      }
+    }
+
+  /* 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 and use the maximum size of the type if
+     it has self-referential size.  */
+  if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
+    {
+      tree gnu_ret_type
+       = TREE_TYPE (TREE_VALUE (TYPE_ARG_TYPES (gnu_subprog_type)));
+
+      if (!gnu_target)
        {
-         *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
-         return build1 (NULL_EXPR, TREE_TYPE (gnu_subprog_type), call_expr);
+         tree gnu_obj_type;
+
+         if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_ret_type)))
+           gnu_obj_type
+             = maybe_pad_type (gnu_ret_type,
+                               max_size (TYPE_SIZE (gnu_ret_type), true),
+                               0, Etype (Name (gnat_node)), false, false,
+                               false, true);
+         else
+           gnu_obj_type = gnu_ret_type;
+
+         /* ??? We may be about to create a static temporary if we happen to
+            be at the global binding level.  That's a regression from what
+            the 3.x back-end would generate in the same situation, but we
+            don't have a mechanism in Gigi for creating automatic variables
+            in the elaboration routines.  */
+         gnu_target
+           = create_var_decl (create_tmp_var_name ("LR"), NULL, gnu_obj_type,
+                              NULL, false, false, false, false, NULL,
+                              gnat_node);
+
+         *gnu_result_type_p = gnu_ret_type;
        }
 
-      return call_expr;
+      gnu_actual_list
+       = tree_cons (NULL_TREE,
+                    build_unary_op (ADDR_EXPR, NULL_TREE,
+                                    unchecked_convert (gnu_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 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_With_Extras (Etype (Name (gnat_node)));
   else if (Nkind (Name (gnat_node)) == N_Attribute_Reference)
     /* Assume here that this must be 'Elab_Body or 'Elab_Spec.  */
-    gnat_formal = Empty;
+    gnat_formal = 0;
   else
     gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
 
-  /* If we are translating a statement, open a new nesting level that will
-     surround it to declare the temporaries created for the call.  */
-  if (Nkind (gnat_node) == N_Procedure_Call_Statement || gnu_target)
-    {
-      start_stmt_group ();
-      gnat_pushlevel ();
-    }
-
-  /* The lifetime of the temporaries created for the call ends with the call
-     so we can give them the scope of the elaboration routine at top level.  */
-  else if (!current_function_decl)
-    {
-      current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
-      went_into_elab_proc = true;
-    }
-
-  /* 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 an expression and the TREE_PURPOSE field is null.  But skip Out
-     parameters not passed by reference and that need not be copied in.  */
+  /* 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 = present_gnu_tree (gnat_formal)
-                       ? get_gnu_tree (gnat_formal) : NULL_TREE;
+      tree gnu_formal
+       = (present_gnu_tree (gnat_formal)
+          ? get_gnu_tree (gnat_formal) : NULL_TREE);
       tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
-      /* In the Out or In Out case, we must suppress conversions that yield
-        an lvalue but can nevertheless cause the creation of a temporary,
-        because we need the real object in this case, either to pass its
-        address if it's passed by reference or as target of the back copy
-        done after the call if it uses the copy-in copy-out mechanism.
-        We do it in the In case too, except for an unchecked conversion
-        because it alone can cause the actual to be misaligned and the
-        addressability test is applied to the real object.  */
+      /* We must suppress conversions that can cause the creation of a
+        temporary in the Out or In Out case because we need the real
+        object in this case, either to pass its address if it's passed
+        by reference or as target of the back copy done after the call
+        if it uses the copy-in copy-out mechanism.  We do it in the In
+        case too, except for an unchecked conversion because it alone
+        can cause the actual to be misaligned and the addressability
+        test is applied to the real object.  */
       bool suppress_type_conversion
        = ((Nkind (gnat_actual) == N_Unchecked_Type_Conversion
            && Ekind (gnat_formal) != E_In_Parameter)
           || (Nkind (gnat_actual) == N_Type_Conversion
               && Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
-      Node_Id gnat_name = suppress_type_conversion
-                         ? Expression (gnat_actual) : gnat_actual;
+      Node_Id gnat_name = (suppress_type_conversion
+                          ? Expression (gnat_actual) : gnat_actual);
       tree gnu_name = gnat_to_gnu (gnat_name), gnu_name_type;
       tree gnu_actual;
 
       /* If it's possible we may need to use this expression twice, make sure
-        that any side-effects are handled via SAVE_EXPRs; likewise if we need
+        that 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 (Ekind (gnat_formal) != E_In_Parameter)
-       gnu_name = gnat_stabilize_reference (gnu_name, true, NULL);
+       gnu_name = gnat_stabilize_reference (gnu_name, true);
 
       /* If we are passing a non-addressable parameter by reference, pass the
         address of a copy.  In the Out or In Out case, set up to copy back
@@ -2719,24 +2540,20 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
          && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
          && !addressable_p (gnu_name, gnu_name_type))
        {
-         tree gnu_orig = gnu_name, gnu_temp, gnu_stmt;
-
-         /* Do not issue warnings for CONSTRUCTORs since this is not a copy
-            but sort of an instantiation for them.  */
-         if (TREE_CODE (gnu_name) == CONSTRUCTOR)
-           ;
-
-         /* If the type is passed by reference, a copy is not allowed.  */
-         else if (TREE_ADDRESSABLE (gnu_formal_type))
-           post_error ("misaligned actual cannot be passed by reference",
-                       gnat_actual);
-
-         /* For users of Starlet we issue a warning because the interface
-            apparently assumes that by-ref parameters outlive the procedure
-            invocation.  The code still will not work as intended, but we
-            cannot do much better since low-level parts of the back-end
-            would allocate temporaries at will because of the misalignment
-            if we did not do so here.  */
+         tree gnu_copy = gnu_name;
+
+         /* If the type is by_reference, a copy is not allowed.  */
+         if (Is_By_Reference_Type (Etype (gnat_formal)))
+           post_error
+             ("misaligned actual cannot be passed by reference", gnat_actual);
+
+         /* For users of Starlet we issue a warning because the
+            interface apparently assumes that by-ref parameters
+            outlive the procedure invocation.  The code still
+            will not work as intended, but we cannot do much
+            better since other low-level parts of the back-end
+            would allocate temporaries at will because of the
+            misalignment if we did not do so here.  */
          else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
            {
              post_error
@@ -2755,54 +2572,39 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
              && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_name_type)))
            ;
 
-         /* Otherwise remove the unpadding from all the objects.  */
+         /* Otherwise remove unpadding from the object and reset the copy.  */
          else if (TREE_CODE (gnu_name) == COMPONENT_REF
                   && TYPE_IS_PADDING_P
                      (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))
-           gnu_orig = gnu_name = TREE_OPERAND (gnu_name, 0);
+           gnu_name = gnu_copy = TREE_OPERAND (gnu_name, 0);
 
-         /* Otherwise convert to the nominal type of the object if needed.
-            There are several cases in which we need to make the temporary
-            using this type instead of the actual type of the object when
-            they are distinct, because the expectations of the callee would
-            otherwise not be met:
+         /* Otherwise convert to the nominal type of the object if it's
+            a record type.  There are several cases in which we need to
+            make the temporary using this type instead of the actual type
+            of the object if they are distinct, because the expectations
+            of the callee would otherwise not be met:
               - if it's a justified modular type,
-              - if the actual type is a smaller form of it,
-              - if it's a smaller form of the actual type.  */
-         else if ((TREE_CODE (gnu_name_type) == RECORD_TYPE
-                   && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
-                       || smaller_form_type_p (TREE_TYPE (gnu_name),
-                                               gnu_name_type)))
-                  || (INTEGRAL_TYPE_P (gnu_name_type)
-                      && smaller_form_type_p (gnu_name_type,
-                                              TREE_TYPE (gnu_name))))
+              - if the actual type is a smaller packable version of it.  */
+         else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
+                  && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
+                      || smaller_packable_type_p (TREE_TYPE (gnu_name),
+                                                  gnu_name_type)))
            gnu_name = convert (gnu_name_type, gnu_name);
 
-         /* Create an explicit temporary holding the copy.  This ensures that
-            its lifetime is as narrow as possible around a statement.  */
-         gnu_temp = create_var_decl (create_tmp_var_name ("A"), NULL_TREE,
-                                     TREE_TYPE (gnu_name), NULL_TREE, false,
-                                     false, false, false, NULL, Empty);
-         DECL_ARTIFICIAL (gnu_temp) = 1;
-         DECL_IGNORED_P (gnu_temp) = 1;
-
-         /* But initialize it on the fly like for an implicit temporary as
-            we aren't necessarily dealing with a statement.  */
-         gnu_stmt
-           = build_binary_op (INIT_EXPR, NULL_TREE, gnu_temp, gnu_name);
-         set_expr_location_from_node (gnu_stmt, gnat_actual);
-
-         /* From now on, the real object is the temporary.  */
-         gnu_name = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_name), gnu_stmt,
-                            gnu_temp);
-
-         /* Set up to move the copy back to the original if needed.  */
+         /* Make a SAVE_EXPR to both properly account for potential side
+            effects and handle the creation of a temporary copy.  Special
+            code in gnat_gimplify_expr ensures that the same temporary is
+            used as the object and copied back after the call if needed.  */
+         gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
+         TREE_SIDE_EFFECTS (gnu_name) = 1;
+
+         /* Set up to move the copy back to the original.  */
          if (Ekind (gnat_formal) != E_In_Parameter)
            {
-             gnu_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig,
-                                         gnu_temp);
-             set_expr_location_from_node (gnu_stmt, gnat_node);
-             append_to_statement_list (gnu_stmt, &gnu_after_list);
+             tree stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
+                                          gnu_name);
+             set_expr_location_from_node (stmt, gnat_node);
+             append_to_statement_list (stmt, &gnu_after_list);
            }
        }
 
@@ -2813,27 +2615,48 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
         So do it here for the part we will use as an input, if any.  */
       if (Ekind (gnat_formal) != E_Out_Parameter
          && TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual)))
-       gnu_actual
-         = convert (get_unpadded_type (Etype (gnat_actual)), gnu_actual);
-
-      /* Put back the conversion we suppressed above in the computation of the
-        real object.  And even if we didn't suppress any conversion there, we
-        may have suppressed a conversion to the Etype of the actual earlier,
-        since the parent is a procedure call, so put it back here.  */
-      if (suppress_type_conversion
-         && Nkind (gnat_actual) == N_Unchecked_Type_Conversion)
-       gnu_actual
-         = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)),
-                              gnu_actual, No_Truncation (gnat_actual));
+       gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)),
+                             gnu_actual);
+
+      /* Do any needed conversions for the actual and make sure that it is
+        in range of the formal's type.  */
+      if (suppress_type_conversion)
+       {
+         /* Put back the conversion we suppressed above in the computation
+            of the real object.  Note that we treat a conversion between
+            aggregate types as if it is an unchecked conversion here.  */
+         gnu_actual
+           = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)),
+                                gnu_actual,
+                                (Nkind (gnat_actual)
+                                 == N_Unchecked_Type_Conversion)
+                                && No_Truncation (gnat_actual));
+
+         if (Ekind (gnat_formal) != E_Out_Parameter
+             && Do_Range_Check (gnat_actual))
+           gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal),
+                                          gnat_actual);
+       }
       else
-       gnu_actual
-         = convert (gnat_to_gnu_type (Etype (gnat_actual)), gnu_actual);
+       {
+         if (Ekind (gnat_formal) != E_Out_Parameter
+             && Do_Range_Check (gnat_actual))
+           gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal),
+                                          gnat_actual);
+
+         /* We may have suppressed a conversion to the Etype of the actual
+            since the parent is a procedure call.  So put it back here.
+            ??? We use the reverse order compared to the case above because
+            of an awkward interaction with the check and actually don't put
+            back the conversion at all if a check is emitted.  This is also
+            done for the conversion to the formal's type just below.  */
+         if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+           gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
+                                 gnu_actual);
+       }
 
-      /* Make sure that the actual 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), gnat_actual);
+      if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+       gnu_actual = convert (gnu_formal_type, gnu_actual);
 
       /* Unless this is an In parameter, we must remove any justified modular
         building from GNU_NAME to get an lvalue.  */
@@ -2841,12 +2664,13 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
          && TREE_CODE (gnu_name) == CONSTRUCTOR
          && TREE_CODE (TREE_TYPE (gnu_name)) == RECORD_TYPE
          && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (gnu_name)))
-       gnu_name
-         = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))), gnu_name);
+       gnu_name = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_name))),
+                           gnu_name);
 
       /* If we have not saved a GCC object for the formal, it means it is an
-        Out parameter not passed by reference and that need not be copied in.
-        Otherwise, first see if the parameter is passed by reference.  */
+        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 (gnu_formal
          && TREE_CODE (gnu_formal) == PARM_DECL
          && DECL_BY_REF_P (gnu_formal))
@@ -2859,7 +2683,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
              gnu_actual = gnu_name;
 
              /* If we have a padded type, be sure we've removed padding.  */
-             if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_actual)))
+             if (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);
 
@@ -2871,18 +2696,13 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
                 and takes its address.  */
              if (TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
                  && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (gnu_actual))
+                 && TREE_CODE (gnu_actual) != SAVE_EXPR
                  && Is_Constr_Subt_For_UN_Aliased (Etype (gnat_actual))
                  && Is_Array_Type (Etype (gnat_actual)))
                gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
                                      gnu_actual);
            }
 
-         /* There is no need to convert the actual to the formal's type before
-            taking its address.  The only exception is for unconstrained array
-            types because of the way we build fat pointers.  */
-         else if (TREE_CODE (gnu_formal_type) == UNCONSTRAINED_ARRAY_TYPE)
-           gnu_actual = convert (gnu_formal_type, gnu_actual);
-
          /* 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));
@@ -2908,20 +2728,20 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
             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 = build_unary_op (ADDR_EXPR, gnu_formal_type, gnu_actual);
+         gnu_actual = convert (gnu_formal_type,
+                               build_unary_op (ADDR_EXPR, NULL_TREE,
+                                               gnu_actual));
        }
       else if (gnu_formal
               && TREE_CODE (gnu_formal) == PARM_DECL
               && DECL_BY_DESCRIPTOR_P (gnu_formal))
        {
-         gnu_actual = convert (gnu_formal_type, gnu_actual);
-
-         /* If this is 'Null_Parameter, pass a zero descriptor.  */
+         /* 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 (gnu_formal), integer_zero_node);
+           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,
@@ -2930,124 +2750,107 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
        }
       else
        {
-         tree gnu_size;
+         tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual));
 
          if (Ekind (gnat_formal) != E_In_Parameter)
            gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
 
-         if (!(gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL))
-           {
-             /* Make sure side-effects are evaluated before the call.  */
-             if (TREE_SIDE_EFFECTS (gnu_name))
-               append_to_statement_list (gnu_name, &gnu_before_list);
-             continue;
-           }
-
-         gnu_actual = convert (gnu_formal_type, gnu_actual);
+         if (!gnu_formal || TREE_CODE (gnu_formal) != PARM_DECL)
+           continue;
 
          /* If this is 'Null_Parameter, pass a zero even though we are
             dereferencing it.  */
-         if (TREE_CODE (gnu_actual) == INDIRECT_REF
-             && TREE_PRIVATE (gnu_actual)
-             && (gnu_size = TYPE_SIZE (TREE_TYPE (gnu_actual)))
-             && TREE_CODE (gnu_size) == INTEGER_CST
-             && compare_tree_int (gnu_size, BITS_PER_WORD) <= 0)
+         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 (gnu_formal),
                                   convert (gnat_type_for_size
-                                           (TREE_INT_CST_LOW (gnu_size), 1),
+                                           (tree_low_cst (gnu_actual_size, 1),
+                                            1),
                                            integer_zero_node),
                                   false);
          else
            gnu_actual = convert (DECL_ARG_TYPE (gnu_formal), gnu_actual);
        }
 
-      VEC_safe_push (tree, gc, gnu_actual_vec, gnu_actual);
+      gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
     }
 
-  gnu_call = build_call_vec (TREE_TYPE (gnu_subprog_type), gnu_subprog_addr,
-                             gnu_actual_vec);
-  set_expr_location_from_node (gnu_call, gnat_node);
+  gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
+                                     gnu_subprog_addr,
+                                     nreverse (gnu_actual_list));
+  set_expr_location_from_node (gnu_subprog_call, gnat_node);
+
+  /* If we return by passing a target, the result is the target after the
+     call.  We must not emit the call directly here because this might be
+     evaluated as part of an expression with conditions to control whether
+     the call should be emitted or not.  */
+  if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
+    {
+      /* Conceptually, what we need is a COMPOUND_EXPR of the call followed by
+        the target object.  Doing so would potentially be inefficient though,
+        as this expression might be wrapped up into a SAVE_EXPR later, which
+        would incur a pointless temporary copy of the whole object.
+
+        What we do instead is build a COMPOUND_EXPR returning the address of
+        the target, and then dereference.  Wrapping up the COMPOUND_EXPR into
+        a SAVE_EXPR then only incurs a mere pointer copy.  */
+      tree gnu_target_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_target);
+      set_expr_location_from_node (gnu_target_addr, gnat_node);
+      gnu_result = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_target_addr),
+                          gnu_subprog_call, gnu_target_addr);
+      return build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+    }
 
-  /* If it's 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.  */
-  if (Nkind (gnat_node) == N_Function_Call)
+  /* 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)
     {
-      tree gnu_result = gnu_call;
+      gnu_result = gnu_subprog_call;
 
-      /* If the function returns an unconstrained array or by direct reference,
-        we have to dereference the pointer.  */
-      if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type)
-         || TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type))
+      /* 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);
 
       if (gnu_target)
-       {
-         Node_Id gnat_parent = Parent (gnat_node);
-         enum tree_code op_code;
-
-         /* If range check is needed, emit code to generate it.  */
-         if (Do_Range_Check (gnat_node))
-           gnu_result
-             = emit_range_check (gnu_result, Etype (Name (gnat_parent)),
-                                 gnat_parent);
-
-         /* ??? If the return type has non-constant size, then force the
-            return slot optimization as we would not be able to generate
-            a temporary.  That's what has been done historically.  */
-         if (TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_subprog_type))))
-           op_code = MODIFY_EXPR;
-         else
-           op_code = INIT_EXPR;
-
-         gnu_result
-           = build_binary_op (op_code, NULL_TREE, gnu_target, gnu_result);
-         add_stmt_with_node (gnu_result, gnat_parent);
-         gnat_poplevel ();
-         gnu_result = end_stmt_group ();
-       }
+       gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+                                     gnu_target, gnu_result);
       else
-       {
-         if (went_into_elab_proc)
-           current_function_decl = NULL_TREE;
-         *gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
-       }
+       *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, then the special parameter
-     passing mechanism must be used.  */
-  if (TYPE_CI_CO_LIST (gnu_subprog_type))
+  /* 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 gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
-      const int length = list_length (gnu_cico_list);
+      /* 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_temp, gnu_stmt;
-
-         /* The call sequence must contain one and only one call, even though
-            the function is pure.  Save the result into a temporary.  */
-         gnu_temp = create_var_decl (create_tmp_var_name ("R"), NULL_TREE,
-                                     TREE_TYPE (gnu_call), NULL_TREE, false,
-                                     false, false, false, NULL, Empty);
-         DECL_ARTIFICIAL (gnu_temp) = 1;
-         DECL_IGNORED_P (gnu_temp) = 1;
-
-         gnu_stmt
-           = build_binary_op (INIT_EXPR, NULL_TREE, gnu_temp, gnu_call);
-         set_expr_location_from_node (gnu_stmt, gnat_node);
-
-         /* Add the call statement to the list and start from its result.  */
-         append_to_statement_list (gnu_stmt, &gnu_before_list);
-         gnu_call = gnu_temp;
+         tree gnu_name;
 
+         gnu_subprog_call = save_expr (gnu_subprog_call);
          gnu_name_list = nreverse (gnu_name_list);
+
+         /* 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)))
+             append_to_statement_list (TREE_VALUE (gnu_name),
+                                       &gnu_before_list);
        }
 
       if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
@@ -3074,10 +2877,10 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
               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_call
-               : build_component_ref (gnu_call, NULL_TREE,
-                                      TREE_PURPOSE (gnu_cico_list), false);
+             = length == 1 ? gnu_subprog_call
+               : build_component_ref (gnu_subprog_call, NULL_TREE,
+                                      TREE_PURPOSE (scalar_return_list),
+                                      false);
 
            /* If the actual is a conversion, get the inner expression, which
               will be the real destination, and convert the result to the
@@ -3087,9 +2890,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 
            /* If the result is a padded type, remove the padding.  */
            if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
-             gnu_result
-               = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
-                          gnu_result);
+             gnu_result = convert (TREE_TYPE (TYPE_FIELDS
+                                              (TREE_TYPE (gnu_result))),
+                                   gnu_result);
 
            /* If the actual is a type conversion, the real target object is
               denoted by the inner Expression and we need to convert the
@@ -3130,22 +2933,25 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
                  gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
              }
 
+           /* Undo wrapping of boolean rvalues.  */
+           if (TREE_CODE (gnu_actual) == NE_EXPR
+               && TREE_CODE (get_base_type (TREE_TYPE (gnu_actual)))
+                  == BOOLEAN_TYPE
+               && integer_zerop (TREE_OPERAND (gnu_actual, 1)))
+             gnu_actual = TREE_OPERAND (gnu_actual, 0);
            gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
                                          gnu_actual, gnu_result);
            set_expr_location_from_node (gnu_result, gnat_node);
            append_to_statement_list (gnu_result, &gnu_before_list);
-           gnu_cico_list = TREE_CHAIN (gnu_cico_list);
+           scalar_return_list = TREE_CHAIN (scalar_return_list);
            gnu_name_list = TREE_CHAIN (gnu_name_list);
          }
-    }
+       }
   else
-    append_to_statement_list (gnu_call, &gnu_before_list);
+    append_to_statement_list (gnu_subprog_call, &gnu_before_list);
 
   append_to_statement_list (gnu_after_list, &gnu_before_list);
-
-  add_stmt (gnu_before_list);
-  gnat_poplevel ();
-  return end_stmt_group ();
+  return gnu_before_list;
 }
 \f
 /* Subroutine of gnat_to_gnu to translate gnat_node, an
@@ -3379,7 +3185,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node)
          else
            this_choice
              = build_binary_op
-               (EQ_EXPR, boolean_type_node,
+               (EQ_EXPR, integer_type_node,
                 convert
                 (integer_type_node,
                  build_component_ref
@@ -3406,7 +3212,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node)
 
          this_choice
            = build_binary_op
-             (EQ_EXPR, boolean_type_node, TREE_VALUE (gnu_except_ptr_stack),
+             (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)));
 
@@ -3423,8 +3229,8 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node)
 
              this_choice
                = build_binary_op
-                 (TRUTH_ORIF_EXPR, boolean_type_node,
-                  build_binary_op (EQ_EXPR, boolean_type_node, gnu_comp,
+                 (TRUTH_ORIF_EXPR, integer_type_node,
+                  build_binary_op (EQ_EXPR, integer_type_node, gnu_comp,
                                    build_int_cst (TREE_TYPE (gnu_comp), 'V')),
                   this_choice);
            }
@@ -3432,7 +3238,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node)
       else
        gcc_unreachable ();
 
-      gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
+      gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
                                    gnu_choice, this_choice);
     }
 
@@ -3456,7 +3262,11 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
      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, or to a dummy object for "others" and "all others".  */
+     id, or to a dummy object for "others" and "all others".
+
+     Care should be taken to ensure that the control flow impact of "others"
+     and "all others" is known to GCC. lang_eh_type_covers is doing the trick
+     currently.  */
   for (gnat_temp = First (Exception_Choices (gnat_node));
        gnat_temp; gnat_temp = Next (gnat_temp))
     {
@@ -3544,29 +3354,26 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
 static void
 Compilation_Unit_to_gnu (Node_Id gnat_node)
 {
-  const Node_Id gnat_unit = Unit (gnat_node);
-  const bool body_p = (Nkind (gnat_unit) == N_Package_Body
-                      || Nkind (gnat_unit) == N_Subprogram_Body);
-  const Entity_Id gnat_unit_entity = Defining_Entity (gnat_unit);
   /* Make the decl for the elaboration procedure.  */
+  bool body_p = (Defining_Entity (Unit (gnat_node)),
+           Nkind (Unit (gnat_node)) == N_Package_Body
+           || Nkind (Unit (gnat_node)) == N_Subprogram_Body);
+  Entity_Id gnat_unit_entity = Defining_Entity (Unit (gnat_node));
   tree gnu_elab_proc_decl
     = create_subprog_decl
-      (create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"),
-       NULL_TREE, void_ftype, NULL_TREE, false, true, false, NULL, gnat_unit);
+      (create_concat_name (gnat_unit_entity,
+                          body_p ? "elabb" : "elabs"),
+       NULL_TREE, void_ftype, NULL_TREE, false, true, false, NULL,
+       gnat_unit_entity);
   struct elab_info *info;
 
   push_stack (&gnu_elab_proc_stack, NULL_TREE, gnu_elab_proc_decl);
-  DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
 
-  /* Initialize the information structure for the function.  */
+  DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
   allocate_struct_function (gnu_elab_proc_decl, false);
+  Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
   set_cfun (NULL);
 
-  current_function_decl = NULL_TREE;
-
-  start_stmt_group ();
-  gnat_pushlevel ();
-
   /* For a body, first process the spec if there is one.  */
   if (Nkind (Unit (gnat_node)) == N_Package_Body
       || (Nkind (Unit (gnat_node)) == N_Subprogram_Body
@@ -3576,34 +3383,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
       finalize_from_with_types ();
     }
 
-  /* If we can inline, generate code for all the inlined subprograms.  */
-  if (optimize)
-    {
-      Entity_Id gnat_entity;
-
-      for (gnat_entity = First_Inlined_Subprogram (gnat_node);
-          Present (gnat_entity);
-          gnat_entity = Next_Inlined_Subprogram (gnat_entity))
-       {
-         Node_Id gnat_body = Parent (Declaration_Node (gnat_entity));
-
-         if (Nkind (gnat_body) != N_Subprogram_Body)
-           {
-             /* ??? This really should always be present.  */
-             if (No (Corresponding_Body (gnat_body)))
-               continue;
-             gnat_body
-               = Parent (Declaration_Node (Corresponding_Body (gnat_body)));
-           }
-
-         if (Present (gnat_body))
-           {
-             /* Define the entity first so we set DECL_EXTERNAL.  */
-             gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
-             add_stmt (gnat_to_gnu (gnat_body));
-           }
-       }
-    }
+  process_inlined_subprograms (gnat_node);
 
   if (type_annotate_only && gnat_node == Cunit (Main_Unit))
     {
@@ -3630,11 +3410,6 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
   set_current_block_context (gnu_elab_proc_decl);
   gnat_poplevel ();
   DECL_SAVED_TREE (gnu_elab_proc_decl) = end_stmt_group ();
-
-  Sloc_to_locus
-    (Sloc (gnat_unit),
-     &DECL_STRUCT_FUNCTION (gnu_elab_proc_decl)->function_end_locus);
-
   info->next = elab_info_list;
   info->elab_proc = gnu_elab_proc_decl;
   info->gnat_node = gnat_node;
@@ -3663,8 +3438,7 @@ unchecked_conversion_nop (Node_Id gnat_node)
      could de facto ensure type consistency and this should be preserved.  */
   if (!(Nkind (Parent (gnat_node)) == N_Assignment_Statement
        && Name (Parent (gnat_node)) == gnat_node)
-      && !((Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
-           || Nkind (Parent (gnat_node)) == N_Function_Call)
+      && !(Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
           && Name (Parent (gnat_node)) != gnat_node))
     return false;
 
@@ -3682,16 +3456,11 @@ unchecked_conversion_nop (Node_Id gnat_node)
   if (to_type == from_type)
     return true;
 
-  /* For an array subtype, the conversion to the PAT is a no-op.  */
+  /* For an array type, the conversion to the PAT is a no-op.  */
   if (Ekind (from_type) == E_Array_Subtype
       && to_type == Packed_Array_Type (from_type))
     return true;
 
-  /* For a record subtype, the conversion to the type is a no-op.  */
-  if (Ekind (from_type) == E_Record_Subtype
-      && to_type == Etype (from_type))
-    return true;
-
   return false;
 }
 
@@ -3733,6 +3502,7 @@ gnat_to_gnu (Node_Id gnat_node)
                                     N_Raise_Constraint_Error));
 
   if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
+       && !IN (kind, N_SCIL_Node)
        && kind != N_Null_Statement)
       || kind == N_Procedure_Call_Statement
       || kind == N_Label
@@ -3741,10 +3511,13 @@ gnat_to_gnu (Node_Id gnat_node)
       || (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void))
     {
       /* If this is a statement and we are at top level, it must be part of
-        the elaboration procedure, so mark us as being in that procedure.  */
+        the elaboration procedure, so mark us as being in that procedure
+        and push our context.  */
       if (!current_function_decl)
        {
          current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
+         start_stmt_group ();
+         gnat_pushlevel ();
          went_into_elab_proc = true;
        }
 
@@ -3994,7 +3767,7 @@ gnat_to_gnu (Node_Id gnat_node)
                                     gnu_expr, false, Is_Public (gnat_temp),
                                     false, false, NULL, gnat_temp);
              else
-               gnu_expr = gnat_save_expr (gnu_expr);
+               gnu_expr = maybe_variable (gnu_expr);
 
              save_gnu_tree (gnat_node, gnu_expr, true);
            }
@@ -4158,21 +3931,21 @@ gnat_to_gnu (Node_Id gnat_node)
              (TYPE_MAX_VALUE (gnu_base_index_type), gnu_result);
            tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
 
-          gnu_min_expr = gnat_protect_expr (gnu_min_expr);
-          gnu_max_expr = gnat_protect_expr (gnu_max_expr);
+          gnu_min_expr = protect_multiple_eval (gnu_min_expr);
+          gnu_max_expr = protect_multiple_eval (gnu_max_expr);
 
            /* Derive a good type to convert everything to.  */
            gnu_expr_type = get_base_type (gnu_index_type);
 
            /* Test whether the minimum slice value is too small.  */
-           gnu_expr_l = build_binary_op (LT_EXPR, boolean_type_node,
+           gnu_expr_l = build_binary_op (LT_EXPR, integer_type_node,
                                          convert (gnu_expr_type,
                                                   gnu_min_expr),
                                          convert (gnu_expr_type,
                                                   gnu_base_min_expr));
 
            /* Test whether the maximum slice value is too large.  */
-           gnu_expr_h = build_binary_op (GT_EXPR, boolean_type_node,
+           gnu_expr_h = build_binary_op (GT_EXPR, integer_type_node,
                                          convert (gnu_expr_type,
                                                   gnu_max_expr),
                                          convert (gnu_expr_type,
@@ -4181,7 +3954,7 @@ gnat_to_gnu (Node_Id gnat_node)
            /* Build a slice index check that returns the low bound,
               assuming the slice is not empty.  */
            gnu_expr = emit_check
-             (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
+             (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
                                gnu_expr_l, gnu_expr_h),
               gnu_min_expr, CE_Index_Check_Failed, gnat_node);
 
@@ -4261,14 +4034,12 @@ gnat_to_gnu (Node_Id gnat_node)
                                   ? Designated_Type (Etype
                                                      (Prefix (gnat_node)))
                                   : Etype (Prefix (gnat_node))))
-             gnu_prefix = gnat_stabilize_reference (gnu_prefix, false, NULL);
+             gnu_prefix = gnat_stabilize_reference (gnu_prefix, false);
 
            gnu_result
              = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
                                     (Nkind (Parent (gnat_node))
-                                     == N_Attribute_Reference)
-                                    && lvalue_required_for_attribute_p
-                                       (Parent (gnat_node)));
+                                     == N_Attribute_Reference));
          }
 
        gcc_assert (gnu_result);
@@ -4278,20 +4049,21 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Attribute_Reference:
       {
-       /* The attribute designator.  */
-       const int attr = Get_Attribute_Id (Attribute_Name (gnat_node));
-
-       /* The Elab_Spec and Elab_Body attributes are special in that Prefix
-          is a unit, not an object with a GCC equivalent.  */
-       if (attr == Attr_Elab_Spec || attr == Attr_Elab_Body)
-         return
-           create_subprog_decl (create_concat_name
-                                (Entity (Prefix (gnat_node)),
-                                 attr == Attr_Elab_Body ? "elabb" : "elabs"),
-                                NULL_TREE, void_ftype, NULL_TREE, false,
-                                true, true, NULL, gnat_node);
-
-       gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr);
+       /* The attribute designator (like an enumeration value).  */
+       int attribute = Get_Attribute_Id (Attribute_Name (gnat_node));
+
+       /* The Elab_Spec and Elab_Body attributes are special in that
+          Prefix is a unit, not an object with a GCC equivalent.  Similarly
+          for Elaborated, since that variable isn't otherwise known.  */
+       if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
+         return (create_subprog_decl
+                 (create_concat_name (Entity (Prefix (gnat_node)),
+                                      attribute == Attr_Elab_Body
+                                      ? "elabb" : "elabs"),
+                  NULL_TREE, void_ftype, NULL_TREE, false, true, true, NULL,
+                  gnat_node));
+
+       gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attribute);
       }
       break;
 
@@ -4450,7 +4222,7 @@ gnat_to_gnu (Node_Id gnat_node)
        else
          {
            tree t1, t2;
-           gnu_obj = gnat_protect_expr (gnu_obj);
+           gnu_obj = protect_multiple_eval (gnu_obj);
            t1 = build_binary_op (GE_EXPR, gnu_result_type, gnu_obj, gnu_low);
            if (EXPR_P (t1))
              set_expr_location_from_node (t1, gnat_node);
@@ -4512,7 +4284,6 @@ gnat_to_gnu (Node_Id gnat_node)
       {
        enum tree_code code = gnu_codes[kind];
        bool ignore_lhs_overflow = false;
-       location_t saved_location = input_location;
        tree gnu_type;
 
        gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
@@ -4604,12 +4375,7 @@ gnat_to_gnu (Node_Id gnat_node)
          gnu_result = build_binary_op_trapv (code, gnu_type,
                                              gnu_lhs, gnu_rhs, gnat_node);
        else
-         {
-           /* Some operations, e.g. comparisons of arrays, generate complex
-              trees that need to be annotated while they are being built.  */
-           input_location = saved_location;
-           gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
-         }
+         gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
 
        /* If this is a logical shift with the shift count not verified,
           we must return zero if it is too large.  We cannot compensate
@@ -4619,7 +4385,7 @@ gnat_to_gnu (Node_Id gnat_node)
          gnu_result
            = build_cond_expr
              (gnu_type,
-              build_binary_op (GE_EXPR, boolean_type_node,
+              build_binary_op (GE_EXPR, integer_type_node,
                                gnu_rhs,
                                convert (TREE_TYPE (gnu_rhs),
                                         TYPE_SIZE (gnu_type))),
@@ -4747,27 +4513,14 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Null_Statement:
-      /* When not optimizing, turn null statements from source into gotos to
-        the next statement that the middle-end knows how to preserve.  */
-      if (!optimize && Comes_From_Source (gnat_node))
-       {
-         tree stmt, label = create_label_decl (NULL_TREE);
-         start_stmt_group ();
-         stmt = build1 (GOTO_EXPR, void_type_node, label);
-         set_expr_location_from_node (stmt, gnat_node);
-         add_stmt (stmt);
-         stmt = build1 (LABEL_EXPR, void_type_node, label);
-         set_expr_location_from_node (stmt, gnat_node);
-         add_stmt (stmt);
-         gnu_result = end_stmt_group ();
-       }
-      else
-       gnu_result = alloc_stmt_list ();
+      gnu_result = alloc_stmt_list ();
       break;
 
     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)));
 
       /* If the type has a size that overflows, convert this into raise of
@@ -4776,9 +4529,10 @@ gnat_to_gnu (Node_Id gnat_node)
           && TREE_OVERFLOW (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))))
        gnu_result = build_call_raise (SE_Object_Too_Large, gnat_node,
                                       N_Raise_Storage_Error);
-      else if (Nkind (Expression (gnat_node)) == N_Function_Call)
-       gnu_result
-         = call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs);
+      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_rhs
@@ -4792,12 +4546,10 @@ gnat_to_gnu (Node_Id gnat_node)
          gnu_result
            = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
 
-         /* If the type being assigned is an array type and the two sides are
-            not completely disjoint, play safe and use memmove.  But don't do
-            it for a bit-packed array as it might not be byte-aligned.  */
+         /* If the type being assigned is an array type and the two sides
+            are not completely disjoint, play safe and use memmove.  */
          if (TREE_CODE (gnu_result) == MODIFY_EXPR
              && Is_Array_Type (Etype (Name (gnat_node)))
-             && !Is_Bit_Packed_Array (Etype (Name (gnat_node)))
              && !(Forwards_OK (gnat_node) && Backwards_OK (gnat_node)))
            {
              tree to, from, size, to_ptr, from_ptr, t;
@@ -4884,83 +4636,116 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Return_Statement:
       {
-       tree gnu_ret_val, gnu_ret_obj;
+       /* 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 = NULL_TREE;
+       /* The place to put the return value.  */
+       tree gnu_lhs;
+
+       /* 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
+          containing the final values of these parameters.  If the list
+          contains only one entry, return just that entry.
+
+          For a full description of the copy in copy out parameter mechanism,
+          see the part of the gnat_to_gnu_entity routine dealing with the
+          translation of subprograms.
+
+          But if we have a return label defined, convert this into
+          a branch to that label.  */
 
-       /* If we have a return label defined, convert this into a branch to
-          that label.  The return proper will be handled elsewhere.  */
        if (TREE_VALUE (gnu_return_label_stack))
          {
            gnu_result = build1 (GOTO_EXPR, void_type_node,
                                 TREE_VALUE (gnu_return_label_stack));
-           /* When not optimizing, make sure the return is preserved.  */
-           if (!optimize && Comes_From_Source (gnat_node))
-             DECL_ARTIFICIAL (TREE_VALUE (gnu_return_label_stack)) = 0;
            break;
          }
 
-       /* If the subprogram is a function, we must return the expression.  */
-       if (Present (Expression (gnat_node)))
+       else if (TYPE_CI_CO_LIST (gnu_subprog_type))
          {
-           tree gnu_subprog_type = TREE_TYPE (current_function_decl);
-           tree gnu_result_decl = DECL_RESULT (current_function_decl);
-           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.  */
-           if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
-               && 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 the subprogram returns by direct reference, return a pointer
-              to the return value.  */
-           if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type)
-               || By_Ref (gnat_node))
-             gnu_ret_val = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
-
-           /* Otherwise, if it returns an unconstrained array, we have to
-              allocate a new version of the result and return it.  */
-           else if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type))
-             {
-               gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
-               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, false);
-             }
+           gnu_lhs = DECL_RESULT (current_function_decl);
+           if (list_length (TYPE_CI_CO_LIST (gnu_subprog_type)) == 1)
+             gnu_ret_val = TREE_VALUE (TYPE_CI_CO_LIST (gnu_subprog_type));
+           else
+             gnu_ret_val
+               = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
+                                         TYPE_CI_CO_LIST (gnu_subprog_type));
+         }
+
+       /* If the Ada subprogram is a function, we just need to return the
+          expression.   If the subprogram returns an unconstrained
+          array, we have to allocate a new version of the result and
+          return it.  If we return by reference, return a pointer.  */
 
-           /* If the subprogram returns by invisible reference, dereference
-              the pointer it is passed using the type of the return value
-              and build the copy operation manually.  This ensures that we
-              don't copy too much data, for example if the return type is
-              unconstrained with a maximum size.  */
-           if (TREE_ADDRESSABLE (gnu_subprog_type))
+       else if (Present (Expression (gnat_node)))
+         {
+           /* 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_ret_obj
-                 = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val),
-                                   gnu_result_decl);
-               gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
-                                             gnu_ret_obj, gnu_ret_val);
-               add_stmt_with_node (gnu_result, gnat_node);
-               gnu_ret_val = NULL_TREE;
-               gnu_ret_obj = gnu_result_decl;
+               gnu_lhs
+                 = build_unary_op (INDIRECT_REF, NULL_TREE,
+                                   DECL_ARGUMENTS (current_function_decl));
+               gnu_result = call_to_gnu (Expression (gnat_node),
+                                         &gnu_result_type, gnu_lhs);
              }
-
-           /* Otherwise, build a regular return.  */
            else
-             gnu_ret_obj = gnu_result_decl;
+             {
+               gnu_ret_val = gnat_to_gnu (Expression (gnat_node));
+
+               if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
+                 /* The original return type was unconstrained so dereference
+                    the TARGET pointer in the actual return value's type.  */
+                 gnu_lhs
+                   = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val),
+                                     DECL_ARGUMENTS (current_function_decl));
+               else
+                 gnu_lhs = DECL_RESULT (current_function_decl);
+
+               /* 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
+                   && 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))
+                 {
+                   gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
+                   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, false);
+                 }
+             }
          }
        else
+         /* If the Ada subprogram is a regular procedure, just return.  */
+         gnu_lhs = NULL_TREE;
+
+       if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
          {
-           gnu_ret_val = NULL_TREE;
-           gnu_ret_obj = NULL_TREE;
+           if (gnu_ret_val)
+             gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+                                           gnu_lhs, gnu_ret_val);
+           add_stmt_with_node (gnu_result, gnat_node);
+           gnu_lhs = NULL_TREE;
          }
 
-       gnu_result = build_return_expr (gnu_ret_obj, gnu_ret_val);
+       gnu_result = build_return_expr (gnu_lhs, gnu_ret_val);
       }
       break;
 
@@ -5094,7 +4879,12 @@ gnat_to_gnu (Node_Id gnat_node)
     /*********************************************************/
 
     case N_Compilation_Unit:
-      /* This is not called for the main unit on which gigi is invoked.  */
+
+      /* This is not called for the main unit, which is handled in function
+        gigi above.  */
+      start_stmt_group ();
+      gnat_pushlevel ();
+
       Compilation_Unit_to_gnu (gnat_node);
       gnu_result = alloc_stmt_list ();
       break;
@@ -5381,8 +5171,7 @@ gnat_to_gnu (Node_Id gnat_node)
                gnu_actual_obj_type
                  = build_unc_object_type_from_ptr (gnu_ptr_type,
                                                    gnu_actual_obj_type,
-                                                   get_identifier ("DEALLOC"),
-                                                   false);
+                                                   get_identifier ("DEALLOC"));
            }
          else
            gnu_actual_obj_type = gnu_obj_type;
@@ -5392,12 +5181,16 @@ gnat_to_gnu (Node_Id gnat_node)
          if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
              && TYPE_CONTAINS_TEMPLATE_P (gnu_obj_type))
            {
-             tree gnu_char_ptr_type
-               = build_pointer_type (unsigned_char_type_node);
+             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 (sizetype,
+                          size_diffop (size_zero_node, gnu_pos));
+             gnu_byte_offset = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+
              gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
              gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
-                                        gnu_ptr, gnu_pos);
+                                        gnu_ptr, gnu_byte_offset);
            }
 
          gnu_result
@@ -5518,33 +5311,35 @@ gnat_to_gnu (Node_Id gnat_node)
       gnu_result = alloc_stmt_list ();
       break;
 
+    case N_SCIL_Dispatch_Table_Object_Init:
+    case N_SCIL_Dispatch_Table_Tag_Init:
+    case N_SCIL_Dispatching_Call:
+    case N_SCIL_Membership_Test:
+    case N_SCIL_Tag_Init:
+      /* SCIL nodes require no processing for GCC.  */
+      gnu_result = alloc_stmt_list ();
+      break;
+
+    case N_Raise_Statement:
+    case N_Function_Specification:
+    case N_Procedure_Specification:
+    case N_Op_Concat:
+    case N_Component_Association:
+    case N_Task_Body:
     default:
-      /* SCIL nodes require no processing for GCC.  Other nodes should only
-        be present when annotating types.  */
-      gcc_assert (IN (kind, N_SCIL_Node) || type_annotate_only);
+      gcc_assert (type_annotate_only);
       gnu_result = alloc_stmt_list ();
     }
 
-  /* If we pushed the processing of the elaboration routine, pop it back.  */
+  /* If we pushed our level as part of processing the elaboration routine,
+     pop it back now.  */
   if (went_into_elab_proc)
-    current_function_decl = NULL_TREE;
-
-  /* When not optimizing, turn boolean rvalues B into B != false tests
-     so that the code just below can put the location information of the
-     reference to B on the inequality operator for better debug info.  */
-  if (!optimize
-      && (kind == N_Identifier
-         || kind == N_Expanded_Name
-         || kind == N_Explicit_Dereference
-         || kind == N_Function_Call
-         || kind == N_Indexed_Component
-         || kind == N_Selected_Component)
-      && TREE_CODE (get_base_type (gnu_result_type)) == BOOLEAN_TYPE
-      && !lvalue_required_p (gnat_node, gnu_result_type, false, false, false))
-    gnu_result = build_binary_op (NE_EXPR, gnu_result_type,
-                                 convert (gnu_result_type, gnu_result),
-                                 convert (gnu_result_type,
-                                          boolean_false_node));
+    {
+      add_stmt (gnu_result);
+      gnat_poplevel ();
+      gnu_result = end_stmt_group ();
+      current_function_decl = NULL_TREE;
+    }
 
   /* Set the location information on the result if it is a real expression.
      References can be reused for multiple GNAT nodes and they would get
@@ -5579,7 +5374,7 @@ gnat_to_gnu (Node_Id gnat_node)
   if (TREE_SIDE_EFFECTS (gnu_result)
       && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
          || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
-    gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
+    gnu_result = gnat_stabilize_reference (gnu_result, false);
 
   /* Now convert the result to the result type, unless we are in one of the
      following cases:
@@ -5810,7 +5605,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
       else
        t = gnu_decl;
 
-      gnu_stmt = build_binary_op (INIT_EXPR, NULL_TREE, t, gnu_init);
+      gnu_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, t, gnu_init);
 
       DECL_INITIAL (gnu_decl) = NULL_TREE;
       if (TREE_READONLY (gnu_decl))
@@ -5854,6 +5649,20 @@ mark_visited (tree t)
   walk_tree (&t, mark_visited_r, NULL, NULL);
 }
 
+/* Utility function to unshare expressions wrapped up in a SAVE_EXPR.  */
+
+static tree
+unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
+                  void *data ATTRIBUTE_UNUSED)
+{
+  tree t = *tp;
+
+  if (TREE_CODE (t) == SAVE_EXPR)
+    TREE_OPERAND (t, 0) = unshare_expr (TREE_OPERAND (t, 0));
+
+  return NULL_TREE;
+}
+
 /* Add GNU_CLEANUP, a cleanup action, to the current code group and
    set its location to that of GNAT_NODE if present.  */
 
@@ -6009,33 +5818,49 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
     case ADDR_EXPR:
       op = TREE_OPERAND (expr, 0);
 
-      if (TREE_CODE (op) == CONSTRUCTOR)
+      /* If we are 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 in static memory when
+        the reference is in an elaboration procedure.  */
+      if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op))
        {
-         /* If we are taking the address of a constant CONSTRUCTOR, make sure
-            it is put into static memory.  We know it's going to be read-only
-            given the semantics we have and it must be in static memory when
-            the reference is in an elaboration procedure.  */
-         if (TREE_CONSTANT (op))
-           {
-             tree addr = build_fold_addr_expr (tree_output_constant_def (op));
-             *expr_p = fold_convert (TREE_TYPE (expr), addr);
-           }
+         tree new_var = create_tmp_var (TREE_TYPE (op), "C");
+         TREE_ADDRESSABLE (new_var) = 1;
 
-         /* Otherwise explicitly create the local temporary.  That's required
-            if the type is passed by reference.  */
-         else
-           {
-             tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
-             TREE_ADDRESSABLE (new_var) = 1;
-             gimple_add_tmp_var (new_var);
+         TREE_READONLY (new_var) = 1;
+         TREE_STATIC (new_var) = 1;
+         DECL_INITIAL (new_var) = op;
 
-             mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op);
-             gimplify_and_add (mod, pre_p);
+         TREE_OPERAND (expr, 0) = new_var;
+         recompute_tree_invariant_for_addr_expr (expr);
+         return GS_ALL_DONE;
+       }
 
-             TREE_OPERAND (expr, 0) = new_var;
-             recompute_tree_invariant_for_addr_expr (expr);
-           }
+      /* If we are taking the address of a SAVE_EXPR, we are typically dealing
+        with a misaligned argument to be passed by reference in a subprogram
+        call.  We cannot let the common gimplifier code perform the creation
+        of the temporary and its initialization because, in order to ensure
+        that the final copy operation is a store and since the temporary made
+        for a SAVE_EXPR is not addressable, it may create another temporary,
+        addressable this time, which would break the back copy mechanism for
+        an IN OUT parameter.  */
+      if (TREE_CODE (op) == SAVE_EXPR && !SAVE_EXPR_RESOLVED_P (op))
+       {
+         tree mod, val = TREE_OPERAND (op, 0);
+         tree new_var = create_tmp_var (TREE_TYPE (op), "S");
+         TREE_ADDRESSABLE (new_var) = 1;
+
+         mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, val);
+         if (EXPR_HAS_LOCATION (val))
+           SET_EXPR_LOCATION (mod, EXPR_LOCATION (val));
+         gimplify_and_add (mod, pre_p);
+         ggc_free (mod);
 
+         TREE_OPERAND (op, 0) = new_var;
+         SAVE_EXPR_RESOLVED_P (op) = 1;
+
+         TREE_OPERAND (expr, 0) = new_var;
+         recompute_tree_invariant_for_addr_expr (expr);
          return GS_ALL_DONE;
        }
 
@@ -6103,43 +5928,43 @@ gnat_gimplify_stmt (tree *stmt_p)
     case LOOP_STMT:
       {
        tree gnu_start_label = create_artificial_label (input_location);
-       tree gnu_cond = LOOP_STMT_COND (stmt);
-       tree gnu_update = LOOP_STMT_UPDATE (stmt);
        tree gnu_end_label = LOOP_STMT_LABEL (stmt);
        tree t;
 
-       /* Build the condition expression from the test, if any.  */
-       if (gnu_cond)
-         gnu_cond
-           = build3 (COND_EXPR, void_type_node, gnu_cond, alloc_stmt_list (),
-                     build1 (GOTO_EXPR, void_type_node, gnu_end_label));
-
        /* Set to emit the statements of the loop.  */
        *stmt_p = NULL_TREE;
 
-       /* We first emit the start label and then a conditional jump to the
-          end label if there's a top condition, then the update if it's at
-          the top, then the body of the loop, then a conditional jump to
-          the end label if there's a bottom condition, then the update if
-          it's at the bottom, and finally a jump to the start label and the
-          definition of the end label.  */
+       /* We first emit the start label and then a conditional jump to
+          the end label if there's a top condition, then the body of the
+          loop, then a conditional branch to the end label, then the update,
+          if any, and finally a jump to the start label and the definition
+          of the end label.  */
        append_to_statement_list (build1 (LABEL_EXPR, void_type_node,
                                          gnu_start_label),
                                  stmt_p);
 
-        if (gnu_cond && !LOOP_STMT_BOTTOM_COND_P (stmt))
-         append_to_statement_list (gnu_cond, stmt_p);
-
-        if (gnu_update && LOOP_STMT_TOP_UPDATE_P (stmt))
-         append_to_statement_list (gnu_update, stmt_p);
+       if (LOOP_STMT_TOP_COND (stmt))
+         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 (gnu_cond && LOOP_STMT_BOTTOM_COND_P (stmt))
-         append_to_statement_list (gnu_cond, stmt_p);
+       if (LOOP_STMT_BOT_COND (stmt))
+         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 (gnu_update && !LOOP_STMT_TOP_UPDATE_P (stmt))
-         append_to_statement_list (gnu_update, stmt_p);
+       if (LOOP_STMT_UPDATE (stmt))
+         append_to_statement_list (LOOP_STMT_UPDATE (stmt), stmt_p);
 
        t = build1 (GOTO_EXPR, void_type_node, gnu_start_label);
        SET_EXPR_LOCATION (t, DECL_SOURCE_LOCATION (gnu_end_label));
@@ -6234,85 +6059,92 @@ elaborate_all_entities (Node_Id gnat_node)
     elaborate_all_entities (Library_Unit (gnat_node));
 }
 \f
-/* Do the processing of GNAT_NODE, an N_Freeze_Entity.  */
+/* Do the processing of N_Freeze_Entity, GNAT_NODE.  */
 
 static void
 process_freeze_entity (Node_Id gnat_node)
 {
-  const Entity_Id gnat_entity = Entity (gnat_node);
-  const Entity_Kind kind = Ekind (gnat_entity);
-  tree gnu_old, gnu_new;
+  Entity_Id gnat_entity = Entity (gnat_node);
+  tree gnu_old;
+  tree gnu_new;
+  tree gnu_init
+    = (Nkind (Declaration_Node (gnat_entity)) == N_Object_Declaration
+       && present_gnu_tree (Declaration_Node (gnat_entity)))
+      ? get_gnu_tree (Declaration_Node (gnat_entity)) : NULL_TREE;
 
-  /* If this is a package, we need to generate code for the package.  */
-  if (kind == E_Package)
+  /* If this is a package, need to generate code for the package.  */
+  if (Ekind (gnat_entity) == E_Package)
     {
       insert_code_for
-       (Parent (Corresponding_Body
-                (Parent (Declaration_Node (gnat_entity)))));
+       (Parent (Corresponding_Body
+                (Parent (Declaration_Node (gnat_entity)))));
       return;
     }
 
-  /* Don't do anything for class-wide types as they are always transformed
-     into their root type.  */
-  if (kind == E_Class_Wide_Type)
-    return;
-
-  /* Check for an old definition.  This freeze node might be for an Itype.  */
+  /* Check for old definition after the above call.  This Freeze_Node
+     might be for one its Itypes.  */
   gnu_old
-    = present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) : NULL_TREE;
+    = present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) : 0;
 
-  /* If this entity has an address representation clause, GNU_OLD is the
+  /* If this entity has an Address representation clause, GNU_OLD is the
      address, so discard it here.  */
   if (Present (Address_Clause (gnat_entity)))
-    gnu_old = NULL_TREE;
+    gnu_old = 0;
+
+  /* Don't do anything for class-wide types as they are always transformed
+     into their root type.  */
+  if (Ekind (gnat_entity) == E_Class_Wide_Type)
+    return;
 
   /* Don't do anything for subprograms that may have been elaborated before
-     their freeze nodes.  This can happen, for example, because of an inner
-     call in an instance body or because of previous compilation of a spec
-     for inlining purposes.  */
+     their freeze nodes.  This can happen, for example because of an inner call
+     in an instance body, or a previous compilation of a spec for inlining
+     purposes.  */
   if (gnu_old
       && ((TREE_CODE (gnu_old) == FUNCTION_DECL
-          && (kind == E_Function || kind == E_Procedure))
-         || (TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
-             && kind == E_Subprogram_Type)))
+          && (Ekind (gnat_entity) == E_Function
+              || Ekind (gnat_entity) == E_Procedure))
+         || (gnu_old
+             && TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
+             && Ekind (gnat_entity) == E_Subprogram_Type)))
     return;
 
   /* If we have a non-dummy type old tree, we have nothing to do, except
      aborting if this is the public view of a private type whose full view was
      not delayed, as this node was never delayed as it should have been.  We
      let this happen for concurrent types and their Corresponding_Record_Type,
-     however, because each might legitimately be elaborated before its own
+     however, because each might legitimately be elaborated before it's own
      freeze node, e.g. while processing the other.  */
   if (gnu_old
       && !(TREE_CODE (gnu_old) == TYPE_DECL
           && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_old))))
     {
-      gcc_assert ((IN (kind, Incomplete_Or_Private_Kind)
+      gcc_assert ((IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
                   && Present (Full_View (gnat_entity))
                   && No (Freeze_Node (Full_View (gnat_entity))))
                  || Is_Concurrent_Type (gnat_entity)
-                 || (IN (kind, Record_Kind)
+                 || (IN (Ekind (gnat_entity), Record_Kind)
                      && Is_Concurrent_Record_Type (gnat_entity)));
       return;
     }
 
   /* Reset the saved tree, if any, and elaborate the object or type for real.
-     If there is a full view, elaborate it and use the result.  And, if this
-     is the root type of a class-wide type, reuse it for the latter.  */
+     If there is a full declaration, elaborate it and copy the type to
+     GNAT_ENTITY.  Likewise if this is the record subtype corresponding to
+     a class wide type or subtype.  */
   if (gnu_old)
     {
       save_gnu_tree (gnat_entity, NULL_TREE, false);
-      if (IN (kind, Incomplete_Or_Private_Kind)
-         && Present (Full_View (gnat_entity))
-         && present_gnu_tree (Full_View (gnat_entity)))
-       save_gnu_tree (Full_View (gnat_entity), NULL_TREE, false);
-      if (IN (kind, Type_Kind)
-         && Present (Class_Wide_Type (gnat_entity))
-         && Root_Type (Class_Wide_Type (gnat_entity)) == gnat_entity)
+      if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
+         && Present (Full_View (gnat_entity))
+         && present_gnu_tree (Full_View (gnat_entity)))
+       save_gnu_tree (Full_View (gnat_entity), NULL_TREE, false);
+      if (Present (Class_Wide_Type (gnat_entity))
+         && Class_Wide_Type (gnat_entity) != gnat_entity)
        save_gnu_tree (Class_Wide_Type (gnat_entity), NULL_TREE, false);
     }
 
-  if (IN (kind, Incomplete_Or_Private_Kind)
+  if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
       && Present (Full_View (gnat_entity)))
     {
       gnu_new = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 1);
@@ -6328,25 +6160,16 @@ process_freeze_entity (Node_Id gnat_node)
        Set_RM_Size (gnat_entity, RM_Size (Full_View (gnat_entity)));
 
       /* The above call may have defined this entity (the simplest example
-        of this is when we have a private enumeral type since the bounds
-        will have the public view).  */
+        of this is when we have a private enumeral type since the bounds
+        will have the public view.  */
       if (!present_gnu_tree (gnat_entity))
-       save_gnu_tree (gnat_entity, gnu_new, false);
+       save_gnu_tree (gnat_entity, gnu_new, false);
+      if (Present (Class_Wide_Type (gnat_entity))
+         && Class_Wide_Type (gnat_entity) != gnat_entity)
+       save_gnu_tree (Class_Wide_Type (gnat_entity), gnu_new, false);
     }
   else
-    {
-      tree gnu_init
-       = (Nkind (Declaration_Node (gnat_entity)) == N_Object_Declaration
-          && present_gnu_tree (Declaration_Node (gnat_entity)))
-         ? get_gnu_tree (Declaration_Node (gnat_entity)) : NULL_TREE;
-
-      gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, 1);
-    }
-
-  if (IN (kind, Type_Kind)
-      && Present (Class_Wide_Type (gnat_entity))
-      && Root_Type (Class_Wide_Type (gnat_entity)) == gnat_entity)
-    save_gnu_tree (Class_Wide_Type (gnat_entity), gnu_new, false);
+    gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, 1);
 
   /* If we've made any pointers to the old version of this type, we
      have to update them.  */
@@ -6355,6 +6178,42 @@ process_freeze_entity (Node_Id gnat_node)
                       TREE_TYPE (gnu_new));
 }
 \f
+/* Process the list of inlined subprograms of GNAT_NODE, which is an
+   N_Compilation_Unit.  */
+
+static void
+process_inlined_subprograms (Node_Id gnat_node)
+{
+  Entity_Id gnat_entity;
+  Node_Id gnat_body;
+
+  /* If we can inline, generate Gimple for all the inlined subprograms.
+     Define the entity first so we set DECL_EXTERNAL.  */
+  if (optimize > 0)
+    for (gnat_entity = First_Inlined_Subprogram (gnat_node);
+        Present (gnat_entity);
+        gnat_entity = Next_Inlined_Subprogram (gnat_entity))
+      {
+       gnat_body = Parent (Declaration_Node (gnat_entity));
+
+       if (Nkind (gnat_body) != N_Subprogram_Body)
+         {
+           /* ??? This really should always be Present.  */
+           if (No (Corresponding_Body (gnat_body)))
+             continue;
+
+           gnat_body
+             = Parent (Declaration_Node (Corresponding_Body (gnat_body)));
+         }
+
+       if (Present (gnat_body))
+         {
+           gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
+           add_stmt (gnat_to_gnu (gnat_body));
+         }
+      }
+}
+\f
 /* Elaborate decls in the lists GNAT_DECLS and GNAT_DECLS2, if present.
    We make two passes, one to elaborate anything other than bodies (but
    we declare a function if there was no spec).  The second pass
@@ -6494,9 +6353,9 @@ build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand,
 {
   gcc_assert (code == NEGATE_EXPR || code == ABS_EXPR);
 
-  operand = gnat_protect_expr (operand);
+  operand = protect_multiple_eval (operand);
 
-  return emit_check (build_binary_op (EQ_EXPR, boolean_type_node,
+  return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
                                      operand, TYPE_MIN_VALUE (gnu_type)),
                     build_unary_op (code, gnu_type, operand),
                     CE_Overflow_Check_Failed, gnat_node);
@@ -6513,8 +6372,8 @@ static tree
 build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
                       tree right, Node_Id gnat_node)
 {
-  tree lhs = gnat_protect_expr (left);
-  tree rhs = gnat_protect_expr (right);
+  tree lhs = protect_multiple_eval (left);
+  tree rhs = protect_multiple_eval (right);
   tree type_max = TYPE_MAX_VALUE (gnu_type);
   tree type_min = TYPE_MIN_VALUE (gnu_type);
   tree gnu_expr;
@@ -6540,8 +6399,8 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
     }
 
   rhs_lt_zero = tree_expr_nonnegative_p (rhs)
-               ? boolean_false_node
-               : build_binary_op (LT_EXPR, boolean_type_node, rhs, zero);
+               ? integer_zero_node
+               : build_binary_op (LT_EXPR, integer_type_node, rhs, zero);
 
   /* ??? Should use more efficient check for operand_equal_p (lhs, rhs, 0) */
 
@@ -6577,10 +6436,10 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
                                              convert (wide_type, rhs));
 
          tree check = build_binary_op
-           (TRUTH_ORIF_EXPR, boolean_type_node,
-            build_binary_op (LT_EXPR, boolean_type_node, wide_result,
+           (TRUTH_ORIF_EXPR, integer_type_node,
+            build_binary_op (LT_EXPR, integer_type_node, wide_result,
                              convert (wide_type, type_min)),
-            build_binary_op (GT_EXPR, boolean_type_node, wide_result,
+            build_binary_op (GT_EXPR, integer_type_node, wide_result,
                              convert (wide_type, type_max)));
 
          tree result = convert (gnu_type, wide_result);
@@ -6603,9 +6462,9 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
          /* Overflow when (rhs < 0) ^ (wrapped_expr < lhs)), for addition
             or when (rhs < 0) ^ (wrapped_expr > lhs) for subtraction.  */
          tree check = build_binary_op
-           (TRUTH_XOR_EXPR, boolean_type_node, rhs_lt_zero,
+           (TRUTH_XOR_EXPR, integer_type_node, rhs_lt_zero,
             build_binary_op (code == PLUS_EXPR ? LT_EXPR : GT_EXPR,
-                             boolean_type_node, wrapped_expr, lhs));
+                             integer_type_node, wrapped_expr, lhs));
 
          return
            emit_check (check, result, CE_Overflow_Check_Failed, gnat_node);
@@ -6616,24 +6475,24 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
     {
     case PLUS_EXPR:
       /* When rhs >= 0, overflow when lhs > type_max - rhs.  */
-      check_pos = build_binary_op (GT_EXPR, boolean_type_node, lhs,
+      check_pos = build_binary_op (GT_EXPR, integer_type_node, lhs,
                                   build_binary_op (MINUS_EXPR, gnu_type,
                                                    type_max, rhs)),
 
       /* When rhs < 0, overflow when lhs < type_min - rhs.  */
-      check_neg = build_binary_op (LT_EXPR, boolean_type_node, lhs,
+      check_neg = build_binary_op (LT_EXPR, integer_type_node, lhs,
                                   build_binary_op (MINUS_EXPR, gnu_type,
                                                    type_min, rhs));
       break;
 
     case MINUS_EXPR:
       /* When rhs >= 0, overflow when lhs < type_min + rhs.  */
-      check_pos = build_binary_op (LT_EXPR, boolean_type_node, lhs,
+      check_pos = build_binary_op (LT_EXPR, integer_type_node, lhs,
                                   build_binary_op (PLUS_EXPR, gnu_type,
                                                    type_min, rhs)),
 
       /* When rhs < 0, overflow when lhs > type_max + rhs.  */
-      check_neg = build_binary_op (GT_EXPR, boolean_type_node, lhs,
+      check_neg = build_binary_op (GT_EXPR, integer_type_node, lhs,
                                   build_binary_op (PLUS_EXPR, gnu_type,
                                                    type_max, rhs));
       break;
@@ -6651,31 +6510,19 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
       tmp1 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_max, rhs);
       tmp2 = build_binary_op (TRUNC_DIV_EXPR, gnu_type, type_min, rhs);
 
-      check_pos
-       = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
-                          build_binary_op (NE_EXPR, boolean_type_node, zero,
-                                           rhs),
-                          build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
-                                           build_binary_op (GT_EXPR,
-                                                            boolean_type_node,
-                                                            lhs, tmp1),
-                                           build_binary_op (LT_EXPR,
-                                                            boolean_type_node,
-                                                            lhs, tmp2)));
-
-      check_neg
-       = fold_build3 (COND_EXPR, boolean_type_node,
-                      build_binary_op (EQ_EXPR, boolean_type_node, rhs,
-                                       build_int_cst (gnu_type, -1)),
-                      build_binary_op (EQ_EXPR, boolean_type_node, lhs,
-                                       type_min),
-                      build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
-                                       build_binary_op (GT_EXPR,
-                                                        boolean_type_node,
-                                                        lhs, tmp2),
-                                       build_binary_op (LT_EXPR,
-                                                        boolean_type_node,
-                                                        lhs, tmp1)));
+      check_pos = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+                   build_binary_op (NE_EXPR, integer_type_node, zero, rhs),
+                   build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+                     build_binary_op (GT_EXPR, integer_type_node, lhs, tmp1),
+                     build_binary_op (LT_EXPR, integer_type_node, lhs, tmp2)));
+
+      check_neg = fold_build3 (COND_EXPR, integer_type_node,
+                   build_binary_op (EQ_EXPR, integer_type_node, rhs,
+                                    build_int_cst (gnu_type, -1)),
+                   build_binary_op (EQ_EXPR, integer_type_node, lhs, type_min),
+                   build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+                     build_binary_op (GT_EXPR, integer_type_node, lhs, tmp2),
+                     build_binary_op (LT_EXPR, integer_type_node, lhs, tmp1)));
       break;
 
     default:
@@ -6689,8 +6536,8 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
   if (TREE_CONSTANT (gnu_expr))
     return gnu_expr;
 
-  check = fold_build3 (COND_EXPR, boolean_type_node, rhs_lt_zero, check_neg,
-                      check_pos);
+  check = fold_build3 (COND_EXPR, integer_type_node,
+                      rhs_lt_zero,  check_neg, check_pos);
 
   return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node);
 }
@@ -6722,20 +6569,21 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
     return gnu_expr;
 
   /* Checked expressions must be evaluated only once.  */
-  gnu_expr = gnat_protect_expr (gnu_expr);
+  gnu_expr = protect_multiple_eval (gnu_expr);
 
-  /* Note that the form of the check is
+  /* There's no good type to use here, so we might as well use
+     integer_type_node. Note that the form of the check is
        (not (expr >= lo)) or (not (expr <= hi))
      the reason for this slightly convoluted form is that NaNs
      are not considered to be in range in the float case.  */
   return emit_check
-    (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
+    (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
                      invert_truthvalue
-                     (build_binary_op (GE_EXPR, boolean_type_node,
+                     (build_binary_op (GE_EXPR, integer_type_node,
                                       convert (gnu_compare_type, gnu_expr),
                                       convert (gnu_compare_type, gnu_low))),
                      invert_truthvalue
-                     (build_binary_op (LE_EXPR, boolean_type_node,
+                     (build_binary_op (LE_EXPR, integer_type_node,
                                        convert (gnu_compare_type, gnu_expr),
                                        convert (gnu_compare_type,
                                                 gnu_high)))),
@@ -6761,7 +6609,7 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
   tree gnu_expr_check;
 
   /* Checked expressions must be evaluated only once.  */
-  gnu_expr = gnat_protect_expr (gnu_expr);
+  gnu_expr = protect_multiple_eval (gnu_expr);
 
   /* Must do this computation in the base type in case the expression's
      type is an unsigned subtypes.  */
@@ -6772,13 +6620,15 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
   gnu_low = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_low, gnu_array_object);
   gnu_high = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_high, gnu_array_object);
 
+  /* There's no good type to use here, so we might as well use
+     integer_type_node.   */
   return emit_check
-    (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
-                     build_binary_op (LT_EXPR, boolean_type_node,
+    (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
+                     build_binary_op (LT_EXPR, integer_type_node,
                                       gnu_expr_check,
                                       convert (TREE_TYPE (gnu_expr_check),
                                                gnu_low)),
-                     build_binary_op (GT_EXPR, boolean_type_node,
+                     build_binary_op (GT_EXPR, integer_type_node,
                                       gnu_expr_check,
                                       convert (TREE_TYPE (gnu_expr_check),
                                                gnu_high))),
@@ -6850,7 +6700,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
       && !(FLOAT_TYPE_P (gnu_base_type) && INTEGRAL_TYPE_P (gnu_in_basetype)))
     {
       /* Ensure GNU_EXPR only gets evaluated once.  */
-      tree gnu_input = gnat_protect_expr (gnu_result);
+      tree gnu_input = protect_multiple_eval (gnu_result);
       tree gnu_cond = integer_zero_node;
       tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_basetype);
       tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_basetype);
@@ -6891,7 +6741,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
             : 1))
        gnu_cond
          = invert_truthvalue
-           (build_binary_op (GE_EXPR, boolean_type_node,
+           (build_binary_op (GE_EXPR, integer_type_node,
                              gnu_input, convert (gnu_in_basetype,
                                                  gnu_out_lb)));
 
@@ -6902,9 +6752,9 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
                                 TREE_REAL_CST (gnu_in_lb))
             : 1))
        gnu_cond
-         = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, gnu_cond,
+         = build_binary_op (TRUTH_ORIF_EXPR, integer_type_node, gnu_cond,
                             invert_truthvalue
-                            (build_binary_op (LE_EXPR, boolean_type_node,
+                            (build_binary_op (LE_EXPR, integer_type_node,
                                               gnu_input,
                                               convert (gnu_in_basetype,
                                                        gnu_out_ub))));
@@ -6920,7 +6770,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
       && !truncatep)
     {
       REAL_VALUE_TYPE half_minus_pred_half, pred_half;
-      tree gnu_conv, gnu_zero, gnu_comp, calc_type;
+      tree gnu_conv, gnu_zero, gnu_comp, gnu_saved_result, calc_type;
       tree gnu_pred_half, gnu_add_pred_half, gnu_subtract_pred_half;
       const struct real_format *fmt;
 
@@ -6943,14 +6793,14 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
       gnu_pred_half = build_real (calc_type, pred_half);
 
       /* If the input is strictly negative, subtract this value
-        and otherwise add it from the input.  For 0.5, the result
+        and otherwise add it from the input. For 0.5, the result
         is exactly between 1.0 and the machine number preceding 1.0
-        (for calc_type).  Since the last bit of 1.0 is even, this 0.5
+        (for calc_type). Since the last bit of 1.0 is even, this 0.5
         will round to 1.0, while all other number with an absolute
-        value less than 0.5 round to 0.0.  For larger numbers exactly
+        value less than 0.5 round to 0.0. For larger numbers exactly
         halfway between integers, rounding will always be correct as
         the true mathematical result will be closer to the higher
-        integer compared to the lower one.  So, this constant works
+        integer compared to the lower one. So, this constant works
         for all floating-point numbers.
 
         The reason to use the same constant with subtract/add instead
@@ -6959,16 +6809,16 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
         conversion of the input to the calc_type (if necessary).  */
 
       gnu_zero = convert (gnu_in_basetype, integer_zero_node);
-      gnu_result = gnat_protect_expr (gnu_result);
-      gnu_conv = convert (calc_type, gnu_result);
-      gnu_comp
-       = fold_build2 (GE_EXPR, boolean_type_node, gnu_result, gnu_zero);
+      gnu_saved_result = save_expr (gnu_result);
+      gnu_conv = convert (calc_type, gnu_saved_result);
+      gnu_comp = build2 (GE_EXPR, integer_type_node,
+                        gnu_saved_result, gnu_zero);
       gnu_add_pred_half
-       = fold_build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+       = build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
       gnu_subtract_pred_half
-       = fold_build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
-      gnu_result = fold_build3 (COND_EXPR, calc_type, gnu_comp,
-                               gnu_add_pred_half, gnu_subtract_pred_half);
+       = build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+      gnu_result = build3 (COND_EXPR, calc_type, gnu_comp,
+                          gnu_add_pred_half, gnu_subtract_pred_half);
     }
 
   if (TREE_CODE (gnu_base_type) == INTEGER_TYPE
@@ -6978,8 +6828,10 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
   else
     gnu_result = convert (gnu_base_type, gnu_result);
 
-  /* Finally, do the range check if requested.  Note that if the result type
-     is a modular type, the range check is actually an overflow check.  */
+  /* Finally, do the range check if requested.  Note that if the
+     result type is a modular type, the range check is actually
+     an overflow check.  */
+
   if (rangep
       || (TREE_CODE (gnu_base_type) == INTEGER_TYPE
          && TYPE_MODULAR_P (gnu_base_type) && overflowp))
@@ -6988,28 +6840,28 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
   return convert (gnu_type, gnu_result);
 }
 \f
-/* Return true if TYPE is a smaller form of ORIG_TYPE.  */
+/* Return true if TYPE is a smaller packable version of RECORD_TYPE.  */
 
 static bool
-smaller_form_type_p (tree type, tree orig_type)
+smaller_packable_type_p (tree type, tree record_type)
 {
-  tree size, osize;
+  tree size, rsize;
 
   /* We're not interested in variants here.  */
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (orig_type))
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (record_type))
     return false;
 
   /* Like a variant, a packable version keeps the original TYPE_NAME.  */
-  if (TYPE_NAME (type) != TYPE_NAME (orig_type))
+  if (TYPE_NAME (type) != TYPE_NAME (record_type))
     return false;
 
   size = TYPE_SIZE (type);
-  osize = TYPE_SIZE (orig_type);
+  rsize = TYPE_SIZE (record_type);
 
-  if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (osize) == INTEGER_CST))
+  if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (rsize) == INTEGER_CST))
     return false;
 
-  return tree_int_cst_lt (size, osize) != 0;
+  return tree_int_cst_lt (size, rsize) != 0;
 }
 
 /* Return true if GNU_EXPR can be directly addressed.  This is the case
@@ -7074,21 +6926,13 @@ smaller_form_type_p (tree type, tree orig_type)
 static bool
 addressable_p (tree gnu_expr, tree gnu_type)
 {
-  /* For an integral type, the size of the actual type of the object may not
-     be greater than that of the expected type, otherwise an indirect access
-     in the latter type wouldn't correctly set all the bits of the object.  */
-  if (gnu_type
-      && INTEGRAL_TYPE_P (gnu_type)
-      && smaller_form_type_p (gnu_type, TREE_TYPE (gnu_expr)))
-    return false;
-
-  /* The size of the actual type of the object may not be smaller than that
-     of the expected type, otherwise an indirect access in the latter type
-     would be larger than the object.  But only record types need to be
-     considered in practice for this case.  */
+  /* The size of the real type of the object must not be smaller than
+     that of the expected type, otherwise an indirect access in the
+     latter type would be larger than the object.  Only records need
+     to be considered in practice.  */
   if (gnu_type
       && TREE_CODE (gnu_type) == RECORD_TYPE
-      && smaller_form_type_p (TREE_TYPE (gnu_expr), gnu_type))
+      && smaller_packable_type_p (TREE_TYPE (gnu_expr), gnu_type))
     return false;
 
   switch (TREE_CODE (gnu_expr))
@@ -7103,19 +6947,11 @@ addressable_p (tree gnu_expr, tree gnu_type)
 
     case UNCONSTRAINED_ARRAY_REF:
     case INDIRECT_REF:
-      /* Taking the address of a dereference yields the original pointer.  */
       return true;
 
+    case CONSTRUCTOR:
     case STRING_CST:
     case INTEGER_CST:
-      /* Taking the address yields a pointer to the constant pool.  */
-      return true;
-
-    case CONSTRUCTOR:
-      /* Taking the address of a static constructor yields a pointer to the
-        tree constant pool.  */
-      return TREE_STATIC (gnu_expr) ? true : false;
-
     case NULL_EXPR:
     case SAVE_EXPR:
     case CALL_EXPR:
@@ -7129,10 +6965,6 @@ addressable_p (tree gnu_expr, tree gnu_type)
         force a temporary to be created by the middle-end.  */
       return true;
 
-    case COMPOUND_EXPR:
-      /* The address of a compound expression is that of its 2nd operand.  */
-      return addressable_p (TREE_OPERAND (gnu_expr, 1), gnu_type);
-
     case COND_EXPR:
       /* We accept &COND_EXPR as soon as both operands are addressable and
         expect the outcome to be the address of the selected operand.  */
@@ -7442,6 +7274,263 @@ maybe_implicit_deref (tree exp)
   return exp;
 }
 \f
+/* Protect EXP from multiple evaluation.  This may make a SAVE_EXPR.  */
+
+tree
+protect_multiple_eval (tree exp)
+{
+  tree type = TREE_TYPE (exp);
+
+  /* If EXP has no side effects, we theoritically don't need to do anything.
+     However, we may be recursively passed more and more complex expressions
+     involving checks which will be reused multiple times and eventually be
+     unshared for gimplification; in order to avoid a complexity explosion
+     at that point, we protect any expressions more complex than a simple
+     arithmetic expression.  */
+  if (!TREE_SIDE_EFFECTS (exp)
+      && (CONSTANT_CLASS_P (exp)
+         || !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp))))
+    return exp;
+
+  /* If this is a conversion, protect what's inside the conversion.
+     Similarly, if we're indirectly referencing something, we only
+     need to protect the address since the data itself can't change
+     in these situations.  */
+  if (TREE_CODE (exp) == NON_LVALUE_EXPR
+      || CONVERT_EXPR_P (exp)
+      || TREE_CODE (exp) == VIEW_CONVERT_EXPR
+      || TREE_CODE (exp) == INDIRECT_REF
+      || TREE_CODE (exp) == UNCONSTRAINED_ARRAY_REF)
+  return build1 (TREE_CODE (exp), type,
+                protect_multiple_eval (TREE_OPERAND (exp, 0)));
+
+  /* If this is a fat pointer or something that can be placed in a register,
+     just make a SAVE_EXPR.  Likewise for a CALL_EXPR as large objects are
+     returned via invisible reference in most ABIs so the temporary will
+     directly be filled by the callee.  */
+  if (TYPE_IS_FAT_POINTER_P (type)
+      || TYPE_MODE (type) != BLKmode
+      || TREE_CODE (exp) == CALL_EXPR)
+    return save_expr (exp);
+
+  /* Otherwise reference, protect the address and dereference.  */
+  return
+    build_unary_op (INDIRECT_REF, type,
+                   save_expr (build_unary_op (ADDR_EXPR,
+                                              build_reference_type (type),
+                                              exp)));
+}
+\f
+/* This is equivalent to stabilize_reference in tree.c, but we know how to
+   handle our own nodes and we take extra arguments.  FORCE says whether to
+   force evaluation of everything.  We set SUCCESS to true unless we walk
+   through something we don't know how to stabilize.  */
+
+tree
+maybe_stabilize_reference (tree ref, bool force, bool *success)
+{
+  tree type = TREE_TYPE (ref);
+  enum tree_code code = TREE_CODE (ref);
+  tree result;
+
+  /* Assume we'll success unless proven otherwise.  */
+  *success = true;
+
+  switch (code)
+    {
+    case CONST_DECL:
+    case VAR_DECL:
+    case PARM_DECL:
+    case RESULT_DECL:
+      /* No action is needed in this case.  */
+      return ref;
+
+    case ADDR_EXPR:
+    CASE_CONVERT:
+    case FLOAT_EXPR:
+    case FIX_TRUNC_EXPR:
+    case VIEW_CONVERT_EXPR:
+      result
+       = build1 (code, type,
+                 maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                            success));
+      break;
+
+    case INDIRECT_REF:
+    case UNCONSTRAINED_ARRAY_REF:
+      result = build1 (code, type,
+                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
+                                                  force));
+      break;
+
+    case COMPONENT_REF:
+     result = build3 (COMPONENT_REF, type,
+                     maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                                success),
+                     TREE_OPERAND (ref, 1), NULL_TREE);
+      break;
+
+    case BIT_FIELD_REF:
+      result = build3 (BIT_FIELD_REF, type,
+                      maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                                 success),
+                      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 = build4 (code, type,
+                      maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
+                                                 success),
+                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
+                                                  force),
+                      NULL_TREE, NULL_TREE);
+      break;
+
+    case CALL_EXPR:
+    case COMPOUND_EXPR:
+      result = gnat_stabilize_reference_1 (ref, force);
+      break;
+
+    case CONSTRUCTOR:
+      /* Constructors with 1 element are used extensively to formally
+        convert objects to special wrapping types.  */
+      if (TREE_CODE (type) == RECORD_TYPE
+         && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
+       {
+         tree index
+           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
+         tree value
+           = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
+         result
+           = build_constructor_single (type, index,
+                                       gnat_stabilize_reference_1 (value,
+                                                                   force));
+       }
+      else
+       {
+         *success = false;
+         return ref;
+       }
+      break;
+
+    case ERROR_MARK:
+      ref = error_mark_node;
+
+      /* ...  fall through to failure ... */
+
+      /* If arg isn't a kind of lvalue we recognize, make no change.
+        Caller should recognize the error for an invalid lvalue.  */
+    default:
+      *success = false;
+      return ref;
+    }
+
+  TREE_READONLY (result) = TREE_READONLY (ref);
+
+  /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS attached to the initial
+     expression may not be sustained across some paths, such as the way via
+     build1 for INDIRECT_REF.  We re-populate those flags here for the general
+     case, which is consistent with the GCC version of this routine.
+
+     Special care should be taken regarding TREE_SIDE_EFFECTS, because some
+     paths introduce side effects where there was none initially (e.g. calls
+     to save_expr), and we also want to keep track of that.  */
+
+  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
+
+  return result;
+}
+
+/* Wrapper around maybe_stabilize_reference, for common uses without
+   lvalue restrictions and without need to examine the success
+   indication.  */
+
+static tree
+gnat_stabilize_reference (tree ref, bool force)
+{
+  bool dummy;
+  return maybe_stabilize_reference (ref, force, &dummy);
+}
+
+/* Similar to stabilize_reference_1 in tree.c, but supports an extra
+   arg to force a SAVE_EXPR for everything.  */
+
+static tree
+gnat_stabilize_reference_1 (tree e, bool force)
+{
+  enum tree_code code = TREE_CODE (e);
+  tree type = TREE_TYPE (e);
+  tree result;
+
+  /* We cannot ignore const expressions because it might be a reference
+     to a const array but whose index contains side-effects.  But we can
+     ignore things that are actual constant or that already have been
+     handled by this function.  */
+
+  if (TREE_CONSTANT (e) || code == SAVE_EXPR)
+    return e;
+
+  switch (TREE_CODE_CLASS (code))
+    {
+    case tcc_exceptional:
+    case tcc_type:
+    case tcc_declaration:
+    case tcc_comparison:
+    case tcc_statement:
+    case tcc_expression:
+    case tcc_reference:
+    case tcc_vl_exp:
+      /* If this is a COMPONENT_REF of a fat pointer, save the entire
+        fat pointer.  This may be more efficient, but will also allow
+        us to more easily find the match for the PLACEHOLDER_EXPR.  */
+      if (code == COMPONENT_REF
+         && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
+       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
+       return e;
+      break;
+
+    case tcc_constant:
+      /* Constants need no processing.  In fact, we should never reach
+        here.  */
+      return e;
+
+    case tcc_binary:
+      /* Recursively stabilize each operand.  */
+      result = build2 (code, type,
+                      gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+                      gnat_stabilize_reference_1 (TREE_OPERAND (e, 1),
+                                                  force));
+      break;
+
+    case tcc_unary:
+      /* Recursively stabilize each operand.  */
+      result = build1 (code, type,
+                      gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
+                                                  force));
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  TREE_READONLY (result) = TREE_READONLY (e);
+
+  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
+  TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
+  return result;
+}
+\f
 /* Convert SLOC into LOCUS.  Return true if SLOC corresponds to a source code
    location and false if it doesn't.  In the former case, set the Gigi global
    variable REF_FILENAME to the simple debug file name as given by sinput.  */
@@ -7515,7 +7604,7 @@ decode_name (const char *name)
 \f
 /* Post an error message.  MSG is the error message, properly annotated.
    NODE is the node at which to post the error and the node to use for the
-   '&' substitution.  */
+   "&" substitution.  */
 
 void
 post_error (const char *msg, Node_Id node)
@@ -7529,8 +7618,8 @@ post_error (const char *msg, Node_Id node)
     Error_Msg_N (fp, node);
 }
 
-/* Similar to post_error, but NODE is the node at which to post the error and
-   ENT is the node to use for the '&' substitution.  */
+/* Similar, but NODE is the node at which to post the error and ENT
+   is the node to use for the "&" substitution.  */
 
 void
 post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
@@ -7544,37 +7633,56 @@ post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
     Error_Msg_NE (fp, node, ent);
 }
 
-/* Similar to post_error_ne, but NUM is the number to use for the '^'.  */
+/* Similar, but NODE is the node at which to post the error, ENT is the node
+   to use for the "&" substitution, and N is the number to use for the ^.  */
 
 void
-post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int num)
+post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int n)
 {
-  Error_Msg_Uint_1 = UI_From_Int (num);
-  post_error_ne (msg, node, ent);
+  String_Template temp;
+  Fat_Pointer fp;
+
+  temp.Low_Bound = 1, temp.High_Bound = strlen (msg);
+  fp.Array = msg, fp.Bounds = &temp;
+  Error_Msg_Uint_1 = UI_From_Int (n);
+
+  if (Present (node))
+    Error_Msg_NE (fp, node, ent);
 }
 \f
-/* Similar to post_error_ne, but T is a GCC tree representing the number to
-   write.  If T represents a constant, the text inside curly brackets in
-   MSG will be output (presumably including a '^').  Otherwise it will not
-   be output and the text inside square brackets will be output instead.  */
+/* Similar to post_error_ne_num, but T is a GCC tree representing the
+   number to write.  If the tree represents a constant that fits within
+   a host integer, the text inside curly brackets in MSG will be output
+   (presumably including a '^').  Otherwise that text will not be output
+   and the text inside square brackets will be output instead.  */
 
 void
 post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, tree t)
 {
-  char *new_msg = XALLOCAVEC (char, strlen (msg) + 1);
+  char *newmsg = XALLOCAVEC (char, strlen (msg) + 1);
+  String_Template temp = {1, 0};
+  Fat_Pointer fp;
   char start_yes, end_yes, start_no, end_no;
   const char *p;
   char *q;
 
-  if (TREE_CODE (t) == INTEGER_CST)
+  fp.Array = newmsg, fp.Bounds = &temp;
+
+  if (host_integerp (t, 1)
+#if HOST_BITS_PER_WIDE_INT > HOST_BITS_PER_INT
+      &&
+      compare_tree_int
+      (t, (((unsigned HOST_WIDE_INT) 1 << (HOST_BITS_PER_INT - 1)) - 1)) < 0
+#endif
+      )
     {
-      Error_Msg_Uint_1 = UI_From_gnu (t);
+      Error_Msg_Uint_1 = UI_From_Int (tree_low_cst (t, 1));
       start_yes = '{', end_yes = '}', start_no = '[', end_no = ']';
     }
   else
     start_yes = '[', end_yes = ']', start_no = '{', end_no = '}';
 
-  for (p = msg, q = new_msg; *p; p++)
+  for (p = msg, q = newmsg; *p; p++)
     {
       if (*p == start_yes)
        for (p++; *p != end_yes; p++)
@@ -7588,10 +7696,13 @@ post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, tree t)
 
   *q = 0;
 
-  post_error_ne (new_msg, node, ent);
+  temp.High_Bound = strlen (newmsg);
+  if (Present (node))
+    Error_Msg_NE (fp, node, ent);
 }
 
-/* Similar to post_error_ne_tree, but NUM is a second integer to write.  */
+/* Similar to post_error_ne_tree, except that NUM is a second
+   integer to write in the message.  */
 
 void
 post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,