2011-08-30 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 178289 using svnmerge.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@178293 138bc75d-0d04-0410-961f-82ee72b054a4

370 files changed, 18878 insertions, 8086 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 1da50b43221..105cfce613a 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,287 @@
+2011-08-30  Christian Bruel  <christian.bruel@st.com>
+
+	* coverage.c (coverage_init): Check flag_branch_probabilities instead of
+	flag_profile_use.
+	
+2011-08-29  Michael Meissner  <meissner@linux.vnet.ibm.com>
+
+	* config/rs6000/rs6000.opt (-msave-toc-indirect): Change default
+	to off.  Document switch.
+	* doc/invoke.texi (-msave-toc-indirect): Ditto.
+
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+
+	* gthr-posix.h (__gthread_active_p): Do not use preprocessor
+	conditionals and comments inside macro arguments.
+
+20011-08-29  Artjoms Sinkarovs  <artyom.shinkaroff@gmail.com>
+	     Richard Guenther  <rguenther@suse.de>
+
+	* tree.h (constant_boolean_node): Adjust prototype.
+	* fold-const.c (fold_convert_loc): Move aggregate conversion
+	leeway down.
+	(constant_boolean_node): Make value parameter boolean, add
+	vector type handling.
+	(fold_unary_loc): Use constant_boolean_node.
+	(fold_binary_loc): Preserve types properly when folding
+	COMPLEX_EXPR <__real x, __imag x>.
+	* gimplify.c (gimplify_expr): Handle vector comparison.
+	* tree.def (EQ_EXPR, ...): Document behavior on vector typed
+	comparison.
+	* tree-cfg.c (verify_gimple_comparison): Verify vector typed
+	comparisons.
+
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/48722
+	* emit-rtl.c (unshare_all_rtl_again): For CALL_INSNs,
+	reset_used_flags also in CALL_INSN_FUNCTION_USAGE.
+	(verify_rtl_sharing): Likewise and verify_rtx_sharing
+	in there too.
+	(unshare_all_rtl_in_chain): For CALL_INSNs
+	copy_rtx_if_shared also CALL_INSN_FUNCTION_USAGE.
+
+2011-08-29  Richard Guenther  <rguenther@suse.de>
+
+	* gimple-fold.c (gimple_fold_stmt_to_constant_1): Set a location
+	on the built ADDR_EXPR.
+
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+
+	PR debug/50215
+	* var-tracking.c (create_entry_value): Call cselib_lookup_from_insn
+	before adding ENTRY_VALUE to val->locs.
+
+2011-08-28  Mikael Pettersson  <mikpe@it.uu.se>
+
+	PR bootstrap/50218
+	* tree-ssa-loop-ivopts.c (determine_use_iv_cost_condition): Initialize
+	comp.
+
+2011-08-27  Bernd Schmidt  <bernds@codesourcery.com>
+
+	* doc/rtl.texi (simple_return): Document.
+	(parallel, PATTERN): Here too.
+	* doc/md.texi (return): Mention it's allowed to expand to simple_return
+	in some cases.
+	(simple_return): Document standard pattern.
+	* gengenrtl.c (special_rtx): SIMPLE_RETURN is special.
+	* final.c (final_scan_insn): Use ANY_RETURN_P on body.
+	* reorg.c (function_return_label, function_simple_return_label):
+	New static variables, replacing...
+	(end_of_function_label): ... this.
+	(simplejump_or_return_p): New static function.
+	(optimize_skip, steal_delay_list_from_fallthrough,
+	fill_slots_from_thread): Use it.
+	(relax_delay_slots): Likewise.  Use ANY_RETURN_P on body.
+	(rare_destination, follow_jumps): Use ANY_RETURN_P on body.
+	(find_end_label): Take a new arg which is one of the two return
+	rtxs.  Depending on which, set either function_return_label or
+	function_simple_return_label.  All callers changed.
+	(make_return_insns): Make both kinds.
+	(dbr_schedule): Adjust for two kinds of end labels.
+	* function.c (emit_return_into_block): Set JUMP_LABEL properly.
+	* genemit.c (gen_exp): Handle SIMPLE_RETURN.
+	(gen_expand, gen_split): Use ANY_RETURN_P.
+	* df-scan.c (df_uses_record): Handle SIMPLE_RETURN.
+	* rtl.def (SIMPLE_RETURN): New code.
+	* ifcvt.c (find_if_case_1): Be more careful about
+	redirecting jumps to the EXIT_BLOCK.
+	* jump.c (condjump_p, condjump_in_parallel_p, any_condjump_p,
+	returnjump_p_1): Handle SIMPLE_RETURNs.
+	* print-rtl.c (print_rtx): Likewise.
+	* rtl.c (copy_rtx): Likewise.
+	* bt-load.c (compute_defs_uses_and_gen): Use ANY_RETURN_P.
+	* combine.c (simplify_set): Likewise.
+	* resource.c (find_dead_or_set_registers, mark_set_resources):
+	Likewise.
+	* emit-rtl.c (verify_rtx_sharing, classify_insn, copy_insn_1,
+	copy_rtx_if_shared_1, mark_used_flags): Handle SIMPLE_RETURNs.
+	(init_emit_regs): Initialize simple_return_rtx.
+	* cfglayout.c (fixup_reorder_chain): Pass a JUMP_LABEL to
+	force_nonfallthru_and_redirect.
+	* rtl.h (ANY_RETURN_P): Allow SIMPLE_RETURN.
+	(GR_SIMPLE_RETURN): New enum value.
+	(simple_return_rtx): New macro.
+	* basic-block.h (force_nonfallthru_and_redirect): Adjust
+	declaration.
+	* cfgrtl.c (force_nonfallthru_and_redirect): Take a new jump_label
+	argument.  All callers changed.  Be careful about what kinds of
+	returnjumps to generate.
+	* config/i386/3i86.c (ix86_pad_returns, ix86_count_insn_bb,
+	ix86_pad_short_function): Likewise.
+	* config/arm/arm.c (arm_final_prescan_insn): Handle both kinds
+	of return.
+	* config/mips/mips.md (any_return): New code_iterator.
+	(optab): Add cases for return and simple_return.
+	(return): Expand to a simple_return.
+	(simple_return): New pattern.
+	(*<optab>, *<optab>_internal for any_return): New patterns.
+	(return_internal): Remove.
+	* config/mips/mips.c (mips_expand_epilogue): Make the last insn
+	a simple_return_internal.
+
+2011-08-27  Uros Bizjak  <ubizjak@gmail.com>
+
+	* config/i386/sse.md (*absneg<mode>2): Fix split condition.
+	(vec_extract_lo_<mode>): Prevent both operands in memory.
+	(vec_extract_lo_v16hi): Ditto.
+	(*vec_extract_v4sf_mem): Add TARGET_SSE insn constraint.
+
+2011-08-27  Uros Bizjak  <ubizjak@gmail.com>
+
+	* config/i386/sse.md (mulv16qi3): Attach REG_EQUAL note.
+	(*sse2_mulv4si3): Ditto.
+	(mulv2di3): Ditto.
+	* config/i386/i386.c (legitimize_tls_address): Change REG_EQIV
+	notes to REG_EQUAL.
+
+2011-08-27  Uros Bizjak  <ubizjak@gmail.com>
+
+	PR target/50202
+	* config/i386/sse.md (sse4_2_pcmpestr): Emit NOTE_INSN_DELETED note
+	when all outputs are unused.
+	(sse4_2_pcmpistr): Ditto.
+
+2011-08-26  Uros Bizjak  <ubizjak@gmail.com>
+
+	* config/i386/i386.md (round<mode>2): New expander.
+	* config/i386/i386.c (enum ix86_builtins): Add
+	IX86_BUILTIN_ROUND{PS,PD}_AZ{,256}.
+	(struct builtin_description): Add __builtin_ia32_round{ps,pd}_az{,256}
+	descriptions.
+	(ix86_builtin_vectorized_function): Handle BUILT_IN_ROUND{,F} builtins.
+	(ix86_build_const_vector): Rewrite using loop with RTVEC_ELT accessor.
+
+2011-08-26  Uros Bizjak  <ubizjak@gmail.com>
+
+	PR middle-end/50083
+	* convert.c (convert_to_integer) <BUIT_IN_ROUND{,F,L}>: Convert
+	only when TARGET_C99_FUNCTIONS.
+	<BUILT_IN_NEARBYINT{,F,L}>: Ditto.
+	<BUILT_IN_RINT{,F,L}>: Ditto.
+
+2011-08-26  Michael Matz  <matz@suse.de>
+	    Jakub Jelinek  <jakub@redhat.com>
+
+	PR lto/50165
+	* lto-streamer-in.c (canon_file_name): Initialize new_slot->len;
+	don't call strlen twice, use memcpy.
+
+2011-08-26  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* config/i386/bmi2intrin.h: Allow in <immintrin.h>.
+	* config/i386/bmiintrin.h: Likewise.
+	* config/i386/lzcntintrin.h: Likewise.
+
+	* config/i386/immintrin.h: Include <lzcntintrin.h>,
+	<bmiintrin.h> and <bmi2intrin.h>.
+
+2011-08-26  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
+
+	PR target/50166
+	* acinclude.m4 (gcc_AC_INITFINI_ARRAY): Check count in main.
+	* configure: Regenerate.
+
+2011-08-26  Jakub Jelinek  <jakub@redhat.com>
+
+	PR c/50179
+	* c-typeck.c (c_process_expr_stmt): Skip over nops and
+	call mark_exp_read even if exprv is ADDR_EXPR.
+
+2011-08-26  Richard Sandiford  <richard.sandiford@linaro.org>
+
+	* df-problems.c (df_note_bb_compute): Pass uses rather than defs
+	to df_set_dead_notes_for_mw.
+
+2011-08-26  Richard Guenther  <rguenther@suse.de>
+
+	* varasm.c (decode_addr_const): Handle MEM_REF[&X, OFF].
+
+2011-08-26  Zdenek Dvorak  <ook@ucw.cz>
+	    Tom de Vries  <tom@codesourcery.com>
+
+	* tree-ssa-loop-ivopts.c (struct cost_pair): Add comp field.
+	(struct ivopts_data): Add loop_single_exit_p field.
+	(niter_for_exit): Change parameter desc_p into return value.  Return
+	desc if	desc->may_be_zero.  Free desc if unused.
+	(niter_for_single_dom_exit): Change return type.
+	(find_induction_variables): Handle changed return type of
+	niter_for_single_dom_exit.  Dump may_be_zero.
+	(add_candidate_1): Keep original base and step type for IP_ORIGINAL.
+	(set_use_iv_cost): Add and handle comp parameter.
+	(determine_use_iv_cost_generic, determine_use_iv_cost_address): Add
+	comp argument to set_use_iv_cost.
+	(strip_wrap_conserving_type_conversions, expr_equal_p)
+	(difference_cannot_overflow_p, iv_elimination_compare_lt): New function.
+	(may_eliminate_iv): Add comp parameter.  Handle new return type of
+	niter_for_exit.  Use loop_single_exit_p.  Use iv_elimination_compare_lt.
+	(determine_use_iv_cost_condition): Add comp argument to set_use_iv_cost
+	and may_eliminate_iv.
+	(rewrite_use_compare): Move call to iv_elimination_compare to ...
+	(may_eliminate_iv): Here.
+	(tree_ssa_iv_optimize_loop): Initialize loop_single_exit_p.
+
+2011-08-26  Tom de Vries  <tom@codesourcery.com>
+
+	* tree-pretty-print (dump_generic_node): Test for NULL_TREE before
+	accessing TREE_TYPE.
+
+2011-08-26  Jiangning Liu  <jiangning.liu@arm.com>
+
+	* config/arm/arm.md (*ior_scc_scc): Enable for Thumb2 as well.
+	(*ior_scc_scc_cmp): Likewise
+	(*and_scc_scc): Likewise.
+	(*and_scc_scc_cmp): Likewise.
+	(*and_scc_scc_nodom): Likewise.
+	(*cmp_ite0, *cmp_ite1, *cmp_and, *cmp_ior): Handle Thumb2.
+
+2011-08-26  Jakub Jelinek  <jakub@redhat.com>
+
+	* rtlanal.c (nonzero_bits1): Handle CLRSB.
+
+2011-08-26  Richard Guenther  <rguenther@suse.de>
+
+	* expr.c (string_constant): Handle &MEM_REF.
+
+2011-08-26  Andrew Stubbs  <ams@codesourcery.com>
+
+	* config/arm/arm.c (struct four_ints): New type.
+	(count_insns_for_constant): Delete function.
+	(find_best_start): Delete function.
+	(optimal_immediate_sequence): New function.
+	(optimal_immediate_sequence_1): New function.
+	(arm_gen_constant): Move constant splitting code to
+	optimal_immediate_sequence.
+	Rewrite constant negation/invertion code.
+
+2011-08-26  Andrew Stubbs  <ams@codesourcery.com>
+
+	* config/arm/arm-protos.h (const_ok_for_op): Add prototype.
+	* config/arm/arm.c (const_ok_for_op): Add support for addw/subw.
+	Remove prototype. Remove static function type.
+	* config/arm/arm.md (*arm_addsi3): Add addw/subw support.
+	Add arch attribute.
+	* config/arm/constraints.md (Pj, PJ): New constraints.
+
+2011-08-26  Ramana Radhakrishnan  <ramana.radhakrishnan@arm.com>
+
+	* config/arm/cortex-a9.md ("cortex_a9_mult_long"): New.
+	("cortex_a9_multiply_long"): New and use above.  Handle all
+	long multiply cases.
+	("cortex_a9_multiply"): Handle smmul and smmulr.
+	("cortex_a9_mac"): Handle smmla.
+
+2011-08-25  Richard Henderson  <rth@redhat.com>
+
+	PR 50132
+	PR 49864
+	* cfgcleanup.c (old_insns_match_p): Don't allow cross-jump for
+	non-constant stack adjutment.
+	* expr.c (find_args_size_adjust): Break out from ...
+	(fixup_args_size_notes): ... here.
+	* rtl.h (find_args_size_adjust): Declare.
+
 2011-08-25  Uros Bizjak  <ubizjak@gmail.com>
 
 	* config/i386/i386.md (isa): Add sse2, sse2_noavx, sse3,
@@ -368,8 +652,7 @@
 
 2011-08-22  H.J. Lu  <hongjiu.lu@intel.com>
 
-	* acinclude.m4 (gcc_AC_INITFINI_ARRAY): Error if __ELF__ isn't
-	defined.
+	* acinclude.m4 (gcc_AC_INITFINI_ARRAY): Error if __ELF__ isn't defined.
 	* configure: Regenerated.
 
 2011-08-22  Jakub Jelinek  <jakub@redhat.com>
diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP
index e80b7105271..1c548c213c4 100644
--- a/gcc/DATESTAMP
+++ b/gcc/DATESTAMP
@@ -1 +1 @@
-20110825
+20110830
diff --git a/gcc/acinclude.m4 b/gcc/acinclude.m4
index a8ecd2d4f6d..d8defea5a78 100644
--- a/gcc/acinclude.m4
+++ b/gcc/acinclude.m4
@@ -477,6 +477,8 @@ void (*const dtors65535[]) ()
 int
 main ()
 {
+  if (count != 65535)
+    abort ();
   return 0;
 }
 #endif
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3554868480c..ca620533c9f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,1809 @@
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+
+	* gcc-interface/Makefile.in (../stamp-gnatlib1-$(RTSDIR)): Copy
+	tsystem.h into $(RTSDIR) instead of rts.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch10.adb, a-coorse.adb, exp_dist.adb, exp_ch3.adb: Minor
+	reformatting.
+	* gcc-interface/Make-lang.in: Update dependencies.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* alfa.ads (Name_Of_Heap_Variable): New constant name.
+	* lib-xref-alfa.adb, lib-xref.adb, lib-xref.ads (Drefs): New global
+	table to hold dereferences.
+	(Add_ALFA_Xrefs): Take into account dereferences as special
+	reads/writes to the variable "HEAP".
+	(Enclosing_Subprogram_Or_Package): Move subprogram here.
+	(Generate_Dereference): New procedure to store a read/write dereferencew
+	in the table Drefs.
+	* put_alfa.adb (Put_ALFA): Use different default than (0,0) used for
+	the special "HEAP" var.
+	* sem_ch4.adb (Analyze_Explicit_Dereference): Store read dereference
+	in ALFA mode.
+	* sem_util.adb (Note_Possible_Modification): Store write dereference
+	in ALFA mode.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Freeze_Type): Generate an accessibility check which
+	ensures that the level of the subpool access type is not deeper than
+	that of the pool object.
+	* sem_util.adb (Object_Access_Level): Expand to handle defining
+	identifiers.
+	* sem_res.adb (Resolve_Allocator): Add a guard to avoid examining the
+	subpool handle name of a rewritten allocator.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* impunit.adb, exp_ch4.adb, s-finmas.adb: Minor reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_dist.adb (TC_Rec_Add_Process_Element): For a choice with multiple
+	values, we generate multiple triples of parameters in the TypeCode.
+	Bump Choice_Index for each such triple so that a subsequent default
+	choice is associated with the correct index in the typecode.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-cdlili.adb (Iterate): Initialize properly an iterator over a null
+	container.
+	(First, Last): Handle properly an iterator over a null container.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* sem_ch10.adb (Analyze_With_Clause,Install_Withed_Unit): Abandon
+	processing if we run across a node with no Scope. This can happen if
+	we're with-ing an library-level instance, and that instance got errors
+	that caused "instantiation abandoned".
+	* sem_util.adb (Unit_Declaration_Node): Make it more robust, by raising
+	an exception instead of using Assert, so it won't go into an infinite
+	loop, even when assertions are turned off.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-coorse.adb: Proper handling of empty ordered sets.
+
+2011-08-29  Johannes Kanig  <kanig@adacore.com>
+
+	* debug.adb: Add comments.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* a-except.adb, a-except-2005.adb: Minor comment rewording and
+	reformatting.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Array_Type_Declaration): Remove insertion of
+	declaration for Itypes in Alfa mode.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-cdlili.ads, a-coinve.ads, a-coorma.adb, a-coorma.ads, s-tassta.adb,
+	a-cborma.adb, a-cborma.ads, a-cohama.ads, a-coorse.ads, a-cbhama.ads,
+	a-cborse.ads, a-cobove.adb, a-cobove.ads, a-cbhase.ads: Minor
+	reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch7.adb, exp_ch7.ads (Build_Exception_Handler): Move its spec to
+	package spec.
+	* exp_intr.adb (Expand_Unc_Deallocation): Use Build_Exception_Handler.
+	* a-except.adb, a-except-2005.adb (Rcheck_22): Do not defer aborts
+	while raising PE.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-cbhama.adb, a-cbhama.ads: Minor reformatting.
+
+2011-08-29  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch8.adb (Analyze_Subprogram_Renaming): Complete support for
+	renamings of formal subprograms when the actual for a formal type is
+	class-wide.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cbhama.ads, a-cbhase.ads (Move): Clear Source following assignment
+	to Target.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cborma.ads, a-cborse.ads (Cursor): Default-initialize all
+	components of record type.
+	* a-cborma.adb, a-cborse.adb (Move): Clear Source following assignmentw
+	to Target.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-cbhama.adb, a-cbhama.ads, a-cborma.adb, a-cborma.ads, a-cobove.adb,
+	a-cobove.ads, a-coorma.adb, a-coorma.ads: Add iterator machinery to
+	container packages.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb, sem_util.adb, gnat1drv.adb, s-parint.ads: Minor
+	reformatting.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cbhama.ads, a-cbhase.ads (Cursor): Default-initialize all
+	components of record type.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* s-tassta.adb (Task_Wrapper): Handle and ignore exceptions propagated
+	by the termination handler.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Array_Type_Declaration): Create declarations for Itypes
+	created in Alfa mode, instead of inserting artificial declarations of
+	non-Itypes in the tree.
+	* sem_util.adb, sem_util.ads (Itype_Has_Declaration): New function to
+	know if an Itype has a corresponding declaration, as defined in
+	itypes.ads.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* gnat1drv.adb: Minor rewrite.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* s-tasuti.adb (Make_Passive): Work around race condition in
+	Make_Independent, which can cause Wait_Count to be zero. So instead of
+	asserting that Wait_Count > 0, and then decrementing it, decrement it
+	only if Wait_Count > 0.
+	* s-taskin.ads (Wait_Count, Alive_Count, Awake_Count): All of these
+	should be nonnegative, so declare them Natural instead of Integer.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch5.adb, sem_ch3.adb, a-cihama.adb, a-cihama.ads, exp_ch7.adb,
+	sem_ch5.adb, a-ciorse.adb, a-ciorse.ads, sem_ch12.adb, a-cidlli.adb,
+	a-cidlli.ads, sem_util.adb, sem_res.adb, gnat1drv.adb, a-except.adb,
+	a-except.ads, a-except-2005.ads, sem_ch4.adb, exp_disp.adb,
+	exp_aggr.adb, sem_ch13.adb, par-ch3.adb: Minor reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* s-auxdec-vms-alpha.adb: Add comments, remove some HT before labels.
+
+2011-08-29  Vadim Godunko  <godunko@adacore.com>
+
+	* s-parint.ads: Minor comment clarification.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* prj.adb (Initialize): Make sure that new reserved words after Ada 95
+	may be used as identifiers.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-coinho.ads: Minor reformating.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_Iterator_Loop): Handle properly a loop over a
+	container of a derived type.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-cidlli.adb, a-cidlli.ads, a-cihama.adb, a-cihama.ads,
+	a-ciorse.adb, a-ciorse.ads: Add iterator machinery to containers.
+
+2011-08-29  Pascal Obry  <obry@adacore.com>
+
+	* exp_disp.adb: Minor comment fix.
+	(Make_Disp_Asynchronous_Select_Body): Properly initialize out parameters
+	to avoid warnings when compiling with -Wall.
+	(Make_Disp_Conditional_Select_Body): Likewise.
+	(Make_Disp_Timed_Select_Body): Likewise.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Analyze_Formal_Subprogram_Declaration): If default is
+	an entity name, generate reference for it.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_Iterator_Loop): Uniform handling of "X of S"
+	iterator form.
+	* sem_util.adb (Is_Iterator, Is_Reversible_Iterator): Yield True for
+	the class-wide type.
+	* sem_ch5.adb: Move some rewriting to the expander, where it belongs.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Check_Constrained_Object): Do not create an actual
+	subtype for an object whose type is an unconstrained union.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch3.adb (P_Array_Type_Definiation, P_Component_Items): "aliased"
+	is allowed in a component definition, by AI95-406.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-chtgbo.adb (Generic_Iteration): Use correct overloading of Next.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* a-except-2005.adb: Alphabetize all routines.
+	(Triggered_By_Abort): New routine.
+	* a-except-2005.ads (Triggered_By_Abort): New routine.
+	* a-except.adb Alphabetize all routines.
+	(Triggered_By_Abort): New routine.
+	* a-except.ads (Triggered_By_Abort): New routine.
+	* exp_ch7.adb: Update all comments involving the detection of aborts in
+	finalization code.
+	(Build_Object_Declarations): Do not generate code to detect the
+	presence of an abort at the start of finalization code, use a runtime
+	routine istead.
+	* rtsfind.ads: Add RE_Triggered_By_Abort to tables RE_Id and
+	RE_Unit_Table.
+	* sem_res.adb (Resolve_Allocator): Emit a warning when attempting to
+	allocate a task on a subpool.
+	* s-stposu.adb: Add library-level flag Finalize_Address_Table_In_Use.
+	The flag disables all actions related to the maintenance of
+	Finalize_Address_Table when subpools are not in use.
+	(Allocate_Any_Controlled): Signal the machinery that subpools are in
+	use.
+	(Deallocate_Any_Controlled): Do not call Delete_Finalize_Address which
+	performs costly task locking when subpools are not in use.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): Restore expansion of tagged
+	types and dispatching calls in Alfa mode.
+	* lib-xref-alfa.adb (Collect_ALFA): Rewrite computation of
+	correspondance between body and spec scopes, to reuse utility functions
+	(Traverse_Declarations_Or_Statements): Protect access to body for stub
+	by testing the presence of the library unit for the body
+	* sem_ch6.adb (Set_Actual_Subtypes): take into account that in Alfa
+	mode the expansion of accept statements is skipped
+	* sem_util.adb, sem_util.ads (Unique_Entity): New function returning
+	the unique entity corresponding to the one returned by
+	Unique_Defining_Entity applied to the enclosing declaration of the
+	argument.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* treepr.ads: Improve debugging facilities. pn(x) no longer crashes in
+	gdb when x is not a node (it can be a node list, name_id, etc). pp is
+	an alias for pn. ppp is an alias for pt.
+
+2011-08-29  Javier Miranda  <miranda@adacore.com>
+
+	* exp_aggr.adb (Expand_Record_Aggregate): Use the top-level enclosing
+	aggregate to take a consistent decision on the need to convert into
+	assignments aggregates that initialize constant objects.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_Allocator_Expression): Add a call to
+	Build_Allocate_Deallocate_Proc in order to handle allocation of
+	non-controlled objects on subpools.
+	* impunit.adb: Remove s-finmas and s-spsufi since they were never meant
+	to be end-user visible.
+	* s-finmas.adb: Add with and use clause for System.HTable.
+	Add an instantiation of Simple_HTable which provides a mapping between
+	the address of a controlled object and the corresponding
+	Finalize_Address used to clean up the object. The table is used when a
+	master is operating in heterogeneous mode.
+	(Attach): Explain why the input node is not verified on being already
+	attached.
+	(Delete_Finalize_Address): New routine.
+	(Detach): Add pragma Assert which ensures that a node is already
+	attached.
+	(Finalize): Add local variable Cleanup. Rewrite the iteration scheme
+	since nodes are no longer removed on traversal. Explain why node
+	detachment is undesirable in this case.
+	(Get_Finalize_Address): New routine.
+	(Hash): New routine.
+	(Is_Empty_List): Removed.
+	(pm): Renamed to Print_Master. Add output for discriminant
+	Is_Homogeneous.
+	Comment reformatting.
+	(Set_Finalize_Address (Address, Finalize_Address_Ptr)): New routine.
+	* s-finmas.ads: Various comments additions / improvements.
+	Type Finalization_Master has a discriminant which determines the mode of
+	operation.
+	(Delete_Finalize_Address): New routine.
+	(Get_Finalize_Address): New routine.
+	(pm): Renamed to Print_Master.
+	(Set_Finalize_Address (Address, Finalize_Address_Ptr)): New routine.
+	* s-stposu.adb: Add with clause for System.Address_Image; Add with and
+	use clause for System.IO.
+	(Allocate_Any_Controlled): Add machinery to set TSS primitive
+	Finalize_Address depending on the mode of allocation and the mode of
+	the master.
+	(Deallocate_Any_Controlled): Remove the relation pair object -
+	Finalize_Address regardless of the master mode. Add comment explaining
+	the reason.
+	(Detach): Ensure that fields Prev and Next are null after detachment.
+	(Finalize_Pool): Remove local variable Next_Ptr. Rewrite the iteration
+	scheme to check whether the list of subpools is empty. There is no
+	longer need to store the next subpool or advance the current pointer.
+	(Is_Empty_List): New routine.
+	(Print_Pool): New routine.
+	(Print_Subpool): New routine.
+	* s-stposu.ads: Various comments additions / improvements.
+	Field Master of type Root_Subpool is now a heterogeneous collection.
+	(Print_Pool): New routine.
+	(Print_Subpool): New routine.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Iterator_Loop): Implement Ada2012 loop iterator
+	forms, using aspects of container types.
+	* sem_ch3.adb (Find_Type_Name): Preserve Has_Delayed_Aspects and
+	Has_Implicit_Dereference flags, that may be set on the partial view.
+	* sem_ch4.adb (Process_Overloaded_Indexed_Component): Prefix may be a
+	container type with an indexing aspect.
+	(Analyze_Quantified_Expression): Analyze construct with expansion
+	disabled, because it will be rewritten as a loop during expansion.
+	(Try_Container_Indexing): The prefix itself may be a container type
+	with an indexing aspect, as with a vector of vectors.
+	* sem_ch5.adb (Analyze_Iteration_Scheme): In a generic context, analyze
+	the original doamin of iteration, for name capture.
+	(Analyze_Iterator_Specification): If the domain is an expression that
+	needs finalization, create a separate declaration for it.
+	For an iterator with "of" retrieve default iterator info from aspect of
+	container type. For "in" iterator, retrieve type of Iterate function.
+	* sem_ch13.adb (Check_Iterator_Function): Fix typo.
+	(Check_Aspect_At_End_Of_Declaration): Make type unfrozen before
+	analysis, to prevent spurious errors about late attributes.
+	* sprint.adb: Handle quantified expression with either loop or iterator
+	specification.
+	* a-convec.ads, a-convec.adb: Iterate function returns a reversible
+	iterator.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Scan_Make_Arg): Take any option as is in packages Compiler,
+	Binder or Linker of the main project file.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic
+	unit.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch9.adb: Partial revert of previous change for Alfa mode
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch11.adb: Minor expansion of comment.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Arithmetic_Op): If the node has a universal
+	interpretation, set the type before resolving the operands, because
+	legality checks on an exponention operand need to know the type of the
+	context.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Analyze_Package_Instantiation): Do not set delayed
+	cleanups on a master if the instance is within a generic unit.
+	Complement to the corresponding fix to inline.adb for K520-030.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current
+	occurrence.
+	* exp_intr.adb: Minor comment fix.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where
+	Delay_Required was used as an uninitialized variable.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-cdlili.adb, a-cdlili.ads, a-coinve.adb, a-coinve.ads,
+	sem_util.adb, sem_util.ads, a-cohama.adb, a-cohama.ads, a-coorse.adb,
+	a-coorse.ads, aspects.ads, sem_ch8.adb: Minor reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* system-freebsd-x86_64.ads (Backend_Overflow_Checks): Set true True.
+	Remove unused variables.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb: Remove Build_Explicit_Dereference.
+	* sem_util.adb, sem_util.ads (Build_Explicit_Dereference): Moved here
+	from sem_res.adb, used in analysis of additional constructs.
+	(Is_Iterator, Is_Reversible_Iterator): New predicates for Ada2012
+	expansion of iterators.
+	(Is_Object_Reference): Recognize variables rewritten as explicit
+	dereferences in Ada2012.
+	* snames.ads-tmpl: Add Has_Element, Forward_Iterator,
+	Reversible_Iterator names, for expansion of Ada2012 iterators.
+	* aspects.ads, aspects.adb (Find_Aspect): Utility.
+	* a-cdlili.ads, a-cdlili.adb: Add new iterator machinery to doubly
+	linked list container.
+	* a-coinve.ads, a-coinve.adb: Ditto for indefinite vector containers.
+	* a-coorse.ads, a-coorse.adb: Ditto for ordered sets.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-cohama.adb, a-cohama.ads: Add iterator primitives to hashed map
+	containers.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Gnatmake): Get the maximum number of simultaneous
+	compilation processes after the Builder switches has been scanned, as
+	there may include -jnn.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-chtgbo.adb (Generic_Equal): Use correct overloading of Next.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* gnatcmd.adb (GNATCmd): On OpenVMS, truncate the length of
+	GNAT_DRIVER_COMMAND_LINE to 255.
+
+2011-08-29  Pascal Obry  <obry@adacore.com>
+
+	* freeze.adb, sem_ch8.adb, a-convec.adb, a-convec.ads: Minor
+	reformatting and style fix (class attribute casing).
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch11.adb: Yet another case where expansion should be common
+	between CodePeer and Alfa.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch9.adb: Partial revert of previous change for Alfa mode.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Matches_Limited_With_View): The limited views of an
+	incomplete type and its completion match.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch13.adb: Adjust previous change.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb, prj.adb, sem_util.adb, sem_res.adb, gnat1drv.adb,
+	exp_ch4.adb, sem_ch8.adb: Minor code reorganization
+	Minor reformatting.
+
+2011-08-29  Emmanuel Briot  <briot@adacore.com>
+
+	* make.adb, prj.adb, prj.ads (Compute_All_Imported_Projects): Also
+	initialize aggregated projects.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Find_Renamed_Entity): Within an instance, use scope
+	depth of candidates to resolve a potentially spurious ambiguity between
+	two visible subprograms.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Allow Test_Case pragma without
+	Requires/Ensures.
+	* sem_util.adb (Get_Ensures_From_Test_Case_Pragma,
+	Get_Requires_From_Test_Case_Pragma): Allow Test_Case pragma without
+	Requires/Ensures.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): Improve previous change.
+	Add comment.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_res.adb: Minor reformatting.
+
+2011-08-29  Johannes Kanig  <kanig@adacore.com>
+
+	* exp_ch4.adb (Expand_Quantified_Expression): Do not expand in ALFA
+	mode.
+	* gnat1drv.adb (Adjust_Global_Switches): Set
+	Use_Expressions_With_Actions to False in ALFA mode.
+	* sem_res.adb (Resolve_Quantified_Expression): Simpler treatment in
+	ALFA mode.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch13.adb (Expand_N_Freeze_Entity): Do nothing in Alfa mode.
+	* exp_ch9.adb: Do not expand tasking constructs in Alfa mode.
+	* gnat1drv.adb (Adjust_Global_Switches): Suppress the expansion of
+	tagged types and dispatching calls in Alfa mode.
+
+2011-08-29  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Process_Discriminants): Add missing check to ensure that
+	we do not report an error on an Empty node.
+
+2011-08-29  Geert Bosch  <bosch@adacore.com>
+
+	* Makefile.rtl (GNATRTL_NONTASKING_OBJECTS): Add a-nllrar.o,
+	a-nlrear.o and a-nurear.o.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* freeze.adb: Minor code reorganization.
+	Minor reformatting.
+	* sem_util.adb, errout.adb, exp_ch11.adb, a-ngrear.adb, s-gearop.adb,
+	sem_ch6.adb: Minor reformatting
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* s-except.ads, s-except.adb: Provide dummy body.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_warn.adb (Within_Postcondition): Take into account the case of
+	an Ensures component in a Test_Case.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* s-excdeb.ads, s-excdeb.adb: New files, created from s-except.
+	* rtsfind.ads (RTU_Id): Replaces System_Exceptions by
+	System_Exceptions_Debug
+	(RE_Unit_Table): Search RE_Local_Raise in System_Exceptions_Debug
+	* a-except.adb: With and use System.Exceptions_Debug instead of
+	System.Exceptions.
+	* a-except-2005.adb: Likewise.
+	* s-assert.adb: Likewise.
+	* s-except.adb, s-except.ads: Move debugging hooks to s-excdeb.
+	* Makefile.rtl: Add s-excdeb.  Adjust compilation rule.
+	* gcc-interfaces/Makefile.in, gcc-interface/Make-lang.in: Add
+	s-excdeb. Update dependencies.
+	(GNATRTL_LINEARALGEBRA_OBJS): Remove a-nlrear.o a-nurear.o a-nllrar.o
+	as these no longer need external libraries.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Op_Expon): Additional check to reject an
+	exponentiation operator on universal values in a context that requires
+	a fixed-point type.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* raise-gcc.c (personnality_routine): Fix thinko.  Set Ada occurrence
+	before calling notify_handled_exception.
+	* a-exextr.adb: Fix comment.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_Allocator_Expression): Add code to set attribute
+	Finalize_Address of the access type's finalization master.
+	(Expand_N_Allocator): Add code to set attribute Finalize_Address of the
+	access type's finalization master. Add a guard to prevent
+	Associated_Storage_Pool from being set on .NET/JVM.
+	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add code to set
+	attribute Finalize_Address of the access type's finalization master.
+	* exp_ch7.adb (Make_Finalize_Address_Call): New routine.
+	* exp_ch7.ads (Make_Finalize_Address_Call): New routine.
+	* rtsfind.ads: Add RE_Set_Finalize_Address to tables RE_Id and
+	RE_Unit_Table.
+	* s-finmas.adb: Add with clause for System.Address_Image. Add with and
+	use clause for System.IO
+	(Detach): Relax the assertion, to be reinstated later.
+	(Finalize): Rewrite the iteration loop to avoid pointer comparison.
+	Relax the assertion on Finalize_Address, to be reinstated later.
+	(Is_Empty_List): New routine.
+	(pm): New debug routine.
+	(Set_Finalize_Address): New routine.
+	* s-finmas.ads (pm): New debug routine.
+	(Set_Finalize_Address): New routine.
+	* s-stposu.adb (Allocate_Any_Controlled): Code reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb (GCC_Exception_Access, GNAT_GCC_Exception_Access):
+	Remove convention C.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* s-taprop-vms.adb (Get_Exc_Stack_Addr): Remove.
+	(Initialize_TCB): Remove Exc_Stack_Ptr initialization.
+	(Finalize_TCB): Remove its finalization.
+	(Initialize): Remove assignment of GET_Exc_Stack_Addr
+	* s-soflin.adb (NT_Exc_Stack): Remove
+	(Get_Exc_Stack_Addr_NT): Likewise.
+	(Get_Exc_Stack_Addr_Soft): Likewise.
+	* s-soflin.ads (Get_Exc_Stack_Addr_NT): Remove.
+	(Get_Exc_Stack_Addr): Likewise.
+	(Get_Exc_Stack_Addr_Soft): Likewise
+	* s-taspri-vms.ads (Exc_Stack_T): Remove.
+	(Exc_Stack_Ptr_T): Likewise.
+	(Private_Data): Remove Exc_Stack_Ptr component.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* raise-gcc.c (get_ip_from_context): New function. Factorize code.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* gnat_ugn.texi: Fix aix and x86-solaris info for run-time.
+
+2011-08-29  Geert Bosch  <bosch@adacore.com>
+
+	* s-gearop.ads (Back_Substitute, Diagonal, Forward_Eliminate,
+	L2_Norm, Swap_Column): New generic subprograms
+	* s-gearop.adb (Back_Substitute, Diagonal, Forward_Eliminate,
+	L2_Norm, Swap_Column): Implement new subprograms in order to
+	eliminate dependency on BLAS and LAPACK libraries in
+	Ada.Numerics.Generic_Real_Arrays and eventually also the complex
+	version. Forward_Eliminate/Back_Substitute can be used to put a
+	matrix in row echelon or reduced row echelon form using partial
+	pivoting.
+	* a-ngrear.adb: (Back_Substitute, Diagonal, Forward_Eleminate,
+	Swap_Column): Instantiate from System.Generic_Array_Operations.
+	("*", "abs"): Implement by instantiation from Generic_Array_Operations.
+	(Sqrt): Local function for simple computation of square root without
+	adding dependencies on Generic_Elementary_Functions.
+	(Swap): New subprogram to exchange floating point numbers.
+	(Inverse): Reimplement using Jordan-Gauss elimination.
+	(Jacobi): New procedure implementing Jacobi's method for computation
+	of eigensystems, based on Rutishauser's implementation.
+	(L2_Norm): Implement directly using the inner product.
+	(Sort_Eigensystem): Sort eigenvalue/eigenvector pairs in order of
+	decreasing eigenvalue as required by the Ada RM.
+	(Swap_Column): New helper procedure for Sort_Eigensystem.
+	Remove with of System.Generic_Real_BLAS and System.Generic_Real_LAPACK.
+	Add with of Ada.Containers.Generic_Anonymous_Array_Sort, for
+	Sort_Eigensystems.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* put_scos.adb (Put_SCOs): Do not emit a newline for an empty
+	statements line.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* s-finmas.adb (Finalize): Check Finalize_Address of the master rather
+	than the current node.
+	* s-finmas.ads: Move field Finalize_Address from type FM_Node to
+	Finalization_Master. The list headers have two fields instead of three.
+	This should fix alignment issue but subpool allocations are now
+	unusable. Alphabetize subprograms.
+	* s-stposu.adb (Allocate_Any_Controlled): Use the offset rather than
+	the size of the header when converting the beginning of the object to
+	a FM_Node. Set the master's Finalize_Address attribute if not already
+	set.
+	(Deallocate_Any_Controlled): Use the offset rather than the size of the
+	header when converting the beginning of the object to a FM_Node.
+
+2011-08-29  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch11.adb (Expand_N_Raise_Statement): Don't suppress expansion of
+	reraise when compiling for CodePeer.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* a-iteint.ads, Makefile.rtl: Add missing compilation of a-iteint.ads,
+	now needed by a-convec.adb. Fix warning.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Build_Allocate_Deallocate_Proc): Add a guard for the
+	processing of TSS routine Finalize_Address when compiling in
+	CodePeer_Mode.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* a-strunb.ads, einfo.ads, g-comlin.ads, sem_ch6.adb,
+	sem_warn.adb: Minor reformatting.
+
+2011-08-29  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-conf.adb (Get_Config_Switches): Also collect the list of
+	languages from aggregated projects.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref-alfa.adb, lib-xref.ads (Traverse_Declarations_Or_Statements,
+	Traverse_Handled_Statement_Sequence, Traverse_Package_Body,
+	Traverse_Package_Declaration, Traverse_Subprogram_Body,
+	Traverse_Compilation_Unit): Add a parameter Inside_Stubs so that bodies
+	for stubs are traversed too when parameter is set
+	(Traverse_All_Compilation_Units): Traverse without going inside stubs
+	(Traverse_Declarations_Or_Statements): Do the special traversing for
+	stubs when required.
+	* sem_util.adb, sem_util.ads (Get_Body_From_Stub): New function to
+	return subprogram or package body from stub.
+	(Is_Subprogram_Stub_Without_Prior_Declaration): New function to detect
+	stubs without prior subprogram decl.
+
+2011-08-29  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* gnat_ugn.texi: Fix typo.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* s-stposu.adb (Allocate_Any_Controlled): Reimplement the mechanism
+	which accounts for size vs alignment issues and calculates the size of
+	the list header.
+	(Deallocate_Any_Controlled): Ditto.
+	(Nearest_Multiple_Rounded_Up): New routine.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exstat.adb (String_To_EO): Do no set Cleanup_Flag.
+	* a-exexda.adb (Set_Exception_C_Msg): Ditto.
+	(Set_Exception_Msg): Ditto.
+	* a-exexpr-gcc.adb (Setup_Current_Excep): Ditto.  Do not set
+	Private_Data.
+	* a-except.adb, a-except-2005.adb (Save_Occurrence_No_Private): Remove.
+	Use Save_Occurrence instead of Save_Occurrence_No_Private.
+	(Raise_With_Msg): Remove Cleanup_Flag.
+	* a-except.ads, a-except-2005.ads (Exception_Occurrence): Remove
+	Clean_Flag and Private_Data components.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* freeze.adb (Freeze_Record_Type): Ignore packing in Alfa mode, like
+	in CodePeer mode.
+	* sem_ch3.adb (Signed_Integer_Type_Declaration): Correct the generation
+	of an explicitly declared type, so that the base types of the original
+	type and this generated type are the same, and a "type" (not a subtype
+	like previously).
+	* errout.adb (Special_Msg_Delete): Do not issue messages "Size too
+	small" in Alfa mode, like in CodePeer mode.
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore rep
+	clauses in Alfa mode.
+
+2011-08-29  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch6.ads, exp_ch6.adb (Is_Null_Procedure): Move the spec of this
+	function to the package spec.
+	* sem_ch6.adb (Find_Corresponding_Spec, New_Overloaded_Entity): For
+	internally generated bodies of null procedures locate the internally
+	generated spec enforcing mode conformance.
+	(Is_Interface_Conformant): Ensure that the controlling formal of the
+	primitives match.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma, case Inline): In an instance, do not
+	reject the pragma if it appears to apply to a formal subprogram.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch4.adb (Expand_Allocator_Expression): Use consistent name for
+	inner expression, to prevent double evaluation.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr.adb (Propagate_Exception): Remove all the parameters as
+	they were unused.
+	* a-exexpr-gcc.adb (Propagate_Exception): Ditto.
+	* a-except-2005.adb (Propagate_Exception): Adjust spec.
+	(Raise_Current_Excep): Adjust call.
+	(Raise_From_Signal_Handler): Call now simply call Raise_Current_Excep.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_disp.adb: Minor reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr.adb (Setup_Exception): Removed.
+	* a-exexpr-gcc.adb (Setup_Exception): Removed.
+	* a-except.adb (Exception_Propagation): Removed.
+	* a-except-2005.adb (Setup_Exception): Removed.
+	(Reraise): Remove call to Setup_Exception.
+	(Reraise_Occurrence): Ditto.
+	(Reraise_Occurrence_Always): Ditto.
+	(Reraise_Occurrence_No_Defer): Ditto.
+	(Transfer_Occurrence): Ditto.
+	* a-exexda.adb (Set_Exception_C_Msg): Remove call to Setup_Exception.
+	(Set_Exception_Msg): Ditto.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-convec.adb, exp_disp.adb: Minor reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb (GNAT_GCC_Exception_Access): Set to convention C.
+
+2011-08-29  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch3.adb (Build_Record_Init_Proc.Build_Init_Procedure): Set
+	Exception_Handlers to No_List instead of Empty_List in the case where
+	there are no handlers.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* gcc-interface/gigi.h (enum standard_datatypes): Add
+	ADT_reraise_zcx_decl
+	(reraise_zcx_decl): New macro.
+	* gcc-interface/trans.c (gnu_incoming_exc_ptr): New variable.
+	(gigi): Set reraise_zcx_decl.
+	(Exception_Handler_to_gnu_zcx): Save and restore gnu_incoming_exc_ptr.
+	(gnat_to_gnu): Handle N_Raise_Statement.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch6.adb, exp_ch3.adb, s-stposu.adb, a-undesu.ads,
+	a-undesu.adb: Minor reformatting.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_disp.adb (Check_Premature_Freezing): When building a dispatch
+	table, accept an unfrozen untagged component if it is an actual for a
+	formal incomplete type.
+	* a-convec.ads, a-convec.adb: Instantiate Ada.Iterator_Interfaces to
+	provide new iterator forms over vectors.
+	Introduce type Iterator in package body to implement operations of
+	Reversible_Iterator interface.
+	* a-iteint.ads: Make package pure so it is usable with new container
+	packages, that are categorized Remote_Types.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-exexpr-gcc.adb, a-synbar.adb, sem_ch13.adb: Minor reformatting.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* sem_aggr.adb (Resolve_Aggr_Expr): Call this routine even in the case
+	of <>, because this is the routine that checks for dimensionality
+	errors (for example, for a two-dimensional array, (others => <>) should
+	be (others => (others => <>)).
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* impunit.adb: Add new run-time units.
+	* freeze.adb, exp_ch7.ads, exp_ch7.adb, exp_util.ads, exp_util.adb,
+	s-stposu.ads, s-stposu.adb: Code clean up.
+	Handle protected class-wide or task class-wide types
+	Handle C/C++/CIL/Java types.
+	* s-spsufi.adb, s-spsufi.ads: New files.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Reject test-case on
+	library-level subprogram.
+	* sem_prag.adb (Check_Test_Case): Stricter rules for test-case
+	placement.
+	(Analyze_Pragma): Change name "Normal" for "Nominal" in test-case
+	component.
+	* snames.ads-tmpl: Change name "Normal" for "Nominal" in test-case
+	component.
+	* gnat_rm.texi: Update doc for Test_Case pragma.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb (Unwind_Exception): Remove default value, made it
+	convention C.
+	(GCC_Exception_Access): New type.
+	(Unwind_DeleteException): New imported procedure
+	(Foreign_Exception): Import it.
+	(GNAT_GCC_Exception): Simply have the occurrence inside.
+	(To_GCC_Exception): New function.
+	(To_GNAT_GCC_Exception): New function.
+	(GNAT_GCC_Exception_Cleanup): New procedure..
+	(Propagate_GCC_Exception): New procedure.
+	(Reraise_GCC_Exception): New procedure.
+	(Setup_Current_Excep): New procedure.
+	(CleanupUnwind_Handler): Change type of UW_Exception parameter.
+	(Unwind_RaiseException): Ditto.
+	(Unwind_ForcedUnwind): Ditto.
+	(Remove): Removed.
+	(Begin_Handler): Change type of parameter.
+	(End_Handler): Ditto. Now delete the exception if still present.
+	(Setup_Key): Removed.
+	(Is_Setup_And_Not_Propagated): Removed.
+	(Set_Setup_And_Not_Propagated): Ditto.
+	(Clear_Setup_And_Not_Propagated): Ditto.
+	(Save_Occurrence_And_Private): Ditto.
+	(EID_For): Add 'not null' constraint on parameter.
+	(Setup_Exception): Does nothing.
+	(Propagate_Exception): Simplified.
+	* exp_ch11.adb (Expand_N_Raise_Statement): In back-end exception model,
+	re-raise is not expanded anymore.
+	* s-except.ads (Foreign_Exception): New exception - placeholder for
+	non Ada exceptions.
+	* raise-gcc.c (__gnat_setup_current_excep): Declare
+	(CXX_EXCEPTION_CLASS): Define (not yet used)
+	(GNAT_EXCEPTION_CLASS): Define.
+	(is_handled_by): Handle foreign exceptions.
+	(PERSONALITY_FUNCTION): Call __gnat_setup_current_excep.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-synbar.adb (Synchronous_Barrier): Some additional clarification.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* a-synbar-posix.adb: Minor reformatting.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-exetim-posix.adb, a-exetim-mingw.adb, a-exetim-mingw.ads,
+	a-exetim-default.ads (Interrupt_Clocks_Supported,
+	Separate_Interrupt_Clocks_Supported, Clock_For_Interrupts): Add these
+	definitions to be compliant with AI-0171. The target systems do not
+	support separate account for the execution time of interrupt handlers.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-synbar.adb (Wait): Change the order of evaluation of the conditions
+	in the barrier to put first the easiest to evaluate (and the one which
+	will be True more often). More efficient.
+
+2011-08-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* s-atocou-x86.adb: Fix constraint in machine code insertion.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* aspects.ads, aspects.adb: Add new aspects for various pragmas and
+	attributes that are now aspects, as specified by AI05-0229-1.
+	* sem_ch13.adb (Analyze_Aspect_Specifications,
+	Check_Aspect_At_Freeze_Point): Analyze the new aspects. Turn them into
+	pragmas or attribute references, as appropriate.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-synbar.ads, a-synbar.adb, a-synbar-posix.adb,
+	a-synbar-posix.ads: Minor reformatting.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* snames.ads-tmpl: Add name Force.
+
+2011-08-29  Pascal Obry  <obry@adacore.com>
+
+	* prj-nmsc.adb: Minor reformatting.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-exetim.ads (Interrupt_Clocks_Supported,
+	Separate_Interrupt_Clocks_Supported, Clock_For_Interrupts): Add these
+	definitions to be compliant with AI-0171.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-ngelfu.adb: Add comments.
+
+2011-08-29  Geert Bosch  <bosch@adacore.com>
+
+	* a-ngelfu.adb (Tan): Do not raise Constraint_Error if the argument is
+	the closest machine number to Pi / 2.0.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* impunit.adb (Non_Imp_File_Names_12): Add a-synbar for new Ada 2012
+	package Ada.Synchronous_Barriers.
+	* a-synbar.ads, a-synbar.adb, a-synbar-posix.ads, a-synbar-posix.adb:
+	Add new specs and bodies for Ada.Synchronous_Barriers. There is a
+	default implementation using protected objects and another one
+	a-synbar-posix using POSIX barriers as the underlying support.
+	* gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for Linux (x86,
+	x86_64, ia64) and MIPS IRIX): Use the a-synbar-posix implementation of
+	Ada.Synchronous_Barriers which uses POSIX barriers (more efficient).
+	Clean up dependencies.
+	* Makefile.rtl (GNATRTL_TASKING_OBJS): Add a-synbar.o
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch7.adb, make.adb, sem_res.adb, exp_intr.adb,
+	exp_dist.adb: Minor code reorganization.
+	Minor reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_cat.adb (Validate_RACW_Primitive): The return type of an RACW
+	primitive operation must support external streaming if it is not a
+	controlling access result.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sinfo.ads, sem_ch7.adb: Minor reformatting.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* sem_ch4.adb (Analyze_Allocator): Check No_Nested_Finalization
+	restriction on allocators, as required by AI05-0013-1.
+	* restrict.ads: Minor comment fix.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr.adb, a-except-2005.ads (Jmpbuf_Address): Move to a-exexpr.adb
+	(To_Jmpbuf_Address): Ditto
+	(builtin_longjmp): Ditto
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_res.adb: Minor reformatting.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Gnatmake): Move special processing for VM targets after the
+	call to Get_Target_Parameters.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch12.adb, par-ch12.adb: Minor reformatting.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_res.adb (Resolve_Allocator): Implement Ada2012-B052. Detect cases
+	where an anonymous access discriminant of a limited designated type
+	appears in a non-immutably limited discriminated type and issue an
+	error message. Add local variable Desig_T and replace all occurrences
+	of Designated_Type.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-rttiev.adb (Set_Handler): Update comment to indicate that our
+	implementation is compliant to RM D.15(15/2) after the modification
+	imposed by AI05-0094-1 (binding interpretation).
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch9.adb, s-tasren.adb, exp_sel.adb, exp_sel.ads, exp_ch11.adb,
+	s-interr-hwint.adb, s-tpobop.adb, sem_ch13.adb: Minor reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* par-endh.adb (Check_End): For an END where it is mandatory to repeat
+	the scope name, do not report a missing label as a style violation (it
+	will be diagnosed as an illegality).
+	* exp_dist.adb (Add_Params_For_Variant_Components): Fix handling of
+	variant records: Get_Enum_Lit_From_Pos already returns a usage
+	occurrence of the literal, no need to use New_Occurrence_Of. Set Etype
+	on Expr in Integer_Literal case so that it can be used by
+	Build_To_Any_Call.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* exp_sel.ads (Build_Abort_BLock_Handler): New function spec.
+	Adjust comment.
+	* exp_sel.adb (Build_Abort_Block): Use Build_Abort_Block_Handler.
+	(Build_Abort_Block_Handler): New function to build an Abort_Signal
+	exception handler.
+	* exp_ch9.adb (Expand_N_Asynchronous_Select): Call
+	Build_Abort_Block_Handler to build the exception handler. Do not
+	undefer aborts for the Abort_Signal exception handler if back-end
+	exception mechanism.
+	* exp_ch11.adb (Expand_Exception_Handlers): Do not undefer aborts if
+	back_end exceptions for all others and abort_signal.
+	* s-except.ads (ZCX_By_Default): New constant.
+	* a-except-2005.adb (Raise_Exception): Do not defer abort if ZCX.
+	(Raise_Exception_Always): Ditto.
+	(Raise_From_Signal_Handler): Ditto.
+	(Raise_With_Location_And_Msg): Ditto.
+	(Raise_With_Msg): Ditto.
+	(Reraise): Ditto.
+	(Reraise_Occurence): Ditto.
+	(Reraise_Occurrence_Always): Ditto.
+	* s-tasren.adb (Exceptional_Complete_Rendezvous): Defer aborts if ZCX.
+	* s-tpobop.adb: (Exceptional_Complete_Body): Undefer abort if ZCX.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_util.ads (Get_Enum_Lit_From_Pos): Clarify documentation.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* snames.adb-tmpl, sem_ch13.adb: Minor reformatting
+	Minor code reorganization.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* usage.adb (-gnatwy): Fix documentation: this switch applies to Ada
+	2012, not just Ada 2005.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* gnat_ugn.texi: Indicate that when the compiler is called by gnatmake
+	with a project file or with gprbuid, if -gnatep= is specified, the
+	builder may need to be invoked with -x.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb: Minor comment fix.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch8.adb: Minor reformatting.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* par-ch2.adb (P_Identifier): Warn that "some" is reserved in Ada 2012.
+	* par-ch4.adb (P_Quantified_Expression): Remove unnecessary code for
+	treating "some" as unreserved in earlier Ada versions. This is now
+	handled in Snames.Is_Keyword_Name. Parse "for some" using Tok_Some,
+	rather than Name_Some, since Tok_Some is now recognized as reserved.
+	* scans.adb (Initialize_Ada_Keywords): Handle Tok_Some like any other
+	reserved word.
+	* scans.ads: Minor comment fixes.
+	* snames.adb-tmpl (Is_Keyword_Name): Handle Ada 2012 reserved words as
+	for other language versions.
+	* scn.adb (Scan_Reserved_Identifier): Remove unnecessary code for
+	treating "some" as unreserved in earlier Ada versions. This is now
+	handled in Snames.Is_Keyword_Name.
+	* par-ch3.adb (P_Defining_Identifier): Warn that "some" is reserved in
+	Ada 2012.
+	(P_Subtype_Mark_Resync): Remove unnecessary code for treating "some" as
+	unreserved in earlier Ada versions. This is now handled in
+	Snames.Is_Keyword_Name.
+	* snames.ads-tmpl (Ada_2012_Reserved_Words): Handle Ada 2012 reserved
+	words as for other language versions.
+	* gnat_ugn.texi (-gnatwy): Fix documentation: this switch applies to
+	Ada 2012, not just Ada 2005.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb: Additional semantic checks for aspects involved in
+	iterators.
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-comutr.ads, a-comutr.adb, a-cimutr.ads, a-cimutr.adb,
+	a-cbmutr.ads, a-cbmutr.adb (Find_In_Subtree): Remove superfluous
+	Container parameter.
+	(Ancestor_Find): ditto.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* par-endh.adb: Minor reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb (Unwind_Action) Rewrite as an integer with constants.
+	(GNAT_GCC_Exception): Remove N_Cleanups_To_Trigger component.
+	(Adjust_N_CLeanups_For): Remove.
+	(CleanupUnwind_Handler): Call Unhandled_Exception_Terminate when end of
+	stack is reached.
+	(Propgate_Exception): Adjust.
+	* raise-gcc.c: Add a few static/const.
+	(Adjust_N_Cleanups_For): Remove declaration.
+	(PERSONALITY_FUNCTION): Remove code dealing with N_Cleanups_To_Trigger.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb: Use type of function return when rewriting as object
+	declaration.
+
+2011-08-29  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_type.adb: Minor reformatting.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* makeutl.adb: Minor reformatting.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Analyze_Object_Renaming): If the renamed object is a
+	function call of a limited type, the expansion of the renaming is
+	complicated by the presence of various temporaries and subtypes that
+	capture constraints of the renamed object.
+	Rewrite node as an object declaration, whose expansion is simpler.
+	Given that the object is limited there is no copy involved and no
+	performance hit.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch5.adb, sinfo.ads, make.adb, s-pooglo.adb, sem_ch12.adb,
+	freeze.adb, sem_ch6.adb, par-ch12.adb: Minor reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* system-darwin-x86.ads, system-linux-s390x.ads, system-linux-alpha.ads,
+	system-tru64.ads, system-irix-n32.ads, system-vxworks-arm.ads,
+	system-linux-hppa.ads, system-linux-s390.ads,
+	system-solaris-sparcv9.ads, system-mingw.ads, system-linux-ia64.ads,
+	system-vms_64.ads, system-vxworks-sparcv9.ads, system-linux-ppc.ads,
+	system-aix64.ads, system-lynxos-ppc.ads, system-linux-sh4.ads,
+	system-solaris-x86.ads, system-linux-x86_64.ads, system-linux-x86.ads,
+	system-vxworks-ppc.ads, system-hpux.ads, system-darwin-ppc.ads,
+	system-solaris-sparc.ads, system-lynxos-x86.ads,
+	system-vxworks-m68k.ads, system-hpux-ia64.ads, system-irix-o32.ads,
+	system-solaris-x86_64.ads, system-mingw-x86_64.ads,
+	system-vxworks-mips.ads, system-linux-sparc.ads, system-vms-ia64.ads,
+	system-freebsd-x86.ads, system-aix.ads, system-darwin-x86_64.ads,
+	system-vxworks-x86.ads: Remove GCC_ZCX_Support
+	* s-taprop-posix.adb, s-taprop-irix.adb, s-taprop-vxworks.adb,
+	s-taprop-tru64.adb, s-taprop-linux.adb, s-taprop-solaris.adb: Ditto.
+	* opt.ads: Adjust comment.
+	* targparm.ads, targparm.adb: Remove GCC_ZCX_Support_On_Target.
+	* gnat1drv.adb: Do not check for GCC_ZCX_Support_On_Target.
+	* system.ads: Move GCC_ZCX_Support to obsolete entries.
+
+2011-08-29  Emmanuel Briot  <briot@adacore.com>
+
+	* makeutl.adb (Do_Complete): Resolve symbolic links when a relative
+	file name is specified on the gnatmake or gprbuild command line, and
+	before we search for that file in the project.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_type.adb (Within_Instance): New predicate in Collect_Interps,
+	used to determine whether a possible interpretation for an overloadable
+	entity is declared within the current instantiation and should be
+	included in the candidate set.
+
+2011-08-29  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* gnat_rm.texi, gnat_ugn.texi: Clean ups.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Actuals): Use base type to determine whether an
+	access subtype is access_to_subprogram, when applying checks for
+	RM 3.10.2 (27).
+
+2011-08-29  Matthew Heaney  <heaney@adacore.com>
+
+	* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Splice_Subtree): Only check
+	for sibling when common parent.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* get_scos.adb: Literals of Pragma_Id are pragma names prefixed with
+	"pragma_".
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Enable freeze actions
+	for the return type when in ASIS mode.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Gnatmake): Get the default search dirs, then the target
+	parameters after getting the Builder switches, as the Builder switches
+	may include --RTS= and that could change the default search dirs.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Make_Adjust_Call): Rewrite to mimic the structure of
+	Make_Final_Call. Move the processing for class-wide types before the
+	processing for derivations from [Limited_]Controlled.
+	(Make_Final_Call): Move the processing for class-wide types before the
+	processing for derivations from [Limited_]Controlled.
+	* s-stposu.adb (Allocate_Any_Controlled): Correct the membership check.
+	Add code to account for alignments larger than the list header. Add a
+	comment illustrating the structure of the allocated object + padding +
+	header.
+	(Deallocate_Any_Controlled): Add code to account for alignments larger
+	than the list header.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sinfo.ads, sinfo.adb: New node kind
+	N_Formal_Incomplete_Type_Definition, related flags.
+	par-ch12.adb (P_Formal_Type_Declaration, G_Formal_Type_Definition):
+	Parse formal incomplete types.
+	* sem.adb (Analyze): Formal_Incomplete_Type_Definitions are handled in
+	sem_ch12.
+	* sem_ch7.adb (Analyze_Package_Specification, Unit_Requires_Body):
+	Formal incomplete types do not need completion.
+	* sem_ch12.adb (Analyze_Formal_Incomplete_Type,
+	Validate_Incomplete_Type_Instance): New procedures to handle formal
+	incomplete types.
+	* freeze.adb (Freeze_Entity): Do not freeze the subtype of an actual
+	that corresponds to a formal incomplete type.
+	* sprint.adb: Handle formal incomplete type declarations.
+	* exp_util.adb (Insert_Actions): An incomplete_type_definition is not
+	an insertion point.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* a-fihema.ads, a-fihema.adb: Unit removed.
+	* a-undesu.ads, a-undesu.adb: New unit implementing
+	Ada.Unchecked_Deallocate_Subpool.
+	* einfo.adb: Remove Associated_Collection from the node usage.
+	Add Finalization_Master to the node usage.
+	(Associated_Collection): Removed.
+	(Finalization_Master): New routine.
+	(Set_Associated_Collection): Removed.
+	(Set_Finalization_Master): New routine.
+	(Write_Field23_Name): Remove Associated_Collection from the output. Add
+	Finalization_Master to the output.
+	* einfo.ads: Remove attribute Associated_Collection and its uses in
+	entities.
+	Add new attribute Finalization_Master along with its uses in entitites.
+	(Associated_Collection): Removed along with its pragma import.
+	(Finalization_Master): New routine along with a pragma import.
+	(Set_Associated_Collection): Removed along with its pragma import.
+	(Set_Finalization_Master): New routine along with a pragma import.
+	* exp_ch3.adb (Expand_Freeze_Array_Type): Replace call to
+	Build_Finalization_Collection with Build_Finalization_Master.
+	(Expand_Freeze_Record_Type): Move the generation of Finalize_Address
+	before the bodies of the predefined routines. Add comment explaining
+	this. Replace call to Build_Finalization_Collection with
+	Build_Finalization_Master.
+	(Freeze_Type): Replace call to Build_Finalization_Collection with
+	Build_Finalization_Master.
+	(Make_Finalize_Address_Body): Comment reformatting.
+	(Make_Predefined_Primitive_Specs): Code reformatting.
+	(Stream_Operation_OK): Update comment mentioning finalization
+	collections. Replace RE_Finalization_Collection with
+	RE_Finalization_Master.
+	* exp_ch4.adb (Complete_Controlled_Allocation): Replace call to
+	Associated_Collection with Finalization_Master. Replace call to
+	Build_Finalization_Collection with Build_Finalization_Master.
+	(Expand_Allocator_Expression): Replace call to Associated_Collection
+	with Finalization_Master. Replace call to Set_Associated_Collection with
+	Set_Finalization_Master. Remove the generation of
+	Set_Finalize_Address_Ptr.
+	(Expand_N_Allocator): Replace call to Associated_Collection with
+	Finalization_Master. Remove the generation of Set_Finalize_Address_Ptr.
+	* exp_ch6.adb (Add_Collection_Actual_To_Build_In_Place_Call): Renamed to
+	Add_Finalization_Master_Actual_To_Build_In_Place_Call. Update the
+	comment on usage. Replace call to Needs_BIP_Collection with
+	Needs_BIP_Finalization_Master Remplace BIP_Collection with
+	BIP_Finalization_Master. Update all comments which mention finalization
+	collections. Replace Associated_Collection with
+	Finalization_Master. Replace Build_Finalization_Collection with
+	Build_Finalization_Master.
+	(BIP_Formal_Suffix): Update BIP_Collection's case.
+	(Build_Heap_Allocator): Update the related comment. Rename local
+	variable Collect to Fin_Mas_Id and update its occurrences. Update
+	comments which mention finalization collections. Replace
+	Set_Associated_Collection with Set_Finalization_Master.
+	(Expand_Call): Update the code which detects a special piece of library
+	code for .NET/JVM.
+	(Make_Build_In_Place_Call_In_Allocator): Replace the call to
+	Add_Collection_Actual_To_Build_In_Place_Call with
+	Add_Finalization_Master_Actual_To_Build_In_Place_Call. Remove the code
+	which generates a call to Make_Set_Finalize_Address_Ptr_Call.
+	(Make_Build_In_Place_Call_In_Anonymous_Context): Replace call to
+	Add_Collection_Actual_To_Build_In_Place_Call with
+	Add_Finalization_Master_Actual_To_Build_In_Place_Call.
+	(Make_Build_In_Place_Call_In_Assignment): Replace call to
+	Add_Collection_Actual_To_Build_In_Place_Call with
+	Add_Finalization_Master_Actual_To_Build_In_Place_Call.
+	(Needs_BIP_Collection): Renamed to Needs_BIP_Finalization_Master.
+	* exp_ch6.ads: Rename BIP_Collection to BIP_Finalization_Master.
+	(Needs_BIP_Collection): Renamed to Needs_BIP_Finalization_Master.
+	* exp_ch7.adb (Build_BIP_Cleanup_Stmts): Update comment on usage.
+	Rename local variable Collect to Fin_Mas_Id and update its occurrences.
+	Replace call to Set_Associated_Collection with Set_Finalization_Master.
+	(Build_Finalization_Collection): Renamed to Build_Finalization_Master.
+	Replace the call to Associated_Collection with Finalization_Master.
+	Rename local variable Coll_Id to Fin_Mas_Id and update its occurrences.
+	Update the way finalization master names are generated. Update the
+	retrieval of the correct access type which will carry the pool and
+	master attributes.
+	(Make_Final_Call): Reimplement the way [Deep_]Finalize is retrieved.
+	(Make_Finalize_Address_Body): Abstract types do not need
+	Finalize_Address. Code reformatting.
+	(Make_Finalize_Address_Stmts): Update comment on usage.
+	(Make_Set_Finalize_Address_Ptr_Call): Removed.
+	(Process_Declarations): Update comments.
+	* exp_ch7.ads (Build_Finalization_Collection): Renamed to
+	Build_Finalization_Master. Update associated comment.
+	(Make_Set_Finalize_Address_Ptr_Call): Removed.
+	* exp_ch13.adb: Update comments which mention finalization collections.
+	(Expand_N_Free_Statement): Replace the call to Associated_Collection
+	with Finalization_Master.
+	* exp_util.adb (Build_Allocate_Deallocate_Proc): Reimplemented to
+	create calls to routines Allocate_Any_Controlled and
+	Deallocate_Any_Controlled.
+	(Find_Finalize_Address): New routine.
+	(Is_Allocate_Deallocate_Proc): Update the RTE entities used in the
+	comparison.
+	(Requires_Cleanup_Actions): Update the comment on freeze node
+	inspection.
+	* exp_util.ads: Remove comment on generated code for
+	Build_Allocate_Deallocate_Proc. The code is now quite complex and it
+	is better to simply look in the body.
+	* freeze.adb (Freeze_All): Update the comment of finalization
+	collections. Replace the call to Associated_Collection with
+	Finalization_Master. Replace the call to Build_Finalization_Collection
+	with Build_Finalization_Master.
+	* impunit.adb: Add a-undesu and s-stposu to the list of units.
+	* Makefile.rtl: Add files a-undesu, s-finmas and s-stposu. Remove file
+	a-fihema.
+	* rtsfind.adb (Get_Unit_Name): Remove the processing for children of
+	Ada.Finalization. Add processing for children of System.Storage_Pools.
+	* rtsfind.ads: Remove the naming of second level children of
+	Ada.Finalization.
+	Remove Ada_Finalization_Heap_Management from the list of units.
+	Remove subtype Ada_Finalization_Child.
+	Remove the following subprogram entities:
+	
+	   RE_Allocate
+	   RE_Deallocate
+	   RE_Finalization_Collection
+	   RE_Finalization_Collection_Ptr
+	   RE_Set_Finalize_Address_Ptr
+	
+	Add the naming of second level children of System.Storage_Pools.
+	Add System_Finalization_Masters and System_Storage_Pools_Subpools to
+	the list of units.
+	Add subtype System_Storage_Pools_Child.
+	Add the following subprogram entities to System.Finalization_Masters:
+	
+	   RE_Finalization_Master
+	   RE_Finalization_Master_Ptr
+	
+	Add the following subprogram entities to System.Storage_Pools.Subpools:
+	
+	   RE_Allocate_Any_Controlled
+	   RE_Deallocate_Any_Controlled
+	   RE_Root_Storage_Pool_With_Subpools
+	   RE_Root_Subpool
+	   RE_Subpool_Handle
+	
+	Move the following subprogram entities from
+	Ada.Finalization.Heap_Management to System.Finalization_Masters:
+	
+	   RE_Add_Offset_To_Address
+	   RE_Attach
+	   RE_Base_Pool
+	   RE_Detach
+	
+	* sem_ch3.adb (Access_Type_Declaration): Replace the call to
+	Set_Associated_Collection with Set_Finalization_Master.
+	* sem_ch6.adb (Create_Extra_Formals): Update the way extra formal
+	BIP_Finalization_Master is created.
+	* s-finmas.adb: New unit System.Finalization_Masters.
+	* s-finmas.ads: New unit System.Finalization_Masters.
+	* s-stopoo.ads, s-stopoo.adb: Minor code reformatting.
+	* s-stposu.ads, s-stposu.adb: New unit implementing
+	System.Storage_Pools.Subpools.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* tbuild.adb: Add assertion.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* s-pooglo.adb: Minor reformatting.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Assignment_Statement): if the left-hand side is
+	an indexed component of a packed array whose element type is a record
+	with a representation clause different from that of the right-hand
+	side, generate a temporary to minimuze the number of bit-field
+	operations generated.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_util.adb (Insert_Actions): Use clauses can be part of lists of
+	declarations, and thus are likely insertion points for actions.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* einfo.ads: Minor comment fix.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* frontend.adb, gnat1drv.adb: Minor reformatting.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* s-pooglo.adb (Allocate, Deallocate): Take into account the alignment.
+	* a-fihema.adb (Allocate, Deallocate): Ditto.  Possibly add padding
+	space in front of the header.
+
+2011-08-29  Johannes Kanig  <kanig@adacore.com>
+
+	* frontend.adb (Frontend): Exit after creating Standard package when
+	-gnatd.H is present.
+	* gnat1drv.adb (Gnat1drv): Call Backend right away when -gnatd.H is
+	present.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch9.adb, mlib-prj.adb, prj.adb, prj.ads, ttypes.ads, sem_ch4.adb,
+	makeutl.adb, makeutl.ads, atree.ads, snames.adb-tmpl,
+	snames.ads-tmpl: Minor reformatting.
+
+2011-08-29  Philippe Gil  <gil@adacore.com>
+
+	* prj.adb (Reset_Units_In_Table): New procedure.
+	Reset units to avoid access to freed memory.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* get_scos.adb: When reading a P statement SCO without a pragma name
+	(from an older ALI file), ensure that the Pragma_Name component is set
+	to Unknown_Pragma (not left uninitialized).
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* makeutl.adb (Get_Directories): New procedure moved from Buildgpr and
+	modified to compute correctly the object path of a SAL project that is
+	extending another library project.
+	(Write_Path_File): New procedure.
+	* makeutl.ads (Directories): New table moved from Buildgpr
+	(Get_Directories): New procedure moved from Buildgpr
+	(Write_Path_File): New procedure
+	* mlib-prj.adb (Build_Library): Use Makeutl.Get_Directories to set the
+	paths before binding SALs, instead of Set_Ada_Paths.
+	* prj-env.adb (Set_Path_File_Var): Procedure has been moved to package
+	Prj.
+	* prj.adb (Set_Path_File_Var): New procedure moved from Prj.Env
+	(Current_Source_Path_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+	(Current_Source_Object_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+	* prj.ads (Set_Path_File_Var): New procedure moved from Prj.Env
+	(Current_Source_Path_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+	(Current_Source_Object_File_Of): New function
+	(Set_Current_Object_Path_File_Of): New procedure
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Assignment_Statement): For an assignment to a
+	packed entity, use a bit-field assignment only if there is no change of
+	representation.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* rtsfind.ads, exp_ch3.adb (In_Runtime): Minor code improvement, use
+	Is_RTU instead of using Chars comparisons.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_strm.adb (Build_Mutable_Record_Read_Procedure): Do not create a
+	temporary object if the actual is constrained, and the discriminants
+	read from the stream don't match.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* sem_attr.adb, exp_attr.adb: Add handling of
+	Attribute_System_Allocator_Alignment
+	* snames.ads-tmpl: Add Name_System_Allocator_Alignment and
+	Attribute_System_Allocator_Alignment.
+	* ttypes.ads, get_targ.ads: Add Get_System_Allocator_Alignment.
+	* gcc-interface/targtyps.c, gcc-interface/utils2.c,
+	gcc-interface/gigi.h: Renames get_target_default_allocator_alignment to
+	get_target_system_allocator_alignment.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
+	dependencies.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch3.adb (In_Runtime): Fix typo.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* sem_ch4.adb (Analyze_Allocator): Analyze the subpool specification.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): If the entity is tagged
+	and a separate tag assignment is generated, ensure that the tag
+	assignment is analyzed.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* atree.ads, atree.adb (Copy_Separate_List): New function that applies
+	Copy_Separate_Tree to a list of nodes. Used to create disjoint copies
+	of statement lists that may contain local declarations.
+	* exp_ch9.adb (Expand_N_Timed_Entry_Call): Use Copy_Separate_List to
+	duplicate the triggering statements needed for the expansion of this
+	construct, when the trigger is a dispatching call to a synchronized
+	primitive.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* gnat_rm.texi: Add doc for 'Elab_Subp_Body.
+	* bindgen.adb: Add comments.
+	* snames.adb-tmpl (Is_Attribute_Name): Only recognize 'Elab_Subp_Body
+	in CodePeer mode.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_attr.adb: Minor reformatting.
+	Minor code reorganization and commenting.
+	* par_sco.adb, checks.adb, sem_attr.adb, get_scos.adb: Minor
+	reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* get_scos.adb: Ignore chaining indicators not currently supported
+	by Ada.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* system.ads: Minor editing.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in
+	CodePeer mode.
+	* sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of
+	Attribute_Elab_Subp_Body.
+	* snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New.
+	* sem_util.adb: Update comments.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record
+	pragma name for each SCO statement corresponding to a pragma.
+
+2011-08-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* opt.ads: Minor editing.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): Remove options for ALFA mode
+	that only made sense for CodePeer mode.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* targparm.ads (Support_64_Bit_Divides_On_Target): Remove this flag
+	which is no longer used.
+	* targparm.adb (S64, S64_Str, Get_Target_Parameters): Remove the
+	handling of the 64-bit division check.
+	* exp_ch4.adb (Expand_N_Op_Divide): Remove the check for 64-bit
+	division available.
+	* system*.ads (Support_64_Bit_Divides): Remove this flag which is no
+	longer used.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* get_scos.adb: Minor reformatting.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Process_Statements_For_Controlled_Objects): Whenever a
+	statement list is wrapped in a block, the block is explicitly analyzed
+	in order to properly redecorate the entities and create a servicing
+	finalizer.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+	* sinfo.ads, sinfo.adb (Zero_Cost_Handling): Remove.
+	(Set_Zero_Cost_Handling): Remove.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Minor reformatting
+
+2011-08-29  Geert Bosch  <bosch@adacore.com>
+
+	* s-vaflop-vms-alpha.adb (Neg_F): Use subtraction instead of negation
+	instruction, as the latter may produce -0.0, which is not a valid VAX
+	F float number.
+	(Neg_G): Likewise for VAX F float.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_util.adb: Minor reformatting.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb: Minor comment update.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* checks.adb (Apply_Type_Conversion_Checks): Use the Underlying_Type of
+	the operand type.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* par_sco.adb (Traverse_Declarations_Or_Statements): Do not flush
+	current statement sequence on a generic instantiation or a subprogram
+	declaration.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_type.adb, einfo.ads, freeze.adb, exp_ch4.adb, sem_ch13.adb:
+	Minor reformatting.
+
+2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
+	Correct the check which involves the freeze node of a controlled or
+	access-to-controlled type.
+
+2011-08-29  Geert Bosch  <bosch@adacore.com>
+
+	* sem_warn.adb (Check_Code_Statement): Remove check for consecutive Asm
+	statements.
+	* s-vaflop-vms-alpha.adb: Remove bogus Volatile => True arguments from
+	Asm statements.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Array_Type_Declaration): Insert a subtype declaration
+	for every index type and component type that is not a subtype_mark.
+	(Process_Subtype): Set Etype of subtype.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* a-cbmutr.adb, a-cimutr.adb, a-comutr.adb, prj-nmsc.adb: Minor code
+	reorganization.  Minor reformatting.
+
+2011-08-29  Steve Baird  <baird@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Op_Expon): Suppress N_Op_Expon node expansion
+	for CodePeer and ALFA modes.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_type.adb (Collect_Interps): Within an instance, collect a homonym
+	that comes from an enclosing scope if it is not the renaming of an
+	actual, to handle properly a spurious ambiguity in an instance.
+
+2011-08-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch13.adb (Alignment_Check_For_Esize_Change): Rename to...
+	(Alignment_Check_For_Size_Change): ...this.  Add SIZE parameter and
+	use it instead of the Esize of the first parameter.
+	(Analyze_Attribute_Definition_Clause) <Object_Size>: Adjust call to
+	above change.
+	<Size>: Likewise.  Call it for composite types on the RM size.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Op_Not): Do not expand not on array.
+	* sem_util.adb (Unique_Name): Correct behaviour for names of
+	compilation units.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb (Check_Precondition_Postcondition): In formal
+	verification mode, analyze pragma expression for correctness, for
+	pre/post on library-level subprogram, as it is not expanded later.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* exp_aggr.adb (Expand_Array_Aggregate): Do not expand array aggregates
+	in formal verification.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_util.adb: Minor reformatting.
+	* freeze.adb, sem_ch13.adb: Fix comment: Bit_Order is an attribute,
+	there's no pragma.
+	* par_sco.ads, par_sco.adb: Update comments.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+	* einfo.adb, einfo.ads: Remove flag Is_Postcondition_Proc and
+	associated getter/setter.
+	* sem_ch6.adb: Remove reference to Is_Postcondition_Proc.
+
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+	* prj-attr.adb: New Compiler attribute Dependency_Kind and Language_Kind
+	* prj-conf.adb: Add_Default_GNAT_Naming_Scheme: Add a package Compiler
+	with declarations for Language_Kind and Dependency_Kind for Ada.
+	* prj-nmsc.adb (Check_Unit_Name): New name of procedure Check_Ada_Name
+	(Process_Compiler): Take into account the new attributes Dependency_Kind
+	and Language_Kind.
+	(Check_Configuration): Check if language kind is unit based, not if the
+	language name is Ada.
+	(Process_Exceptions_Unit_Based): Ditto
+	(Add_Language): Remove default additions of language and dependency kind
+	* prj.ads: Minor comment change
+	* snames.ads-tmpl: New standard names Dependency_Kind and Language_Kind
+
+2011-08-29  Johannes Kanig  <kanig@adacore.com>
+
+	* debug.adb: Update comments.
+
 2011-08-24  Joseph Myers  <joseph@codesourcery.com>
 
 	* gcc-interface/Make-lang.in (CFLAGS-ada/tracebak.o)
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 22eb02f18ef..eac13f7eacd 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -33,6 +33,7 @@ GNATRTL_TASKING_OBJS= \
   a-reatim$(objext) \
   a-retide$(objext) \
   a-rttiev$(objext) \
+  a-synbar$(objext) \
   a-sytaco$(objext) \
   a-tasatt$(objext) \
   a-taside$(objext) \
@@ -154,13 +155,13 @@ GNATRTL_NONTASKING_OBJS= \
   a-envvar$(objext) \
   a-except$(objext) \
   a-exctra$(objext) \
-  a-fihema$(objext) \
   a-finali$(objext) \
   a-flteio$(objext) \
   a-fwteio$(objext) \
   a-fzteio$(objext) \
   a-inteio$(objext) \
   a-ioexce$(objext) \
+  a-iteint$(objext) \
   a-iwteio$(objext) \
   a-izteio$(objext) \
   a-lcteio$(objext) \
@@ -183,6 +184,9 @@ GNATRTL_NONTASKING_OBJS= \
   a-ngcoty$(objext) \
   a-ngelfu$(objext) \
   a-ngrear$(objext) \
+  a-nllrar$(objext) \
+  a-nlrear$(objext) \
+  a-nurear$(objext) \
   a-nlcefu$(objext) \
   a-nlcoty$(objext) \
   a-nlelfu$(objext) \
@@ -290,6 +294,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-tiunio$(objext) \
   a-unccon$(objext) \
   a-uncdea$(objext) \
+  a-undesu$(objext) \
   a-wichha$(objext) \
   a-wichun$(objext) \
   a-widcha$(objext) \
@@ -477,6 +482,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-crtrun$(objext) \
   s-direio$(objext) \
   s-dsaser$(objext) \
+  s-excdeb$(objext) \
   s-except$(objext) \
   s-exctab$(objext) \
   s-exnint$(objext) \
@@ -495,6 +501,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-ficobl$(objext) \
   s-fileio$(objext) \
   s-filofl$(objext) \
+  s-finmas$(objext) \
   s-finroo$(objext) \
   s-fishfl$(objext) \
   s-flocon$(objext) \
@@ -605,12 +612,14 @@ GNATRTL_NONTASKING_OBJS= \
   s-sequio$(objext) \
   s-shasto$(objext) \
   s-soflin$(objext) \
+  s-spsufi$(objext) \
   s-stache$(objext) \
   s-stalib$(objext) \
   s-stausa$(objext) \
   s-stchop$(objext) \
   s-stoele$(objext) \
   s-stopoo$(objext) \
+  s-stposu$(objext) \
   s-stratt$(objext) \
   s-strhas$(objext) \
   s-string$(objext) \
diff --git a/gcc/ada/a-cbhama.adb b/gcc/ada/a-cbhama.adb
index 942007cde5d..629c1041ed9 100644
--- a/gcc/ada/a-cbhama.adb
+++ b/gcc/ada/a-cbhama.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -38,6 +38,18 @@ with System;  use type System.Address;
 
 package body Ada.Containers.Bounded_Hashed_Maps is
 
+   type Iterator is new
+     Map_Iterator_Interfaces.Forward_Iterator with record
+        Container : Map_Access;
+        Node      : Count_Type;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -411,6 +423,17 @@ package body Ada.Containers.Bounded_Hashed_Maps is
       return Cursor'(Container'Unrestricted_Access, Node);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+      M : constant Map_Access := Object.Container;
+      N : constant Count_Type := HT_Ops.First (M.all);
+   begin
+      if N = 0 then
+         return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, N);
+      end if;
+   end First;
+
    -----------------
    -- Has_Element --
    -----------------
@@ -652,6 +675,15 @@ package body Ada.Containers.Bounded_Hashed_Maps is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+   is
+      Node : constant Count_Type := HT_Ops.First (Container);
+      It   : constant Iterator   := (Container'Unrestricted_Access, Node);
+   begin
+      return It;
+   end Iterate;
+
    ---------
    -- Key --
    ---------
@@ -695,7 +727,8 @@ package body Ada.Containers.Bounded_Hashed_Maps is
            "attempt to tamper with cursors (container is busy)";
       end if;
 
-      Assign (Target => Target, Source => Source);
+      Target.Assign (Source);
+      Source.Clear;
    end Move;
 
    ----------
@@ -733,6 +766,18 @@ package body Ada.Containers.Bounded_Hashed_Maps is
       Position := Next (Position);
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Node = 0 then
+         return No_Element;
+      else
+         return (Object.Container, Next (Position).Node);
+      end if;
+   end Next;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -832,6 +877,38 @@ package body Ada.Containers.Bounded_Hashed_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference (Container : Map; Key : Key_Type)
+   return Constant_Reference_Type is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Constant_Reference;
+
+   function Reference (Container : Map; Key : Key_Type)
+   return Reference_Type is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Reference;
+
    -------------
    -- Replace --
    -------------
@@ -1065,4 +1142,20 @@ package body Ada.Containers.Bounded_Hashed_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Bounded_Hashed_Maps;
diff --git a/gcc/ada/a-cbhama.ads b/gcc/ada/a-cbhama.ads
index 042cc0fa1df..4d7cfa2225b 100644
--- a/gcc/ada/a-cbhama.ads
+++ b/gcc/ada/a-cbhama.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,7 +32,9 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Containers.Hash_Tables;
-private with Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Key_Type is private;
@@ -46,7 +48,12 @@ package Ada.Containers.Bounded_Hashed_Maps is
    pragma Pure;
    pragma Remote_Types;
 
-   type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private;
+   type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Map);
 
    type Cursor is private;
@@ -60,6 +67,12 @@ package Ada.Containers.Bounded_Hashed_Maps is
    --  Cursor objects declared without an initialization expression are
    --  initialized to the value No_Element.
 
+   function Has_Element (Position : Cursor) return Boolean;
+   --  Equivalent to Position /= No_Element
+
+   package Map_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : Map) return Boolean;
    --  For each key/element pair in Left, equality attempts to find the key in
    --  Right; if a search fails the equality returns False. The search works by
@@ -253,9 +266,6 @@ package Ada.Containers.Bounded_Hashed_Maps is
    function Element (Container : Map; Key : Key_Type) return Element_Type;
    --  Equivalent to Element (Find (Container, Key))
 
-   function Has_Element (Position : Cursor) return Boolean;
-   --  Equivalent to Position /= No_Element
-
    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
    --  Returns the result of calling Equivalent_Keys with the keys of the nodes
    --  designated by cursors Left and Right.
@@ -273,8 +283,51 @@ package Ada.Containers.Bounded_Hashed_Maps is
       Process   : not null access procedure (Position : Cursor));
    --  Calls Process for each node in the map
 
+   function Iterate (Container : Map)
+      return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED???
+      return Constant_Reference_Type;
+
+   function Reference (Container : Map; Key : Key_Type) return Reference_Type;
+
 private
-   --  pragma Inline ("=");
    pragma Inline (Length);
    pragma Inline (Is_Empty);
    pragma Inline (Clear);
@@ -285,7 +338,6 @@ private
    pragma Inline (Capacity);
    pragma Inline (Reserve_Capacity);
    pragma Inline (Has_Element);
-   pragma Inline (Equivalent_Keys);
    pragma Inline (Next);
 
    type Node_Type is record
@@ -301,7 +353,6 @@ private
       new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
 
    use HT_Types;
-   use Ada.Streams;
 
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
@@ -318,9 +369,15 @@ private
    type Map_Access is access all Map;
    for Map_Access'Storage_Size use 0;
 
+   --  Note: If a Cursor object has no explicit initialization expression,
+   --  it must default initialize to the same value as constant No_Element.
+   --  The Node component of type Cursor has scalar type Count_Type, so it
+   --  requires an explicit initialization expression of its own declaration,
+   --  in order for objects of record type Cursor to properly initialize.
+
    type Cursor is record
       Container : Map_Access;
-      Node      : Count_Type;
+      Node      : Count_Type := 0;
    end record;
 
    procedure Read
@@ -335,6 +392,12 @@ private
 
    for Cursor'Write use Write;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    No_Element : constant Cursor := (Container => null, Node => 0);
 
    Empty_Map : constant Map :=
diff --git a/gcc/ada/a-cbhase.adb b/gcc/ada/a-cbhase.adb
index e477690d997..3b85e2effef 100644
--- a/gcc/ada/a-cbhase.adb
+++ b/gcc/ada/a-cbhase.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -925,7 +925,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
            "attempt to tamper with cursors (container is busy)";
       end if;
 
-      Assign (Target => Target, Source => Source);
+      Target.Assign (Source);
+      Source.Clear;
    end Move;
 
    ----------
diff --git a/gcc/ada/a-cbhase.ads b/gcc/ada/a-cbhase.ads
index 9618ff3087e..711c0116963 100644
--- a/gcc/ada/a-cbhase.ads
+++ b/gcc/ada/a-cbhase.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -429,9 +429,15 @@ private
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
 
+   --  Note: If a Cursor object has no explicit initialization expression,
+   --  it must default initialize to the same value as constant No_Element.
+   --  The Node component of type Cursor has scalar type Count_Type, so it
+   --  requires an explicit initialization expression of its own declaration,
+   --  in order for objects of record type Cursor to properly initialize.
+
    type Cursor is record
       Container : Set_Access;
-      Node      : Count_Type;
+      Node      : Count_Type := 0;
    end record;
 
    procedure Write
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
index cc569e83673..e206e98e38f 100644
--- a/gcc/ada/a-cbmutr.adb
+++ b/gcc/ada/a-cbmutr.adb
@@ -286,21 +286,21 @@ package body Ada.Containers.Bounded_Multiway_Trees is
    -------------------
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
-      R : constant Count_Type := Root_Node (Container);
-      N : Count_Type;
+      R, N : Count_Type;
 
    begin
       if Position = No_Element then
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ruling by ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       --  AI-0136 says to raise PE if Position equals the root node. This does
       --  not seem correct, as this value is just the limiting condition of the
@@ -311,13 +311,14 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       --     raise Program_Error with "Position cursor designates root";
       --  end if;
 
+      R := Root_Node (Position.Container.all);
       N := Position.Node;
       while N /= R loop
-         if Container.Elements (N) = Item then
-            return Cursor'(Container'Unrestricted_Access, N);
+         if Position.Container.Elements (N) = Item then
+            return Cursor'(Position.Container, N);
          end if;
 
-         N := Container.Nodes (N).Parent;
+         N := Position.Container.Nodes (N).Parent;
       end loop;
 
       return No_Element;
@@ -435,14 +436,14 @@ package body Ada.Containers.Bounded_Multiway_Trees is
    begin
       if Parent = No_Element then
          return 0;
-      end if;
 
-      if Parent.Container.Count = 0 then
+      elsif Parent.Container.Count = 0 then
          pragma Assert (Is_Root (Parent));
          return 0;
-      end if;
 
-      return Child_Count (Parent.Container.all, Parent.Node);
+      else
+         return Child_Count (Parent.Container.all, Parent.Node);
+      end if;
    end Child_Count;
 
    function Child_Count
@@ -1289,9 +1290,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
    ---------------------
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
       Result : Count_Type;
 
@@ -1300,27 +1300,35 @@ package body Ada.Containers.Bounded_Multiway_Trees is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ruling by ARG.  ???
 
-      if Container.Count = 0 then
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
+
+      if Position.Container.Count = 0 then
          pragma Assert (Is_Root (Position));
          return No_Element;
       end if;
 
       if Is_Root (Position) then
-         Result := Find_In_Children (Container, Position.Node, Item);
+         Result := Find_In_Children
+                     (Container => Position.Container.all,
+                      Subtree   => Position.Node,
+                      Item      => Item);
 
       else
-         Result := Find_In_Subtree (Container, Position.Node, Item);
+         Result := Find_In_Subtree
+                     (Container => Position.Container.all,
+                      Subtree   => Position.Node,
+                      Item      => Item);
       end if;
 
       if Result = 0 then
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Result);
+      return Cursor'(Position.Container, Result);
    end Find_In_Subtree;
 
    function Find_In_Subtree
@@ -2676,13 +2684,18 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       end if;
 
       if Target'Address = Source'Address then
-         if Before = No_Element then
-            if Target.Nodes (Position.Node).Next <= 0 then  -- last child
+         if Target.Nodes (Position.Node).Parent = Parent.Node then
+            if Before = No_Element then
+               if Target.Nodes (Position.Node).Next <= 0 then  -- last child
+                  return;
+               end if;
+
+            elsif Position.Node = Before.Node then
                return;
-            end if;
 
-         elsif Position.Node = Before.Node then
-            return;
+            elsif Target.Nodes (Position.Node).Next = Before.Node then
+               return;
+            end if;
          end if;
 
          if Target.Busy > 0 then
@@ -2769,13 +2782,18 @@ package body Ada.Containers.Bounded_Multiway_Trees is
          raise Constraint_Error with "Position cursor designates root";
       end if;
 
-      if Before = No_Element then
-         if Container.Nodes (Position.Node).Next <= 0 then  -- last child
+      if Container.Nodes (Position.Node).Parent = Parent.Node then
+         if Before = No_Element then
+            if Container.Nodes (Position.Node).Next <= 0 then  -- last child
+               return;
+            end if;
+
+         elsif Position.Node = Before.Node then
             return;
-         end if;
 
-      elsif Position.Node = Before.Node then
-         return;
+         elsif Container.Nodes (Position.Node).Next = Before.Node then
+            return;
+         end if;
       end if;
 
       if Container.Busy > 0 then
@@ -2809,6 +2827,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       Target_Count   : Count_Type;
 
    begin
+      --  This is a utility operation to do the heavy lifting associated with
+      --  splicing a subtree from one tree to another. Note that "splicing"
+      --  is a bit of a misnomer here in the case of a bounded tree, because
+      --  the elements must be copied from the source to the target.
+
       if Target.Count > Target.Capacity - Source_Count then
          raise Capacity_Error  -- ???
            with "Source count exceeds available storage on Target";
@@ -2830,6 +2853,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
 
       pragma Assert (Target_Count = Source_Count);
 
+      --  Now link the newly-allocated subtree into the target.
+
       Insert_Subtree_Node
         (Container => Target,
          Subtree   => Target_Subtree,
@@ -2838,6 +2863,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
 
       Target.Count := Target.Count + Target_Count;
 
+      --  The manipulation of the Target container is complete. Now we remove
+      --  the subtree from the Source container.
+
+      Remove_Subtree (Source, Position);  -- unlink the subtree
+
       --  As with Copy_Subtree, operation Deallocate_Subtree returns a count of
       --  the number of nodes it deallocates, but it works by incrementing the
       --  value passed in. We must therefore initialize the count before
@@ -2845,7 +2875,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
 
       Source_Count := 0;
 
-      Deallocate_Children (Source, Position, Source_Count);
+      Deallocate_Subtree (Source, Position, Source_Count);
       pragma Assert (Source_Count = Target_Count);
 
       Source.Count := Source.Count - Source_Count;
diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads
index b62e67fe308..818cde28a1c 100644
--- a/gcc/ada/a-cbmutr.ads
+++ b/gcc/ada/a-cbmutr.ads
@@ -113,22 +113,36 @@ package Ada.Containers.Bounded_Multiway_Trees is
       Item      : Element_Type) return Cursor;
 
    --  This version of the AI:
-
-   --    10-06-02  AI05-0136-1/07
-
-   --  declares Find_In_Subtree with a Container parameter, but this seems
-   --  incorrect. We need a ruling from the ARG about whether this really was
-   --  intended. ???
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree this way:
+   --
+   --  function Find_In_Subtree
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Ancestor_Find this way:
+   --
+   --  function Ancestor_Find
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
 
    function Contains
      (Container : Tree;
diff --git a/gcc/ada/a-cborma.adb b/gcc/ada/a-cborma.adb
index 64c248f7b50..89ec1310405 100644
--- a/gcc/ada/a-cborma.adb
+++ b/gcc/ada/a-cborma.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -39,6 +39,24 @@ with System;  use type System.Address;
 
 package body Ada.Containers.Bounded_Ordered_Maps is
 
+   type Iterator is new
+     Map_Iterator_Interfaces.Reversible_Iterator with record
+        Container : Map_Access;
+        Node      : Count_Type;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------------
    -- Node Access Subprograms --
    -----------------------------
@@ -238,7 +256,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       declare
          LN : Node_Type renames Left.Container.Nodes (Left.Node);
-
       begin
          return Right < LN.Key;
       end;
@@ -497,13 +514,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
    function Element (Container : Map; Key : Key_Type) return Element_Type is
       Node : constant Count_Type := Key_Ops.Find (Container, Key);
-
    begin
       if Node = 0 then
          raise Constraint_Error with "key not in map";
+      else
+         return Container.Nodes (Node).Element;
       end if;
-
-      return Container.Nodes (Node).Element;
    end Element;
 
    ---------------------
@@ -541,13 +557,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
    function Find (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Count_Type := Key_Ops.Find (Container, Key);
-
    begin
       if Node = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Find;
 
    -----------
@@ -558,9 +573,19 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.First = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Container.First);
       end if;
+   end First;
 
-      return Cursor'(Container'Unrestricted_Access, Container.First);
+   function First (Object : Iterator) return Cursor is
+      F : constant Count_Type := Object.Container.First;
+   begin
+      if F = 0 then
+         return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, F);
+      end if;
    end First;
 
    -------------------
@@ -571,9 +596,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.First = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.First).Element;
       end if;
-
-      return Container.Nodes (Container.First).Element;
    end First_Element;
 
    ---------------
@@ -584,9 +609,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.First = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.First).Key;
       end if;
-
-      return Container.Nodes (Container.First).Key;
    end First_Key;
 
    -----------
@@ -595,13 +620,12 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
    function Floor (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Count_Type := Key_Ops.Floor (Container, Key);
-
    begin
       if Node = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
    -----------------
@@ -636,7 +660,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
          declare
             N : Node_Type renames Container.Nodes (Position.Node);
-
          begin
             N.Key := Key;
             N.Element := New_Item;
@@ -686,7 +709,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       function New_Node return Count_Type is
          Result : Count_Type;
-
       begin
          Allocate (Container, Result);
          return Result;
@@ -750,6 +772,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       procedure Assign (Node : in out Node_Type) is
       begin
          Node.Key := Key;
+
+         --  Why is the following commented out ???
          --  Node.Element := New_Item;
       end Assign;
 
@@ -759,7 +783,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       function New_Node return Count_Type is
          Result : Count_Type;
-
       begin
          Allocate (Container, Result);
          return Result;
@@ -795,7 +818,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       Right : Node_Type) return Boolean
    is
    begin
-      --  k > node same as node < k
+      --  Left > Right same as Right < Left
 
       return Right.Key < Left;
    end Is_Greater_Key_Node;
@@ -853,6 +876,25 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+   is
+      It : constant Iterator :=
+             (Container'Unrestricted_Access, Container.First);
+   begin
+      return It;
+   end Iterate;
+
+   function Iterate
+     (Container : Map;
+      Start     : Cursor)
+      return Map_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
+   begin
+      return It;
+   end Iterate;
+
    ---------
    -- Key --
    ---------
@@ -878,9 +920,19 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.Last = 0 then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Container.Last);
       end if;
+   end Last;
 
-      return Cursor'(Container'Unrestricted_Access, Container.Last);
+   function Last (Object : Iterator) return Cursor is
+      F : constant Count_Type := Object.Container.Last;
+   begin
+      if F = 0 then
+         return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, F);
+      end if;
    end Last;
 
    ------------------
@@ -891,9 +943,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.Last = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.Last).Element;
       end if;
-
-      return Container.Nodes (Container.Last).Element;
    end Last_Element;
 
    --------------
@@ -904,9 +956,9 @@ package body Ada.Containers.Bounded_Ordered_Maps is
    begin
       if Container.Last = 0 then
          raise Constraint_Error with "map is empty";
+      else
+         return Container.Nodes (Container.Last).Key;
       end if;
-
-      return Container.Nodes (Container.Last).Key;
    end Last_Key;
 
    ----------
@@ -942,7 +994,8 @@ package body Ada.Containers.Bounded_Ordered_Maps is
            "attempt to tamper with cursors (container is busy)";
       end if;
 
-      Assign (Target => Target, Source => Source);
+      Target.Assign (Source);
+      Source.Clear;
    end Move;
 
    ----------
@@ -978,6 +1031,15 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       end;
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Next (Position);
+   end Next;
+
    ------------
    -- Parent --
    ------------
@@ -1020,6 +1082,15 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       end;
    end Previous;
 
+   function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Previous (Position);
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -1104,6 +1175,42 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type) return Constant_Reference_Type
+   is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Constant_Reference;
+
+   function Reference
+     (Container : Map;
+      Key       : Key_Type) return Reference_Type
+   is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Reference;
+
    -------------
    -- Replace --
    -------------
@@ -1190,7 +1297,7 @@ package body Ada.Containers.Bounded_Ordered_Maps is
 
       B : Natural renames Container'Unrestricted_Access.all.Busy;
 
-      --  Start of processing for Reverse_Iterate
+   --  Start of processing for Reverse_Iterate
 
    begin
       B := B + 1;
@@ -1345,4 +1452,20 @@ package body Ada.Containers.Bounded_Ordered_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Bounded_Ordered_Maps;
diff --git a/gcc/ada/a-cborma.ads b/gcc/ada/a-cborma.ads
index 74dac985168..e1f9f08f379 100644
--- a/gcc/ada/a-cborma.ads
+++ b/gcc/ada/a-cborma.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,7 +32,9 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Containers.Red_Black_Trees;
-private with Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Key_Type is private;
@@ -47,7 +49,12 @@ package Ada.Containers.Bounded_Ordered_Maps is
 
    function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
-   type Map (Capacity : Count_Type) is tagged private;
+   type Map (Capacity : Count_Type) is tagged private with
+      constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Map);
 
    type Cursor is private;
@@ -57,6 +64,11 @@ package Ada.Containers.Bounded_Ordered_Maps is
 
    No_Element : constant Cursor;
 
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package Map_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : Map) return Boolean;
 
    function Length (Container : Map) return Count_Type;
@@ -83,7 +95,7 @@ package Ada.Containers.Bounded_Ordered_Maps is
      (Container : in out Map;
       Position  : Cursor;
       Process   : not null access
-                   procedure (Key : Key_Type; Element : in out Element_Type));
+                    procedure (Key : Key_Type; Element : in out Element_Type));
 
    procedure Assign (Target : in out Map; Source : Map);
 
@@ -159,8 +171,6 @@ package Ada.Containers.Bounded_Ordered_Maps is
 
    function Contains (Container : Map; Key : Key_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    function "<" (Left, Right : Cursor) return Boolean;
 
    function ">" (Left, Right : Cursor) return Boolean;
@@ -173,10 +183,58 @@ package Ada.Containers.Bounded_Ordered_Maps is
 
    function ">" (Left : Key_Type; Right : Cursor) return Boolean;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED ???
+      return Constant_Reference_Type;
+
+   function Reference (Container : Map; Key : Key_Type) return Reference_Type;
+
    procedure Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate
+     (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+   function Iterate
+     (Container : Map;
+      Start     : Cursor)
+      return Map_Iterator_Interfaces.Reversible_Iterator'class;
+
    procedure Reverse_Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
@@ -206,11 +264,10 @@ private
 
    use Red_Black_Trees;
    use Tree_Types;
-   use Ada.Streams;
 
    type Cursor is record
       Container : Map_Access;
-      Node      : Count_Type;
+      Node      : Count_Type := 0;
    end record;
 
    procedure Write
@@ -239,6 +296,12 @@ private
 
    for Map'Read use Read;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    Empty_Map : constant Map := Map'(Tree_Type with Capacity => 0);
 
 end Ada.Containers.Bounded_Ordered_Maps;
diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb
index 12d253c648f..4a4bc71d416 100644
--- a/gcc/ada/a-cborse.adb
+++ b/gcc/ada/a-cborse.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -1244,7 +1244,8 @@ package body Ada.Containers.Bounded_Ordered_Sets is
            "attempt to tamper with cursors (container is busy)";
       end if;
 
-      Assign (Target => Target, Source => Source);
+      Target.Assign (Source);
+      Source.Clear;
    end Move;
 
    ----------
diff --git a/gcc/ada/a-cborse.ads b/gcc/ada/a-cborse.ads
index f9719dcdbc6..e56b71b4c61 100644
--- a/gcc/ada/a-cborse.ads
+++ b/gcc/ada/a-cborse.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -255,9 +255,15 @@ private
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
 
+   --  Note: If a Cursor object has no explicit initialization expression,
+   --  it must default initialize to the same value as constant No_Element.
+   --  The Node component of type Cursor has scalar type Count_Type, so it
+   --  requires an explicit initialization expression of its own declaration,
+   --  in order for objects of record type Cursor to properly initialize.
+
    type Cursor is record
       Container : Set_Access;
-      Node      : Count_Type;
+      Node      : Count_Type := 0;
    end record;
 
    use Tree_Types;
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb
index cbac8fd4a1d..ef02e460cce 100644
--- a/gcc/ada/a-cdlili.adb
+++ b/gcc/ada/a-cdlili.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -32,6 +32,22 @@ with System;  use type System.Address;
 with Ada.Unchecked_Deallocation;
 
 package body Ada.Containers.Doubly_Linked_Lists is
+   type Iterator is new
+     List_Iterator_Interfaces.Reversible_Iterator with record
+        Container : List_Access;
+        Node      : Node_Access;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
 
    -----------------------
    -- Local Subprograms --
@@ -395,6 +411,15 @@ package body Ada.Containers.Doubly_Linked_Lists is
       return Cursor'(Container'Unchecked_Access, Container.First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      if Object.Container = null then
+         return No_Element;
+      else
+         return (Object.Container, Object.Container.First);
+      end if;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -794,6 +819,25 @@ package body Ada.Containers.Doubly_Linked_Lists is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : List)
+     return List_Iterator_Interfaces.Reversible_Iterator'class
+   is
+   begin
+      if Container.Length = 0 then
+         return Iterator'(null, null);
+      else
+         return Iterator'(Container'Unchecked_Access, Container.First);
+      end if;
+   end Iterate;
+
+   function Iterate (Container : List; Start : Cursor)
+     return List_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Start.Node);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -807,6 +851,15 @@ package body Ada.Containers.Doubly_Linked_Lists is
       return Cursor'(Container'Unchecked_Access, Container.Last);
    end Last;
 
+   function Last (Object : Iterator) return Cursor is
+   begin
+      if Object.Container = null then
+         return No_Element;
+      else
+         return (Object.Container, Object.Container.Last);
+      end if;
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -878,6 +931,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
       declare
          Next_Node : constant Node_Access := Position.Node.Next;
+
       begin
          if Next_Node = null then
             return No_Element;
@@ -887,6 +941,18 @@ package body Ada.Containers.Doubly_Linked_Lists is
       end;
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Node = Object.Container.Last then
+         return No_Element;
+      else
+         return (Object.Container, Position.Node.Next);
+      end if;
+   end Next;
+
    -------------
    -- Prepend --
    -------------
@@ -919,6 +985,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
       declare
          Prev_Node : constant Node_Access := Position.Node.Prev;
+
       begin
          if Prev_Node = null then
             return No_Element;
@@ -928,6 +995,18 @@ package body Ada.Containers.Doubly_Linked_Lists is
       end;
    end Previous;
 
+   function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Node = Position.Container.First then
+         return No_Element;
+      else
+         return (Object.Container, Position.Node.Prev);
+      end if;
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -1027,6 +1106,50 @@ package body Ada.Containers.Doubly_Linked_Lists is
       raise Program_Error with "attempt to stream list cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference (Container : List; Position : Cursor)
+   return Constant_Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element'Access);
+   end Constant_Reference;
+
+   function Reference (Container : List; Position : Cursor)
+   return Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element'Access);
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -1832,4 +1955,20 @@ package body Ada.Containers.Doubly_Linked_Lists is
       raise Program_Error with "attempt to stream list cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Doubly_Linked_Lists;
diff --git a/gcc/ada/a-cdlili.ads b/gcc/ada/a-cdlili.ads
index 30e37085427..d38b0d08ba3 100644
--- a/gcc/ada/a-cdlili.ads
+++ b/gcc/ada/a-cdlili.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,7 +32,9 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Finalization;
-private with Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Element_Type is private;
@@ -44,7 +46,13 @@ package Ada.Containers.Doubly_Linked_Lists is
    pragma Preelaborate;
    pragma Remote_Types;
 
-   type List is tagged private;
+   type List is tagged private
+   with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (List);
 
    type Cursor is private;
@@ -53,6 +61,10 @@ package Ada.Containers.Doubly_Linked_Lists is
    Empty_List : constant List;
 
    No_Element : constant Cursor;
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package List_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
 
    function "=" (Left, Right : List) return Boolean;
 
@@ -126,6 +138,12 @@ package Ada.Containers.Doubly_Linked_Lists is
 
    procedure Reverse_Elements (Container : in out List);
 
+   function Iterate (Container : List)
+      return List_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate (Container : List; Start : Cursor)
+      return List_Iterator_Interfaces.Reversible_Iterator'class;
+
    procedure Swap
      (Container : in out List;
       I, J      : Cursor);
@@ -180,8 +198,6 @@ package Ada.Containers.Doubly_Linked_Lists is
      (Container : List;
       Item      : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    procedure Iterate
      (Container : List;
       Process   : not null access procedure (Position : Cursor));
@@ -202,6 +218,48 @@ package Ada.Containers.Doubly_Linked_Lists is
 
    end Generic_Sorting;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : List; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type;
+
+   function Reference
+     (Container : List; Position : Cursor)    --  SHOULD BE ALIASED
+   return Reference_Type;
+
 private
 
    pragma Inline (Next);
@@ -212,7 +270,7 @@ private
 
    type Node_Type is
       limited record
-         Element : Element_Type;
+         Element : aliased Element_Type;
          Next    : Node_Access;
          Prev    : Node_Access;
       end record;
@@ -232,8 +290,6 @@ private
 
    overriding procedure Finalize (Container : in out List) renames Clear;
 
-   use Ada.Streams;
-
    procedure Read
      (Stream : not null access Root_Stream_Type'Class;
       Item   : out List);
@@ -267,6 +323,12 @@ private
 
    for Cursor'Write use Write;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    Empty_List : constant List := (Controlled with null, null, 0, 0, 0);
 
    No_Element : constant Cursor := Cursor'(null, null);
diff --git a/gcc/ada/a-chtgbo.adb b/gcc/ada/a-chtgbo.adb
index b19668e1391..a4254697044 100644
--- a/gcc/ada/a-chtgbo.adb
+++ b/gcc/ada/a-chtgbo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -296,7 +296,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
 
       --  Find the first node of hash table L
 
-      L_Index := 0;
+      L_Index := L.Buckets'First;
       loop
          L_Node := L.Buckets (L_Index);
          exit when L_Node /= 0;
@@ -314,7 +314,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
 
          N := N - 1;
 
-         L_Node := Next (L, L_Node);
+         L_Node := Next (L.Nodes (L_Node));
 
          if L_Node = 0 then
             --  We have exhausted the nodes in this bucket
@@ -350,7 +350,7 @@ package body Ada.Containers.Hash_Tables.Generic_Bounded_Operations is
          Node := HT.Buckets (Indx);
          while Node /= 0 loop
             Process (Node);
-            Node := Next (HT, Node);
+            Node := Next (HT.Nodes (Node));
          end loop;
       end loop;
    end Generic_Iteration;
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb
index 8d1f8e36439..849cb53c64a 100644
--- a/gcc/ada/a-cidlli.adb
+++ b/gcc/ada/a-cidlli.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -35,6 +35,24 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
    procedure Free is
      new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
 
+   type Iterator is new
+     List_Iterator_Interfaces.Reversible_Iterator with record
+        Container : List_Access;
+        Node      : Node_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -431,6 +449,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       return Cursor'(Container'Unchecked_Access, Container.First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      if Object.Container = null then
+         return No_Element;
+      else
+         return Cursor'(Object.Container, Object.Container.First);
+      end if;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -820,6 +847,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : List)
+      return List_Iterator_Interfaces.Reversible_Iterator'class
+   is
+   begin
+      if Container.Length = 0 then
+         return Iterator'(null, null);
+      else
+         return Iterator'(Container'Unchecked_Access, Container.First);
+      end if;
+   end Iterate;
+
+   function Iterate
+     (Container : List;
+      Start     : Cursor)
+      return List_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Start.Node);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -833,6 +882,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       return Cursor'(Container'Unchecked_Access, Container.Last);
    end Last;
 
+   function Last (Object : Iterator) return Cursor is
+   begin
+      if Object.Container = null then
+         return No_Element;
+      else
+         return Cursor'(Object.Container, Object.Container.Last);
+      end if;
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -910,6 +968,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       end;
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Node = Object.Container.Last then
+         return No_Element;
+
+      else
+         return (Object.Container, Position.Node.Next);
+      end if;
+   end Next;
+
    -------------
    -- Prepend --
    -------------
@@ -951,6 +1019,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       end;
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Node = Position.Container.First then
+         return No_Element;
+      else
+         return (Object.Container, Position.Node.Prev);
+      end if;
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -1056,6 +1133,50 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       raise Program_Error with "attempt to stream list cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference (Container : List; Position : Cursor)
+   return Constant_Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element.all'Access);
+   end Constant_Reference;
+
+   function Reference (Container : List; Position : Cursor)
+   return Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element.all'Access);
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -1907,4 +2028,20 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       raise Program_Error with "attempt to stream list cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Indefinite_Doubly_Linked_Lists;
diff --git a/gcc/ada/a-cidlli.ads b/gcc/ada/a-cidlli.ads
index 7d572a8cc93..8a23fc75442 100644
--- a/gcc/ada/a-cidlli.ads
+++ b/gcc/ada/a-cidlli.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -31,8 +31,10 @@
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
 
+with Ada.Iterator_Interfaces;
+with Ada.Streams;             use Ada.Streams;
+
 private with Ada.Finalization;
-private with Ada.Streams;
 
 generic
    type Element_Type (<>) is private;
@@ -44,7 +46,12 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
    pragma Preelaborate;
    pragma Remote_Types;
 
-   type List is tagged private;
+   type List is tagged private with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (List);
 
    type Cursor is private;
@@ -54,6 +61,11 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    No_Element : constant Cursor;
 
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package List_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : List) return Boolean;
 
    function Length (Container : List) return Count_Type;
@@ -170,8 +182,6 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Container : List;
       Item      : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    procedure Iterate
      (Container : List;
       Process   : not null access procedure (Position : Cursor));
@@ -180,6 +190,59 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Container : List;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate
+     (Container : List)
+      return List_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate
+     (Container : List;
+      Start     : Cursor)
+      return List_Iterator_Interfaces.Reversible_Iterator'class;
+
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : List;
+      Position  : Cursor)    --  SHOULD BE ALIASED ???
+      return Constant_Reference_Type;
+
+   function Reference
+     (Container : List;
+      Position  : Cursor)    --  SHOULD BE ALIASED ???
+      return Reference_Type;
+
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
    package Generic_Sorting is
@@ -220,12 +283,16 @@ private
         Lock   : Natural := 0;
      end record;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    overriding procedure Adjust (Container : in out List);
 
    overriding procedure Finalize (Container : in out List) renames Clear;
 
-   use Ada.Streams;
-
    procedure Read
      (Stream : not null access Root_Stream_Type'Class;
       Item   : out List);
diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb
index b487394b366..d4f2c1d92dc 100644
--- a/gcc/ada/a-cihama.adb
+++ b/gcc/ada/a-cihama.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -43,6 +43,18 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    procedure Free_Element is
       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
 
+   type Iterator is new
+     Map_Iterator_Interfaces.Forward_Iterator with record
+        Container : Map_Access;
+        Node      : Node_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -398,6 +410,17 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       return Cursor'(Container'Unchecked_Access, Node);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+      M : constant Map_Access  := Object.Container;
+      N : constant Node_Access := HT_Ops.First (M.HT);
+   begin
+      if N = null then
+         return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, N);
+      end if;
+   end First;
+
    ----------
    -- Free --
    ----------
@@ -405,6 +428,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    procedure Free (X : in out Node_Access) is
       procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
    begin
       if X = null then
          return;
@@ -626,6 +650,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Map)
+      return Map_Iterator_Interfaces.Forward_Iterator'class
+   is
+      Node : constant Node_Access := HT_Ops.First (Container.HT);
+      It   : constant Iterator := (Container'Unrestricted_Access, Node);
+   begin
+      return It;
+   end Iterate;
+
    ---------
    -- Key --
    ---------
@@ -709,6 +742,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       end;
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Node = null then
+         return No_Element;
+      else
+         return (Object.Container, Next (Position).Node);
+      end if;
+   end Next;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -784,6 +826,22 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
    ---------------
    -- Read_Node --
    ---------------
@@ -814,6 +872,28 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       return Node;
    end Read_Node;
 
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type) return Constant_Reference_Type
+   is
+   begin
+      return (Element =>
+        Container.Find (Key).Node.Element.all'Unrestricted_Access);
+   end Constant_Reference;
+
+   function Reference
+     (Container : Map;
+      Key       : Key_Type) return Reference_Type
+   is
+   begin
+      return (Element =>
+         Container.Find (Key).Node.Element.all'Unrestricted_Access);
+   end Reference;
+
    -------------
    -- Replace --
    -------------
@@ -1064,6 +1144,22 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
    ----------------
    -- Write_Node --
    ----------------
diff --git a/gcc/ada/a-cihama.ads b/gcc/ada/a-cihama.ads
index 8a27c7e2619..1b16d8f4589 100644
--- a/gcc/ada/a-cihama.ads
+++ b/gcc/ada/a-cihama.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,8 +32,9 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Containers.Hash_Tables;
-private with Ada.Streams;
 private with Ada.Finalization;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Key_Type (<>) is private;
@@ -47,13 +48,18 @@ package Ada.Containers.Indefinite_Hashed_Maps is
    pragma Preelaborate;
    pragma Remote_Types;
 
-   type Map is tagged private;
+   type Map is tagged private with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Map);
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
 
-   Empty_Map  : constant Map;
+   Empty_Map : constant Map;
    --  Map objects declared without an initialization expression are
    --  initialized to the value Empty_Map.
 
@@ -61,6 +67,12 @@ package Ada.Containers.Indefinite_Hashed_Maps is
    --  Cursor objects declared without an initialization expression are
    --  initialized to the value No_Element.
 
+   function Has_Element (Position : Cursor) return Boolean;
+   --  Equivalent to Position /= No_Element
+
+   package Map_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    overriding function "=" (Left, Right : Map) return Boolean;
    --  For each key/element pair in Left, equality attempts to find the key in
    --  Right; if a search fails the equality returns False. The search works by
@@ -227,9 +239,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is
    function Element (Container : Map; Key : Key_Type) return Element_Type;
    --  Equivalent to Element (Find (Container, Key))
 
-   function Has_Element (Position : Cursor) return Boolean;
-   --  Equivalent to Position /= No_Element
-
    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
    --  Returns the result of calling Equivalent_Keys with the keys of the nodes
    --  designated by cursors Left and Right.
@@ -242,11 +251,55 @@ package Ada.Containers.Indefinite_Hashed_Maps is
    --  Returns the result of calling Equivalent_Keys with key Left and the node
    --  designated by Right.
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED ???
+      return Constant_Reference_Type;
+
+   function Reference (Container : Map; Key : Key_Type)
+   return Reference_Type;
+
    procedure Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
    --  Calls Process for each node in the map
 
+   function Iterate (Container : Map)
+      return Map_Iterator_Interfaces.Forward_Iterator'class;
+
 private
    pragma Inline ("=");
    pragma Inline (Length);
@@ -283,7 +336,6 @@ private
 
    use HT_Types;
    use Ada.Finalization;
-   use Ada.Streams;
 
    overriding procedure Adjust (Container : in out Map);
 
@@ -303,6 +355,12 @@ private
 
    for Cursor'Write use Write;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    procedure Read
      (Stream : not null access Root_Stream_Type'Class;
       Item   : out Cursor);
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb
index a7f16ae1574..90fedaef0e1 100644
--- a/gcc/ada/a-cimutr.adb
+++ b/gcc/ada/a-cimutr.adb
@@ -164,21 +164,21 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    -------------------
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
-      R : constant Tree_Node_Access := Root_Node (Container);
-      N : Tree_Node_Access;
+      R, N : Tree_Node_Access;
 
    begin
       if Position = No_Element then
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ARG ruling.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       --  AI-0136 says to raise PE if Position equals the root node. This does
       --  not seem correct, as this value is just the limiting condition of the
@@ -188,10 +188,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       --     raise Program_Error with "Position cursor designates root";
       --  end if;
 
+      R := Root_Node (Position.Container.all);
       N := Position.Node;
       while N /= R loop
          if N.Element.all = Item then
-            return Cursor'(Container'Unrestricted_Access, N);
+            return Cursor'(Position.Container, N);
          end if;
 
          N := N.Parent;
@@ -303,9 +304,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    begin
       if Parent = No_Element then
          return 0;
+      else
+         return Child_Count (Parent.Node.Children);
       end if;
-
-      return Child_Count (Parent.Node.Children);
    end Child_Count;
 
    function Child_Count (Children : Children_Type) return Count_Type is
@@ -974,9 +975,8 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
    ---------------------
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
       Result : Tree_Node_Access;
 
@@ -985,9 +985,11 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending ruling from ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       if Is_Root (Position) then
          Result := Find_In_Children (Position.Node, Item);
@@ -1000,7 +1002,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Result);
+      return Cursor'(Position.Container, Result);
    end Find_In_Subtree;
 
    function Find_In_Subtree
@@ -2101,10 +2103,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       end if;
 
       if Target'Address = Source'Address then
-         if Position.Node = Before.Node
-           or else Position.Node.Next = Before.Node
-         then
-            return;
+         if Position.Node.Parent = Parent.Node then
+            if Position.Node = Before.Node then
+               return;
+            end if;
+
+            if Position.Node.Next = Before.Node then
+               return;
+            end if;
          end if;
 
          if Target.Busy > 0 then
@@ -2199,10 +2205,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
          raise Constraint_Error with "Position cursor designates root";
       end if;
 
-      if Position.Node = Before.Node
-        or else Position.Node.Next = Before.Node
-      then
-         return;
+      if Position.Node.Parent = Parent.Node then
+         if Position.Node = Before.Node then
+            return;
+         end if;
+
+         if Position.Node.Next = Before.Node then
+            return;
+         end if;
       end if;
 
       if Container.Busy > 0 then
diff --git a/gcc/ada/a-cimutr.ads b/gcc/ada/a-cimutr.ads
index 7e8e7c80b62..9f3b5d7c193 100644
--- a/gcc/ada/a-cimutr.ads
+++ b/gcc/ada/a-cimutr.ads
@@ -113,15 +113,37 @@ package Ada.Containers.Indefinite_Multiway_Trees is
      (Container : Tree;
       Item      : Element_Type) return Cursor;
 
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree this way:
+   --
+   --  function Find_In_Subtree
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
+
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Ancestor_Find this way:
+   --
+   --  function Ancestor_Find
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
 
    function Contains
      (Container : Tree;
diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb
index 7153c6dd235..673cd510a3c 100644
--- a/gcc/ada/a-ciorse.adb
+++ b/gcc/ada/a-ciorse.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -40,6 +40,24 @@ with Ada.Unchecked_Deallocation;
 
 package body Ada.Containers.Indefinite_Ordered_Sets is
 
+   type Iterator is new
+     Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
+        Container : access constant Set;
+        Node      : Node_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -566,6 +584,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      return Cursor'(
+        Object.Container.all'Unrestricted_Access, Object.Container.Tree.First);
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -574,9 +598,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    begin
       if Container.Tree.First = null then
          raise Constraint_Error with "set is empty";
+      else
+         return Container.Tree.First.Element.all;
       end if;
-
-      return Container.Tree.First.Element.all;
    end First_Element;
 
    -----------
@@ -586,13 +610,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function Floor (Container : Set; Item : Element_Type) return Cursor is
       Node : constant Node_Access :=
                Element_Keys.Floor (Container.Tree, Item);
-
    begin
       if Node = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
    ----------
@@ -1190,6 +1213,26 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Set)
+      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator :=
+             (Container'Unchecked_Access, Container.Tree.First);
+   begin
+      return It;
+   end Iterate;
+
+   function Iterate
+     (Container : Set;
+      Start     : Cursor)
+      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Start.Node);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -1198,9 +1241,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    begin
       if Container.Tree.Last = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
       end if;
+   end Last;
 
-      return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
+   function Last (Object : Iterator) return Cursor is
+   begin
+      if Object.Container.Tree.Last = null then
+         return No_Element;
+      else
+         return Cursor'(
+           Object.Container.all'Unrestricted_Access,
+           Object.Container.Tree.Last);
+      end if;
    end Last;
 
    ------------------
@@ -1211,9 +1265,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    begin
       if Container.Tree.Last = null then
          raise Constraint_Error with "set is empty";
+      else
+         return Container.Tree.Last.Element.all;
       end if;
-
-      return Container.Tree.Last.Element.all;
    end Last_Element;
 
    ----------
@@ -1281,6 +1335,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       end;
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Next (Position);
+   end Next;
+
    -------------
    -- Overlap --
    -------------
@@ -1334,6 +1397,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       end;
    end Previous;
 
+   function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+      pragma Unreferenced (Object);
+   begin
+      return Previous (Position);
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -1426,6 +1498,50 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       raise Program_Error with "attempt to stream set cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference (Container : Set; Position : Cursor)
+   return Constant_Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element.all'Access);
+   end Constant_Reference;
+
+   function Reference (Container : Set; Position : Cursor)
+   return Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element.all'Access);
+   end Reference;
+
    -------------
    -- Replace --
    -------------
@@ -1758,4 +1874,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       raise Program_Error with "attempt to stream set cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Indefinite_Ordered_Sets;
diff --git a/gcc/ada/a-ciorse.ads b/gcc/ada/a-ciorse.ads
index 9d60bdcac89..78b5d764b06 100644
--- a/gcc/ada/a-ciorse.ads
+++ b/gcc/ada/a-ciorse.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -33,7 +33,8 @@
 
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Element_Type (<>) is private;
@@ -47,7 +48,12 @@ package Ada.Containers.Indefinite_Ordered_Sets is
 
    function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
 
-   type Set is tagged private;
+   type Set is tagged private with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Set);
 
    type Cursor is private;
@@ -57,6 +63,52 @@ package Ada.Containers.Indefinite_Ordered_Sets is
 
    No_Element : constant Cursor;
 
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package Ordered_Set_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
+   type Constant_Reference_Type
+     (Element : not null access constant Element_Type) is
+   private with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   function Constant_Reference
+     (Container : Set;
+      Position  : Cursor) return Constant_Reference_Type;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Reference
+     (Container : Set; Position : Cursor)
+   return Reference_Type;
+
    function "=" (Left, Right : Set) return Boolean;
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -168,8 +220,6 @@ package Ada.Containers.Indefinite_Ordered_Sets is
 
    function Contains (Container : Set; Item : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    function "<" (Left, Right : Cursor) return Boolean;
 
    function ">" (Left, Right : Cursor) return Boolean;
@@ -190,6 +240,15 @@ package Ada.Containers.Indefinite_Ordered_Sets is
      (Container : Set;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate
+     (Container : Set)
+      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate
+     (Container : Set;
+      Start     : Cursor)
+      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
+
    generic
       type Key_Type (<>) is private;
 
@@ -271,7 +330,6 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
-   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -307,6 +365,12 @@ private
 
    for Set'Read use Read;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    Empty_Set : constant Set :=
                  (Controlled with Tree => (First  => null,
                                            Last   => null,
diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index eaef697d36c..3d46ba7cf41 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -28,10 +28,28 @@
 ------------------------------------------------------------------------------
 
 with Ada.Containers.Generic_Array_Sort;
+
 with System; use type System.Address;
 
 package body Ada.Containers.Bounded_Vectors is
 
+   type Iterator is new
+     Vector_Iterator_Interfaces.Reversible_Iterator with record
+        Container : Vector_Access;
+        Index     : Index_Type;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -626,18 +644,18 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
+      else
+         return Container.Elements (To_Array_Index (Index));
       end if;
-
-      return Container.Elements (To_Array_Index (Index));
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
    begin
       if Position.Container = null then
          raise Constraint_Error with "Position cursor has no element";
+      else
+         return Position.Container.Element (Position.Index);
       end if;
-
-      return Position.Container.Element (Position.Index);
    end Element;
 
    ----------
@@ -696,9 +714,18 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
+      else
+         return (Container'Unrestricted_Access, Index_Type'First);
       end if;
+   end First;
 
-      return (Container'Unrestricted_Access, Index_Type'First);
+   function First (Object : Iterator) return Cursor is
+   begin
+      if Is_Empty (Object.Container.all) then
+         return No_Element;
+      else
+         return  Cursor'(Object.Container, Index_Type'First);
+      end if;
    end First;
 
    -------------------
@@ -709,9 +736,9 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
+      else
+         return Container.Elements (To_Array_Index (Index_Type'First));
       end if;
-
-      return Container.Elements (To_Array_Index (Index_Type'First));
    end First_Element;
 
    -----------------
@@ -1589,6 +1616,23 @@ package body Ada.Containers.Bounded_Vectors is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+   begin
+      return Iterator'(Container'Unrestricted_Access, Index_Type'First);
+   end Iterate;
+
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+   is
+   begin
+      return Iterator'(Container'Unrestricted_Access, Start.Index);
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -1597,9 +1641,18 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
+      else
+         return (Container'Unrestricted_Access, Container.Last);
       end if;
+   end Last;
 
-      return (Container'Unrestricted_Access, Container.Last);
+   function Last (Object : Iterator) return Cursor is
+   begin
+      if Is_Empty (Object.Container.all) then
+         return No_Element;
+      else
+         return Cursor'(Object.Container, Object.Container.Last);
+      end if;
    end Last;
 
    ------------------
@@ -1610,9 +1663,9 @@ package body Ada.Containers.Bounded_Vectors is
    begin
       if Container.Last = No_Index then
          raise Constraint_Error with "Container is empty";
+      else
+         return Container.Elements (Container.Length);
       end if;
-
-      return Container.Elements (Container.Length);
    end Last_Element;
 
    ----------------
@@ -1713,9 +1766,14 @@ package body Ada.Containers.Bounded_Vectors is
       return No_Element;
    end Next;
 
-   ----------
-   -- Next --
-   ----------
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Index = Object.Container.Last then
+         return  No_Element;
+      else
+         return (Object.Container, Position.Index + 1);
+      end if;
+   end Next;
 
    procedure Next (Position : in out Cursor) is
    begin
@@ -1781,6 +1839,15 @@ package body Ada.Containers.Bounded_Vectors is
       return No_Element;
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Index > Index_Type'First then
+         return (Object.Container, Position.Index - 1);
+      else
+         return No_Element;
+      end if;
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -1860,6 +1927,88 @@ package body Ada.Containers.Bounded_Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+       (Element =>
+          Position.Container.Elements
+            (To_Array_Index (Position.Index))'Access);
+   end Constant_Reference;
+
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type is
+   begin
+      if (Position) > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element =>
+                Container.Elements (To_Array_Index (Position))'Access);
+   end Constant_Reference;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+        (Element =>
+           Position.Container.Elements
+             (To_Array_Index (Position.Index))'Access);
+   end Reference;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type is
+   begin
+      if Position > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      else
+         return (Element =>
+           Container.Elements (To_Array_Index (Position))'Unrestricted_Access);
+      end if;
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -2129,7 +2278,7 @@ package body Ada.Containers.Bounded_Vectors is
       --    Index >= Index_Type'First
       --  hence we also know that
       --    Index - Index_Type'First >= 0
-      --
+
       --  The issue is that even though 0 is guaranteed to be a value
       --  in the type Index_Type'Base, there's no guarantee that the
       --  difference is a value in that type. To prevent overflow we
@@ -2232,6 +2381,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Length.
@@ -2291,6 +2441,7 @@ package body Ada.Containers.Bounded_Vectors is
       --  create a Last index value greater than Index_Type'Last.
 
       if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
+
          --  We perform a two-part test. First we determine whether the
          --  computed Last value lies in the base range of the type, and then
          --  determine whether it lies in the range of the index (sub)type.
@@ -2319,6 +2470,7 @@ package body Ada.Containers.Bounded_Vectors is
          end if;
 
       elsif Index_Type'First <= 0 then
+
          --  Here we can compute Last directly, in the normal way. We know that
          --  No_Index is less than 0, so there is no danger of overflow when
          --  adding the (positive) value of Length.
@@ -2436,4 +2588,20 @@ package body Ada.Containers.Bounded_Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Bounded_Vectors;
diff --git a/gcc/ada/a-cobove.ads b/gcc/ada/a-cobove.ads
index 9fc7945da86..7c009c0352c 100644
--- a/gcc/ada/a-cobove.ads
+++ b/gcc/ada/a-cobove.ads
@@ -31,7 +31,8 @@
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
 
-private with Ada.Streams;
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Index_Type is range <>;
@@ -49,7 +50,12 @@ package Ada.Containers.Bounded_Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   type Vector (Capacity : Count_Type) is tagged private;
+   type Vector (Capacity : Count_Type) is tagged private with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Vector);
 
    type Cursor is private;
@@ -58,6 +64,10 @@ package Ada.Containers.Bounded_Vectors is
    Empty_Vector : constant Vector;
 
    No_Element : constant Cursor;
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package Vector_Iterator_Interfaces is new
+      Ada.Iterator_Interfaces (Cursor, Has_Element);
 
    overriding function "=" (Left, Right : Vector) return Boolean;
 
@@ -281,8 +291,6 @@ package Ada.Containers.Bounded_Vectors is
      (Container : Vector;
       Item      : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    procedure Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
@@ -291,6 +299,63 @@ package Ada.Containers.Bounded_Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate
+     (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
+
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class;
+
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type;
+
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type;
+
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
    package Generic_Sorting is
@@ -318,7 +383,7 @@ private
    pragma Inline (Next);
    pragma Inline (Previous);
 
-   type Elements_Array is array (Count_Type range <>) of Element_Type;
+   type Elements_Array is array (Count_Type range <>) of aliased Element_Type;
    function "=" (L, R : Elements_Array) return Boolean is abstract;
 
    type Vector (Capacity : Count_Type) is tagged record
@@ -328,8 +393,6 @@ private
       Lock     : Natural := 0;
    end record;
 
-   use Ada.Streams;
-
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
       Container : Vector);
@@ -362,6 +425,12 @@ private
 
    for Cursor'Read use Read;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    Empty_Vector : constant Vector := (Capacity => 0, others => <>);
 
    No_Element : constant Cursor := Cursor'(null, Index_Type'First);
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb
index 65247241939..c06ba9e35e4 100644
--- a/gcc/ada/a-cohama.adb
+++ b/gcc/ada/a-cohama.adb
@@ -37,6 +37,18 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
 
 package body Ada.Containers.Hashed_Maps is
 
+   type Iterator is new
+     Map_Iterator_Interfaces.Forward_Iterator with record
+        Container : Map_Access;
+        Node      : Node_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -362,6 +374,17 @@ package body Ada.Containers.Hashed_Maps is
       return Cursor'(Container'Unchecked_Access, Node);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+      M : constant Map_Access  := Object.Container;
+      N : constant Node_Access := HT_Ops.First (M.HT);
+   begin
+      if N = null then
+         return No_Element;
+      end if;
+
+      return Cursor'(Object.Container.all'Unchecked_Access, N);
+   end First;
+
    ----------
    -- Free --
    ----------
@@ -578,6 +601,15 @@ package body Ada.Containers.Hashed_Maps is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+   is
+      Node : constant Node_Access := HT_Ops.First (Container.HT);
+      It   : constant Iterator := (Container'Unrestricted_Access, Node);
+   begin
+      return It;
+   end Iterate;
+
    ---------
    -- Key --
    ---------
@@ -650,6 +682,18 @@ package body Ada.Containers.Hashed_Maps is
       Position := Next (Position);
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Node = null then
+         return No_Element;
+      else
+         return (Object.Container, Next (Position).Node);
+      end if;
+   end Next;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -716,6 +760,38 @@ package body Ada.Containers.Hashed_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference (Container : Map; Key : Key_Type)
+   return Constant_Reference_Type is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Constant_Reference;
+
+   function Reference (Container : Map; Key : Key_Type)
+   return Reference_Type is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Reference;
+
    ---------------
    -- Read_Node --
    ---------------
@@ -939,6 +1015,22 @@ package body Ada.Containers.Hashed_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
    ----------------
    -- Write_Node --
    ----------------
diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads
index 9c00c6e4f37..0d614bd4f8f 100644
--- a/gcc/ada/a-cohama.ads
+++ b/gcc/ada/a-cohama.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,9 +32,11 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Containers.Hash_Tables;
-private with Ada.Streams;
 private with Ada.Finalization;
 
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
+
 generic
    type Key_Type is private;
    type Element_Type is private;
@@ -47,12 +49,30 @@ package Ada.Containers.Hashed_Maps is
    pragma Preelaborate;
    pragma Remote_Types;
 
-   type Map is tagged private;
+   type Map is tagged private
+   with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Map);
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
    Empty_Map : constant Map;
    --  Map objects declared without an initialization expression are
    --  initialized to the value Empty_Map.
@@ -61,6 +81,12 @@ package Ada.Containers.Hashed_Maps is
    --  Cursor objects declared without an initialization expression are
    --  initialized to the value No_Element.
 
+   function Has_Element (Position : Cursor) return Boolean;
+   --  Equivalent to Position /= No_Element
+
+   package Map_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : Map) return Boolean;
    --  For each key/element pair in Left, equality attempts to find the key in
    --  Right; if a search fails the equality returns False. The search works by
@@ -235,9 +261,6 @@ package Ada.Containers.Hashed_Maps is
    function Element (Container : Map; Key : Key_Type) return Element_Type;
    --  Equivalent to Element (Find (Container, Key))
 
-   function Has_Element (Position : Cursor) return Boolean;
-   --  Equivalent to Position /= No_Element
-
    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
    --  Returns the result of calling Equivalent_Keys with the keys of the nodes
    --  designated by cursors Left and Right.
@@ -250,11 +273,54 @@ package Ada.Containers.Hashed_Maps is
    --  Returns the result of calling Equivalent_Keys with key Left and the node
    --  designated by Right.
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : Map; Key : Key_Type)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type;
+
+   function Reference (Container : Map; Key : Key_Type)
+   return Reference_Type;
+
    procedure Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
    --  Calls Process for each node in the map
 
+   function Iterate (Container : Map)
+      return Map_Iterator_Interfaces.Forward_Iterator'class;
+
 private
    pragma Inline ("=");
    pragma Inline (Length);
@@ -293,8 +359,6 @@ private
 
    overriding procedure Finalize (Container : in out Map);
 
-   use Ada.Streams;
-
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
       Container : Map);
@@ -315,17 +379,11 @@ private
       Node      : Node_Access;
    end record;
 
-   procedure Read
-     (Stream : not null access Root_Stream_Type'Class;
-      Item   : out Cursor);
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
 
-   for Cursor'Read use Read;
-
-   procedure Write
-     (Stream : not null access Root_Stream_Type'Class;
-      Item   : Cursor);
-
-   for Cursor'Write use Write;
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
 
    Empty_Map : constant Map := (Controlled with HT => (null, 0, 0, 0));
 
diff --git a/gcc/ada/a-coinho.ads b/gcc/ada/a-coinho.ads
index d5d0cf40478..4646b6722b8 100644
--- a/gcc/ada/a-coinho.ads
+++ b/gcc/ada/a-coinho.ads
@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---       A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S        --
+--    A D A . C O N T A I N E R S . I N D E F I N I T E _ H O L D E R S     --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb
index c6f8cb26325..d66b9ec563b 100644
--- a/gcc/ada/a-coinve.adb
+++ b/gcc/ada/a-coinve.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -39,6 +39,24 @@ package body Ada.Containers.Indefinite_Vectors is
    procedure Free is
      new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
 
+   type Iterator is new
+     Vector_Iterator_Interfaces.Reversible_Iterator with record
+      Container : Vector_Access;
+      Index     : Index_Type;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    ---------
    -- "&" --
    ---------
@@ -1075,6 +1093,12 @@ package body Ada.Containers.Indefinite_Vectors is
       return (Container'Unchecked_Access, Index_Type'First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+      C : constant Cursor := (Object.Container, Index_Type'First);
+   begin
+      return C;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -2406,6 +2430,25 @@ package body Ada.Containers.Indefinite_Vectors is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Index_Type'First);
+   begin
+      return It;
+   end Iterate;
+
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator :=
+             (Container'Unchecked_Access, Start.Index);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -2419,6 +2462,12 @@ package body Ada.Containers.Indefinite_Vectors is
       return (Container'Unchecked_Access, Container.Last);
    end Last;
 
+   function Last (Object : Iterator) return Cursor is
+      C : constant Cursor := (Object.Container, Object.Container.Last);
+   begin
+      return C;
+   end Last;
+
    -----------------
    -- Last_Element --
    ------------------
@@ -2533,9 +2582,14 @@ package body Ada.Containers.Indefinite_Vectors is
       return No_Element;
    end Next;
 
-   ----------
-   -- Next --
-   ----------
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Index = Object.Container.Last then
+         return  No_Element;
+      else
+         return (Object.Container, Position.Index + 1);
+      end if;
+   end Next;
 
    procedure Next (Position : in out Cursor) is
    begin
@@ -2601,6 +2655,15 @@ package body Ada.Containers.Indefinite_Vectors is
       return No_Element;
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Index > Index_Type'First then
+         return (Object.Container, Position.Index - 1);
+      else
+         return No_Element;
+      end if;
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -2695,6 +2758,83 @@ package body Ada.Containers.Indefinite_Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+       (Element => Position.Container.Elements.EA (Position.Index).all'Access);
+   end Constant_Reference;
+
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type is
+   begin
+      if (Position) > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element => Container.Elements.EA (Position).all'Access);
+   end Constant_Reference;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+        (Element =>
+           Position.Container.Elements.EA (Position.Index).all'Access);
+   end Reference;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type is
+   begin
+      if Position > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element => Container.Elements.EA (Position).all'Access);
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -3579,4 +3719,20 @@ package body Ada.Containers.Indefinite_Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Indefinite_Vectors;
diff --git a/gcc/ada/a-coinve.ads b/gcc/ada/a-coinve.ads
index a8e8af21bd0..a13003819b0 100644
--- a/gcc/ada/a-coinve.ads
+++ b/gcc/ada/a-coinve.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,7 +32,9 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Finalization;
-private with Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Index_Type is range <>;
@@ -50,7 +52,13 @@ package Ada.Containers.Indefinite_Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   type Vector is tagged private;
+   type Vector is tagged private
+   with
+     Constant_Indexing => Constant_Reference,
+     Variable_Indexing => Reference,
+     Default_Iterator  => Iterate,
+     Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Vector);
 
    type Cursor is private;
@@ -59,6 +67,22 @@ package Ada.Containers.Indefinite_Vectors is
    Empty_Vector : constant Vector;
 
    No_Element : constant Cursor;
+   function Has_Element (Position : Cursor) return Boolean;
+
+   procedure Read
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : out Cursor);
+
+   for Cursor'Read use Read;
+
+   procedure Write
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : Cursor);
+
+   for Cursor'Write use Write;
+
+   package Vector_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
 
    overriding function "=" (Left, Right : Vector) return Boolean;
 
@@ -92,6 +116,53 @@ package Ada.Containers.Indefinite_Vectors is
 
    procedure Clear (Container : in out Vector);
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type;
+
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type;
+
    function To_Cursor
      (Container : Vector;
       Index     : Extended_Index) return Cursor;
@@ -267,12 +338,18 @@ package Ada.Containers.Indefinite_Vectors is
      (Container : Vector;
       Item      : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    procedure Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate
+     (Container : Vector;
+      Start     : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class;
+
    procedure Reverse_Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
@@ -323,12 +400,16 @@ private
       Lock     : Natural := 0;
    end record;
 
+   type Constant_Reference_Type
+     (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+     (Element : not null access Element_Type) is null record;
+
    overriding procedure Adjust (Container : in out Vector);
 
    overriding procedure Finalize (Container : in out Vector);
 
-   use Ada.Streams;
-
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
       Container : Vector);
@@ -349,18 +430,6 @@ private
       Index     : Index_Type := Index_Type'First;
    end record;
 
-   procedure Write
-     (Stream   : not null access Root_Stream_Type'Class;
-      Position : Cursor);
-
-   for Cursor'Write use Write;
-
-   procedure Read
-     (Stream   : not null access Root_Stream_Type'Class;
-      Position : out Cursor);
-
-   for Cursor'Read use Read;
-
    Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
 
    No_Element : constant Cursor := Cursor'(null, Index_Type'First);
diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index f3c77ed6211..c4ad64ef0c1 100644
--- a/gcc/ada/a-comutr.adb
+++ b/gcc/ada/a-comutr.adb
@@ -163,21 +163,21 @@ package body Ada.Containers.Multiway_Trees is
    -------------------
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
-      R : constant Tree_Node_Access := Root_Node (Container);
-      N : Tree_Node_Access;
+      R, N : Tree_Node_Access;
 
    begin
       if Position = No_Element then
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented-out pending official ruling from ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       --  AI-0136 says to raise PE if Position equals the root node. This does
       --  not seem correct, as this value is just the limiting condition of the
@@ -187,10 +187,11 @@ package body Ada.Containers.Multiway_Trees is
       --     raise Program_Error with "Position cursor designates root";
       --  end if;
 
+      R := Root_Node (Position.Container.all);
       N := Position.Node;
       while N /= R loop
          if N.Element = Item then
-            return Cursor'(Container'Unrestricted_Access, N);
+            return Cursor'(Position.Container, N);
          end if;
 
          N := N.Parent;
@@ -299,9 +300,9 @@ package body Ada.Containers.Multiway_Trees is
    begin
       if Parent = No_Element then
          return 0;
+      else
+         return Child_Count (Parent.Node.Children);
       end if;
-
-      return Child_Count (Parent.Node.Children);
    end Child_Count;
 
    function Child_Count (Children : Children_Type) return Count_Type is
@@ -950,9 +951,8 @@ package body Ada.Containers.Multiway_Trees is
    ---------------------
 
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor
    is
       Result : Tree_Node_Access;
 
@@ -961,9 +961,11 @@ package body Ada.Containers.Multiway_Trees is
          raise Constraint_Error with "Position cursor has no element";
       end if;
 
-      if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error with "Position cursor not in container";
-      end if;
+      --  Commented out pending official ruling by ARG.  ???
+
+      --  if Position.Container /= Container'Unrestricted_Access then
+      --     raise Program_Error with "Position cursor not in container";
+      --  end if;
 
       if Is_Root (Position) then
          Result := Find_In_Children (Position.Node, Item);
@@ -976,7 +978,7 @@ package body Ada.Containers.Multiway_Trees is
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Result);
+      return Cursor'(Position.Container, Result);
    end Find_In_Subtree;
 
    function Find_In_Subtree
@@ -2147,10 +2149,14 @@ package body Ada.Containers.Multiway_Trees is
       end if;
 
       if Target'Address = Source'Address then
-         if Position.Node = Before.Node
-           or else Position.Node.Next = Before.Node
-         then
-            return;
+         if Position.Node.Parent = Parent.Node then
+            if Position.Node = Before.Node then
+               return;
+            end if;
+
+            if Position.Node.Next = Before.Node then
+               return;
+            end if;
          end if;
 
          if Target.Busy > 0 then
@@ -2245,10 +2251,14 @@ package body Ada.Containers.Multiway_Trees is
          raise Constraint_Error with "Position cursor designates root";
       end if;
 
-      if Position.Node = Before.Node
-        or else Position.Node.Next = Before.Node
-      then
-         return;
+      if Position.Node.Parent = Parent.Node then
+         if Position.Node = Before.Node then
+            return;
+         end if;
+
+         if Position.Node.Next = Before.Node then
+            return;
+         end if;
       end if;
 
       if Container.Busy > 0 then
diff --git a/gcc/ada/a-comutr.ads b/gcc/ada/a-comutr.ads
index 6a9cfdecee1..d2291df0ce4 100644
--- a/gcc/ada/a-comutr.ads
+++ b/gcc/ada/a-comutr.ads
@@ -113,15 +113,37 @@ package Ada.Containers.Multiway_Trees is
      (Container : Tree;
       Item      : Element_Type) return Cursor;
 
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Find_In_Subtree this way:
+   --
+   --  function Find_In_Subtree
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
+
    function Find_In_Subtree
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
+
+   --  This version of the AI:
+   --   10-06-02  AI05-0136-1/07
+   --  declares Ancestor_Find this way:
+   --
+   --  function Ancestor_Find
+   --    (Container : Tree;
+   --     Item      : Element_Type;
+   --     Position  : Cursor) return Cursor;
+   --
+   --  It seems that the Container parameter is there by mistake, but we need
+   --  an official ruling from the ARG. ???
 
    function Ancestor_Find
-     (Container : Tree;
-      Item      : Element_Type;
-      Position  : Cursor) return Cursor;
+     (Position : Cursor;
+      Item     : Element_Type) return Cursor;
 
    function Contains
      (Container : Tree;
diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb
index 6a3d186a200..08220e9e36b 100644
--- a/gcc/ada/a-convec.adb
+++ b/gcc/ada/a-convec.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -37,6 +37,19 @@ package body Ada.Containers.Vectors is
    procedure Free is
      new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
 
+   type Iterator is new
+     Vector_Iterator_Interfaces.Reversible_Iterator with record
+      Container : Vector_Access;
+      Index     : Index_Type;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+   overriding function Next  (Object : Iterator; Position : Cursor)
+     return Cursor;
+   overriding function Previous (Object : Iterator; Position : Cursor)
+     return Cursor;
+
    ---------
    -- "&" --
    ---------
@@ -786,6 +799,12 @@ package body Ada.Containers.Vectors is
       return (Container'Unchecked_Access, Index_Type'First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+      C : constant Cursor := (Object.Container, Index_Type'First);
+   begin
+      return C;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -937,11 +956,7 @@ package body Ada.Containers.Vectors is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Container = null then
-         return False;
-      end if;
-
-      return Position.Index <= Position.Container.Last;
+      return Position /= No_Element;
    end Has_Element;
 
    ------------
@@ -2018,6 +2033,23 @@ package body Ada.Containers.Vectors is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Index_Type'First);
+   begin
+      return It;
+   end Iterate;
+
+   function Iterate (Container : Vector; Start : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator :=
+             (Container'Unchecked_Access, Start.Index);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -2031,6 +2063,12 @@ package body Ada.Containers.Vectors is
       return (Container'Unchecked_Access, Container.Last);
    end Last;
 
+   function Last (Object : Iterator) return Cursor is
+      C : constant Cursor := (Object.Container, Object.Container.Last);
+   begin
+      return C;
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -2138,6 +2176,15 @@ package body Ada.Containers.Vectors is
       return No_Element;
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Index = Object.Container.Last then
+         return  No_Element;
+      else
+         return (Object.Container, Position.Index + 1);
+      end if;
+   end Next;
+
    ----------
    -- Next --
    ----------
@@ -2206,6 +2253,15 @@ package body Ada.Containers.Vectors is
       return No_Element;
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Index > Index_Type'First then
+         return (Object.Container, Position.Index - 1);
+      else
+         return No_Element;
+      end if;
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -2287,6 +2343,83 @@ package body Ada.Containers.Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+       (Element =>
+          Position.Container.Elements.EA (Position.Index)'Access);
+   end Constant_Reference;
+
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type is
+   begin
+      if (Position) > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element => Container.Elements.EA (Position)'Access);
+   end Constant_Reference;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+        (Element => Position.Container.Elements.EA (Position.Index)'Access);
+   end Reference;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type is
+   begin
+      if Position > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element => Container.Elements.EA (Position)'Access);
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -3117,4 +3250,20 @@ package body Ada.Containers.Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Vectors;
diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads
index 71276eba61e..e2532f85803 100644
--- a/gcc/ada/a-convec.ads
+++ b/gcc/ada/a-convec.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -32,8 +32,8 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Finalization;
-private with Ada.Streams;
-
+with Ada.Streams;
+with Ada.Iterator_Interfaces;
 generic
    type Index_Type is range <>;
    type Element_Type is private;
@@ -43,6 +43,7 @@ generic
 package Ada.Containers.Vectors is
    pragma Preelaborate;
    pragma Remote_Types;
+   use Ada.Streams;
 
    subtype Extended_Index is Index_Type'Base
      range Index_Type'First - 1 ..
@@ -50,15 +51,35 @@ package Ada.Containers.Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   type Vector is tagged private;
+   type Vector is tagged private
+   with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
    pragma Preelaborable_Initialization (Vector);
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
+   No_Element : constant Cursor;
 
-   Empty_Vector : constant Vector;
+   function Has_Element (Position : Cursor) return Boolean;
 
-   No_Element : constant Cursor;
+   procedure Read
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : out Cursor);
+
+   for Cursor'Read use Read;
+
+   procedure Write
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : Cursor);
+   for Cursor'Write use Write;
+
+   package Vector_Iterator_Interfaces is new
+      Ada.Iterator_Interfaces (Cursor, Has_Element);
+
+   Empty_Vector : constant Vector;
 
    overriding function "=" (Left, Right : Vector) return Boolean;
 
@@ -133,8 +154,55 @@ package Ada.Containers.Vectors is
       Position  : Cursor;
       Process   : not null access procedure (Element : in out Element_Type));
 
-   procedure Move (Target : in out Vector; Source : in out Vector);
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type;
 
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type;
+
+   procedure Move (Target : in out Vector; Source : in out Vector);
    procedure Insert
      (Container : in out Vector;
       Before    : Extended_Index;
@@ -278,8 +346,6 @@ package Ada.Containers.Vectors is
      (Container : Vector;
       Item      : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    procedure Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
@@ -288,6 +354,12 @@ package Ada.Containers.Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'Class;
+
+   function Iterate (Container : Vector; Start : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class;
+
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
    package Generic_Sorting is
@@ -315,7 +387,7 @@ private
    pragma Inline (Next);
    pragma Inline (Previous);
 
-   type Elements_Array is array (Index_Type range <>) of Element_Type;
+   type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
    function "=" (L, R : Elements_Array) return Boolean is abstract;
 
    type Elements_Type (Last : Index_Type) is limited record
@@ -333,11 +405,13 @@ private
       Lock     : Natural := 0;
    end record;
 
-   overriding procedure Adjust (Container : in out Vector);
-
-   overriding procedure Finalize (Container : in out Vector);
+   type Vector_Access is access constant Vector;
+   for Vector_Access'Storage_Size use 0;
 
-   use Ada.Streams;
+   type Cursor is record
+      Container   : Vector_Access;
+      Index       : Index_Type := Index_Type'First;
+   end record;
 
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
@@ -351,28 +425,17 @@ private
 
    for Vector'Read use Read;
 
-   type Vector_Access is access constant Vector;
-   for Vector_Access'Storage_Size use 0;
-
-   type Cursor is record
-      Container : Vector_Access;
-      Index     : Index_Type := Index_Type'First;
-   end record;
-
-   procedure Write
-     (Stream   : not null access Root_Stream_Type'Class;
-      Position : Cursor);
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
 
-   for Cursor'Write use Write;
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
 
-   procedure Read
-     (Stream   : not null access Root_Stream_Type'Class;
-      Position : out Cursor);
+   overriding procedure Adjust (Container : in out Vector);
 
-   for Cursor'Read use Read;
+   overriding procedure Finalize (Container : in out Vector);
 
+   No_Element   : constant Cursor := Cursor'(null, Index_Type'First);
    Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
 
-   No_Element : constant Cursor := Cursor'(null, Index_Type'First);
-
 end Ada.Containers.Vectors;
diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb
index ba865202d24..c1ae68297b3 100644
--- a/gcc/ada/a-coorma.adb
+++ b/gcc/ada/a-coorma.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -37,6 +37,24 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
 
 package body Ada.Containers.Ordered_Maps is
 
+   type Iterator is new
+     Map_Iterator_Interfaces.Reversible_Iterator with record
+        Container : Map_Access;
+        Node      : Node_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------------
    -- Node Access Subprograms --
    -----------------------------
@@ -249,8 +267,7 @@ package body Ada.Containers.Ordered_Maps is
    -- Clear --
    -----------
 
-   procedure Clear is
-      new Tree_Operations.Generic_Clear (Delete_Tree);
+   procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
 
    procedure Clear (Container : in out Map) is
    begin
@@ -266,6 +283,18 @@ package body Ada.Containers.Ordered_Maps is
       return Node.Color;
    end Color;
 
+   ------------------------
+   -- Constant_Reference --
+   ------------------------
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type) return Constant_Reference_Type
+   is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Constant_Reference;
+
    --------------
    -- Contains --
    --------------
@@ -436,13 +465,23 @@ package body Ada.Containers.Ordered_Maps is
 
    function First (Container : Map) return Cursor is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.First = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, T.First);
       end if;
+   end First;
 
-      return Cursor'(Container'Unrestricted_Access, T.First);
+   function First (Object : Iterator) return Cursor is
+      M : constant Map_Access  := Object.Container;
+      N : constant Node_Access := M.Tree.First;
+   begin
+      if N = null then
+         return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, N);
+      end if;
    end First;
 
    -------------------
@@ -455,9 +494,9 @@ package body Ada.Containers.Ordered_Maps is
    begin
       if T.First = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.First.Element;
       end if;
-
-      return T.First.Element;
    end First_Element;
 
    ---------------
@@ -466,13 +505,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function First_Key (Container : Map) return Key_Type is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.First = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.First.Key;
       end if;
-
-      return T.First.Key;
    end First_Key;
 
    -----------
@@ -481,13 +519,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Floor (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
-
    begin
       if Node = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
-
-      return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
    ----------
@@ -664,7 +701,8 @@ package body Ada.Containers.Ordered_Maps is
    ------------------------
 
    function Is_Equal_Node_Node
-     (L, R : Node_Access) return Boolean is
+     (L, R : Node_Access) return Boolean
+   is
    begin
       if L.Key < R.Key then
          return False;
@@ -686,7 +724,7 @@ package body Ada.Containers.Ordered_Maps is
       Right : Node_Access) return Boolean
    is
    begin
-      --  k > node same as node < k
+      --  Left > Right same as Right < Left
 
       return Right.Key < Left;
    end Is_Greater_Key_Node;
@@ -744,6 +782,24 @@ package body Ada.Containers.Ordered_Maps is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+   is
+      Node : constant Node_Access := Container.Tree.First;
+      It   : constant Iterator := (Container'Unrestricted_Access, Node);
+
+   begin
+      return It;
+   end Iterate;
+
+   function Iterate (Container : Map; Start : Cursor)
+      return Map_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
+   begin
+      return It;
+   end Iterate;
+
    ---------
    -- Key --
    ---------
@@ -767,13 +823,23 @@ package body Ada.Containers.Ordered_Maps is
 
    function Last (Container : Map) return Cursor is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.Last = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, T.Last);
       end if;
+   end Last;
 
-      return Cursor'(Container'Unrestricted_Access, T.Last);
+   function Last (Object : Iterator) return Cursor is
+      M : constant Map_Access  := Object.Container;
+      N : constant Node_Access := M.Tree.Last;
+   begin
+      if N = null then
+         return No_Element;
+      else
+         return Cursor'(Object.Container.all'Unchecked_Access, N);
+      end if;
    end Last;
 
    ------------------
@@ -782,13 +848,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Last_Element (Container : Map) return Element_Type is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.Last = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.Last.Element;
       end if;
-
-      return T.Last.Element;
    end Last_Element;
 
    --------------
@@ -797,13 +862,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Last_Key (Container : Map) return Key_Type is
       T : Tree_Type renames Container.Tree;
-
    begin
       if T.Last = null then
          raise Constraint_Error with "map is empty";
+      else
+         return T.Last.Key;
       end if;
-
-      return T.Last.Key;
    end Last_Key;
 
    ----------
@@ -867,6 +931,18 @@ package body Ada.Containers.Ordered_Maps is
       end;
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Node = null then
+         return No_Element;
+      else
+         return (Object.Container, Tree_Operations.Next (Position.Node));
+      end if;
+   end Next;
+
    ------------
    -- Parent --
    ------------
@@ -907,6 +983,17 @@ package body Ada.Containers.Ordered_Maps is
       end;
    end Previous;
 
+   function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Node = null then
+         return No_Element;
+      else
+         return (Object.Container, Tree_Operations.Previous (Position.Node));
+      end if;
+   end Previous;
    -------------------
    -- Query_Element --
    -------------------
@@ -1000,6 +1087,35 @@ package body Ada.Containers.Ordered_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Reference
+     (Container : Map;
+      Key       : Key_Type)
+      return Reference_Type
+   is
+   begin
+      return (Element => Container.Element (Key)'Unrestricted_Access);
+   end Reference;
+
    -------------
    -- Replace --
    -------------
@@ -1081,7 +1197,7 @@ package body Ada.Containers.Ordered_Maps is
 
       B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
 
-      --  Start of processing for Reverse_Iterate
+   --  Start of processing for Reverse_Iterate
 
    begin
       B := B + 1;
@@ -1241,4 +1357,20 @@ package body Ada.Containers.Ordered_Maps is
       raise Program_Error with "attempt to stream map cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Ordered_Maps;
diff --git a/gcc/ada/a-coorma.ads b/gcc/ada/a-coorma.ads
index 3b3f2273aa0..1beea7bbff5 100644
--- a/gcc/ada/a-coorma.ads
+++ b/gcc/ada/a-coorma.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -33,7 +33,9 @@
 
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
-private with Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Key_Type is private;
@@ -48,8 +50,11 @@ package Ada.Containers.Ordered_Maps is
 
    function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
-   type Map is tagged private;
-   pragma Preelaborable_Initialization (Map);
+   type Map is tagged private with
+      constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
@@ -58,6 +63,11 @@ package Ada.Containers.Ordered_Maps is
 
    No_Element : constant Cursor;
 
+   function Has_Element (Position : Cursor) return Boolean;
+
+   package Map_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : Map) return Boolean;
 
    function Length (Container : Map) return Count_Type;
@@ -156,8 +166,6 @@ package Ada.Containers.Ordered_Maps is
 
    function Contains (Container : Map; Key : Key_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    function "<" (Left, Right : Cursor) return Boolean;
 
    function ">" (Left, Right : Cursor) return Boolean;
@@ -170,10 +178,60 @@ package Ada.Containers.Ordered_Maps is
 
    function ">" (Left : Key_Type; Right : Cursor) return Boolean;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   function Constant_Reference
+     (Container : Map;
+      Key       : Key_Type)    --  SHOULD BE ALIASED???
+      return Constant_Reference_Type;
+
+   function Reference (Container : Map; Key : Key_Type)
+   return Reference_Type;
+
    procedure Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate
+     (Container : Map)
+      return Map_Iterator_Interfaces.Forward_Iterator'class;
+
+   function Iterate
+     (Container : Map;
+      Start     : Cursor)
+      return Map_Iterator_Interfaces.Reversible_Iterator'class;
+
    procedure Reverse_Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
@@ -209,7 +267,6 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
-   use Ada.Streams;
 
    type Map_Access is access all Map;
    for Map_Access'Storage_Size use 0;
@@ -245,6 +302,12 @@ private
 
    for Map'Read use Read;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    Empty_Map : constant Map :=
                  (Controlled with Tree => (First  => null,
                                            Last   => null,
@@ -252,5 +315,4 @@ private
                                            Length => 0,
                                            Busy   => 0,
                                            Lock   => 0));
-
 end Ada.Containers.Ordered_Maps;
diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb
index d4e73029b2a..7465f930b1f 100644
--- a/gcc/ada/a-coorse.adb
+++ b/gcc/ada/a-coorse.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -40,6 +40,24 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
 
 package body Ada.Containers.Ordered_Sets is
 
+   type Iterator is new
+     Ordered_Set_Iterator_Interfaces.Reversible_Iterator with record
+        Container : access constant Set;
+        Node      : Node_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Last (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
+   overriding function Previous
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    ------------------------------
    -- Access to Fields of Node --
    ------------------------------
@@ -512,6 +530,18 @@ package body Ada.Containers.Ordered_Sets is
       return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      if Object.Container = null then
+         return No_Element;
+      else
+         return
+           Cursor'(
+             Object.Container.all'Unrestricted_Access,
+             Object.Container.Tree.First);
+      end if;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -1115,6 +1145,25 @@ package body Ada.Containers.Ordered_Sets is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Set)
+     return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
+   is
+   begin
+      if Container.Length = 0 then
+         return Iterator'(null, null);
+      else
+         return Iterator'(Container'Unchecked_Access, Container.Tree.First);
+      end if;
+   end Iterate;
+
+   function Iterate (Container : Set; Start : Cursor)
+     return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Start.Node);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -1123,9 +1172,20 @@ package body Ada.Containers.Ordered_Sets is
    begin
       if Container.Tree.Last = null then
          return No_Element;
+      else
+         return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
       end if;
+   end Last;
 
-      return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
+   function Last (Object : Iterator) return Cursor is
+   begin
+      if Object.Container = null then
+         return No_Element;
+      else
+         return Cursor'(
+           Object.Container.all'Unrestricted_Access,
+                        Object.Container.Tree.Last);
+      end if;
    end Last;
 
    ------------------
@@ -1136,9 +1196,9 @@ package body Ada.Containers.Ordered_Sets is
    begin
       if Container.Tree.Last = null then
          raise Constraint_Error with "set is empty";
+      else
+         return Container.Tree.Last.Element;
       end if;
-
-      return Container.Tree.Last.Element;
    end Last_Element;
 
    ----------
@@ -1202,6 +1262,12 @@ package body Ada.Containers.Ordered_Sets is
       Position := Next (Position);
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+      pragma Unreferenced (Object);
+   begin
+      return Next (Position);
+   end Next;
+
    -------------
    -- Overlap --
    -------------
@@ -1236,13 +1302,12 @@ package body Ada.Containers.Ordered_Sets is
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Previous (Position.Node);
-
       begin
          if Node = null then
             return No_Element;
+         else
+            return Cursor'(Position.Container, Node);
          end if;
-
-         return Cursor'(Position.Container, Node);
       end;
    end Previous;
 
@@ -1251,6 +1316,12 @@ package body Ada.Containers.Ordered_Sets is
       Position := Previous (Position);
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+      pragma Unreferenced (Object);
+   begin
+      return Previous (Position);
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -1339,6 +1410,50 @@ package body Ada.Containers.Ordered_Sets is
       raise Program_Error with "attempt to stream set cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference (Container : Set; Position : Cursor)
+   return Constant_Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element'Access);
+   end Constant_Reference;
+
+   function Reference (Container : Set; Position : Cursor)
+   return Reference_Type
+   is
+      pragma Unreferenced (Container);
+   begin
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      return (Element => Position.Node.Element'Access);
+   end Reference;
+
    -------------
    -- Replace --
    -------------
@@ -1654,4 +1769,20 @@ package body Ada.Containers.Ordered_Sets is
       raise Program_Error with "attempt to stream set cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Ordered_Sets;
diff --git a/gcc/ada/a-coorse.ads b/gcc/ada/a-coorse.ads
index afa767159cd..21eb7197779 100644
--- a/gcc/ada/a-coorse.ads
+++ b/gcc/ada/a-coorse.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -33,7 +33,9 @@
 
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
-private with Ada.Streams;
+
+with Ada.Streams; use Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Element_Type is private;
@@ -47,16 +49,81 @@ package Ada.Containers.Ordered_Sets is
 
    function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
 
-   type Set is tagged private;
+   type Set is tagged private
+   with
+     Constant_Indexing => Constant_Reference,
+     Variable_Indexing => Reference,
+     Default_Iterator  => Iterate,
+     Iterator_Element  => Element_Type;
+
    pragma Preelaborable_Initialization (Set);
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
 
+   function Has_Element (Position : Cursor) return Boolean;
+
    Empty_Set : constant Set;
 
    No_Element : constant Cursor;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   package Ordered_Set_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   function Constant_Reference
+     (Container : Set; Position : Cursor)
+   return Constant_Reference_Type;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Reference
+     (Container : Set; Position : Cursor)
+   return Reference_Type;
+
    function "=" (Left, Right : Set) return Boolean;
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
@@ -168,8 +235,6 @@ package Ada.Containers.Ordered_Sets is
 
    function Contains (Container : Set; Item : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    function "<" (Left, Right : Cursor) return Boolean;
 
    function ">" (Left, Right : Cursor) return Boolean;
@@ -190,6 +255,15 @@ package Ada.Containers.Ordered_Sets is
      (Container : Set;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate
+     (Container : Set)
+      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate
+     (Container : Set;
+      Start     : Cursor)
+      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class;
+
    generic
       type Key_Type (<>) is private;
 
@@ -243,7 +317,7 @@ private
       Left    : Node_Access;
       Right   : Node_Access;
       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
-      Element : Element_Type;
+      Element : aliased Element_Type;
    end record;
 
    package Tree_Types is
@@ -260,7 +334,6 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
-   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -270,18 +343,6 @@ private
       Node      : Node_Access;
    end record;
 
-   procedure Write
-     (Stream : not null access Root_Stream_Type'Class;
-      Item   : Cursor);
-
-   for Cursor'Write use Write;
-
-   procedure Read
-     (Stream : not null access Root_Stream_Type'Class;
-      Item   : out Cursor);
-
-   for Cursor'Read use Read;
-
    No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write
@@ -296,6 +357,12 @@ private
 
    for Set'Read use Read;
 
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
+
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
+
    Empty_Set : constant Set :=
                  (Controlled with Tree => (First  => null,
                                            Last   => null,
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 3b72130cbe8..509ea924f76 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -46,6 +46,7 @@ pragma Polling (Off);
 
 with System;                  use System;
 with System.Exceptions;       use System.Exceptions;
+with System.Exceptions_Debug; use System.Exceptions_Debug;
 with System.Standard_Library; use System.Standard_Library;
 with System.Soft_Links;       use System.Soft_Links;
 with System.WCh_Con;          use System.WCh_Con;
@@ -239,25 +240,7 @@ package body Ada.Exceptions is
       -- Exception propagation routines --
       ------------------------------------
 
-      procedure Setup_Exception
-        (Excep    : EOA;
-         Current  : EOA;
-         Reraised : Boolean := False);
-      --  Perform the necessary operations to prepare the propagation of Excep
-      --  in a task where Current is the current occurrence. Excep is assumed
-      --  to be a valid (non null) pointer.
-      --
-      --  This should be called before any (re-)setting of the current
-      --  occurrence. Any such (re-)setting shall take care *not* to clobber
-      --  the Private_Data component.
-      --
-      --  Having Current provided as an argument (instead of retrieving it via
-      --  Get_Current_Excep internally) is required to allow one task to setup
-      --  an exception for another task, which is used by Transfer_Occurrence.
-
-      procedure Propagate_Exception
-        (E                   : Exception_Id;
-         From_Signal_Handler : Boolean);
+      procedure Propagate_Exception;
       pragma No_Return (Propagate_Exception);
       --  This procedure propagates the exception represented by the occurrence
       --  referenced by Current_Excep in the TSD for the current task.
@@ -284,8 +267,7 @@ package body Ada.Exceptions is
    procedure Raise_Current_Excep (E : Exception_Id);
    pragma No_Return (Raise_Current_Excep);
    pragma Export (C, Raise_Current_Excep, "__gnat_raise_nodefer_with_msg");
-   --  This is a simple wrapper to Exception_Propagation.Propagate_Exception
-   --  setting the From_Signal_Handler argument to False.
+   --  This is a simple wrapper to Exception_Propagation.Propagate_Exception.
    --
    --  This external name for Raise_Current_Excep is historical, and probably
    --  should be changed but for now we keep it, because gdb and gigi know
@@ -399,18 +381,6 @@ package body Ada.Exceptions is
    --  the TSD (all fields of this exception occurrence are set). Abort
    --  is deferred before the reraise operation.
 
-   --  Save_Occurrence variations: As the management of the private data
-   --  attached to occurrences is delicate, whether or not pointers to such
-   --  data has to be copied in various situations is better made explicit.
-   --  The following procedures provide an internal interface to help making
-   --  this explicit.
-
-   procedure Save_Occurrence_No_Private
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence);
-   --  Copy all the components of Source to Target, except the
-   --  Private_Data pointer.
-
    procedure Transfer_Occurrence
      (Target : Exception_Occurrence_Access;
       Source : Exception_Occurrence);
@@ -452,7 +422,6 @@ package body Ada.Exceptions is
    procedure Rcheck_19 (File : System.Address; Line : Integer);
    procedure Rcheck_20 (File : System.Address; Line : Integer);
    procedure Rcheck_21 (File : System.Address; Line : Integer);
-   procedure Rcheck_22 (File : System.Address; Line : Integer);
    procedure Rcheck_23 (File : System.Address; Line : Integer);
    procedure Rcheck_24 (File : System.Address; Line : Integer);
    procedure Rcheck_25 (File : System.Address; Line : Integer);
@@ -475,6 +444,14 @@ package body Ada.Exceptions is
    procedure Rcheck_12_Ext
      (File : System.Address; Line, Column, Index, First, Last : Integer);
 
+   procedure Rcheck_22 (File : System.Address; Line : Integer);
+   --  This routine is separated out because it has quite different behavior
+   --  from the others. This is the "finalize/adjust raised exception". This
+   --  subprogram is always called with abort deferred, unlike all other
+   --  Rcheck_* routines, it needs to call Raise_Exception_No_Defer.
+   --
+   --  It should probably have a distinguished name ???
+
    pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
    pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
    pragma Export (C, Rcheck_02, "__gnat_rcheck_02");
@@ -792,6 +769,20 @@ package body Ada.Exceptions is
    --  in case we do not want any exception tracing support. This is
    --  why this package is separated.
 
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Index : Integer) return String is
+      Result : constant String := Integer'Image (Index);
+   begin
+      if Result (1) = ' ' then
+         return Result (2 .. Result'Last);
+      else
+         return Result;
+      end if;
+   end Image;
+
    -----------------------
    -- Stream Attributes --
    -----------------------
@@ -831,8 +822,7 @@ package body Ada.Exceptions is
    procedure Raise_Current_Excep (E : Exception_Id) is
    begin
       Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E));
-      Exception_Propagation.Propagate_Exception
-        (E => E, From_Signal_Handler => False);
+      Exception_Propagation.Propagate_Exception;
    end Raise_Current_Excep;
 
    ---------------------
@@ -855,7 +845,11 @@ package body Ada.Exceptions is
       --  Go ahead and raise appropriate exception
 
       Exception_Data.Set_Exception_Msg (EF, Message);
-      Abort_Defer.all;
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
       Raise_Current_Excep (EF);
    end Raise_Exception;
 
@@ -869,66 +863,68 @@ package body Ada.Exceptions is
    is
    begin
       Exception_Data.Set_Exception_Msg (E, Message);
-      Abort_Defer.all;
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
       Raise_Current_Excep (E);
    end Raise_Exception_Always;
 
+   ------------------------------
+   -- Raise_Exception_No_Defer --
+   ------------------------------
+
+   procedure Raise_Exception_No_Defer
+     (E       : Exception_Id;
+      Message : String := "")
+   is
+   begin
+      Exception_Data.Set_Exception_Msg (E, Message);
+
+      --  Do not call Abort_Defer.all, as specified by the spec
+
+      Raise_Current_Excep (E);
+   end Raise_Exception_No_Defer;
+
    -------------------------------------
    -- Raise_From_Controlled_Operation --
    -------------------------------------
 
    procedure Raise_From_Controlled_Operation
-     (X          : Ada.Exceptions.Exception_Occurrence;
-      From_Abort : Boolean)
+     (X : Ada.Exceptions.Exception_Occurrence)
    is
+      Prefix             : constant String := "adjust/finalize raised ";
+      Orig_Msg           : constant String := Exception_Message (X);
+      Orig_Prefix_Length : constant Natural :=
+                             Integer'Min (Prefix'Length, Orig_Msg'Length);
+      Orig_Prefix        : String renames Orig_Msg
+                             (Orig_Msg'First ..
+                              Orig_Msg'First + Orig_Prefix_Length - 1);
    begin
-      --  When finalization was triggered by an abort, keep propagating the
-      --  abort signal rather than raising Program_Error.
-
-      if From_Abort then
-         raise Standard'Abort_Signal;
+      --  Message already has the proper prefix, just re-raise
 
-      --  Otherwise, raise Program_Error
+      if Orig_Prefix = Prefix then
+         Raise_Exception_No_Defer
+           (E       => Program_Error'Identity,
+            Message => Orig_Msg);
 
       else
          declare
-            Prefix             : constant String := "adjust/finalize raised ";
-            Orig_Msg           : constant String := Exception_Message (X);
-            Orig_Prefix_Length : constant Natural :=
-                                   Integer'Min
-                                     (Prefix'Length, Orig_Msg'Length);
-            Orig_Prefix        : String renames Orig_Msg
-                                   (Orig_Msg'First ..
-                                    Orig_Msg'First + Orig_Prefix_Length - 1);
+            New_Msg  : constant String := Prefix & Exception_Name (X);
 
          begin
-            --  Message already has the proper prefix, just re-raise
+            --  No message present, just provide our own
 
-            if Orig_Prefix = Prefix then
+            if Orig_Msg = "" then
                Raise_Exception_No_Defer
                  (E       => Program_Error'Identity,
-                  Message => Orig_Msg);
+                  Message => New_Msg);
 
-            else
-               declare
-                  New_Msg  : constant String := Prefix & Exception_Name (X);
+            --  Message present, add informational prefix
 
-               begin
-                  --  No message present, just provide our own
-
-                  if Orig_Msg = "" then
-                     Raise_Exception_No_Defer
-                       (E       => Program_Error'Identity,
-                        Message => New_Msg);
-
-                  --  Message present, add informational prefix
-
-                  else
-                     Raise_Exception_No_Defer
-                       (E       => Program_Error'Identity,
-                        Message => New_Msg & ": " & Orig_Msg);
-                  end if;
-               end;
+            else
+               Raise_Exception_No_Defer
+                 (E       => Program_Error'Identity,
+                  Message => New_Msg & ": " & Orig_Msg);
             end if;
          end;
       end if;
@@ -944,10 +940,12 @@ package body Ada.Exceptions is
    is
    begin
       Exception_Data.Set_Exception_C_Msg (E, M);
-      Abort_Defer.all;
-      Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E));
-      Exception_Propagation.Propagate_Exception
-        (E => E, From_Signal_Handler => True);
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Raise_Current_Excep (E);
    end Raise_From_Signal_Handler;
 
    -------------------------
@@ -1015,7 +1013,11 @@ package body Ada.Exceptions is
    is
    begin
       Exception_Data.Set_Exception_C_Msg (E, F, L, C, M);
-      Abort_Defer.all;
+
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
       Raise_Current_Excep (E);
    end Raise_With_Location_And_Msg;
 
@@ -1027,30 +1029,20 @@ package body Ada.Exceptions is
       Excep : constant EOA := Get_Current_Excep.all;
 
    begin
-      Exception_Propagation.Setup_Exception (Excep, Excep);
-
       Excep.Exception_Raised := False;
       Excep.Id               := E;
       Excep.Num_Tracebacks   := 0;
-      Excep.Cleanup_Flag     := False;
       Excep.Pid              := Local_Partition_ID;
-      Abort_Defer.all;
-      Raise_Current_Excep (E);
-   end Raise_With_Msg;
 
-   -----------
-   -- Image --
-   -----------
+      --  The following is a common pattern, should be abstracted
+      --  into a procedure call ???
 
-   function Image (Index : Integer) return String is
-      Result : constant String := Integer'Image (Index);
-   begin
-      if Result (1) = ' ' then
-         return Result (2 .. Result'Last);
-      else
-         return Result;
+      if not ZCX_By_Default then
+         Abort_Defer.all;
       end if;
-   end Image;
+
+      Raise_Current_Excep (E);
+   end Raise_With_Msg;
 
    --------------------------------------
    -- Calls to Run-Time Check Routines --
@@ -1166,11 +1158,6 @@ package body Ada.Exceptions is
       Raise_Program_Error_Msg (File, Line, Rmsg_21'Address);
    end Rcheck_21;
 
-   procedure Rcheck_22 (File : System.Address; Line : Integer) is
-   begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
-   end Rcheck_22;
-
    procedure Rcheck_23 (File : System.Address; Line : Integer) is
    begin
       Raise_Program_Error_Msg (File, Line, Rmsg_23'Address);
@@ -1269,6 +1256,24 @@ package body Ada.Exceptions is
       Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
    end Rcheck_12_Ext;
 
+   ---------------
+   -- Rcheck_22 --
+   ---------------
+
+   procedure Rcheck_22 (File : System.Address; Line : Integer) is
+      E : constant Exception_Id := Program_Error_Def'Access;
+
+   begin
+      --  This is "finalize/adjust raised exception". This subprogram is always
+      --  called with abort deferred, unlike all other Rcheck_* routines, it
+      --  needs to call Raise_Exception_No_Defer.
+
+      --  This is consistent with Raise_From_Controlled_Operation
+
+      Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
+      Raise_Current_Excep (E);
+   end Rcheck_22;
+
    -------------
    -- Reraise --
    -------------
@@ -1276,8 +1281,9 @@ package body Ada.Exceptions is
    procedure Reraise is
       Excep : constant EOA := Get_Current_Excep.all;
    begin
-      Abort_Defer.all;
-      Exception_Propagation.Setup_Exception (Excep, Excep, Reraised => True);
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
       Raise_Current_Excep (Excep.Id);
    end Reraise;
 
@@ -1288,10 +1294,11 @@ package body Ada.Exceptions is
    procedure Reraise_Occurrence (X : Exception_Occurrence) is
    begin
       if X.Id /= null then
-         Abort_Defer.all;
-         Exception_Propagation.Setup_Exception
-           (X'Unrestricted_Access, Get_Current_Excep.all, Reraised => True);
-         Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
+         if not ZCX_By_Default then
+            Abort_Defer.all;
+         end if;
+
+         Save_Occurrence (Get_Current_Excep.all.all, X);
          Raise_Current_Excep (X.Id);
       end if;
    end Reraise_Occurrence;
@@ -1302,10 +1309,11 @@ package body Ada.Exceptions is
 
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence) is
    begin
-      Abort_Defer.all;
-      Exception_Propagation.Setup_Exception
-        (X'Unrestricted_Access, Get_Current_Excep.all, Reraised => True);
-      Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
+      if not ZCX_By_Default then
+         Abort_Defer.all;
+      end if;
+
+      Save_Occurrence (Get_Current_Excep.all.all, X);
       Raise_Current_Excep (X.Id);
    end Reraise_Occurrence_Always;
 
@@ -1315,9 +1323,7 @@ package body Ada.Exceptions is
 
    procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
    begin
-      Exception_Propagation.Setup_Exception
-        (X'Unrestricted_Access, Get_Current_Excep.all, Reraised => True);
-      Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
+      Save_Occurrence (Get_Current_Excep.all.all, X);
       Raise_Current_Excep (X.Id);
    end Reraise_Occurrence_No_Defer;
 
@@ -1330,56 +1336,24 @@ package body Ada.Exceptions is
       Source : Exception_Occurrence)
    is
    begin
-      Save_Occurrence_No_Private (Target, Source);
-   end Save_Occurrence;
-
-   function Save_Occurrence (Source : Exception_Occurrence) return EOA is
-      Target : constant EOA := new Exception_Occurrence;
-   begin
-      Save_Occurrence (Target.all, Source);
-      return Target;
-   end Save_Occurrence;
-
-   --------------------------------
-   -- Save_Occurrence_No_Private --
-   --------------------------------
-
-   procedure Save_Occurrence_No_Private
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence)
-   is
-   begin
       Target.Id             := Source.Id;
       Target.Msg_Length     := Source.Msg_Length;
       Target.Num_Tracebacks := Source.Num_Tracebacks;
       Target.Pid            := Source.Pid;
-      Target.Cleanup_Flag   := Source.Cleanup_Flag;
 
       Target.Msg (1 .. Target.Msg_Length) :=
         Source.Msg (1 .. Target.Msg_Length);
 
       Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
         Source.Tracebacks (1 .. Target.Num_Tracebacks);
-   end Save_Occurrence_No_Private;
-
-   -------------------------
-   -- Transfer_Occurrence --
-   -------------------------
+   end Save_Occurrence;
 
-   procedure Transfer_Occurrence
-     (Target : Exception_Occurrence_Access;
-      Source : Exception_Occurrence)
-   is
+   function Save_Occurrence (Source : Exception_Occurrence) return EOA is
+      Target : constant EOA := new Exception_Occurrence;
    begin
-      --  Setup Target as an exception to be propagated in the calling task
-      --  (rendezvous-wise), taking care not to clobber the associated private
-      --  data.  Target is expected to be a pointer to the calling task's
-      --  fixed TSD occurrence, which is very different from Get_Current_Excep
-      --  here because this subprogram is called from the called task.
-
-      Exception_Propagation.Setup_Exception (Target, Target);
-      Save_Occurrence_No_Private (Target.all, Source);
-   end Transfer_Occurrence;
+      Save_Occurrence (Target.all, Source);
+      return Target;
+   end Save_Occurrence;
 
    -------------------
    -- String_To_EId --
@@ -1395,22 +1369,6 @@ package body Ada.Exceptions is
    function String_To_EO (S : String) return Exception_Occurrence
      renames Stream_Attributes.String_To_EO;
 
-   ------------------------------
-   -- Raise_Exception_No_Defer --
-   ------------------------------
-
-   procedure Raise_Exception_No_Defer
-     (E       : Exception_Id;
-      Message : String := "")
-   is
-   begin
-      Exception_Data.Set_Exception_Msg (E, Message);
-
-      --  Do not call Abort_Defer.all, as specified by the spec
-
-      Raise_Current_Excep (E);
-   end Raise_Exception_No_Defer;
-
    ---------------
    -- To_Stderr --
    ---------------
@@ -1435,6 +1393,30 @@ package body Ada.Exceptions is
    end To_Stderr;
 
    -------------------------
+   -- Transfer_Occurrence --
+   -------------------------
+
+   procedure Transfer_Occurrence
+     (Target : Exception_Occurrence_Access;
+      Source : Exception_Occurrence)
+   is
+   begin
+      Save_Occurrence (Target.all, Source);
+   end Transfer_Occurrence;
+
+   ------------------------
+   -- Triggered_By_Abort --
+   ------------------------
+
+   function Triggered_By_Abort return Boolean is
+      Ex : constant Exception_Occurrence_Access := Get_Current_Excep.all;
+
+   begin
+      return Ex /= null
+        and then Exception_Identity (Ex.all) = Standard'Abort_Signal'Identity;
+   end Triggered_By_Abort;
+
+   -------------------------
    -- Wide_Exception_Name --
    -------------------------
 
diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads
index d631684a406..a7dbfd62430 100644
--- a/gcc/ada/a-except-2005.ads
+++ b/gcc/ada/a-except-2005.ads
@@ -50,8 +50,6 @@ with System.Parameters;
 with System.Standard_Library;
 with System.Traceback_Entries;
 
-with Ada.Unchecked_Conversion;
-
 package Ada.Exceptions is
    pragma Warnings (Off);
    pragma Preelaborate_05;
@@ -230,16 +228,13 @@ private
    --  system to return here rather than to the original location.
 
    procedure Raise_From_Controlled_Operation
-     (X          : Ada.Exceptions.Exception_Occurrence;
-      From_Abort : Boolean);
+     (X : Ada.Exceptions.Exception_Occurrence);
    pragma No_Return (Raise_From_Controlled_Operation);
    pragma Export
      (Ada, Raise_From_Controlled_Operation,
            "__gnat_raise_from_controlled_operation");
    --  Raise Program_Error, providing information about X (an exception raised
-   --  during a controlled operation) in the exception message. However, if the
-   --  finalization was triggered by abort, keep aborting instead of raising
-   --  Program_Error.
+   --  during a controlled operation) in the exception message.
 
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
    pragma No_Return (Reraise_Occurrence_Always);
@@ -255,6 +250,10 @@ private
    --  occurrence. This is used in generated code when it is known that abort
    --  is already deferred.
 
+   function Triggered_By_Abort return Boolean;
+   --  Determine whether the current exception (if it exists) is an instance of
+   --  Standard'Abort_Signal.
+
    -----------------------
    -- Polling Interface --
    -----------------------
@@ -306,13 +305,6 @@ private
       Msg : String (1 .. Exception_Msg_Max_Length);
       --  Characters of message
 
-      Cleanup_Flag : Boolean := False;
-      --  The cleanup flag is normally False, it is set True for an exception
-      --  occurrence passed to a cleanup routine, and will still be set True
-      --  when the cleanup routine does a Reraise_Occurrence call using this
-      --  exception occurrence. This is used to avoid recording a bogus trace
-      --  back entry from this reraise call.
-
       Exception_Raised : Boolean := False;
       --  Set to true to indicate that this exception occurrence has actually
       --  been raised. When an exception occurrence is first created, this is
@@ -330,11 +322,6 @@ private
 
       Tracebacks : Tracebacks_Array;
       --  Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks))
-
-      Private_Data : System.Address := System.Null_Address;
-      --  Field used by low level exception mechanism to store specific data.
-      --  Currently used by the GCC exception mechanism to store a pointer to
-      --  a GNAT_GCC_Exception.
    end record;
 
    function "=" (Left, Right : Exception_Occurrence) return Boolean
@@ -352,25 +339,9 @@ private
      Id               => null,
      Msg_Length       => 0,
      Msg              => (others => ' '),
-     Cleanup_Flag     => False,
      Exception_Raised => False,
      Pid              => 0,
      Num_Tracebacks   => 0,
-     Tracebacks       => (others => TBE.Null_TB_Entry),
-     Private_Data     => System.Null_Address);
-
-   --  Common binding to __builtin_longjmp for sjlj variants.
-
-   --  The builtin expects a pointer type for the jmpbuf address argument, and
-   --  System.Address doesn't work because this is really an integer type.
-
-   type Jmpbuf_Address is access Character;
-
-   function To_Jmpbuf_Address is new
-     Ada.Unchecked_Conversion (System.Address, Jmpbuf_Address);
-
-   procedure builtin_longjmp (buffer : Jmpbuf_Address; Flag : Integer);
-   pragma No_Return (builtin_longjmp);
-   pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
+     Tracebacks       => (others => TBE.Null_TB_Entry));
 
 end Ada.Exceptions;
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 2633cf4a241..f34d4975612 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -50,7 +50,7 @@ pragma Polling (Off);
 --  elaboration circularities with System.Exception_Tables.
 
 with System;                  use System;
-with System.Exceptions;       use System.Exceptions;
+with System.Exceptions_Debug; use System.Exceptions_Debug;
 with System.Standard_Library; use System.Standard_Library;
 with System.Soft_Links;       use System.Soft_Links;
 
@@ -209,16 +209,6 @@ package body Ada.Exceptions is
 
    end Exception_Traces;
 
-   package Exception_Propagation is
-
-      procedure Setup_Exception
-        (Excep    : EOA;
-         Current  : EOA;
-         Reraised : Boolean := False);
-      --  Dummy routine used to share a-exexda.adb, do nothing
-
-   end Exception_Propagation;
-
    package Stream_Attributes is
 
       --------------------------------
@@ -351,18 +341,6 @@ package body Ada.Exceptions is
    --  (all fields of this exception occurrence are set). Abort is deferred
    --  before the reraise operation.
 
-   --  Save_Occurrence variations: As the management of the private data
-   --  attached to occurrences is delicate, whether or not pointers to such
-   --  data has to be copied in various situations is better made explicit.
-   --  The following procedures provide an internal interface to help making
-   --  this explicit.
-
-   procedure Save_Occurrence_No_Private
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence);
-   --  Copy all the components of Source to Target, except the
-   --  Private_Data pointer.
-
    procedure Transfer_Occurrence
      (Target : Exception_Occurrence_Access;
       Source : Exception_Occurrence);
@@ -403,7 +381,6 @@ package body Ada.Exceptions is
    procedure Rcheck_19 (File : System.Address; Line : Integer);
    procedure Rcheck_20 (File : System.Address; Line : Integer);
    procedure Rcheck_21 (File : System.Address; Line : Integer);
-   procedure Rcheck_22 (File : System.Address; Line : Integer);
    procedure Rcheck_23 (File : System.Address; Line : Integer);
    procedure Rcheck_24 (File : System.Address; Line : Integer);
    procedure Rcheck_25 (File : System.Address; Line : Integer);
@@ -417,6 +394,14 @@ package body Ada.Exceptions is
    procedure Rcheck_33 (File : System.Address; Line : Integer);
    procedure Rcheck_34 (File : System.Address; Line : Integer);
 
+   procedure Rcheck_22 (File : System.Address; Line : Integer);
+   --  This routine is separated out because it has quite different behavior
+   --  from the others. This is the "finalize/adjust raised exception". This
+   --  subprogram is always called with abort deferred, unlike all other
+   --  Rcheck_* routines, it needs to call Raise_Exception_No_Defer.
+   --
+   --  It should probably have a distinguished name ???
+
    pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
    pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
    pragma Export (C, Rcheck_02, "__gnat_rcheck_02");
@@ -677,22 +662,6 @@ package body Ada.Exceptions is
    --  This package can be easily dummied out if we do not want the basic
    --  support for exception messages (such as in Ada 83).
 
-   package body Exception_Propagation is
-
-      procedure Setup_Exception
-        (Excep    : EOA;
-         Current  : EOA;
-         Reraised : Boolean := False)
-      is
-         pragma Warnings (Off, Excep);
-         pragma Warnings (Off, Current);
-         pragma Warnings (Off, Reraised);
-      begin
-         null;
-      end Setup_Exception;
-
-   end Exception_Propagation;
-
    ----------------------
    -- Exception_Traces --
    ----------------------
@@ -845,62 +814,62 @@ package body Ada.Exceptions is
       Raise_Current_Excep (E);
    end Raise_Exception_Always;
 
+   ------------------------------
+   -- Raise_Exception_No_Defer --
+   ------------------------------
+
+   procedure Raise_Exception_No_Defer
+     (E       : Exception_Id;
+      Message : String := "")
+   is
+   begin
+      Exception_Data.Set_Exception_Msg (E, Message);
+
+      --  Do not call Abort_Defer.all, as specified by the spec
+
+      Raise_Current_Excep (E);
+   end Raise_Exception_No_Defer;
+
    -------------------------------------
    -- Raise_From_Controlled_Operation --
    -------------------------------------
 
    procedure Raise_From_Controlled_Operation
-     (X          : Ada.Exceptions.Exception_Occurrence;
-      From_Abort : Boolean)
+     (X : Ada.Exceptions.Exception_Occurrence)
    is
+      Prefix             : constant String := "adjust/finalize raised ";
+      Orig_Msg           : constant String := Exception_Message (X);
+      Orig_Prefix_Length : constant Natural :=
+                             Integer'Min (Prefix'Length, Orig_Msg'Length);
+      Orig_Prefix        : String renames Orig_Msg
+                            (Orig_Msg'First ..
+                             Orig_Msg'First + Orig_Prefix_Length - 1);
    begin
-      --  When finalization was triggered by an abort, keep propagating the
-      --  abort signal rather than raising Program_Error.
+      --  Message already has proper prefix, just re-reraise
 
-      if From_Abort then
-         raise Standard'Abort_Signal;
-
-      --  Otherwise, raise Program_Error
+      if Orig_Prefix = Prefix then
+         Raise_Exception_No_Defer
+           (E       => Program_Error'Identity,
+            Message => Orig_Msg);
 
       else
          declare
-            Prefix             : constant String := "adjust/finalize raised ";
-            Orig_Msg           : constant String := Exception_Message (X);
-            Orig_Prefix_Length : constant Natural :=
-                                   Integer'Min
-                                     (Prefix'Length, Orig_Msg'Length);
-            Orig_Prefix        : String renames Orig_Msg
-                                   (Orig_Msg'First ..
-                                    Orig_Msg'First + Orig_Prefix_Length - 1);
+            New_Msg  : constant String := Prefix & Exception_Name (X);
 
          begin
-            --  Message already has proper prefix, just re-reraise
+            --  No message present, just provide our own
 
-            if Orig_Prefix = Prefix then
+            if Orig_Msg = "" then
                Raise_Exception_No_Defer
                  (E       => Program_Error'Identity,
-                  Message => Orig_Msg);
-
-            else
-               declare
-                  New_Msg  : constant String := Prefix & Exception_Name (X);
+                  Message => New_Msg);
 
-               begin
-                  --  No message present, just provide our own
+            --  Message present, add informational prefix
 
-                  if Orig_Msg = "" then
-                     Raise_Exception_No_Defer
-                       (E       => Program_Error'Identity,
-                        Message => New_Msg);
-
-                  --  Message present, add informational prefix
-
-                  else
-                     Raise_Exception_No_Defer
-                       (E       => Program_Error'Identity,
-                        Message => New_Msg & ": " & Orig_Msg);
-                  end if;
-               end;
+            else
+               Raise_Exception_No_Defer
+                 (E       => Program_Error'Identity,
+                  Message => New_Msg & ": " & Orig_Msg);
             end if;
          end;
       end if;
@@ -1001,7 +970,6 @@ package body Ada.Exceptions is
       Excep.Exception_Raised := False;
       Excep.Id               := E;
       Excep.Num_Tracebacks   := 0;
-      Excep.Cleanup_Flag     := False;
       Excep.Pid              := Local_Partition_ID;
       Abort_Defer.all;
       Raise_Current_Excep (E);
@@ -1122,8 +1090,17 @@ package body Ada.Exceptions is
    end Rcheck_21;
 
    procedure Rcheck_22 (File : System.Address; Line : Integer) is
+      E : constant Exception_Id := Program_Error_Def'Access;
+
    begin
-      Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
+      --  This is "finalize/adjust raised exception". This subprogram is always
+      --  called with abort deferred, unlike all other Rcheck_* routines, it
+      --  needs to call Raise_Exception_No_Defer.
+
+      --  This is consistent with Raise_From_Controlled_Operation
+
+      Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
+      Raise_Current_Excep (E);
    end Rcheck_22;
 
    procedure Rcheck_23 (File : System.Address; Line : Integer) is
@@ -1206,7 +1183,7 @@ package body Ada.Exceptions is
    begin
       if X.Id /= null then
          Abort_Defer.all;
-         Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
+         Save_Occurrence (Get_Current_Excep.all.all, X);
          Raise_Current_Excep (X.Id);
       end if;
    end Reraise_Occurrence;
@@ -1218,7 +1195,7 @@ package body Ada.Exceptions is
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence) is
    begin
       Abort_Defer.all;
-      Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
+      Save_Occurrence (Get_Current_Excep.all.all, X);
       Raise_Current_Excep (X.Id);
    end Reraise_Occurrence_Always;
 
@@ -1228,7 +1205,7 @@ package body Ada.Exceptions is
 
    procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
    begin
-      Save_Occurrence_No_Private (Get_Current_Excep.all.all, X);
+      Save_Occurrence (Get_Current_Excep.all.all, X);
       Raise_Current_Excep (X.Id);
    end Reraise_Occurrence_No_Defer;
 
@@ -1241,55 +1218,24 @@ package body Ada.Exceptions is
       Source : Exception_Occurrence)
    is
    begin
-      Save_Occurrence_No_Private (Target, Source);
-   end Save_Occurrence;
-
-   function Save_Occurrence (Source : Exception_Occurrence) return EOA is
-      Target : constant EOA := new Exception_Occurrence;
-   begin
-      Save_Occurrence (Target.all, Source);
-      return Target;
-   end Save_Occurrence;
-
-   --------------------------------
-   -- Save_Occurrence_No_Private --
-   --------------------------------
-
-   procedure Save_Occurrence_No_Private
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence)
-   is
-   begin
       Target.Id             := Source.Id;
       Target.Msg_Length     := Source.Msg_Length;
       Target.Num_Tracebacks := Source.Num_Tracebacks;
       Target.Pid            := Source.Pid;
-      Target.Cleanup_Flag   := Source.Cleanup_Flag;
 
       Target.Msg (1 .. Target.Msg_Length) :=
         Source.Msg (1 .. Target.Msg_Length);
 
       Target.Tracebacks (1 .. Target.Num_Tracebacks) :=
         Source.Tracebacks (1 .. Target.Num_Tracebacks);
-   end Save_Occurrence_No_Private;
-
-   -------------------------
-   -- Transfer_Occurrence --
-   -------------------------
+   end Save_Occurrence;
 
-   procedure Transfer_Occurrence
-     (Target : Exception_Occurrence_Access;
-      Source : Exception_Occurrence)
-   is
+   function Save_Occurrence (Source : Exception_Occurrence) return EOA is
+      Target : constant EOA := new Exception_Occurrence;
    begin
-      --  Setup Target as an exception to be propagated in the calling task
-      --  (rendezvous-wise), taking care not to clobber the associated private
-      --  data. Target is expected to be a pointer to the calling task's fixed
-      --  TSD occurrence, which is very different from Get_Current_Excep here
-      --  because this subprogram is called from the called task.
-
-      Save_Occurrence_No_Private (Target.all, Source);
-   end Transfer_Occurrence;
+      Save_Occurrence (Target.all, Source);
+      return Target;
+   end Save_Occurrence;
 
    -------------------
    -- String_To_EId --
@@ -1305,22 +1251,6 @@ package body Ada.Exceptions is
    function String_To_EO (S : String) return Exception_Occurrence
      renames Stream_Attributes.String_To_EO;
 
-   ------------------------------
-   -- Raise_Exception_No_Defer --
-   ------------------------------
-
-   procedure Raise_Exception_No_Defer
-     (E       : Exception_Id;
-      Message : String := "")
-   is
-   begin
-      Exception_Data.Set_Exception_Msg (E, Message);
-
-      --  Do not call Abort_Defer.all, as specified by the spec
-
-      Raise_Current_Excep (E);
-   end Raise_Exception_No_Defer;
-
    ---------------
    -- To_Stderr --
    ---------------
@@ -1344,4 +1274,27 @@ package body Ada.Exceptions is
       end loop;
    end To_Stderr;
 
+   -------------------------
+   -- Transfer_Occurrence --
+   -------------------------
+
+   procedure Transfer_Occurrence
+     (Target : Exception_Occurrence_Access;
+      Source : Exception_Occurrence)
+   is
+   begin
+      Save_Occurrence (Target.all, Source);
+   end Transfer_Occurrence;
+
+   ------------------------
+   -- Triggered_By_Abort --
+   ------------------------
+
+   function Triggered_By_Abort return Boolean is
+      Ex : constant Exception_Occurrence_Access := Get_Current_Excep.all;
+   begin
+      return Ex /= null
+        and then Exception_Identity (Ex.all) = Standard'Abort_Signal'Identity;
+   end Triggered_By_Abort;
+
 end Ada.Exceptions;
diff --git a/gcc/ada/a-except.ads b/gcc/ada/a-except.ads
index a6f571313b1..d7c14bab4e3 100644
--- a/gcc/ada/a-except.ads
+++ b/gcc/ada/a-except.ads
@@ -199,16 +199,13 @@ private
    --  system to return here rather than to the original location.
 
    procedure Raise_From_Controlled_Operation
-     (X          : Ada.Exceptions.Exception_Occurrence;
-      From_Abort : Boolean);
+     (X : Ada.Exceptions.Exception_Occurrence);
    pragma No_Return (Raise_From_Controlled_Operation);
    pragma Export
      (Ada, Raise_From_Controlled_Operation,
            "__gnat_raise_from_controlled_operation");
    --  Raise Program_Error, providing information about X (an exception raised
-   --  during a controlled operation) in the exception message. However, if the
-   --  finalization was triggered by abort, keep aborting instead of raising
-   --  Program_Error.
+   --  during a controlled operation) in the exception message.
 
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
    pragma No_Return (Reraise_Occurrence_Always);
@@ -224,6 +221,10 @@ private
    --  occurrence. This is used in generated code when it is known that
    --  abort is already deferred.
 
+   function Triggered_By_Abort return Boolean;
+   --  Determine whether the current exception (if it exists) is an instance of
+   --  Standard'Abort_Signal.
+
    -----------------------
    -- Polling Interface --
    -----------------------
@@ -274,13 +275,6 @@ private
       Msg : String (1 .. Exception_Msg_Max_Length);
       --  Characters of message
 
-      Cleanup_Flag : Boolean := False;
-      --  The cleanup flag is normally False, it is set True for an exception
-      --  occurrence passed to a cleanup routine, and will still be set True
-      --  when the cleanup routine does a Reraise_Occurrence call using this
-      --  exception occurrence. This is used to avoid recording a bogus trace
-      --  back entry from this reraise call.
-
       Exception_Raised : Boolean := False;
       --  Set to true to indicate that this exception occurrence has actually
       --  been raised. When an exception occurrence is first created, this is
@@ -298,11 +292,6 @@ private
 
       Tracebacks : Tracebacks_Array;
       --  Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks))
-
-      Private_Data : System.Address := System.Null_Address;
-      --  Field used by low level exception mechanism to store specific data.
-      --  Currently used by the GCC exception mechanism to store a pointer to
-      --  a GNAT_GCC_Exception.
    end record;
 
    function "=" (Left, Right : Exception_Occurrence) return Boolean
@@ -320,11 +309,9 @@ private
      Id               => null,
      Msg_Length       => 0,
      Msg              => (others => ' '),
-     Cleanup_Flag     => False,
      Exception_Raised => False,
      Pid              => 0,
      Num_Tracebacks   => 0,
-     Tracebacks       => (others => TBE.Null_TB_Entry),
-     Private_Data     => System.Null_Address);
+     Tracebacks       => (others => TBE.Null_TB_Entry));
 
 end Ada.Exceptions;
diff --git a/gcc/ada/a-exetim-default.ads b/gcc/ada/a-exetim-default.ads
index edc6f19a205..3267baad606 100644
--- a/gcc/ada/a-exetim-default.ads
+++ b/gcc/ada/a-exetim-default.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2007-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2007-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -81,6 +81,11 @@ package Ada.Execution_Time is
       TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
       return CPU_Time;
 
+   Interrupt_Clocks_Supported          : constant Boolean := False;
+   Separate_Interrupt_Clocks_Supported : constant Boolean := False;
+
+   function Clock_For_Interrupts return CPU_Time;
+
 private
 
    type CPU_Time is new Ada.Real_Time.Time;
diff --git a/gcc/ada/a-exetim-mingw.adb b/gcc/ada/a-exetim-mingw.adb
index 973817c0bec..c80d1128609 100755
--- a/gcc/ada/a-exetim-mingw.adb
+++ b/gcc/ada/a-exetim-mingw.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2007-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2007-2011, 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- --
@@ -129,6 +129,19 @@ package body Ada.Execution_Time is
                  + (Long_Long_Float (U_Time) / Hundreds_Nano_In_Sec))));
    end Clock;
 
+   --------------------------
+   -- Clock_For_Interrupts --
+   --------------------------
+
+   function Clock_For_Interrupts return CPU_Time is
+   begin
+      --  According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
+      --  is set to False the function raises Program_Error.
+
+      raise Program_Error;
+      return CPU_Time_First;
+   end Clock_For_Interrupts;
+
    -----------
    -- Split --
    -----------
diff --git a/gcc/ada/a-exetim-mingw.ads b/gcc/ada/a-exetim-mingw.ads
index 374e066abe1..a2b68061838 100755
--- a/gcc/ada/a-exetim-mingw.ads
+++ b/gcc/ada/a-exetim-mingw.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---             Copyright (C) 2009  Free Software Foundation, Inc.           --
+--          Copyright (C) 2009-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -81,6 +81,11 @@ package Ada.Execution_Time is
        TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
        return CPU_Time;
 
+   Interrupt_Clocks_Supported          : constant Boolean := False;
+   Separate_Interrupt_Clocks_Supported : constant Boolean := False;
+
+   function Clock_For_Interrupts return CPU_Time;
+
 private
 
    type CPU_Time is new Ada.Real_Time.Time;
diff --git a/gcc/ada/a-exetim-posix.adb b/gcc/ada/a-exetim-posix.adb
index fe00abe5595..65b21d61d7a 100644
--- a/gcc/ada/a-exetim-posix.adb
+++ b/gcc/ada/a-exetim-posix.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2007-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 2007-2011, 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- --
@@ -127,6 +127,19 @@ package body Ada.Execution_Time is
       return To_CPU_Time (To_Duration (TS));
    end Clock;
 
+   --------------------------
+   -- Clock_For_Interrupts --
+   --------------------------
+
+   function Clock_For_Interrupts return CPU_Time is
+   begin
+      --  According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
+      --  is set to False the function raises Program_Error.
+
+      raise Program_Error;
+      return CPU_Time_First;
+   end Clock_For_Interrupts;
+
    -----------
    -- Split --
    -----------
diff --git a/gcc/ada/a-exetim.ads b/gcc/ada/a-exetim.ads
index c4b8ba2eb32..1dc5f61f9c0 100644
--- a/gcc/ada/a-exetim.ads
+++ b/gcc/ada/a-exetim.ads
@@ -72,6 +72,11 @@ package Ada.Execution_Time is
        TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
        return CPU_Time;
 
+   Interrupt_Clocks_Supported          : constant Boolean := False;
+   Separate_Interrupt_Clocks_Supported : constant Boolean := False;
+
+   function Clock_For_Interrupts return CPU_Time;
+
 private
 
    type CPU_Time is new Ada.Real_Time.Time;
diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb
index 63ab461a9fa..69a1accc465 100644
--- a/gcc/ada/a-exexda.adb
+++ b/gcc/ada/a-exexda.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -612,13 +612,11 @@ package body Exception_Data is
    --  Start of processing for Set_Exception_C_Msg
 
    begin
-      Exception_Propagation.Setup_Exception (Excep, Excep);
       Excep.Exception_Raised := False;
       Excep.Id               := Id;
       Excep.Num_Tracebacks   := 0;
       Excep.Pid              := Local_Partition_ID;
       Excep.Msg_Length       := 0;
-      Excep.Cleanup_Flag     := False;
 
       while To_Ptr (Msg1) (Excep.Msg_Length + 1) /= ASCII.NUL
         and then Excep.Msg_Length < Exception_Msg_Max_Length
@@ -663,14 +661,12 @@ package body Exception_Data is
       Excep  : constant EOA := Get_Current_Excep.all;
 
    begin
-      Exception_Propagation.Setup_Exception (Excep, Excep);
       Excep.Exception_Raised := False;
       Excep.Msg_Length       := Len;
       Excep.Msg (1 .. Len)   := Message (First .. First + Len - 1);
       Excep.Id               := Id;
       Excep.Num_Tracebacks   := 0;
       Excep.Pid              := Local_Partition_ID;
-      Excep.Cleanup_Flag     := False;
 
    end Set_Exception_Msg;
 
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 358f6fa2f40..1f11227c971 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -76,20 +76,21 @@ package body Exception_Propagation is
 
    --  Phase identifiers
 
-   type Unwind_Action is
+   type Unwind_Action is new Integer;
+   pragma Convention (C, Unwind_Action);
+
+   UA_SEARCH_PHASE  : constant Unwind_Action := 1;
+   UA_CLEANUP_PHASE : constant Unwind_Action := 2;
+   UA_HANDLER_FRAME : constant Unwind_Action := 4;
+   UA_FORCE_UNWIND  : constant Unwind_Action := 8;
+   UA_END_OF_STACK  : constant Unwind_Action := 16;  --  GCC extension ?
+
+   pragma Unreferenced
      (UA_SEARCH_PHASE,
       UA_CLEANUP_PHASE,
       UA_HANDLER_FRAME,
       UA_FORCE_UNWIND);
 
-   for Unwind_Action use
-      (UA_SEARCH_PHASE  => 1,
-       UA_CLEANUP_PHASE => 2,
-       UA_HANDLER_FRAME => 4,
-       UA_FORCE_UNWIND  => 8);
-
-   pragma Convention (C, Unwind_Action);
-
    --  Mandatory common header for any exception object handled by the
    --  GCC unwinding runtime.
 
@@ -103,11 +104,12 @@ package body Exception_Propagation is
    --  Map the corresponding C type used in Unwind_Exception below
 
    type Unwind_Exception is record
-      Class    : Exception_Class := GNAT_Exception_Class;
-      Cleanup  : System.Address  := System.Null_Address;
+      Class    : Exception_Class;
+      Cleanup  : System.Address;
       Private1 : Unwind_Word;
       Private2 : Unwind_Word;
    end record;
+   pragma Convention (C, Unwind_Exception);
    --  Map the GCC struct used for exception handling
 
    for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
@@ -116,6 +118,19 @@ package body Exception_Propagation is
    --  maximally aligned (see unwind.h). See additional comments on the
    --  alignment below.
 
+   type GCC_Exception_Access is access all Unwind_Exception;
+   --  Pointer to a GCC exception. Do not use convention C as on VMS this
+   --  would imply the use of 32-bits pointers.
+
+   procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access);
+   pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
+   --  Procedure to free any GCC exception
+
+   Foreign_Exception : aliased System.Standard_Library.Exception_Data;
+   pragma Import (Ada, Foreign_Exception,
+                  "system__exceptions__foreign_exception");
+   --  Id for foreign exceptions
+
    --------------------------------------------------------------
    -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
    --------------------------------------------------------------
@@ -127,20 +142,8 @@ package body Exception_Propagation is
       Header : Unwind_Exception;
       --  ABI Exception header first
 
-      Id : Exception_Id;
-      --  GNAT Exception identifier.  This is filled by Propagate_Exception
-      --  and then used by the personality routine to determine if the context
-      --  it examines contains a handler for the exception being propagated.
-
-      N_Cleanups_To_Trigger : Integer;
-      --  Number of cleanup only frames encountered in SEARCH phase.  This is
-      --  initialized to 0 by Propagate_Exception and maintained by the
-      --  personality routine to control a forced unwinding phase triggering
-      --  all the cleanups before calling Unhandled_Exception_Terminate when
-      --  an exception is not handled.
-
-      Next_Exception : EOA;
-      --  Used to create a linked list of exception occurrences
+      Occurrence : Exception_Occurrence;
+      --  The Ada occurrence
    end record;
 
    pragma Convention (C, GNAT_GCC_Exception);
@@ -164,20 +167,40 @@ package body Exception_Propagation is
 
    type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
 
-   function To_GNAT_GCC_Exception is new
-     Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access);
-
-   procedure Free is new Unchecked_Deallocation
-     (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
+   function To_GCC_Exception is new
+     Unchecked_Conversion (GNAT_GCC_Exception_Access, GCC_Exception_Access);
 
-   procedure Free is new Unchecked_Deallocation
-     (Exception_Occurrence, EOA);
+   function To_GNAT_GCC_Exception is new
+     Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access);
+
+   procedure GNAT_GCC_Exception_Cleanup
+     (Reason : Unwind_Reason_Code;
+      Excep  : not null GNAT_GCC_Exception_Access);
+   pragma Convention (C, GNAT_GCC_Exception_Cleanup);
+   --  Procedure called when a GNAT GCC exception is free.
+
+   procedure Propagate_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access);
+   pragma No_Return (Propagate_GCC_Exception);
+   --  Propagate a GCC exception
+
+   procedure Reraise_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access);
+   pragma No_Return (Reraise_GCC_Exception);
+   pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
+   --  Called to implement raise without exception, ie reraise.  Called
+   --  directly from gigi.
+
+   procedure Setup_Current_Excep
+     (GCC_Exception : not null GCC_Exception_Access);
+   pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
+   --  Write Get_Current_Excep.all from GCC_Exception
 
    function CleanupUnwind_Handler
      (UW_Version   : Integer;
       UW_Phases    : Unwind_Action;
       UW_Eclass    : Exception_Class;
-      UW_Exception : not null access GNAT_GCC_Exception;
+      UW_Exception : not null GCC_Exception_Access;
       UW_Context   : System.Address;
       UW_Argument  : System.Address) return Unwind_Reason_Code;
    --  Hook called at each step of the forced unwinding we perform to
@@ -189,57 +212,25 @@ package body Exception_Propagation is
    --  __gnat stubs for these.
 
    procedure Unwind_RaiseException
-     (UW_Exception : not null access GNAT_GCC_Exception);
+     (UW_Exception : not null GCC_Exception_Access);
    pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
 
    procedure Unwind_ForcedUnwind
-     (UW_Exception : not null access GNAT_GCC_Exception;
+     (UW_Exception : not null GCC_Exception_Access;
       UW_Handler   : System.Address;
       UW_Argument  : System.Address);
    pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
 
-   ------------------------------------------------------------------
-   -- Occurrence Stack Management Facilities for the GCC-EH Scheme --
-   ------------------------------------------------------------------
-
-   function Remove
-     (Top   : EOA;
-      Excep : GNAT_GCC_Exception_Access) return Boolean;
-   --  Remove Excep from the stack starting at Top.
-   --  Return True if Excep was found and removed, false otherwise.
-
    --  Hooks called when entering/leaving an exception handler for a given
    --  occurrence, aimed at handling the stack of active occurrences. The
    --  calls are generated by gigi in tree_transform/N_Exception_Handler.
 
-   procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+   procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access);
    pragma Export (C, Begin_Handler, "__gnat_begin_handler");
 
-   procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+   procedure End_Handler (GCC_Exception : GCC_Exception_Access);
    pragma Export (C, End_Handler, "__gnat_end_handler");
 
-   Setup_Key : constant := 16#DEAD#;
-   --  To handle the case of a task "transferring" an exception occurrence to
-   --  another task, for instance via Exceptional_Complete_Rendezvous, we need
-   --  to be able to identify occurrences which have been Setup and not yet
-   --  Propagated. We hijack one of the common header fields for that purpose,
-   --  setting it to a special key value during the setup process, clearing it
-   --  at the very beginning of the propagation phase, and expecting it never
-   --  to be reset to the special value later on. A 16-bit value is used rather
-   --  than a 32-bit value for static compatibility with 16-bit targets such as
-   --  AAMP (where type Unwind_Word will be 16 bits).
-
-   function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
-
-   procedure Set_Setup_And_Not_Propagated (E : EOA);
-   procedure Clear_Setup_And_Not_Propagated (E : EOA);
-
-   procedure Save_Occurrence_And_Private
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence);
-   --  Copy all the components of Source to Target as well as the
-   --  Private_Data pointer.
-
    --------------------------------------------------------------------
    -- Accessors to Basic Components of a GNAT Exception Data Pointer --
    --------------------------------------------------------------------
@@ -260,15 +251,10 @@ package body Exception_Propagation is
    function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
    pragma Export (C, Import_Code_For, "__gnat_import_code_for");
 
-   function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access)
+   function EID_For (GNAT_Exception : not null GNAT_GCC_Exception_Access)
      return Exception_Id;
    pragma Export (C, EID_For, "__gnat_eid_for");
 
-   procedure Adjust_N_Cleanups_For
-     (GNAT_Exception : GNAT_GCC_Exception_Access;
-      Adjustment     : Integer);
-   pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
-
    ---------------------------------------------------------------------------
    -- Objects to materialize "others" and "all others" in the GCC EH tables --
    ---------------------------------------------------------------------------
@@ -285,64 +271,26 @@ package body Exception_Propagation is
    All_Others_Value : constant Integer := 16#7FFF#;
    pragma Export (C, All_Others_Value, "__gnat_all_others_value");
 
-   ------------
-   -- Remove --
-   ------------
+   --------------------------------
+   -- GNAT_GCC_Exception_Cleanup --
+   --------------------------------
 
-   function Remove
-     (Top   : EOA;
-      Excep : GNAT_GCC_Exception_Access) return Boolean
+   procedure GNAT_GCC_Exception_Cleanup
+     (Reason : Unwind_Reason_Code;
+      Excep  : not null GNAT_GCC_Exception_Access)
    is
-      Prev          : GNAT_GCC_Exception_Access := null;
-      Iter          : EOA := Top;
-      GCC_Exception : GNAT_GCC_Exception_Access;
-
-   begin
-      --  Pop stack
-
-      loop
-         pragma Assert (Iter.Private_Data /= System.Null_Address);
-
-         GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data);
-
-         if GCC_Exception = Excep then
-            if Prev = null then
-
-               --  Special case for the top of the stack: shift the contents
-               --  of the next item to the top, since top is at a fixed
-               --  location and can't be changed.
-
-               Iter := GCC_Exception.Next_Exception;
-
-               if Iter = null then
-
-                  --  Stack is now empty
-
-                  Top.Private_Data := System.Null_Address;
+      pragma Unreferenced (Reason);
 
-               else
-                  Save_Occurrence_And_Private (Top.all, Iter.all);
-                  Free (Iter);
-               end if;
+      procedure Free is new Unchecked_Deallocation
+        (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
 
-            else
-               Prev.Next_Exception := GCC_Exception.Next_Exception;
-               Free (Iter);
-            end if;
+      Copy : GNAT_GCC_Exception_Access := Excep;
 
-            Free (GCC_Exception);
-
-            return True;
-         end if;
-
-         exit when GCC_Exception.Next_Exception = null;
-
-         Prev := GCC_Exception;
-         Iter := GCC_Exception.Next_Exception;
-      end loop;
+   begin
+      --  Simply free the memory
 
-      return False;
-   end Remove;
+      Free (Copy);
+   end GNAT_GCC_Exception_Cleanup;
 
    ---------------------------
    -- CleanupUnwind_Handler --
@@ -352,163 +300,68 @@ package body Exception_Propagation is
      (UW_Version   : Integer;
       UW_Phases    : Unwind_Action;
       UW_Eclass    : Exception_Class;
-      UW_Exception : not null access GNAT_GCC_Exception;
+      UW_Exception : not null GCC_Exception_Access;
       UW_Context   : System.Address;
       UW_Argument  : System.Address) return Unwind_Reason_Code
    is
-      pragma Unreferenced
-        (UW_Version, UW_Phases, UW_Eclass, UW_Context, UW_Argument);
+      pragma Unreferenced (UW_Version, UW_Eclass, UW_Context, UW_Argument);
 
    begin
-      --  Terminate as soon as we know there is nothing more to run. The
-      --  count is maintained by the personality routine.
+      --  Terminate when the end of the stack is reached
 
-      if UW_Exception.N_Cleanups_To_Trigger = 0 then
+      if UW_Phases >= UA_END_OF_STACK then
+         Setup_Current_Excep (UW_Exception);
          Unhandled_Exception_Terminate;
       end if;
 
       --  We know there is at least one cleanup further up. Return so that it
       --  is searched and entered, after which Unwind_Resume will be called
-      --  and this hook will gain control (with an updated count) again.
+      --  and this hook will gain control again.
 
       return URC_NO_REASON;
    end CleanupUnwind_Handler;
 
-   ---------------------------------
-   -- Is_Setup_And_Not_Propagated --
-   ---------------------------------
-
-   function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
-      GCC_E : constant GNAT_GCC_Exception_Access :=
-                To_GNAT_GCC_Exception (E.Private_Data);
-   begin
-      return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
-   end Is_Setup_And_Not_Propagated;
-
-   ------------------------------------
-   -- Clear_Setup_And_Not_Propagated --
-   ------------------------------------
-
-   procedure Clear_Setup_And_Not_Propagated (E : EOA) is
-      GCC_E : constant GNAT_GCC_Exception_Access :=
-                To_GNAT_GCC_Exception (E.Private_Data);
-   begin
-      pragma Assert (GCC_E /= null);
-      GCC_E.Header.Private1 := 0;
-   end Clear_Setup_And_Not_Propagated;
-
-   ----------------------------------
-   -- Set_Setup_And_Not_Propagated --
-   ----------------------------------
-
-   procedure Set_Setup_And_Not_Propagated (E : EOA) is
-      GCC_E : constant GNAT_GCC_Exception_Access :=
-                To_GNAT_GCC_Exception (E.Private_Data);
-   begin
-      pragma Assert (GCC_E /= null);
-      GCC_E.Header.Private1 := Setup_Key;
-   end Set_Setup_And_Not_Propagated;
-
-   --------------------------------
-   -- Save_Occurrence_And_Private --
-   --------------------------------
-
-   procedure Save_Occurrence_And_Private
-     (Target : out Exception_Occurrence;
-      Source : Exception_Occurrence)
-   is
-   begin
-      Save_Occurrence_No_Private (Target, Source);
-      Target.Private_Data := Source.Private_Data;
-   end Save_Occurrence_And_Private;
-
-   ---------------------
-   -- Setup_Exception --
-   ---------------------
-
-   --  In the GCC-EH implementation of the propagation scheme, this
-   --  subprogram should be understood as: Setup the exception occurrence
-   --  stack headed at Current for a forthcoming raise of Excep.
+   -------------------------
+   -- Setup_Current_Excep --
+   -------------------------
 
-   procedure Setup_Exception
-     (Excep    : EOA;
-      Current  : EOA;
-      Reraised : Boolean := False)
+   procedure Setup_Current_Excep
+     (GCC_Exception : not null GCC_Exception_Access)
    is
-      Top           : constant EOA := Current;
-      Next          : EOA;
-      GCC_Exception : GNAT_GCC_Exception_Access;
+      Excep : constant EOA := Get_Current_Excep.all;
 
    begin
-      --  The exception Excep is soon to be propagated, and the
-      --  storage used for that will be the occurrence statically allocated
-      --  for the current thread. This storage might currently be used for a
-      --  still active occurrence, so we need to push it on the thread's
-      --  occurrence stack (headed at that static occurrence) before it gets
-      --  clobbered.
-
-      --  What we do here is to trigger this push when need be, and allocate a
-      --  Private_Data block for the forthcoming Propagation.
-
-      --  Some tasking rendez-vous attempts lead to an occurrence transfer
-      --  from the server to the client (see Exceptional_Complete_Rendezvous).
-      --  In those cases Setup is called twice for the very same occurrence
-      --  before it gets propagated: once from the server, because this is
-      --  where the occurrence contents is elaborated and known, and then
-      --  once from the client when it detects the case and actually raises
-      --  the exception in its own context.
-
-      --  The Is_Setup_And_Not_Propagated predicate tells us when we are in
-      --  the second call to Setup for a Transferred occurrence, and there is
-      --  nothing to be done here in this situation. This predicate cannot be
-      --  True if we are dealing with a Reraise, and we may even be called
-      --  with a raw uninitialized Excep occurrence in this case so we should
-      --  not check anyway. Observe the front-end expansion for a "raise;" to
-      --  see that happening. We get a local occurrence and a direct call to
-      --  Save_Occurrence without the intermediate init-proc call.
-
-      if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
-         return;
-      end if;
+      --  Setup the exception occurrence
 
-      --  Allocate what will be the Private_Data block for the exception
-      --  to be propagated.
+      if GCC_Exception.Class = GNAT_Exception_Class then
 
-      GCC_Exception := new GNAT_GCC_Exception;
+         --  From the GCC exception
 
-      --  If the Top of the occurrence stack is not currently used for an
-      --  active exception (the stack is empty) we just need to setup the
-      --  Private_Data pointer.
+         declare
+            GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
+                                To_GNAT_GCC_Exception (GCC_Exception);
+         begin
+            Excep.all := GNAT_Occurrence.Occurrence;
+         end;
+      else
 
-      --  Otherwise, we also need to shift the contents of the Top of the
-      --  stack in a freshly allocated entry and link everything together.
+         --  A default one
 
-      if Top.Private_Data /= System.Null_Address then
-         Next := new Exception_Occurrence;
-         Save_Occurrence_And_Private (Next.all, Top.all);
-
-         GCC_Exception.Next_Exception := Next;
-         Top.Private_Data := GCC_Exception.all'Address;
+         Excep.Id := Foreign_Exception'Access;
+         Excep.Msg_Length := 0;
+         Excep.Exception_Raised := True;
+         Excep.Pid := Local_Partition_ID;
+         Excep.Num_Tracebacks := 0;
       end if;
-
-      Top.Private_Data := GCC_Exception.all'Address;
-
-      Set_Setup_And_Not_Propagated (Top);
-   end Setup_Exception;
+   end Setup_Current_Excep;
 
    -------------------
    -- Begin_Handler --
    -------------------
 
-   procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
+   procedure Begin_Handler (GCC_Exception : not null GCC_Exception_Access) is
       pragma Unreferenced (GCC_Exception);
-
    begin
-      --  Every necessary operation related to the occurrence stack has
-      --  already been performed by Propagate_Exception. This hook remains for
-      --  potential future necessity in optimizing the overall scheme, as well
-      --  a useful debugging tool.
-
       null;
    end Begin_Handler;
 
@@ -516,45 +369,84 @@ package body Exception_Propagation is
    -- End_Handler --
    -----------------
 
-   procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
-      Removed : Boolean;
+   procedure End_Handler (GCC_Exception : GCC_Exception_Access) is
    begin
-      Removed := Remove (Get_Current_Excep.all, GCC_Exception);
-      pragma Assert (Removed);
+      if GCC_Exception /= null then
+
+         --  The exception might have been reraised, in this case the cleanup
+         --  mustn't be called.
+
+         Unwind_DeleteException (GCC_Exception);
+      end if;
    end End_Handler;
 
+   -----------------------------
+   -- Reraise_GCC_Exception --
+   -----------------------------
+
+   procedure Reraise_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access)
+   is
+   begin
+      --  Simply propagate it
+      Propagate_GCC_Exception (GCC_Exception);
+   end Reraise_GCC_Exception;
+
+   -----------------------------
+   -- Propagate_GCC_Exception --
+   -----------------------------
+
+   --  Call Unwind_RaiseException to actually throw, taking care of handling
+   --  the two phase scheme it implements.
+
+   procedure Propagate_GCC_Exception
+     (GCC_Exception : not null GCC_Exception_Access)
+   is
+   begin
+      --  Perform a standard raise first. If a regular handler is found, it
+      --  will be entered after all the intermediate cleanups have run. If
+      --  there is no regular handler, it will return.
+
+      Unwind_RaiseException (GCC_Exception);
+
+      --  If we get here we know the exception is not handled, as otherwise
+      --  Unwind_RaiseException arranges for the handler to be entered. Take
+      --  the necessary steps to enable the debugger to gain control while the
+      --  stack is still intact.
+
+      Setup_Current_Excep (GCC_Exception);
+      Notify_Unhandled_Exception;
+
+      --  Now, un a forced unwind to trigger cleanups. Control should not
+      --  resume there, if there are cleanups and in any cases as the
+      --  unwinding hook calls Unhandled_Exception_Terminate when end of
+      --  stack is reached.
+
+      Unwind_ForcedUnwind (GCC_Exception,
+                           CleanupUnwind_Handler'Address,
+                           System.Null_Address);
+
+      --  We get here in case of error. The debugger has been notified before
+      --  the second step above.
+
+      Setup_Current_Excep (GCC_Exception);
+      Unhandled_Exception_Terminate;
+   end Propagate_GCC_Exception;
+
    -------------------------
    -- Propagate_Exception --
    -------------------------
 
    --  Build an object suitable for the libgcc processing and call
-   --  Unwind_RaiseException to actually throw, taking care of handling
-   --  the two phase scheme it implements.
+   --  Unwind_RaiseException to actually do the raise, taking care of
+   --  handling the two phase scheme it implements.
 
    procedure Propagate_Exception
-     (E                   : Exception_Id;
-      From_Signal_Handler : Boolean)
    is
-      pragma Inspection_Point (E);
-      pragma Unreferenced (From_Signal_Handler);
-
       Excep         : constant EOA := Get_Current_Excep.all;
       GCC_Exception : GNAT_GCC_Exception_Access;
 
    begin
-      pragma Assert (Excep.Private_Data /= System.Null_Address);
-
-      --  Retrieve the Private_Data for this occurrence and set the useful
-      --  flags for the personality routine, which will be called for each
-      --  frame via Unwind_RaiseException below.
-
-      GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
-
-      Clear_Setup_And_Not_Propagated (Excep);
-
-      GCC_Exception.Id := Excep.Id;
-      GCC_Exception.N_Cleanups_To_Trigger := 0;
-
       --  Compute the backtrace for this occurrence if the corresponding
       --  binder option has been set. Call_Chain takes care of the reraise
       --  case.
@@ -578,60 +470,30 @@ package body Exception_Propagation is
 
       Call_Chain (Excep);
 
-      --  Perform a standard raise first. If a regular handler is found, it
-      --  will be entered after all the intermediate cleanups have run. If
-      --  there is no regular handler, control will get back to after the
-      --  call, with N_Cleanups_To_Trigger set to the number of frames with
-      --  cleanups found on the way up, and none of these already run.
+      --  Allocate the GCC exception
 
-      Unwind_RaiseException (GCC_Exception);
+      GCC_Exception :=
+        new GNAT_GCC_Exception'
+          (Header     => (Class => GNAT_Exception_Class,
+                          Cleanup => GNAT_GCC_Exception_Cleanup'Address,
+                          Private1 => 0,
+                          Private2 => 0),
+           Occurrence => Excep.all);
 
-      --  If we get here we know the exception is not handled, as otherwise
-      --  Unwind_RaiseException arranges for the handler to be entered. Take
-      --  the necessary steps to enable the debugger to gain control while the
-      --  stack is still intact.
+      --  Propagate it
 
-      Notify_Unhandled_Exception;
-
-      --  Now, if cleanups have been found, run a forced unwind to trigger
-      --  them. Control should not resume there, as the unwinding hook calls
-      --  Unhandled_Exception_Terminate as soon as the last cleanup has been
-      --  triggered.
-
-      if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
-         Unwind_ForcedUnwind (GCC_Exception,
-                              CleanupUnwind_Handler'Address,
-                              System.Null_Address);
-      end if;
-
-      --  We get here when there is no handler or cleanup to be run at all.
-      --  The debugger has been notified before the second step above.
-
-      Unhandled_Exception_Terminate;
+      Propagate_GCC_Exception (To_GCC_Exception (GCC_Exception));
    end Propagate_Exception;
 
-   ---------------------------
-   -- Adjust_N_Cleanups_For --
-   ---------------------------
-
-   procedure Adjust_N_Cleanups_For
-     (GNAT_Exception : GNAT_GCC_Exception_Access;
-      Adjustment     : Integer)
-   is
-   begin
-      GNAT_Exception.N_Cleanups_To_Trigger :=
-        GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
-   end Adjust_N_Cleanups_For;
-
    -------------
    -- EID_For --
    -------------
 
    function EID_For
-     (GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
+     (GNAT_Exception : not null GNAT_GCC_Exception_Access) return Exception_Id
    is
    begin
-      return GNAT_Exception.Id;
+      return GNAT_Exception.Occurrence.Id;
    end EID_For;
 
    ---------------------
@@ -663,67 +525,4 @@ package body Exception_Propagation is
       return E.all.Lang;
    end Language_For;
 
-   -----------
-   -- Notes --
-   -----------
-
-   --  The current model implemented for the stack of occurrences is a
-   --  simplification of previous attempts, which all proved to be flawed or
-   --  would have needed significant additional circuitry to be made to work
-   --  correctly.
-
-   --  We now represent every propagation by a new entry on the stack, which
-   --  means that an exception occurrence may appear more than once (e.g. when
-   --  it is reraised during the course of its own handler).
-
-   --  This may seem overcostly compared to the C++ model as implemented in
-   --  the g++ v3 libstd. This is actually understandable when one considers
-   --  the extra variations of possible run-time configurations induced by the
-   --  freedom offered by the Save_Occurrence/Reraise_Occurrence public
-   --  interface.
-
-   --  The basic point is that arranging for an occurrence to always appear at
-   --  most once on the stack requires a way to determine if a given occurrence
-   --  is already there, which is not as easy as it might seem.
-
-   --  An attempt was made to use the Private_Data pointer for this purpose.
-   --  It did not work because:
-
-   --  1) The Private_Data has to be saved by Save_Occurrence to be usable
-   --     as a key in case of a later reraise,
-
-   --  2) There is no easy way to synchronize End_Handler for an occurrence
-   --     and the data attached to potential copies, so these copies may end
-   --     up pointing to stale data. Moreover ...
-
-   --  3) The same address may be reused for different occurrences, which
-   --     defeats the idea of using it as a key.
-
-   --  The example below illustrates:
-
-   --  Saved_CE : Exception_Occurrence;
-
-   --  begin
-   --    raise Constraint_Error;
-   --  exception
-   --    when CE: others =>
-   --      Save_Occurrence (Saved_CE, CE);      <= Saved_CE.PDA = CE.PDA
-   --  end;
-
-   --                                           <= Saved_CE.PDA is stale (!)
-
-   --  begin
-   --    raise Program_Error;                   <= Saved_CE.PDA = PE.PDA (!!)
-   --  exception
-   --    when others =>
-   --      Reraise_Occurrence (Saved_CE);
-   --  end;
-
-   --  Not releasing the Private_Data via End_Handler could be an option,
-   --  but making this to work while still avoiding memory leaks is far
-   --  from trivial.
-
-   --  The current scheme has the advantage of being simple, and induces
-   --  extra costs only in reraise cases which is acceptable.
-
 end Exception_Propagation;
diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb
index e3ae5b01cff..cbe8a5c1c38 100644
--- a/gcc/ada/a-exexpr.adb
+++ b/gcc/ada/a-exexpr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -32,43 +32,23 @@
 --  This is the default version, using the __builtin_setjmp/longjmp EH
 --  mechanism.
 
-with System.Storage_Elements;  use System.Storage_Elements;
-
-pragma Warnings (Off);
---  Since several constructs give warnings in 3.14a1, including unreferenced
---  variables and pragma Unreferenced itself.
+with Ada.Unchecked_Conversion;
 
 separate (Ada.Exceptions)
 package body Exception_Propagation is
 
-   ---------------------
-   -- Setup_Exception --
-   ---------------------
+   --  Common binding to __builtin_longjmp for sjlj variants.
 
-   procedure Setup_Exception
-     (Excep    : EOA;
-      Current  : EOA;
-      Reraised : Boolean := False)
-   is
-      pragma Unreferenced (Excep, Current, Reraised);
-   begin
-      --  In the GNAT-SJLJ case this "stack" only exists implicitly, by way of
-      --  local occurrence declarations together with save/restore operations
-      --  generated by the front-end, and this routine has nothing to do.
-
-      null;
-   end Setup_Exception;
+   procedure builtin_longjmp (buffer : System.Address; Flag : Integer);
+   pragma No_Return (builtin_longjmp);
+   pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
 
    -------------------------
    -- Propagate_Exception --
    -------------------------
 
    procedure Propagate_Exception
-     (E                   : Exception_Id;
-      From_Signal_Handler : Boolean)
    is
-      pragma Inspection_Point (E);
-
       Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
       Excep       : constant EOA := Get_Current_Excep.all;
    begin
@@ -110,7 +90,7 @@ package body Exception_Propagation is
             Exception_Traces.Notify_Handled_Exception;
          end if;
 
-         builtin_longjmp (To_Jmpbuf_Address (Jumpbuf_Ptr), 1);
+         builtin_longjmp (Jumpbuf_Ptr, 1);
 
       else
          Exception_Traces.Notify_Unhandled_Exception;
diff --git a/gcc/ada/a-exextr.adb b/gcc/ada/a-exextr.adb
index 26567b3a488..61ae6b1ebaf 100644
--- a/gcc/ada/a-exextr.adb
+++ b/gcc/ada/a-exextr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -93,11 +93,6 @@ package body Exception_Traces is
       --  configuration. Take care not to output information about internal
       --  exceptions.
 
-      --  ??? In the Front-End ZCX case, the traceback entries we have at this
-      --  point only include the ones we stored while walking up the stack *up
-      --  to the handler*. All the frames above the subprogram in which the
-      --  handler is found are missing.
-
       if not Excep.Id.Not_Handled_By_Others
         and then
           (Exception_Trace = Every_Raise
diff --git a/gcc/ada/a-exstat.adb b/gcc/ada/a-exstat.adb
index 79ab578624c..f5674e5e867 100644
--- a/gcc/ada/a-exstat.adb
+++ b/gcc/ada/a-exstat.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -144,8 +144,6 @@ package body Stream_Attributes is
          return Null_Occurrence;
 
       else
-         X.Cleanup_Flag := False;
-
          To := S'First - 2;
          Next_String;
 
diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb
deleted file mode 100644
index 3759e712e0b..00000000000
--- a/gcc/ada/a-fihema.adb
+++ /dev/null
@@ -1,551 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---     A D A . F I N A L I Z A T I O N . H E A P _ M A N A G E M E N T      --
---                                                                          --
---                                B o d y                                   --
---                                                                          --
---          Copyright (C) 2008-2011, 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- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception,   --
--- version 3.1, as published by the Free Software Foundation.               --
---                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
-with Ada.Exceptions;          use Ada.Exceptions;
-with Ada.Unchecked_Conversion;
-
-with System;                  use System;
-with System.Address_Image;
-with System.IO;               use System.IO;
---  ???with System.OS_Lib;
---  Breaks ravenscar runtimes
-with System.Soft_Links;       use System.Soft_Links;
-with System.Storage_Elements; use System.Storage_Elements;
-with System.Storage_Pools;    use System.Storage_Pools;
-
-package body Ada.Finalization.Heap_Management is
-
-   Debug : constant Boolean := False;
-   --  True for debugging printouts.
-
-   Header_Size : constant Storage_Count  := Node'Size / Storage_Unit;
-   --  Size of the header in bytes. Added to Storage_Size requested by
-   --  Allocate/Deallocate to determine the Storage_Size passed to the
-   --  underlying pool.
-
-   Header_Offset : constant Storage_Offset := Header_Size;
-   --  Offset from the header to the actual object. Used to get from the
-   --  address of a header to the address of the actual object, and vice-versa.
-
-   function Address_To_Node_Ptr is
-     new Ada.Unchecked_Conversion (Address, Node_Ptr);
-
-   procedure Attach (N : Node_Ptr; L : Node_Ptr);
-   --  Prepend a node to a list
-
-   procedure Detach (N : Node_Ptr);
-   --  Unhook a node from an arbitrary list
-
-   procedure Fin_Assert (Condition : Boolean; Message : String);
-   --  Asserts that the condition is True. Used instead of pragma Assert in
-   --  delicate places where raising an exception would cause re-invocation of
-   --  finalization. Instead of raising an exception, aborts the whole process.
-
-   function Is_Empty (Objects : Node_Ptr) return Boolean;
-   --  True if the Objects list is empty
-
-   ----------------
-   -- Fin_Assert --
-   ----------------
-
-   procedure Fin_Assert (Condition : Boolean; Message : String) is
-
-      procedure Fail;
-      --  Use a separate procedure to make it easy to set a breakpoint here.
-
-      ----------
-      -- Fail --
-      ----------
-
-      procedure Fail is
-      begin
-         Put_Line ("Heap_Management: Fin_Assert failed: " & Message);
-         --  ???OS_Lib.OS_Abort;
-         --  Breaks ravenscar runtimes
-      end Fail;
-
-   --  Start of processing for Fin_Assert
-
-   begin
-      if not Condition then
-         Fail;
-      end if;
-   end Fin_Assert;
-
-   ---------------------------
-   -- Add_Offset_To_Address --
-   ---------------------------
-
-   function Add_Offset_To_Address
-     (Addr   : System.Address;
-      Offset : System.Storage_Elements.Storage_Offset) return System.Address
-   is
-   begin
-      return System.Storage_Elements."+" (Addr, Offset);
-   end Add_Offset_To_Address;
-
-   --------------
-   -- Allocate --
-   --------------
-
-   procedure Allocate
-     (Collection   : in out Finalization_Collection;
-      Addr         : out System.Address;
-      Storage_Size : System.Storage_Elements.Storage_Count;
-      Alignment    : System.Storage_Elements.Storage_Count;
-      Needs_Header : Boolean := True)
-   is
-   begin
-      --  Allocation of an object with controlled parts
-
-      if Needs_Header then
-
-         --  Do not allow the allocation of controlled objects while the
-         --  associated collection is being finalized.
-
-         if Collection.Finalization_Started then
-            raise Program_Error with "allocation after finalization started";
-         end if;
-
-         declare
-            N_Addr : Address;
-            N_Ptr  : Node_Ptr;
-
-         begin
-            --  Use the underlying pool to allocate enough space for the object
-            --  and the list header. The returned address points to the list
-            --  header. If locking is necessary, it will be done by the
-            --  underlying pool.
-
-            Allocate
-              (Collection.Base_Pool.all,
-               N_Addr,
-               Storage_Size + Header_Size,
-               Alignment);
-
-            --  Map the allocated memory into a Node record. This converts the
-            --  top of the allocated bits into a list header.
-
-            N_Ptr := Address_To_Node_Ptr (N_Addr);
-            Attach (N_Ptr, Collection.Objects'Unchecked_Access);
-
-            --  Move the address from Prev to the start of the object. This
-            --  operation effectively hides the list header.
-
-            Addr := N_Addr + Header_Offset;
-         end;
-
-      --  Allocation of a non-controlled object
-
-      else
-         Allocate
-           (Collection.Base_Pool.all,
-            Addr,
-            Storage_Size,
-            Alignment);
-      end if;
-
-      pragma Assert (Addr mod Alignment = 0);
-   end Allocate;
-
-   ------------
-   -- Attach --
-   ------------
-
-   procedure Attach (N : Node_Ptr; L : Node_Ptr) is
-   begin
-      Lock_Task.all;
-
-      L.Next.Prev := N;
-      N.Next := L.Next;
-      L.Next := N;
-      N.Prev := L;
-
-      Unlock_Task.all;
-
-      --  Note: no need to unlock in case of exceptions; the above code cannot
-      --  raise any.
-
-   end Attach;
-
-   ---------------
-   -- Base_Pool --
-   ---------------
-
-   function Base_Pool
-     (Collection : Finalization_Collection) return Any_Storage_Pool_Ptr
-   is
-   begin
-      return Collection.Base_Pool;
-   end Base_Pool;
-
-   ----------------
-   -- Deallocate --
-   ----------------
-
-   procedure Deallocate
-     (Collection   : in out Finalization_Collection;
-      Addr         : System.Address;
-      Storage_Size : System.Storage_Elements.Storage_Count;
-      Alignment    : System.Storage_Elements.Storage_Count;
-      Has_Header   : Boolean := True)
-   is
-      pragma Assert (Addr mod Alignment = 0);
-   begin
-      --  Deallocation of an object with controlled parts
-
-      if Has_Header then
-         declare
-            N_Addr : Address;
-            N_Ptr  : Node_Ptr;
-
-         begin
-            --  Move address from the object to beginning of the list header
-
-            N_Addr := Addr - Header_Offset;
-
-            --  Converts the bits preceding the object into a list header
-
-            N_Ptr := Address_To_Node_Ptr (N_Addr);
-            Detach (N_Ptr);
-
-            --  Use the underlying pool to destroy the object along with the
-            --  list header.
-
-            Deallocate
-              (Collection.Base_Pool.all,
-               N_Addr,
-               Storage_Size + Header_Size,
-               Alignment);
-         end;
-
-      --  Deallocation of a non-controlled object
-
-      else
-         Deallocate
-           (Collection.Base_Pool.all,
-            Addr,
-            Storage_Size,
-            Alignment);
-      end if;
-   end Deallocate;
-
-   ------------
-   -- Detach --
-   ------------
-
-   procedure Detach (N : Node_Ptr) is
-   begin
-      pragma Debug (Fin_Assert (N /= null, "Detach null"));
-
-      Lock_Task.all;
-
-      if N.Next = null then
-         pragma Assert (N.Prev = null);
-
-      else
-         N.Prev.Next := N.Next;
-         N.Next.Prev := N.Prev;
-         N.Next := null;
-         N.Prev := null;
-      end if;
-
-      Unlock_Task.all;
-
-      --  Note: no need to unlock in case of exceptions; the above code cannot
-      --  raise any.
-
-   end Detach;
-
-   --------------
-   -- Finalize --
-   --------------
-
-   overriding procedure Finalize
-     (Collection : in out Finalization_Collection)
-   is
-      Ex_Occur : Exception_Occurrence;
-      Raised   : Boolean := False;
-
-   begin
-      if Debug then
-         Put_Line ("-->Heap_Management: ");
-         pcol (Collection);
-      end if;
-
-      --  Set Finalization_Started to prevent any allocations of objects with
-      --  controlled parts during finalization. The associated access type is
-      --  about to go out of scope; Finalization_Started is never again
-      --  modified.
-
-      if Collection.Finalization_Started then
-
-         --  ???Needed for shared libraries
-
-         return;
-      end if;
-
-      pragma Debug (Fin_Assert (not Collection.Finalization_Started,
-                                "Finalize: already started"));
-      Collection.Finalization_Started := True;
-
-      --  For each object in the Objects list, detach it, and finalize it. Note
-      --  that other tasks can be doing Unchecked_Deallocations at the same
-      --  time, so we need to beware of race conditions.
-
-      while not Is_Empty (Collection.Objects'Unchecked_Access) loop
-
-         declare
-            Node : constant Node_Ptr := Collection.Objects.Next;
-         begin
-            --  Remove the current node from the list first, in case some other
-            --  task is simultaneously doing Unchecked_Deallocation on this
-            --  object. Detach does Lock_Task. Note that we can't Lock_Task
-            --  during Finalize_Address, because finalization can do pretty
-            --  much anything.
-
-            Detach (Node);
-
-            --  ??? Kludge: Don't do anything until the proper place to set
-            --  primitive Finalize_Address has been determined.
-
-            if Collection.Finalize_Address /= null then
-               declare
-                  Object_Address : constant Address :=
-                                     Node.all'Address + Header_Offset;
-                  --  Get address of object from address of header
-
-               begin
-                  Collection.Finalize_Address (Object_Address);
-               exception
-                  when Fin_Except : others =>
-                     if not Raised then
-                        Raised := True;
-                        Save_Occurrence (Ex_Occur, Fin_Except);
-                     end if;
-               end;
-            end if;
-         end;
-      end loop;
-
-      if Debug then
-         Put_Line ("<--Heap_Management: ");
-         pcol (Collection);
-      end if;
-
-      --  If the finalization of a particular node raised an exception, reraise
-      --  it after the remainder of the list has been finalized.
-
-      if Raised then
-         if Debug then
-            Put_Line ("Heap_Management: reraised");
-         end if;
-
-         Reraise_Occurrence (Ex_Occur);
-      end if;
-   end Finalize;
-
-   ----------------
-   -- Initialize --
-   ----------------
-
-   overriding procedure Initialize
-     (Collection : in out Finalization_Collection)
-   is
-   begin
-      --  The dummy head must point to itself in both directions
-
-      Collection.Objects.Next := Collection.Objects'Unchecked_Access;
-      Collection.Objects.Prev := Collection.Objects'Unchecked_Access;
-      pragma Assert (Is_Empty (Collection.Objects'Unchecked_Access));
-   end Initialize;
-
-   --------------
-   -- Is_Empty --
-   --------------
-
-   function Is_Empty (Objects : Node_Ptr) return Boolean is
-   begin
-      pragma Debug
-        (Fin_Assert ((Objects.Next = Objects) = (Objects.Prev = Objects),
-                     "Is_Empty"));
-      return Objects.Next = Objects;
-   end Is_Empty;
-
-   ----------
-   -- pcol --
-   ----------
-
-   procedure pcol (Collection : Finalization_Collection) is
-      Head      : constant Node_Ptr := Collection.Objects'Unrestricted_Access;
-      --  "Unrestricted", because we are getting access-to-variable of a
-      --  constant! Normally worrisome, this is OK for debugging code.
-
-      Head_Seen : Boolean := False;
-      N_Ptr     : Node_Ptr;
-
-   begin
-      --  Output the basic contents of the collection
-
-      --    Collection: 0x123456789
-      --    Base_Pool : null <or> 0x123456789
-      --    Fin_Addr  : null <or> 0x123456789
-      --    Fin_Start : TRUE <or> FALSE
-
-      Put ("Collection: ");
-      Put_Line (Address_Image (Collection'Address));
-
-      Put ("Base_Pool : ");
-
-      if Collection.Base_Pool = null then
-         Put_Line (" null");
-      else
-         Put_Line (Address_Image (Collection.Base_Pool'Address));
-      end if;
-
-      Put ("Fin_Addr  : ");
-
-      if Collection.Finalize_Address = null then
-         Put_Line ("null");
-      else
-         Put_Line (Address_Image (Collection.Finalize_Address'Address));
-      end if;
-
-      Put ("Fin_Start : ");
-      Put_Line (Collection.Finalization_Started'Img);
-
-      --  Output all chained elements. The format is the following:
-
-      --    ^ <or> ? <or> null
-      --    |Header: 0x123456789 (dummy head)
-      --    |  Prev: 0x123456789
-      --    |  Next: 0x123456789
-      --    V
-
-      --  ^ - the current element points back to the correct element
-      --  ? - the current element points back to an erroneous element
-      --  n - the current element points back to null
-
-      --  Header - the address of the list header
-      --  Prev   - the address of the list header which the current element
-      --         - points back to
-      --  Next   - the address of the list header which the current element
-      --         - points to
-      --  (dummy head) - present if dummy head
-
-      N_Ptr := Head;
-      while N_Ptr /= null loop -- Should never be null; we being defensive
-         Put_Line ("V");
-
-         --  We see the head initially; we want to exit when we see the head a
-         --  SECOND time.
-
-         if N_Ptr = Head then
-            exit when Head_Seen;
-
-            Head_Seen := True;
-         end if;
-
-         --  The current element is null. This should never happen since the
-         --  list is circular.
-
-         if N_Ptr.Prev = null then
-            Put_Line ("null (ERROR)");
-
-         --  The current element points back to the correct element
-
-         elsif N_Ptr.Prev.Next = N_Ptr then
-            Put_Line ("^");
-
-         --  The current element points to an erroneous element
-
-         else
-            Put_Line ("? (ERROR)");
-         end if;
-
-         --  Output the header and fields
-
-         Put ("|Header: ");
-         Put (Address_Image (N_Ptr.all'Address));
-
-         --  Detect the dummy head
-
-         if N_Ptr = Head then
-            Put_Line (" (dummy head)");
-         else
-            Put_Line ("");
-         end if;
-
-         Put ("|  Prev: ");
-
-         if N_Ptr.Prev = null then
-            Put_Line ("null");
-         else
-            Put_Line (Address_Image (N_Ptr.Prev.all'Address));
-         end if;
-
-         Put ("|  Next: ");
-
-         if N_Ptr.Next = null then
-            Put_Line ("null");
-         else
-            Put_Line (Address_Image (N_Ptr.Next.all'Address));
-         end if;
-
-         N_Ptr := N_Ptr.Next;
-      end loop;
-   end pcol;
-
-   ------------------------------
-   -- Set_Finalize_Address_Ptr --
-   ------------------------------
-
-   procedure Set_Finalize_Address_Ptr
-     (Collection : in out Finalization_Collection;
-      Proc_Ptr   : Finalize_Address_Ptr)
-   is
-   begin
-      Collection.Finalize_Address := Proc_Ptr;
-   end Set_Finalize_Address_Ptr;
-
-   --------------------------
-   -- Set_Storage_Pool_Ptr --
-   --------------------------
-
-   procedure Set_Storage_Pool_Ptr
-     (Collection : in out Finalization_Collection;
-      Pool_Ptr   : Any_Storage_Pool_Ptr)
-   is
-   begin
-      Collection.Base_Pool := Pool_Ptr;
-   end Set_Storage_Pool_Ptr;
-
-end Ada.Finalization.Heap_Management;
diff --git a/gcc/ada/a-fihema.ads b/gcc/ada/a-fihema.ads
deleted file mode 100644
index e3f412f91e4..00000000000
--- a/gcc/ada/a-fihema.ads
+++ /dev/null
@@ -1,160 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---     A D A . F I N A L I Z A T I O N . H E A P _ M A N A G E M E N T      --
---                                                                          --
---                                S p e c                                   --
---                                                                          --
---          Copyright (C) 2008-2011, 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- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception,   --
--- version 3.1, as published by the Free Software Foundation.               --
---                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
-with System;
-with System.Storage_Elements;
-with System.Storage_Pools;
-
-package Ada.Finalization.Heap_Management is
-
-   --  A reference to any derivation of Root_Storage_Pool. Since this type may
-   --  not be used to allocate objects, its storage size is zero.
-
-   type Any_Storage_Pool_Ptr is
-     access System.Storage_Pools.Root_Storage_Pool'Class;
-   for Any_Storage_Pool_Ptr'Storage_Size use 0;
-
-   --  ??? Comment needed on overall mechanism
-
-   type Finalization_Collection is
-     new Ada.Finalization.Limited_Controlled with private;
-
-   type Finalization_Collection_Ptr is access all Finalization_Collection;
-   for Finalization_Collection_Ptr'Storage_Size use 0;
-
-   --  A reference used to describe primitive Finalize_Address
-
-   type Finalize_Address_Ptr is access procedure (Obj : System.Address);
-
-   --  Since RTSfind cannot contain names of the form RE_"+", the following
-   --  routine serves as a wrapper around System.Storage_Elements."+".
-
-   function Add_Offset_To_Address
-     (Addr   : System.Address;
-      Offset : System.Storage_Elements.Storage_Offset) return System.Address;
-
-   procedure Allocate
-     (Collection   : in out Finalization_Collection;
-      Addr         : out System.Address;
-      Storage_Size : System.Storage_Elements.Storage_Count;
-      Alignment    : System.Storage_Elements.Storage_Count;
-      Needs_Header : Boolean := True);
-   --  Allocate a chunk of memory described by Storage_Size and Alignment on
-   --  Collection's underlying storage pool. Return the address of the chunk.
-   --  The routine creates a list header which precedes the chunk of memory if
-   --  Needs_Header is True. If allocated, the header is attached to the
-   --  Collection's objects. The interface to this routine is provided by
-   --  Build_Allocate_Deallocate_Proc.
-
-   function Base_Pool
-     (Collection : Finalization_Collection) return Any_Storage_Pool_Ptr;
-   --  Return a reference to the underlying storage pool of Collection
-
-   procedure Deallocate
-     (Collection   : in out Finalization_Collection;
-      Addr         : System.Address;
-      Storage_Size : System.Storage_Elements.Storage_Count;
-      Alignment    : System.Storage_Elements.Storage_Count;
-      Has_Header   : Boolean := True);
-   --  Deallocate a chunk of memory described by Storage_Size and Alignment
-   --  from Collection's underlying storage pool. The beginning of the memory
-   --  chunk is designated by Addr. The routine detaches and destroys the
-   --  preceding list header if flag Has_Header is set. The interface to this
-   --  routine is provided by Build_Allocate_Deallocate_Proc.
-
-   overriding procedure Finalize
-     (Collection : in out Finalization_Collection);
-   --  Traverse objects of Collection, invoking Finalize_Address on each one
-
-   overriding procedure Initialize
-     (Collection : in out Finalization_Collection);
-   --  Initialize the finalization list to empty
-
-   procedure Set_Finalize_Address_Ptr
-     (Collection : in out Finalization_Collection;
-      Proc_Ptr   : Finalize_Address_Ptr);
-   --  Set the finalization address routine of a finalization collection
-
-   procedure Set_Storage_Pool_Ptr
-     (Collection : in out Finalization_Collection;
-      Pool_Ptr   : Any_Storage_Pool_Ptr);
-   --  Set the underlying storage pool of a finalization collection
-
-private
-   --  Homogeneous collection types
-
-   type Node;
-   type Node_Ptr is access all Node;
-   pragma No_Strict_Aliasing (Node_Ptr);
-
-   --  The following record type should really be limited, but we can see the
-   --  full view of Limited_Controlled, which is NOT limited. Note that default
-   --  initialization does not happen for this type (the pointers will not be
-   --  automatically set to null), because of the games we're playing with
-   --  address arithmetic.
-
-   type Node is record
-      Prev : Node_Ptr;
-      Next : Node_Ptr;
-   end record;
-
-   type Finalization_Collection is
-     new Ada.Finalization.Limited_Controlled with
-   record
-      Base_Pool : Any_Storage_Pool_Ptr;
-      --  All objects and node headers are allocated on this underlying pool;
-      --  the collection is simply a wrapper around it.
-
-      Objects : aliased Node;
-      --  The head of a doubly linked list containing all allocated objects
-      --  with controlled parts that still exist (Unchecked_Deallocation has
-      --  not been done on them).
-
-      Finalize_Address : Finalize_Address_Ptr;
-      --  A reference to a routine that finalizes an object denoted by its
-      --  address. The collection must be homogeneous since the same routine
-      --  will be invoked for every allocated object when the pool is
-      --  finalized.
-
-      Finalization_Started : Boolean := False;
-      pragma Atomic (Finalization_Started);
-      --  When the finalization of a collection takes place, any allocations of
-      --  objects with controlled or protected parts on the same collection are
-      --  prohibited and the action must raise Program_Error. This needs to be
-      --  atomic, because it is accessed without Lock_Task/Unlock_Task. See
-      --  RM-4.8(10.2/2).
-   end record;
-
-   procedure pcol (Collection : Finalization_Collection);
-   --  Output the contents of a collection in a readable form. Intended for
-   --  debugging purposes.
-
-end Ada.Finalization.Heap_Management;
diff --git a/gcc/ada/a-iteint.ads b/gcc/ada/a-iteint.ads
index 99dd304a4e9..192bdcb430b 100644
--- a/gcc/ada/a-iteint.ads
+++ b/gcc/ada/a-iteint.ads
@@ -6,32 +6,46 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
--- GNAT.  In accordance with the copyright of that document, you can freely --
--- copy and modify this specification,  provided that if you redistribute a --
--- modified version,  any changes that you have made are clearly indicated. --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
 --                                                                          --
 ------------------------------------------------------------------------------
 
 generic
-   type Cursor is private;
-   No_Element : Cursor;
-   pragma Unreferenced (No_Element);
-
+   type Cursor;
+   with function Has_Element (Position : Cursor) return Boolean;
+   pragma Unreferenced (Has_Element);
 package Ada.Iterator_Interfaces is
-   type Forward_Iterator is limited interface;
+   pragma Pure;
 
+   type Forward_Iterator is limited interface;
    function First (Object : Forward_Iterator) return Cursor is abstract;
-
    function Next
-     (Object : Forward_Iterator;
+     (Object   : Forward_Iterator;
       Position : Cursor) return Cursor is abstract;
-
    type Reversible_Iterator is limited interface and Forward_Iterator;
 
    function Last (Object : Reversible_Iterator) return Cursor is abstract;
-
    function Previous
-     (Object : Reversible_Iterator;
+     (Object   : Reversible_Iterator;
       Position : Cursor) return Cursor is abstract;
 end Ada.Iterator_Interfaces;
diff --git a/gcc/ada/a-ngelfu.adb b/gcc/ada/a-ngelfu.adb
index b615f9da957..ae95d66547b 100644
--- a/gcc/ada/a-ngelfu.adb
+++ b/gcc/ada/a-ngelfu.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -914,11 +914,13 @@ package body Ada.Numerics.Generic_Elementary_Functions is
    begin
       if abs X < Sqrt_Epsilon then
          return X;
-
-      elsif abs X = Pi / 2.0 then
-         raise Constraint_Error;
       end if;
 
+      --  Note: if X is exactly pi/2, then we should raise an exception, since
+      --  the result would overflow. But for all floating-point formats we deal
+      --  with, it is impossible for X to be exactly pi/2, and the result is
+      --  always in range.
+
       return Float_Type'Base (Aux.Tan (Double (X)));
    end Tan;
 
diff --git a/gcc/ada/a-ngrear.adb b/gcc/ada/a-ngrear.adb
index 5c8a0092477..8ce8d9a98b0 100644
--- a/gcc/ada/a-ngrear.adb
+++ b/gcc/ada/a-ngrear.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2006-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2006-2011, 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- --
@@ -29,51 +29,151 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  This version of Generic_Real_Arrays avoids the use of BLAS and LAPACK. One
+--  reason for this is new Ada 2012 requirements that prohibit algorithms such
+--  as Strassen's algorithm, which may be used by some BLAS implementations. In
+--  addition, some platforms lacked suitable compilers to compile the reference
+--  BLAS/LAPACK implementation. Finally, on many platforms there may be more
+--  floating point types than supported by BLAS/LAPACK.
+
+with Ada.Containers.Generic_Anonymous_Array_Sort; use Ada.Containers;
+
 with System; use System;
-with System.Generic_Real_BLAS;
-with System.Generic_Real_LAPACK;
 with System.Generic_Array_Operations; use System.Generic_Array_Operations;
 
 package body Ada.Numerics.Generic_Real_Arrays is
 
-   --  Operations involving inner products use BLAS library implementations.
-   --  This allows larger matrices and vectors to be computed efficiently,
-   --  taking into account memory hierarchy issues and vector instructions
-   --  that vary widely between machines.
-
-   --  Operations that are defined in terms of operations on the type Real,
-   --  such as addition, subtraction and scaling, are computed in the canonical
-   --  way looping over all elements.
+   package Ops renames System.Generic_Array_Operations;
 
-   --  Operations for solving linear systems and computing determinant,
-   --  eigenvalues, eigensystem and inverse, are implemented using the
-   --  LAPACK library.
+   function Is_Non_Zero (X : Real'Base) return Boolean is (X /= 0.0);
 
-   package BLAS is
-      new Generic_Real_BLAS (Real'Base, Real_Vector, Real_Matrix);
+   procedure Back_Substitute is new Ops.Back_Substitute
+     (Scalar        => Real'Base,
+      Matrix        => Real_Matrix,
+      Is_Non_Zero   => Is_Non_Zero);
 
-   package LAPACK is
-      new Generic_Real_LAPACK (Real'Base, Real_Vector, Real_Matrix);
+   function Diagonal is new Ops.Diagonal
+     (Scalar       => Real'Base,
+      Vector       => Real_Vector,
+      Matrix       => Real_Matrix);
 
-   use BLAS, LAPACK;
+   procedure Forward_Eliminate is new Ops.Forward_Eliminate
+    (Scalar        => Real'Base,
+     Matrix        => Real_Matrix,
+     Zero          => 0.0,
+     One           => 1.0);
 
-   --  Procedure versions of functions returning unconstrained values.
-   --  This allows for inlining the function wrapper.
+   procedure Swap_Column is new Ops.Swap_Column
+    (Scalar        => Real'Base,
+     Matrix        => Real_Matrix);
 
-   procedure Eigenvalues (A : Real_Matrix; Values : out Real_Vector);
-   procedure Inverse   (A : Real_Matrix; R : out Real_Matrix);
-   procedure Solve     (A : Real_Matrix; X : Real_Vector; B : out Real_Vector);
-   procedure Solve     (A : Real_Matrix; X : Real_Matrix; B : out Real_Matrix);
-
-   procedure Transpose is new
-     Generic_Array_Operations.Transpose
+   procedure Transpose is new  Ops.Transpose
        (Scalar        => Real'Base,
         Matrix        => Real_Matrix);
 
+   function Is_Symmetric (A : Real_Matrix) return Boolean is
+     (Transpose (A) = A);
+   --  Return True iff A is symmetric, see RM G.3.1 (90).
+
+   function Is_Tiny (Value, Compared_To : Real) return Boolean is
+     (abs Compared_To + 100.0 * abs (Value) = abs Compared_To);
+   --  Return True iff the Value is much smaller in magnitude than the least
+   --  significant digit of Compared_To.
+
+   procedure Jacobi
+     (A               : Real_Matrix;
+      Values          : out Real_Vector;
+      Vectors         : out Real_Matrix;
+      Compute_Vectors : Boolean := True);
+   --  Perform Jacobi's eigensystem algorithm on real symmetric matrix A
+
+   function Length is new Square_Matrix_Length (Real'Base, Real_Matrix);
    --  Helper function that raises a Constraint_Error is the argument is
    --  not a square matrix, and otherwise returns its length.
 
-   function Length is new Square_Matrix_Length (Real'Base, Real_Matrix);
+   procedure Rotate (X, Y : in out Real; Sin, Tau : Real);
+   --  Perform a Givens rotation
+
+   procedure Sort_Eigensystem
+     (Values  : in out Real_Vector;
+      Vectors : in out Real_Matrix);
+   --  Sort Values and associated Vectors by decreasing absolute value
+
+   procedure Swap (Left, Right : in out Real);
+   --  Exchange Left and Right
+
+   function Sqrt (X : Real) return Real;
+   --  Sqrt is implemented locally here, in order to avoid dragging in all of
+   --  the elementary functions. Speed of the square root is not a big concern
+   --  here. This also avoids depending on a specific floating point type.
+
+   ------------
+   -- Rotate --
+   ------------
+
+   procedure Rotate (X, Y : in out Real; Sin, Tau : Real) is
+      Old_X : constant Real := X;
+      Old_Y : constant Real := Y;
+   begin
+      X := Old_X - Sin * (Old_Y + Old_X * Tau);
+      Y := Old_Y + Sin * (Old_X - Old_Y * Tau);
+   end Rotate;
+
+   ----------
+   -- Sqrt --
+   ----------
+
+   function Sqrt (X : Real) return Real is
+      Root, Next : Real;
+
+   begin
+      --  Be defensive: any comparisons with NaN values will yield False.
+
+      if not (X > 0.0) then
+         if X = 0.0 then
+            return X;
+         else
+            raise Argument_Error;
+         end if;
+      end if;
+
+      --  Compute an initial estimate based on:
+
+      --     X = M * R**E and Sqrt (X) = Sqrt (M) * R**(E / 2.0),
+
+      --  where M is the mantissa, R is the radix and E the exponent.
+
+      --  By ignoring the mantissa and ignoring the case of an odd
+      --  exponent, we get a final error that is at most R. In other words,
+      --  the result has about a single bit precision.
+
+      Root := Real (Real'Machine_Radix) ** (Real'Exponent (X) / 2);
+
+      --  Because of the poor initial estimate, use the Babylonian method of
+      --  computing the square root, as it is stable for all inputs. Every step
+      --  will roughly double the precision of the result. Just a few steps
+      --  suffice in most cases. Eight iterations should give about 2**8 bits
+      --  of precision.
+
+      for J in 1 .. 8 loop
+         Next := (Root + X / Root) / 2.0;
+         exit when Root = Next;
+         Root := Next;
+      end loop;
+
+      return Root;
+   end Sqrt;
+
+   ----------
+   -- Swap --
+   ----------
+
+   procedure Swap (Left, Right : in out Real) is
+      Temp : constant Real := Left;
+   begin
+      Left := Right;
+      Right := Temp;
+   end Swap;
 
    --  Instantiating the following subprograms directly would lead to
    --  name clashes, so use a local package.
@@ -197,6 +297,45 @@ package body Ada.Numerics.Generic_Real_Arrays is
            Right_Vector  => Real_Vector,
            Matrix        => Real_Matrix);
 
+      function "*" is new
+        Inner_Product
+          (Left_Scalar   => Real'Base,
+           Right_Scalar  => Real'Base,
+           Result_Scalar => Real'Base,
+           Left_Vector   => Real_Vector,
+           Right_Vector  => Real_Vector,
+           Zero          => 0.0);
+
+      function "*" is new
+        Matrix_Vector_Product
+          (Left_Scalar   => Real'Base,
+           Right_Scalar  => Real'Base,
+           Result_Scalar => Real'Base,
+           Matrix        => Real_Matrix,
+           Right_Vector  => Real_Vector,
+           Result_Vector => Real_Vector,
+           Zero          => 0.0);
+
+      function "*" is new
+        Vector_Matrix_Product
+          (Left_Scalar   => Real'Base,
+           Right_Scalar  => Real'Base,
+           Result_Scalar => Real'Base,
+           Left_Vector   => Real_Vector,
+           Matrix        => Real_Matrix,
+           Result_Vector => Real_Vector,
+           Zero          => 0.0);
+
+      function "*" is new
+        Matrix_Matrix_Product
+          (Left_Scalar   => Real'Base,
+           Right_Scalar  => Real'Base,
+           Result_Scalar => Real'Base,
+           Left_Matrix   => Real_Matrix,
+           Right_Matrix  => Real_Matrix,
+           Result_Matrix => Real_Matrix,
+           Zero          => 0.0);
+
       function "/" is new
         Vector_Scalar_Elementwise_Operation
           (Left_Scalar   => Real'Base,
@@ -216,6 +355,13 @@ package body Ada.Numerics.Generic_Real_Arrays is
            Operation     => "/");
 
       function "abs" is new
+        L2_Norm
+          (Scalar        => Real'Base,
+           Vector        => Real_Vector,
+           Inner_Product => "*",
+           Sqrt          => Sqrt);
+
+      function "abs" is new
         Vector_Elementwise_Operation
           (X_Scalar      => Real'Base,
            Result_Scalar => Real'Base,
@@ -252,29 +398,29 @@ package body Ada.Numerics.Generic_Real_Arrays is
    ---------
 
    function "+" (Right : Real_Vector) return Real_Vector
-      renames Instantiations."+";
+     renames Instantiations."+";
 
    function "+" (Right : Real_Matrix) return Real_Matrix
-      renames Instantiations."+";
+     renames Instantiations."+";
 
    function "+" (Left, Right : Real_Vector) return Real_Vector
-      renames Instantiations."+";
+     renames Instantiations."+";
 
    function "+" (Left, Right : Real_Matrix) return Real_Matrix
-      renames Instantiations."+";
+     renames Instantiations."+";
 
    ---------
    -- "-" --
    ---------
 
    function "-" (Right : Real_Vector) return Real_Vector
-      renames Instantiations."-";
+     renames Instantiations."-";
 
    function "-" (Right : Real_Matrix) return Real_Matrix
-      renames Instantiations."-";
+     renames Instantiations."-";
 
    function "-" (Left, Right : Real_Vector) return Real_Vector
-      renames Instantiations."-";
+     renames Instantiations."-";
 
    function "-" (Left, Right : Real_Matrix) return Real_Matrix
       renames Instantiations."-";
@@ -286,157 +432,70 @@ package body Ada.Numerics.Generic_Real_Arrays is
    --  Scalar multiplication
 
    function "*" (Left : Real'Base; Right : Real_Vector) return Real_Vector
-      renames Instantiations."*";
+     renames Instantiations."*";
 
    function "*" (Left : Real_Vector; Right : Real'Base) return Real_Vector
-      renames Instantiations."*";
+     renames Instantiations."*";
 
    function "*" (Left : Real'Base; Right : Real_Matrix) return Real_Matrix
-      renames Instantiations."*";
+     renames Instantiations."*";
 
    function "*" (Left : Real_Matrix; Right : Real'Base) return Real_Matrix
-      renames Instantiations."*";
+     renames Instantiations."*";
 
    --  Vector multiplication
 
-   function "*" (Left, Right : Real_Vector) return Real'Base is
-   begin
-      if Left'Length /= Right'Length then
-         raise Constraint_Error with
-            "vectors are of different length in inner product";
-      end if;
-
-      return dot (Left'Length, X => Left, Y => Right);
-   end "*";
+   function "*" (Left, Right : Real_Vector) return Real'Base
+     renames Instantiations."*";
 
    function "*" (Left, Right : Real_Vector) return Real_Matrix
-      renames Instantiations."*";
-
-   function "*"
-     (Left : Real_Vector;
-      Right : Real_Matrix) return Real_Vector
-   is
-      R : Real_Vector (Right'Range (2));
+     renames Instantiations."*";
 
-   begin
-      if Left'Length /= Right'Length (1) then
-         raise Constraint_Error with
-           "incompatible dimensions in vector-matrix multiplication";
-      end if;
-
-      gemv (Trans => No_Trans'Access,
-            M     => Right'Length (2),
-            N     => Right'Length (1),
-            A     => Right,
-            Ld_A  => Right'Length (2),
-            X     => Left,
-            Y     => R);
+   function "*" (Left : Real_Vector; Right : Real_Matrix) return Real_Vector
+     renames Instantiations."*";
 
-      return R;
-   end "*";
-
-   function "*"
-     (Left : Real_Matrix;
-      Right : Real_Vector) return Real_Vector
-   is
-      R : Real_Vector (Left'Range (1));
-
-   begin
-      if Left'Length (2) /= Right'Length then
-         raise Constraint_Error with
-            "incompatible dimensions in matrix-vector multiplication";
-      end if;
-
-      gemv (Trans => Trans'Access,
-            M     => Left'Length (2),
-            N     => Left'Length (1),
-            A     => Left,
-            Ld_A  => Left'Length (2),
-            X     => Right,
-            Y     => R);
-
-      return R;
-   end "*";
+   function "*" (Left : Real_Matrix; Right : Real_Vector) return Real_Vector
+     renames Instantiations."*";
 
    --  Matrix Multiplication
 
-   function "*" (Left, Right : Real_Matrix) return Real_Matrix is
-      R : Real_Matrix (Left'Range (1), Right'Range (2));
-
-   begin
-      if Left'Length (2) /= Right'Length (1) then
-         raise Constraint_Error with
-            "incompatible dimensions in matrix-matrix multiplication";
-      end if;
-
-      gemm (Trans_A => No_Trans'Access,
-            Trans_B => No_Trans'Access,
-            M       => Right'Length (2),
-            N       => Left'Length (1),
-            K       => Right'Length (1),
-            A       => Right,
-            Ld_A    => Right'Length (2),
-            B       => Left,
-            Ld_B    => Left'Length (2),
-            C       => R,
-            Ld_C    => R'Length (2));
-
-      return R;
-   end "*";
+   function "*" (Left, Right : Real_Matrix) return Real_Matrix
+     renames Instantiations."*";
 
    ---------
    -- "/" --
    ---------
 
    function "/" (Left : Real_Vector; Right : Real'Base) return Real_Vector
-      renames Instantiations."/";
+     renames Instantiations."/";
 
    function "/" (Left : Real_Matrix; Right : Real'Base) return Real_Matrix
-      renames Instantiations."/";
+     renames Instantiations."/";
 
    -----------
    -- "abs" --
    -----------
 
-   function "abs" (Right : Real_Vector) return Real'Base is
-   begin
-      return nrm2 (Right'Length, Right);
-   end "abs";
+   function "abs" (Right : Real_Vector) return Real'Base
+     renames Instantiations."abs";
 
    function "abs" (Right : Real_Vector) return Real_Vector
-      renames Instantiations."abs";
+     renames Instantiations."abs";
 
    function "abs" (Right : Real_Matrix) return Real_Matrix
-      renames Instantiations."abs";
+     renames Instantiations."abs";
 
    -----------------
    -- Determinant --
    -----------------
 
    function Determinant (A : Real_Matrix) return Real'Base is
-      N    : constant Integer := Length (A);
-      LU   : Real_Matrix (1 .. N, 1 .. N) := A;
-      Piv  : Integer_Vector (1 .. N);
-      Info : aliased Integer := -1;
-      Det  : Real := 1.0;
-
+      M : Real_Matrix := A;
+      B : Real_Matrix (A'Range (1), 1 .. 0);
+      R : Real'Base;
    begin
-      getrf (M     => N,
-             N     => N,
-             A     => LU,
-             Ld_A  => N,
-             I_Piv => Piv,
-             Info  => Info'Access);
-
-      if Info /= 0 then
-         raise Constraint_Error with "ill-conditioned matrix";
-      end if;
-
-      for J in 1 .. N loop
-         Det := (if Piv (J) /= J then -Det * LU (J, J) else Det * LU (J, J));
-      end loop;
-
-      return Det;
+      Forward_Eliminate (M, B, R);
+      return R;
    end Determinant;
 
    -----------------
@@ -448,306 +507,317 @@ package body Ada.Numerics.Generic_Real_Arrays is
       Values  : out Real_Vector;
       Vectors : out Real_Matrix)
    is
-      N      : constant Natural := Length (A);
-      Tau    : Real_Vector (1 .. N);
-      L_Work : Real_Vector (1 .. 1);
-      Info   : aliased Integer;
-
-      E : Real_Vector (1 .. N);
-      pragma Warnings (Off, E);
-
    begin
-      if Values'Length /= N then
-         raise Constraint_Error with "wrong length for output vector";
-      end if;
-
-      if N = 0 then
-         return;
-      end if;
-
-      --  Initialize working matrix and check for symmetric input matrix
-
-      Transpose (A, Vectors);
-
-      if A /= Vectors then
-         raise Argument_Error with "matrix not symmetric";
-      end if;
+      Jacobi (A, Values, Vectors, Compute_Vectors => True);
+      Sort_Eigensystem (Values, Vectors);
+   end Eigensystem;
 
-      --  Compute size of additional working space
+   -----------------
+   -- Eigenvalues --
+   -----------------
 
-      sytrd (Uplo   => Lower'Access,
-             N      => N,
-             A      => Vectors,
-             Ld_A   => N,
-             D      => Values,
-             E      => E,
-             Tau    => Tau,
-             Work   => L_Work,
-             L_Work => -1,
-             Info   => Info'Access);
+   function Eigenvalues (A : Real_Matrix) return Real_Vector is
+      Values  : Real_Vector (A'Range (1));
+      Vectors : Real_Matrix (1 .. 0, 1 .. 0);
+   begin
+      Jacobi (A, Values, Vectors, Compute_Vectors => False);
+      Sort_Eigensystem (Values, Vectors);
+      return Values;
+   end Eigenvalues;
 
-      declare
-         Work : Real_Vector (1 .. Integer'Max (Integer (L_Work (1)), 2 * N));
-         pragma Warnings (Off, Work);
+   -------------
+   -- Inverse --
+   -------------
 
-         Comp_Z : aliased constant Character := 'V';
+   function Inverse (A : Real_Matrix) return Real_Matrix is
+     (Solve (A, Unit_Matrix (Length (A))));
 
-      begin
-         --  Reduce matrix to tridiagonal form
-
-         sytrd (Uplo   => Lower'Access,
-                N      => N,
-                A      => Vectors,
-                Ld_A   => A'Length (1),
-                D      => Values,
-                E      => E,
-                Tau    => Tau,
-                Work   => Work,
-                L_Work => Work'Length,
-                Info   => Info'Access);
-
-         if Info /= 0 then
-            raise Program_Error;
-         end if;
+   ------------
+   -- Jacobi --
+   ------------
 
-         --  Generate the real orthogonal matrix determined by sytrd
+   procedure Jacobi
+     (A               : Real_Matrix;
+      Values          : out Real_Vector;
+      Vectors         : out Real_Matrix;
+      Compute_Vectors : Boolean := True)
+   is
+      --  This subprogram uses Carl Gustav Jacob Jacobi's iterative method
+      --  for computing eigenvalues and eigenvectors and is based on
+      --  Rutishauser's implementation.
 
-         orgtr (Uplo   => Lower'Access,
-                N      => N,
-                A      => Vectors,
-                Ld_A   => N,
-                Tau    => Tau,
-                Work   => Work,
-                L_Work => Work'Length,
-                Info   => Info'Access);
+      --  The given real symmetric matrix is transformed iteratively to
+      --  diagonal form through a sequence of appropriately chosen elementary
+      --  orthogonal transformations, called Jacobi rotations here.
 
-         if Info /= 0 then
-            raise Program_Error;
-         end if;
+      --  The Jacobi method produces a systematic decrease of the sum of the
+      --  squares of off-diagonal elements. Convergence to zero is quadratic,
+      --  both for this implementation, as for the classic method that doesn't
+      --  use row-wise scanning for pivot selection.
 
-         --  Compute all eigenvalues and eigenvectors using QR algorithm
+      --  The numerical stability and accuracy of Jacobi's method make it the
+      --  best choice here, even though for large matrices other methods will
+      --  be significantly more efficient in both time and space.
 
-         steqr (Comp_Z => Comp_Z'Access,
-                N      => N,
-                D      => Values,
-                E      => E,
-                Z      => Vectors,
-                Ld_Z   => N,
-                Work   => Work,
-                Info   => Info'Access);
+      --  While the eigensystem computations are absolutely foolproof for all
+      --  real symmetric matrices, in presence of invalid values, or similar
+      --  exceptional situations it might not. In such cases the results cannot
+      --  be trusted and Constraint_Error is raised.
 
-         if Info /= 0 then
-            raise Constraint_Error with
-               "eigensystem computation failed to converge";
-         end if;
-      end;
-   end Eigensystem;
+      --  Note: this implementation needs temporary storage for 2 * N + N**2
+      --        values of type Real.
 
-   -----------------
-   -- Eigenvalues --
-   -----------------
+      Max_Iterations  : constant := 50;
+      N               : constant Natural := Length (A);
 
-   procedure Eigenvalues
-     (A      : Real_Matrix;
-      Values : out Real_Vector)
-   is
-      N      : constant Natural := Length (A);
-      L_Work : Real_Vector (1 .. 1);
-      Info   : aliased Integer;
+      subtype Square_Matrix is Real_Matrix (1 .. N, 1 .. N);
 
-      B   : Real_Matrix (1 .. N, 1 .. N);
-      Tau : Real_Vector (1 .. N);
-      E   : Real_Vector (1 .. N);
-      pragma Warnings (Off, B);
-      pragma Warnings (Off, Tau);
-      pragma Warnings (Off, E);
+      --  In order to annihilate the M (Row, Col) element, the
+      --  rotation parameters Cos and Sin are computed as
+      --  follows:
 
-   begin
-      if Values'Length /= N then
-         raise Constraint_Error with "wrong length for output vector";
-      end if;
+      --    Theta = Cot (2.0 * Phi)
+      --          = (Diag (Col) - Diag (Row)) / (2.0 * M (Row, Col))
 
-      if N = 0 then
-         return;
-      end if;
+      --  Then Tan (Phi) as the smaller root (in modulus) of
 
-      --  Initialize working matrix and check for symmetric input matrix
+      --    T**2 + 2 * T * Theta = 1 (or 0.5 / Theta, if Theta is large)
 
-      Transpose (A, B);
+      function Compute_Tan (Theta : Real) return Real is
+         (Real'Copy_Sign (1.0 / (abs Theta + Sqrt (1.0 + Theta**2)), Theta));
 
-      if A /= B then
-         raise Argument_Error with "matrix not symmetric";
-      end if;
+      function Compute_Tan (P, H : Real) return Real is
+         (if Is_Tiny (P, Compared_To => H) then P / H
+          else Compute_Tan (Theta => H / (2.0 * P)));
 
-      --  Find size of work area
+      function Sum_Strict_Upper (M : Square_Matrix) return Real;
+      --  Return the sum of all elements in the strict upper triangle of M
 
-      sytrd (Uplo   => Lower'Access,
-             N      => N,
-             A      => B,
-             Ld_A   => N,
-             D      => Values,
-             E      => E,
-             Tau    => Tau,
-             Work   => L_Work,
-             L_Work => -1,
-             Info   => Info'Access);
+      ----------------------
+      -- Sum_Strict_Upper --
+      ----------------------
 
-      declare
-         Work : Real_Vector (1 .. Integer'Min (Integer (L_Work (1)), 4 * N));
-         pragma Warnings (Off, Work);
+      function Sum_Strict_Upper (M : Square_Matrix) return Real is
+         Sum : Real := 0.0;
 
       begin
-         --  Reduce matrix to tridiagonal form
-
-         sytrd (Uplo   => Lower'Access,
-                N      => N,
-                A      => B,
-                Ld_A   => A'Length (1),
-                D      => Values,
-                E      => E,
-                Tau    => Tau,
-                Work   => Work,
-                L_Work => Work'Length,
-                Info   => Info'Access);
-
-         if Info /= 0 then
-            raise Constraint_Error;
-         end if;
-
-         --  Compute all eigenvalues using QR algorithm
-
-         sterf (N      => N,
-                D      => Values,
-                E      => E,
-                Info   => Info'Access);
-
-         if Info /= 0 then
-            raise Constraint_Error with
-               "eigenvalues computation failed to converge";
-         end if;
-      end;
-   end Eigenvalues;
-
-   function Eigenvalues (A : Real_Matrix) return Real_Vector is
-      R : Real_Vector (A'Range (1));
-   begin
-      Eigenvalues (A, R);
-      return R;
-   end Eigenvalues;
-
-   -------------
-   -- Inverse --
-   -------------
-
-   procedure Inverse (A : Real_Matrix; R : out Real_Matrix) is
-      N      : constant Integer := Length (A);
-      Piv    : Integer_Vector (1 .. N);
-      L_Work : Real_Vector (1 .. 1);
-      Info   : aliased Integer := -1;
+         for Row in 1 .. N - 1 loop
+            for Col in Row + 1 .. N loop
+               Sum := Sum + abs M (Row, Col);
+            end loop;
+         end loop;
+
+         return Sum;
+      end Sum_Strict_Upper;
+
+      M         : Square_Matrix := A; --  Work space for solving eigensystem
+      Threshold : Real;
+      Sum       : Real;
+      Diag      : Real_Vector (1 .. N);
+      Diag_Adj  : Real_Vector (1 .. N);
+
+      --  The vector Diag_Adj indicates the amount of change in each value,
+      --  while Diag tracks the value itself and Values holds the values as
+      --  they were at the beginning. As the changes typically will be small
+      --  compared to the absolute value of Diag, at the end of each iteration
+      --  Diag is computed as Diag + Diag_Adj thus avoiding accumulating
+      --  rounding errors. This technique is due to Rutishauser.
 
    begin
-      --  All computations are done using column-major order, but this works
-      --  out fine, because Transpose (Inverse (Transpose (A))) = Inverse (A).
-
-      R := A;
+      if Compute_Vectors
+         and then (Vectors'Length (1) /= N or else Vectors'Length (2) /= N)
+      then
+         raise Constraint_Error with "incompatible matrix dimensions";
 
-      --  Compute LU decomposition
+      elsif Values'Length /= N then
+         raise Constraint_Error with "incompatible vector length";
 
-      getrf (M      => N,
-             N      => N,
-             A      => R,
-             Ld_A   => N,
-             I_Piv  => Piv,
-             Info   => Info'Access);
+      elsif not Is_Symmetric (M) then
+         raise Constraint_Error with "matrix not symmetric";
+      end if;
 
-      if Info /= 0 then
-         raise Constraint_Error with "inverting singular matrix";
+      --  Note: Only the locally declared matrix M and vectors (Diag, Diag_Adj)
+      --        have lower bound equal to 1. The Vectors matrix may have
+      --        different bounds, so take care indexing elements. Assignment
+      --        as a whole is fine as sliding is automatic in that case.
+
+      Vectors := (if not Compute_Vectors then (1 .. 0 => (1 .. 0 => 0.0))
+                  else Unit_Matrix (Vectors'Length (1), Vectors'Length (2)));
+      Values := Diagonal (M);
+
+      Sweep : for Iteration in 1 .. Max_Iterations loop
+
+         --  The first three iterations, perform rotation for any non-zero
+         --  element. After this, rotate only for those that are not much
+         --  smaller than the average off-diagnal element. After the fifth
+         --  iteration, additionally zero out off-diagonal elements that are
+         --  very small compared to elements on the diagonal with the same
+         --  column or row index.
+
+         Sum := Sum_Strict_Upper (M);
+
+         exit Sweep when Sum = 0.0;
+
+         Threshold := (if Iteration < 4 then 0.2 * Sum / Real (N**2) else 0.0);
+
+         --  Iterate over all off-diagonal elements, rotating any that have
+         --  an absolute value that exceeds the threshold.
+
+         Diag := Values;
+         Diag_Adj := (others => 0.0); -- Accumulates adjustments to Diag
+
+         for Row in 1 .. N - 1 loop
+            for Col in Row + 1 .. N loop
+
+               --  If, before the rotation M (Row, Col) is tiny compared to
+               --  Diag (Row) and Diag (Col), rotation is skipped. This is
+               --  meaningful, as it produces no larger error than would be
+               --  produced anyhow if the rotation had been performed.
+               --  Suppress this optimization in the first four sweeps, so
+               --  that this procedure can be used for computing eigenvectors
+               --  of perturbed diagonal matrices.
+
+               if Iteration > 4
+                  and then Is_Tiny (M (Row, Col), Compared_To => Diag (Row))
+                  and then Is_Tiny (M (Row, Col), Compared_To => Diag (Col))
+               then
+                  M (Row, Col) := 0.0;
+
+               elsif abs M (Row, Col) > Threshold then
+                  Perform_Rotation : declare
+                     Tan : constant Real := Compute_Tan (M (Row, Col),
+                                               Diag (Col) - Diag (Row));
+                     Cos : constant Real := 1.0 / Sqrt (1.0 + Tan**2);
+                     Sin : constant Real := Tan * Cos;
+                     Tau : constant Real := Sin / (1.0 + Cos);
+                     Adj : constant Real := Tan * M (Row, Col);
+
+                  begin
+                     Diag_Adj (Row) := Diag_Adj (Row) - Adj;
+                     Diag_Adj (Col) := Diag_Adj (Col) + Adj;
+                     Diag (Row) := Diag (Row) - Adj;
+                     Diag (Col) := Diag (Col) + Adj;
+
+                     M (Row, Col) := 0.0;
+
+                     for J in 1 .. Row - 1 loop        --  1 <= J < Row
+                        Rotate (M (J, Row), M (J, Col), Sin, Tau);
+                     end loop;
+
+                     for J in Row + 1 .. Col - 1 loop  --  Row < J < Col
+                        Rotate (M (Row, J), M (J, Col), Sin, Tau);
+                     end loop;
+
+                     for J in Col + 1 .. N loop        --  Col < J <= N
+                        Rotate (M (Row, J), M (Col, J), Sin, Tau);
+                     end loop;
+
+                     for J in Vectors'Range (1) loop
+                        Rotate (Vectors (J, Row - 1 + Vectors'First (2)),
+                                Vectors (J, Col - 1 + Vectors'First (2)),
+                                Sin, Tau);
+                     end loop;
+                  end Perform_Rotation;
+               end if;
+            end loop;
+         end loop;
+
+         Values := Values + Diag_Adj;
+      end loop Sweep;
+
+      --  All normal matrices with valid values should converge perfectly.
+
+      if Sum /= 0.0 then
+         raise Constraint_Error with "eigensystem solution does not converge";
       end if;
+   end Jacobi;
 
-      --  Determine size of work area
+   -----------
+   -- Solve --
+   -----------
 
-      getri (N      => N,
-             A      => R,
-             Ld_A   => N,
-             I_Piv  => Piv,
-             Work   => L_Work,
-             L_Work => -1,
-             Info   => Info'Access);
+   function Solve (A : Real_Matrix; X : Real_Vector) return Real_Vector is
+      N   : constant Natural := Length (A);
+      MA  : Real_Matrix := A;
+      MX  : Real_Matrix (A'Range (1), 1 .. 1);
+      R   : Real_Vector (A'Range (2));
+      Det : Real'Base;
 
-      if Info /= 0 then
-         raise Constraint_Error;
+   begin
+      if X'Length /= N then
+         raise Constraint_Error with "incompatible vector length";
       end if;
 
-      declare
-         Work : Real_Vector (1 .. Integer (L_Work (1)));
-         pragma Warnings (Off, Work);
+      for J in 0 .. MX'Length (1) - 1 loop
+         MX (MX'First (1) + J, 1) := X (X'First + J);
+      end loop;
 
-      begin
-         --  Compute inverse from LU decomposition
-
-         getri (N      => N,
-                A      => R,
-                Ld_A   => N,
-                I_Piv  => Piv,
-                Work   => Work,
-                L_Work => Work'Length,
-                Info   => Info'Access);
-
-         if Info /= 0 then
-            raise Constraint_Error with "inverting singular matrix";
-         end if;
+      Forward_Eliminate (MA, MX, Det);
+      Back_Substitute (MA, MX);
 
-         --  ??? Should iterate with gerfs, based on implementation advice
-      end;
-   end Inverse;
+      for J in 0 .. R'Length - 1 loop
+         R (R'First + J) := MX (MX'First (1) + J, 1);
+      end loop;
 
-   function Inverse (A : Real_Matrix) return Real_Matrix is
-      R : Real_Matrix (A'Range (2), A'Range (1));
-   begin
-      Inverse (A, R);
       return R;
-   end Inverse;
+   end Solve;
 
-   -----------
-   -- Solve --
-   -----------
+   function Solve (A, X : Real_Matrix) return Real_Matrix is
+      N  : constant Natural := Length (A);
+      MA : Real_Matrix (A'Range (2), A'Range (2));
+      MB : Real_Matrix (A'Range (2), X'Range (2));
+      Det : Real'Base;
 
-   procedure Solve (A : Real_Matrix; X : Real_Vector; B : out Real_Vector) is
    begin
-      if Length (A) /= X'Length then
-         raise Constraint_Error with
-           "incompatible matrix and vector dimensions";
+      if X'Length (1) /= N then
+         raise Constraint_Error with "matrices have unequal number of rows";
       end if;
 
-      --  ??? Should solve directly, is faster and more accurate
+      for J in 0 .. A'Length (1) - 1 loop
+         for K in MA'Range (2) loop
+            MA (MA'First (1) + J, K) := A (A'First (1) + J, K);
+         end loop;
+
+         for K in MB'Range (2) loop
+            MB (MB'First (1) + J, K) := X (X'First (1) + J, K);
+         end loop;
+      end loop;
+
+      Forward_Eliminate (MA, MB, Det);
+      Back_Substitute (MA, MB);
 
-      B := Inverse (A) * X;
+      return MB;
    end Solve;
 
-   procedure Solve (A : Real_Matrix; X : Real_Matrix; B : out Real_Matrix) is
-   begin
-      if Length (A) /= X'Length (1) then
-         raise Constraint_Error with "incompatible matrix dimensions";
-      end if;
+   ----------------------
+   -- Sort_Eigensystem --
+   ----------------------
 
-      --  ??? Should solve directly, is faster and more accurate
+   procedure Sort_Eigensystem
+     (Values  : in out Real_Vector;
+      Vectors : in out Real_Matrix)
+   is
+      procedure Swap (Left, Right : Integer);
+      --  Swap Values (Left) with Values (Right), and also swap the
+      --  corresponding eigenvectors. Note that lowerbounds may differ.
 
-      B := Inverse (A) * X;
-   end Solve;
+      function Less (Left, Right : Integer) return Boolean is
+        (Values (Left) > Values (Right));
+      --  Sort by decreasing eigenvalue, see RM G.3.1 (76).
 
-   function Solve (A : Real_Matrix; X : Real_Vector) return Real_Vector is
-      B : Real_Vector (A'Range (2));
-   begin
-      Solve (A, X, B);
-      return B;
-   end Solve;
+      procedure Sort is new Generic_Anonymous_Array_Sort (Integer);
+      --  Sorts eigenvalues and eigenvectors by decreasing value
+
+      procedure Swap (Left, Right : Integer) is
+      begin
+         Swap (Values (Left), Values (Right));
+         Swap_Column (Vectors, Left - Values'First + Vectors'First (2),
+                               Right - Values'First + Vectors'First (2));
+      end Swap;
 
-   function Solve (A, X : Real_Matrix) return Real_Matrix is
-      B : Real_Matrix (A'Range (2), X'Range (2));
    begin
-      Solve (A, X, B);
-      return B;
-   end Solve;
+      Sort (Values'First, Values'Last);
+   end Sort_Eigensystem;
 
    ---------------
    -- Transpose --
@@ -757,7 +827,6 @@ package body Ada.Numerics.Generic_Real_Arrays is
       R : Real_Matrix (X'Range (2), X'Range (1));
    begin
       Transpose (X, R);
-
       return R;
    end Transpose;
 
diff --git a/gcc/ada/a-rttiev.adb b/gcc/ada/a-rttiev.adb
index 1c1fe859dd5..67b81c72ba8 100644
--- a/gcc/ada/a-rttiev.adb
+++ b/gcc/ada/a-rttiev.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2005-2010, Free Software Foundation, Inc.        --
+--           Copyright (C) 2005-2011, 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- --
@@ -281,12 +281,15 @@ package body Ada.Real_Time.Timing_Events is
       Remove_From_Queue (Event'Unchecked_Access);
       Event.Handler := null;
 
-      --  RM D.15(15/2) requires that at this point, we check whether the time
+      --  RM D.15(15/2) required that at this point, we check whether the time
       --  has already passed, and if so, call Handler.all directly from here
-      --  instead of doing the enqueuing below. However, this causes a nasty
+      --  instead of doing the enqueuing below. However, this caused a nasty
       --  race condition and potential deadlock. If the current task has
       --  already locked the protected object of Handler.all, and the time has
-      --  passed, deadlock would occur. Therefore, we ignore the requirement.
+      --  passed, deadlock would occur. It has been fixed by AI05-0094-1, which
+      --  says that the handler should be executed as soon as possible, meaning
+      --  that the timing event will be executed after the protected action
+      --  finishes (Handler.all should not be called directly from here).
       --  The same comment applies to the other Set_Handler below.
 
       if Handler /= null then
diff --git a/gcc/ada/a-strunb.ads b/gcc/ada/a-strunb.ads
index af063f0c9d2..334146665ae 100644
--- a/gcc/ada/a-strunb.ads
+++ b/gcc/ada/a-strunb.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -433,5 +433,5 @@ private
    Null_Unbounded_String : constant Unbounded_String :=
                              (AF.Controlled with
                                 Reference => Null_String'Access,
-                                Last => 0);
+                                Last      => 0);
 end Ada.Strings.Unbounded;
diff --git a/gcc/ada/a-synbar-posix.adb b/gcc/ada/a-synbar-posix.adb
new file mode 100644
index 00000000000..73dc9fa2008
--- /dev/null
+++ b/gcc/ada/a-synbar-posix.adb
@@ -0,0 +1,109 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--             A D A . S Y N C H R O N O U S _ B A R R I E R S              --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the body of this package using POSIX barriers
+
+with Interfaces.C; use Interfaces.C;
+
+package body Ada.Synchronous_Barriers is
+
+   --------------------
+   -- POSIX barriers --
+   --------------------
+
+   function pthread_barrier_init
+     (barrier : not null access pthread_barrier_t;
+      attr    : System.Address := System.Null_Address;
+      count   : unsigned) return int;
+   pragma Import (C, pthread_barrier_init, "pthread_barrier_init");
+   --  Initialize barrier with the attributes in attr. The barrier is opened
+   --  when count waiters arrived. If attr is null the default barrier
+   --  attributes shall be used.
+
+   function pthread_barrier_destroy
+     (barrier : not null access pthread_barrier_t) return int;
+   pragma Import (C, pthread_barrier_destroy, "pthread_barrier_destroy");
+   --  Destroy a previously dynamically initialized barrier
+
+   function pthread_barrier_wait
+     (barrier : not null access pthread_barrier_t) return int;
+   pragma Import (C, pthread_barrier_wait, "pthread_barrier_wait");
+   --  Wait on barrier
+
+   --------------
+   -- Finalize --
+   --------------
+
+   overriding procedure Finalize (Barrier : in out Synchronous_Barrier) is
+      Result : int;
+   begin
+      Result := pthread_barrier_destroy (Barrier.POSIX_Barrier'Access);
+      pragma Assert (Result = 0);
+   end Finalize;
+
+   overriding procedure Initialize (Barrier : in out Synchronous_Barrier) is
+      Result : int;
+   begin
+      Result := pthread_barrier_init
+        (barrier => Barrier.POSIX_Barrier'Access,
+         attr    => System.Null_Address,
+         count   => unsigned (Barrier.Release_Threshold));
+      pragma Assert (Result = 0);
+   end Initialize;
+
+   ----------------------
+   -- Wait_For_Release --
+   ----------------------
+
+   procedure Wait_For_Release
+     (The_Barrier : in out Synchronous_Barrier;
+      Notified    : out Boolean)
+   is
+      Result : int;
+
+      PTHREAD_BARRIER_SERIAL_THREAD : constant := -1;
+      --  Value used to indicate the task which receives the notification for
+      --  the barrier open.
+
+   begin
+      Result := pthread_barrier_wait
+        (barrier => The_Barrier.POSIX_Barrier'Access);
+      pragma Assert
+        (Result = 0 or else Result = PTHREAD_BARRIER_SERIAL_THREAD);
+
+      Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD);
+   end Wait_For_Release;
+
+end Ada.Synchronous_Barriers;
diff --git a/gcc/ada/a-synbar-posix.ads b/gcc/ada/a-synbar-posix.ads
new file mode 100644
index 00000000000..4c01852b0e6
--- /dev/null
+++ b/gcc/ada/a-synbar-posix.ads
@@ -0,0 +1,84 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--             A D A . S Y N C H R O N O U S _ B A R R I E R S              --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the spec of this package using POSIX barriers
+
+with System;
+private with Ada.Finalization;
+private with Interfaces.C;
+
+package Ada.Synchronous_Barriers is
+   pragma Preelaborate (Synchronous_Barriers);
+
+   subtype Barrier_Limit is Positive range 1 .. Positive'Last;
+
+   type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
+      limited private;
+
+   procedure Wait_For_Release
+     (The_Barrier : in out Synchronous_Barrier;
+      Notified    : out Boolean);
+
+private
+   --  POSIX barrier data type
+
+   SIZEOF_PTHREAD_BARRIER_T : constant :=
+     (if System.Word_Size = 64 then 32 else 20);
+   --  Value defined according to the linux definition in pthreadtypes.h. On
+   --  other system, e.g. MIPS IRIX, the object is smaller, so it works
+   --  correctly although we are wasting some space.
+
+   type pthread_barrier_t_view is (size_based, align_based);
+
+   type pthread_barrier_t (Kind : pthread_barrier_t_view := size_based) is
+      record
+         case Kind is
+            when size_based =>
+               size : Interfaces.C.char_array (1 .. SIZEOF_PTHREAD_BARRIER_T);
+            when align_based =>
+               align : Interfaces.C.long;
+         end case;
+      end record;
+   pragma Unchecked_Union (pthread_barrier_t);
+
+   type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
+     new Ada.Finalization.Limited_Controlled with
+        record
+           POSIX_Barrier : aliased pthread_barrier_t;
+        end record;
+
+   overriding procedure Initialize (Barrier : in out Synchronous_Barrier);
+   overriding procedure Finalize   (Barrier : in out Synchronous_Barrier);
+end Ada.Synchronous_Barriers;
diff --git a/gcc/ada/a-synbar.adb b/gcc/ada/a-synbar.adb
new file mode 100644
index 00000000000..33bb3e478c7
--- /dev/null
+++ b/gcc/ada/a-synbar.adb
@@ -0,0 +1,78 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--             A D A . S Y N C H R O N O U S _ B A R R I E R S              --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body Ada.Synchronous_Barriers is
+
+   protected body Synchronous_Barrier is
+
+      --  The condition "Wait'Count = Release_Threshold" opens the barrier when
+      --  the required number of tasks is reached. The condition "Keep_Open"
+      --  leaves the barrier open while there are queued tasks. While there are
+      --  tasks in the queue no new task will be queued (no new protected
+      --  action can be started on a protected object while another protected
+      --  action on the same protected object is underway, RM 9.5.1 (4)),
+      --  guaranteeing that the barrier will remain open only for those tasks
+      --  already inside the queue when the barrier was open.
+
+      entry Wait (Notified : out Boolean)
+        when Keep_Open or else Wait'Count = Release_Threshold
+      is
+      begin
+         --  If we are executing the entry it means that the required number of
+         --  tasks have been queued in the entry. Keep_Open barrier will remain
+         --  true until all queued tasks are out.
+
+         Keep_Open := Wait'Count > 0;
+
+         --  The last released task will close the barrier and get the Notified
+         --  token.
+
+         Notified := Wait'Count = 0;
+      end Wait;
+   end Synchronous_Barrier;
+
+   ----------------------
+   -- Wait_For_Release --
+   ----------------------
+
+   procedure Wait_For_Release
+     (The_Barrier : in out Synchronous_Barrier;
+      Notified    : out Boolean)
+   is
+   begin
+      The_Barrier.Wait (Notified);
+   end Wait_For_Release;
+
+end Ada.Synchronous_Barriers;
diff --git a/gcc/ada/a-synbar.ads b/gcc/ada/a-synbar.ads
new file mode 100644
index 00000000000..6c084c23f43
--- /dev/null
+++ b/gcc/ada/a-synbar.ads
@@ -0,0 +1,54 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--             A D A . S Y N C H R O N O U S _ B A R R I E R S              --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package Ada.Synchronous_Barriers is
+   pragma Preelaborate (Synchronous_Barriers);
+
+   subtype Barrier_Limit is Positive range 1 .. Positive'Last;
+
+   type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
+      limited private;
+
+   procedure Wait_For_Release
+     (The_Barrier : in out Synchronous_Barrier;
+      Notified    : out Boolean);
+
+private
+   protected type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is
+      entry Wait (Notified : out Boolean);
+   private
+      Keep_Open : Boolean := False;
+   end Synchronous_Barrier;
+end Ada.Synchronous_Barriers;
diff --git a/gcc/ada/a-undesu.adb b/gcc/ada/a-undesu.adb
new file mode 100644
index 00000000000..d2bd292e145
--- /dev/null
+++ b/gcc/ada/a-undesu.adb
@@ -0,0 +1,43 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--     A D A . U N C H E C K E D _ D E A L L O C A T E _ S U B P O O L      --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Storage_Pools.Subpools,
+     System.Storage_Pools.Subpools.Finalization;
+
+use System.Storage_Pools.Subpools,
+    System.Storage_Pools.Subpools.Finalization;
+
+procedure Ada.Unchecked_Deallocate_Subpool
+  (Subpool : in out System.Storage_Pools.Subpools.Subpool_Handle)
+is
+begin
+   Finalize_And_Deallocate (Subpool);
+end Ada.Unchecked_Deallocate_Subpool;
diff --git a/gcc/ada/a-undesu.ads b/gcc/ada/a-undesu.ads
new file mode 100644
index 00000000000..666572530dd
--- /dev/null
+++ b/gcc/ada/a-undesu.ads
@@ -0,0 +1,19 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--     A D A . U N C H E C K E D _ D E A L L O C A T E _ S U B P O O L      --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System.Storage_Pools.Subpools;
+
+procedure Ada.Unchecked_Deallocate_Subpool
+  (Subpool : in out System.Storage_Pools.Subpools.Subpool_Handle);
diff --git a/gcc/ada/alfa.ads b/gcc/ada/alfa.ads
index 39bddabf29d..3c45c14dedc 100644
--- a/gcc/ada/alfa.ads
+++ b/gcc/ada/alfa.ads
@@ -175,6 +175,11 @@ package ALFA is
    --        r = reference
    --        s = subprogram reference in a static call
 
+   --  Special entries for reads and writes to memory reference a special
+   --  variable called "HEAP". These special entries are present in every scope
+   --  where reads and writes to memory are present. Line and column for this
+   --  special variable are always 0.
+
    --    Examples: ??? add examples here
 
    ----------------
@@ -327,6 +332,14 @@ package ALFA is
      Table_Initial        => 20,
      Table_Increment      => 200);
 
+   ---------------
+   -- Constants --
+   ---------------
+
+   Name_Of_Heap_Variable : constant String := "HEAP";
+   --  Name of special variable used in effects to denote reads and writes
+   --  through explicit dereference.
+
    -----------------
    -- Subprograms --
    -----------------
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 74d17c7cea7..f2159db7291 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -30,6 +30,7 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Einfo;    use Einfo;
 with Nlists;   use Nlists;
 with Sinfo;    use Sinfo;
 with Tree_IO;  use Tree_IO;
@@ -118,6 +119,32 @@ package body Aspects is
       return Aspect_Id_Hash_Table.Get (Name);
    end Get_Aspect_Id;
 
+   -----------------
+   -- Find_Aspect --
+   -----------------
+
+   function Find_Aspect (Ent : Entity_Id; A : Aspect_Id) return Node_Id is
+      Ritem : Node_Id;
+
+   begin
+      Ritem := First_Rep_Item (Ent);
+      while Present (Ritem) loop
+         if Nkind (Ritem) = N_Aspect_Specification
+           and then Get_Aspect_Id (Chars (Identifier (Ritem))) = A
+         then
+            if A = Aspect_Default_Iterator then
+               return Expression (Aspect_Rep_Item (Ritem));
+            else
+               return Expression (Ritem);
+            end if;
+         end if;
+
+         Next_Rep_Item (Ritem);
+      end loop;
+
+      return Empty;
+   end Find_Aspect;
+
    ------------------
    -- Move_Aspects --
    ------------------
@@ -185,8 +212,10 @@ package body Aspects is
     Aspect_Ada_2012                     => Aspect_Ada_2005,
     Aspect_Address                      => Aspect_Address,
     Aspect_Alignment                    => Aspect_Alignment,
+    Aspect_Asynchronous                 => Aspect_Asynchronous,
     Aspect_Atomic                       => Aspect_Atomic,
     Aspect_Atomic_Components            => Aspect_Atomic_Components,
+    Aspect_Attach_Handler               => Aspect_Attach_Handler,
     Aspect_Bit_Order                    => Aspect_Bit_Order,
     Aspect_Component_Size               => Aspect_Component_Size,
     Aspect_Constant_Indexing            => Aspect_Constant_Indexing,
@@ -198,8 +227,12 @@ package body Aspects is
     Aspect_External_Tag                 => Aspect_External_Tag,
     Aspect_Favor_Top_Level              => Aspect_Favor_Top_Level,
     Aspect_Implicit_Dereference         => Aspect_Implicit_Dereference,
+    Aspect_Independent                  => Aspect_Independent,
+    Aspect_Independent_Components       => Aspect_Independent_Components,
     Aspect_Inline                       => Aspect_Inline,
     Aspect_Inline_Always                => Aspect_Inline,
+    Aspect_Interrupt_Handler            => Aspect_Interrupt_Handler,
+    Aspect_Interrupt_Priority           => Aspect_Interrupt_Priority,
     Aspect_Iterator_Element             => Aspect_Iterator_Element,
     Aspect_All_Calls_Remote             => Aspect_All_Calls_Remote,
     Aspect_Compiler_Unit                => Aspect_Compiler_Unit,
@@ -226,10 +259,12 @@ package body Aspects is
     Aspect_Precondition                 => Aspect_Pre,
     Aspect_Predicate                    => Aspect_Predicate,
     Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
+    Aspect_Priority                     => Aspect_Priority,
     Aspect_Pure_Function                => Aspect_Pure_Function,
     Aspect_Read                         => Aspect_Read,
     Aspect_Shared                       => Aspect_Atomic,
     Aspect_Size                         => Aspect_Size,
+    Aspect_Small                        => Aspect_Small,
     Aspect_Static_Predicate             => Aspect_Predicate,
     Aspect_Storage_Pool                 => Aspect_Storage_Pool,
     Aspect_Storage_Size                 => Aspect_Storage_Size,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index af4448f3ce9..ecf74ba4d20 100755
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -46,6 +46,7 @@ package Aspects is
      (No_Aspect,                            -- Dummy entry for no aspect
       Aspect_Address,
       Aspect_Alignment,
+      Aspect_Attach_Handler,
       Aspect_Bit_Order,
       Aspect_Component_Size,
       Aspect_Constant_Indexing,
@@ -56,6 +57,7 @@ package Aspects is
       Aspect_External_Tag,
       Aspect_Implicit_Dereference,
       Aspect_Input,
+      Aspect_Interrupt_Priority,
       Aspect_Invariant,
       Aspect_Iterator_Element,
       Aspect_Machine_Radix,
@@ -66,8 +68,10 @@ package Aspects is
       Aspect_Pre,
       Aspect_Precondition,
       Aspect_Predicate,                     -- GNAT
+      Aspect_Priority,
       Aspect_Read,
       Aspect_Size,
+      Aspect_Small,
       Aspect_Static_Predicate,
       Aspect_Storage_Pool,
       Aspect_Storage_Size,
@@ -104,12 +108,16 @@ package Aspects is
 
       Aspect_Ada_2005,                      -- GNAT
       Aspect_Ada_2012,                      -- GNAT
+      Aspect_Asynchronous,
       Aspect_Atomic,
       Aspect_Atomic_Components,
       Aspect_Discard_Names,
       Aspect_Favor_Top_Level,               -- GNAT
+      Aspect_Independent,
+      Aspect_Independent_Components,
       Aspect_Inline,
       Aspect_Inline_Always,                 -- GNAT
+      Aspect_Interrupt_Handler,
       Aspect_No_Return,
       Aspect_Pack,
       Aspect_Persistent_BSS,                -- GNAT
@@ -166,7 +174,7 @@ package Aspects is
 
    type Aspect_Expression is
      (Optional,               -- Optional boolean expression
-      Expression,             -- Required non-boolean expression
+      Expression,             -- Required expression
       Name);                  -- Required name
 
    --  The following array indicates what argument type is required
@@ -175,6 +183,7 @@ package Aspects is
                        (No_Aspect                      => Optional,
                         Aspect_Address                 => Expression,
                         Aspect_Alignment               => Expression,
+                        Aspect_Attach_Handler          => Expression,
                         Aspect_Bit_Order               => Expression,
                         Aspect_Component_Size          => Expression,
                         Aspect_Constant_Indexing       => Name,
@@ -185,6 +194,7 @@ package Aspects is
                         Aspect_External_Tag            => Expression,
                         Aspect_Implicit_Dereference    => Name,
                         Aspect_Input                   => Name,
+                        Aspect_Interrupt_Priority      => Expression,
                         Aspect_Invariant               => Expression,
                         Aspect_Iterator_Element        => Name,
                         Aspect_Machine_Radix           => Expression,
@@ -195,8 +205,10 @@ package Aspects is
                         Aspect_Pre                     => Expression,
                         Aspect_Precondition            => Expression,
                         Aspect_Predicate               => Expression,
+                        Aspect_Priority                => Expression,
                         Aspect_Read                    => Name,
                         Aspect_Size                    => Expression,
+                        Aspect_Small                   => Expression,
                         Aspect_Static_Predicate        => Expression,
                         Aspect_Storage_Pool            => Name,
                         Aspect_Storage_Size            => Expression,
@@ -226,8 +238,10 @@ package Aspects is
      Aspect_Address                      => Name_Address,
      Aspect_Alignment                    => Name_Alignment,
      Aspect_All_Calls_Remote             => Name_All_Calls_Remote,
+     Aspect_Asynchronous                 => Name_Asynchronous,
      Aspect_Atomic                       => Name_Atomic,
      Aspect_Atomic_Components            => Name_Atomic_Components,
+     Aspect_Attach_Handler               => Name_Attach_Handler,
      Aspect_Bit_Order                    => Name_Bit_Order,
      Aspect_Compiler_Unit                => Name_Compiler_Unit,
      Aspect_Component_Size               => Name_Component_Size,
@@ -241,9 +255,13 @@ package Aspects is
      Aspect_External_Tag                 => Name_External_Tag,
      Aspect_Favor_Top_Level              => Name_Favor_Top_Level,
      Aspect_Implicit_Dereference         => Name_Implicit_Dereference,
+     Aspect_Independent                  => Name_Independent,
+     Aspect_Independent_Components       => Name_Independent_Components,
      Aspect_Inline                       => Name_Inline,
      Aspect_Inline_Always                => Name_Inline_Always,
      Aspect_Input                        => Name_Input,
+     Aspect_Interrupt_Handler            => Name_Interrupt_Handler,
+     Aspect_Interrupt_Priority           => Name_Interrupt_Priority,
      Aspect_Invariant                    => Name_Invariant,
      Aspect_Iterator_Element             => Name_Iterator_Element,
      Aspect_Machine_Radix                => Name_Machine_Radix,
@@ -260,6 +278,7 @@ package Aspects is
      Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization,
      Aspect_Preelaborate                 => Name_Preelaborate,
      Aspect_Preelaborate_05              => Name_Preelaborate_05,
+     Aspect_Priority                     => Name_Priority,
      Aspect_Pure                         => Name_Pure,
      Aspect_Pure_05                      => Name_Pure_05,
      Aspect_Pure_Function                => Name_Pure_Function,
@@ -269,6 +288,7 @@ package Aspects is
      Aspect_Shared                       => Name_Shared,
      Aspect_Shared_Passive               => Name_Shared_Passive,
      Aspect_Size                         => Name_Size,
+     Aspect_Small                        => Name_Small,
      Aspect_Static_Predicate             => Name_Static_Predicate,
      Aspect_Storage_Pool                 => Name_Storage_Pool,
      Aspect_Storage_Size                 => Name_Storage_Size,
@@ -339,6 +359,9 @@ package Aspects is
    --  node that has its Has_Aspects flag set True on entry, or with L being an
    --  empty list or No_List.
 
+   function Find_Aspect (Ent : Entity_Id; A : Aspect_Id) return Node_Id;
+   --  Find value of a given aspect from aspect list of entity
+
    procedure Move_Aspects (From : Node_Id; To : Node_Id);
    --  Moves aspects from 'From' node to 'To' node. Has_Aspects (To) must be
    --  False on entry. If Has_Aspects (From) is False, the call has no effect.
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 0df415d859f..17c6814fb90 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -646,6 +646,24 @@ package body Atree is
    end Copy_Node;
 
    ------------------------
+   -- Copy_Separate_List --
+   ------------------------
+
+   function Copy_Separate_List (Source : List_Id) return List_Id is
+      Result : constant List_Id := New_List;
+      Nod    : Node_Id;
+
+   begin
+      Nod := First (Source);
+      while Present (Nod) loop
+         Append (Copy_Separate_Tree (Nod), Result);
+         Next (Nod);
+      end loop;
+
+      return Result;
+   end Copy_Separate_List;
+
+   ------------------------
    -- Copy_Separate_Tree --
    ------------------------
 
@@ -766,8 +784,8 @@ package body Atree is
          Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id)));
          Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id)));
 
-         --  Set Entity field to Empty
-         --  Why is this done??? and why is it always right to do it???
+         --  Set Entity field to Empty to ensure that no entity references
+         --  are shared between the two, if the source is already analyzed.
 
          if Nkind (New_Id) in N_Has_Entity
            or else Nkind (New_Id) = N_Freeze_Entity
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 6538a19cf6c..4e20b0b0f00 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -435,10 +435,15 @@ package Atree is
    --  whose parent field references a copied node (descendants not linked to
    --  a copied node by the parent field are also copied.) The parent pointers
    --  in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns
-   --  Empty/Error. The semantic fields are not copied and the new subtree
-   --  does not share any entity with source subtree.
-   --  But the code *does* copy semantic fields, and the description above
-   --  is in any case unclear on this point ??? (RBKD)
+   --  Empty/Error. The new subtree does not share entities with the source,
+   --  but has new entities with the same name. Most of the time this routine
+   --  is called on an unanalyzed tree, and no semantic information is copied.
+   --  However, to ensure that no entities are shared between the two when the
+   --  source is already analyzed, entity fields in the copy are zeroed out.
+
+   function Copy_Separate_List (Source : List_Id) return List_Id;
+   --  Applies Copy_Separate_Tree to each element of the Source list, returning
+   --  a new list of the results of these copy operations.
 
    procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id);
    --  Exchange the contents of two entities. The parent pointers are switched
@@ -449,16 +454,15 @@ package Atree is
    --  two entities may be list members.
 
    function Extend_Node (Node : Node_Id) return Entity_Id;
-   --  This function returns a copy of its input node with an extension
-   --  added. The fields of the extension are set to Empty. Due to the way
-   --  extensions are handled (as four consecutive array elements), it may
-   --  be necessary to reallocate the node, so that the returned value is
-   --  not the same as the input value, but where possible the returned
-   --  value will be the same as the input value (i.e. the extension will
-   --  occur in place). It is the caller's responsibility to ensure that
-   --  any pointers to the original node are appropriately updated. This
-   --  function is used only by Sinfo.CN to change nodes into their
-   --  corresponding entities.
+   --  This function returns a copy of its input node with an extension added.
+   --  The fields of the extension are set to Empty. Due to the way extensions
+   --  are handled (as four consecutive array elements), it may be necessary
+   --  to reallocate the node, so that the returned value is not the same as
+   --  the input value, but where possible the returned value will be the same
+   --  as the input value (i.e. the extension will occur in place). It is the
+   --  caller's responsibility to ensure that any pointers to the original node
+   --  are appropriately updated. This function is used only by Sinfo.CN to
+   --  change nodes into their corresponding entities.
 
    type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);
 
@@ -475,7 +479,7 @@ package Atree is
    --  the results of Process calls. See below for details.
 
    generic
-     with function Process (N : Node_Id) return Traverse_Result is <>;
+      with function Process (N : Node_Id) return Traverse_Result is <>;
    function Traverse_Func (Node : Node_Id) return Traverse_Final_Result;
    --  This is a generic function that, given the parent node for a subtree,
    --  traverses all syntactic nodes of this tree, calling the given function
@@ -501,7 +505,7 @@ package Atree is
    --  all calls to process returned either OK, OK_Orig, or Skip).
 
    generic
-     with function Process (N : Node_Id) return Traverse_Result is <>;
+      with function Process (N : Node_Id) return Traverse_Result is <>;
    procedure Traverse_Proc (Node : Node_Id);
    pragma Inline (Traverse_Proc);
    --  This is the same as Traverse_Func except that no result is returned,
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 78c077cc11f..2a161fad534 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -984,7 +984,16 @@ package body Bindgen is
 
             --  Case of no elaboration code
 
-            elsif U.No_Elab then
+            --  In CodePeer mode, we special case subprogram bodies which
+            --  are handled in the 'else' part below, and lead to a call to
+            --  <subp>'Elab_Subp_Body.
+
+            elsif U.No_Elab
+              and then (not CodePeer_Mode
+                         or else U.Utype = Is_Spec
+                         or else U.Utype = Is_Spec_Only
+                         or else U.Unit_Kind /= 's')
+            then
 
                --  The only case in which we have to do something is if this
                --  is a body, with a separate spec, where the separate spec
@@ -1019,10 +1028,10 @@ package body Bindgen is
             --  The uname_E increment is skipped if this is a separate spec,
             --  since it will be done when we process the body.
 
-            --  Ignore subprograms in CodePeer mode, since no useful
-            --  elaboration subprogram is needed by CodePeer.
+            --  In CodePeer mode, we do not generate any reference to xxx_E
+            --  variables, only calls to 'Elab* subprograms.
 
-            elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then
+            else
                Check_Elab_Flag :=
                  not CodePeer_Mode
                    and then (Force_Checking_Of_Elaboration_Flags
@@ -1055,12 +1064,22 @@ package body Bindgen is
                   if Name_Buffer (Name_Len) = 's' then
                      Name_Buffer (Name_Len - 1 .. Name_Len + 8) :=
                        "'elab_spec";
+                     Name_Len := Name_Len + 8;
+
+                  --  Special case in CodePeer mode for subprogram bodies
+                  --  which correspond to CodePeer 'Elab_Subp_Body special
+                  --  init procedure.
+
+                  elsif U.Unit_Kind = 's' and CodePeer_Mode then
+                     Name_Buffer (Name_Len - 1 .. Name_Len + 13) :=
+                       "'elab_subp_body";
+                     Name_Len := Name_Len + 13;
+
                   else
                      Name_Buffer (Name_Len - 1 .. Name_Len + 8) :=
                        "'elab_body";
+                     Name_Len := Name_Len + 8;
                   end if;
-
-                  Name_Len := Name_Len + 8;
                end if;
 
                Set_Casing (U.Icasing);
@@ -1436,9 +1455,8 @@ package body Bindgen is
             Write_Statement_Buffer;
 
             Set_String ("            procedure Raise_From_Controlled_");
-            Set_String ("Operation ");
-            Set_String ("(X : Ada.Exceptions.Exception_Occurrence; ");
-            Set_String (" From_Abort : Boolean);");
+            Set_String ("Operation (X : Ada.Exceptions.Exception_");
+            Set_String ("Occurrence);");
             Write_Statement_Buffer;
 
             Set_String ("            pragma Import (Ada, Raise_From_");
@@ -1447,7 +1465,7 @@ package body Bindgen is
             Write_Statement_Buffer;
 
             WBI ("         begin");
-            WBI ("            Raise_From_Controlled_Operation (LE, False);");
+            WBI ("            Raise_From_Controlled_Operation (LE);");
             WBI ("         end;");
 
          --  VM-specific code, use regular Ada to produce the desired behavior
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a798e3f22fa..2f3b11bfed4 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1545,7 +1545,7 @@ package body Checks is
    --          Lo_OK be True.
    --      (3) If I'Last < 0, then let Hi be F'Succ (I'Last) and let Hi_OK
    --          be False. Otherwise let Hi be F'Pred (I'Last + 1) and let
-   --          Hi_OK be False
+   --          Hi_OK be True.
 
    procedure Apply_Float_Conversion_Check
      (Ck_Node    : Node_Id;
@@ -2325,7 +2325,11 @@ package body Checks is
       Target_Type : constant Entity_Id := Etype (N);
       Target_Base : constant Entity_Id := Base_Type (Target_Type);
       Expr        : constant Node_Id   := Expression (N);
-      Expr_Type   : constant Entity_Id := Etype (Expr);
+
+      Expr_Type : constant Entity_Id := Underlying_Type (Etype (Expr));
+      --  Note: if Etype (Expr) is a private type without discriminants, its
+      --  full view might have discriminants with defaults, so we need the
+      --  full view here to retrieve the constraints.
 
    begin
       if Inside_A_Generic then
@@ -2383,7 +2387,7 @@ package body Checks is
         and then not Is_Constrained (Target_Type)
         and then Present (Stored_Constraint (Target_Type))
       then
-         --  An unconstrained derived type may have inherited discriminant
+         --  An unconstrained derived type may have inherited discriminant.
          --  Build an actual discriminant constraint list using the stored
          --  constraint, to verify that the expression of the parent type
          --  satisfies the constraints imposed by the (unconstrained!)
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index af6200dc836..6f9a7d68d49 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -125,10 +125,10 @@ package body Debug is
    --  d.E
    --  d.F  ALFA mode
    --  d.G  Precondition only mode for gnat2why
-   --  d.H
+   --  d.H  Standard package only mode for gnat2why
    --  d.I  SCIL generation mode
    --  d.J  Disable parallel SCIL generation mode
-   --  d.K
+   --  d.K  Alfa detection only mode for gnat2why
    --  d.L  Depend on back end for limited types in conditional expressions
    --  d.M
    --  d.N
@@ -588,6 +588,10 @@ package body Debug is
    --       only generate Why code that checks for the well-guardedness of
    --       preconditions.
 
+   --  d.H  Standard package only mode for gnat2why. In this mode, gnat2why
+   --       will only generate Why code for package Standard. Any given input
+   --       file will be ignored.
+
    --  d.I  Generate SCIL mode. Generate intermediate code for the sake of
    --       of static analysis tools, and ensure additional tree consistency
    --       between different compilations of specs.
@@ -596,6 +600,9 @@ package body Debug is
    --       done in parallel to speed processing. This switch disables this
    --       behavior.
 
+   --  d.K  Alfa detection only mode for gnat2why. In this mode, gnat2why
+   --       will only generate the .alfa file, but no Why code.
+
    --  d.L  Normally the front end generates special expansion for conditional
    --       expressions of a limited type. This debug flag removes this special
    --       case expansion, leaving it up to the back end to handle conditional
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index db0fcb1d881..753dd4bfc91 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -195,11 +195,11 @@ package body Einfo is
    --    Scope_Depth_Value               Uint22
    --    Shared_Var_Procs_Instance       Node22
 
-   --    Associated_Collection           Node23
    --    CR_Discriminant                 Node23
    --    Entry_Cancel_Parameter          Node23
    --    Enum_Pos_To_Rep                 Node23
    --    Extra_Constrained               Node23
+   --    Finalization_Master             Node23
    --    Generic_Renamings               Elist23
    --    Inner_Instances                 Elist23
    --    Limited_View                    Node23
@@ -519,10 +519,10 @@ package body Einfo is
    --    Is_Safe_To_Reevaluate           Flag249
    --    Has_Predicates                  Flag250
 
-   --    (Has_Implicit_Dereference)      Flag251
+   --    Has_Implicit_Dereference        Flag251
    --    Is_Processed_Transient          Flag252
-   --    Is_Postcondition_Proc           Flag253
 
+   --    (unused)                        Flag253
    --    (unused)                        Flag254
 
    -----------------------
@@ -612,12 +612,6 @@ package body Einfo is
       return Uint14 (Id);
    end Alignment;
 
-   function Associated_Collection (Id : E) return E is
-   begin
-      pragma Assert (Is_Access_Type (Id));
-      return Node23 (Id);
-   end Associated_Collection;
-
    function Associated_Formal_Package (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Package);
@@ -1075,6 +1069,12 @@ package body Einfo is
       return Flag229 (Base_Type (Id));
    end Can_Use_Internal_Rep;
 
+   function Finalization_Master (Id : E) return E is
+   begin
+      pragma Assert (Is_Access_Type (Id));
+      return Node23 (Root_Type (Id));
+   end Finalization_Master;
+
    function Finalize_Storage_Only (Id : E) return B is
    begin
       pragma Assert (Is_Type (Id));
@@ -1987,12 +1987,6 @@ package body Einfo is
       return Flag138 (Id);
    end Is_Packed_Array_Type;
 
-   function Is_Postcondition_Proc (Id : E) return B is
-   begin
-      pragma Assert (Ekind (Id) = E_Procedure);
-      return Flag253 (Id);
-   end Is_Postcondition_Proc;
-
    function Is_Potentially_Use_Visible (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -3057,12 +3051,6 @@ package body Einfo is
       Set_Elist16 (Id, V);
    end Set_Access_Disp_Table;
 
-   procedure Set_Associated_Collection (Id : E; V : E) is
-   begin
-      pragma Assert (Is_Access_Type (Id));
-      Set_Node23 (Id, V);
-   end Set_Associated_Collection;
-
    procedure Set_Associated_Formal_Package (Id : E; V : E) is
    begin
       Set_Node12 (Id, V);
@@ -3550,6 +3538,12 @@ package body Einfo is
       Set_Flag229 (Id, V);
    end Set_Can_Use_Internal_Rep;
 
+   procedure Set_Finalization_Master (Id : E; V : E) is
+   begin
+      pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
+      Set_Node23 (Id, V);
+   end Set_Finalization_Master;
+
    procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
@@ -4511,12 +4505,6 @@ package body Einfo is
       Set_Flag138 (Id, V);
    end Set_Is_Packed_Array_Type;
 
-   procedure Set_Is_Postcondition_Proc (Id : E; V : B := True) is
-   begin
-      pragma Assert (Ekind (Id) = E_Procedure);
-      Set_Flag253 (Id, V);
-   end Set_Is_Postcondition_Proc;
-
    procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -6953,15 +6941,7 @@ package body Einfo is
       if Ekind (T) = E_Class_Wide_Type then
          return Etype (T);
 
-      elsif Ekind (T) = E_Class_Wide_Subtype then
-         return Etype (Base_Type (T));
-
-         --  ??? T comes from Base_Type, how can it be a subtype?
-         --  Also Base_Type is supposed to be idempotent, so either way
-         --  this is equivalent to "return Etype (T)" and should be merged
-         --  with the E_Class_Wide_Type case.
-
-      --  All other cases
+      --  Other cases
 
       else
          loop
@@ -7558,7 +7538,6 @@ package body Einfo is
       W ("Is_Package_Body_Entity",          Flag160 (Id));
       W ("Is_Packed",                       Flag51  (Id));
       W ("Is_Packed_Array_Type",            Flag138 (Id));
-      W ("Is_Postcondition_Proc",           Flag253 (Id));
       W ("Is_Potentially_Use_Visible",      Flag9   (Id));
       W ("Is_Preelaborated",                Flag59  (Id));
       W ("Is_Primitive",                    Flag218 (Id));
@@ -8472,9 +8451,6 @@ package body Einfo is
    procedure Write_Field23_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when Access_Kind                                  =>
-            Write_Str ("Associated_Collection");
-
          when E_Discriminant                               =>
             Write_Str ("CR_Discriminant");
 
@@ -8488,6 +8464,9 @@ package body Einfo is
               E_Variable                                   =>
             Write_Str ("Extra_Constrained");
 
+         when Access_Kind                                  =>
+            Write_Str ("Finalization_Master");
+
          when E_Generic_Function                           |
               E_Generic_Package                            |
               E_Generic_Procedure                          =>
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 35fce3adc27..c60fdd1aeb0 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -427,12 +427,6 @@ package Einfo is
 --       definition clause with an (obsolescent) mod clause is converted
 --       into an attribute definition clause for this purpose.
 
---    Associated_Collection (Node23)
---       Present in non-subprogram access type entities. Contains the entity of
---       the finalization collection on which dynamically allocated objects
---       referenced by the access type are stored. Empty when the access type
---       cannot reference a controlled object.
-
 --    Associated_Formal_Package (Node12)
 --       Present in packages that are the actuals of formal_packages. Points
 --       to the entity in the declaration for the formal package.
@@ -1088,9 +1082,9 @@ package Einfo is
 --       is itself another entity. For a type entity, points to the parent
 --       type for a derived type, or if the type is not derived, points to
 --       itself. For a subtype entity, Etype points to the base type. For
---       a class wide type, points to the parent type. For a subprogram or
---       subprogram type, Etype has the return type of a function or is set
---       to Standard_Void_Type to represent a procedure.
+--       a class wide type, points to the corresponding specific type. For a
+--       subprogram or subprogram type, Etype has the return type of a function
+--       or is set to Standard_Void_Type to represent a procedure.
 --
 --       Note one obscure case: for pragma Default_Storage_Pool (null), the
 --       Etype of the N_Null node is Empty.
@@ -1144,6 +1138,13 @@ package Einfo is
 --       must be retrieved through the entity designed by this field instead of
 --       being computed.
 
+--    Finalization_Master (Node23) [root type only]
+--       Present in access-to-controlled or access-to-class-wide types. The
+--       field contains the entity of the finalization master which handles
+--       dynamically allocated controlled objects referenced by the access
+--       type. Empty for access-to-subprogram types. Empty for access types
+--       whose designated type does not need finalization actions.
+
 --    Finalize_Storage_Only (Flag158) [base type only]
 --       Present in all types. Set on direct controlled types to which a
 --       valid Finalize_Storage_Only pragma applies. This flag is also set on
@@ -1236,10 +1237,10 @@ package Einfo is
 --       representation pragmas nodes and representation clause nodes that
 --       apply to the entity, linked using Next_Rep_Item, with Empty marking
 --       the end of the list. In the case of derived types and subtypes, the
---       new entity inherits the chain at the point of declaration. This
---       means that it is possible to have multiple instances of the same
---       kind of rep item on the chain, in which case it is the first one
---       that applies to the entity.
+--       new entity inherits the chain at the point of declaration. This means
+--       that it is possible to have multiple instances of the same kind of rep
+--       item on the chain, in which case it is the first one that applies to
+--       the entity.
 --
 --       Note: pragmas that can apply to more than one overloadable entity,
 --       (Convention, Interface, Inline, Inline_Always, Import, Export,
@@ -1259,8 +1260,8 @@ package Einfo is
 --          Linker_Section pragma
 --          Weak_External pragma
 --
---       If any of these items are present, then the flag Has_Gigi_Rep_Item
---       is set, indicating that Gigi should search the chain.
+--       If any of these items are present, then the flag Has_Gigi_Rep_Item is
+--       set, indicating that Gigi should search the chain.
 --
 --       Other representation items are included in the chain so that error
 --       messages can easily locate the relevant nodes for posting errors.
@@ -1273,10 +1274,10 @@ package Einfo is
 --       the floating-point representation to be used.
 
 --    Freeze_Node (Node7)
---       Present in all entities. If there is an associated freeze node for
---       the entity, this field references this freeze node. If no freeze
---       node is associated with the entity, then this field is Empty. See
---       package Freeze for further details.
+--       Present in all entities. If there is an associated freeze node for the
+--       entity, this field references this freeze node. If no freeze node is
+--       associated with the entity, then this field is Empty. See package
+--       Freeze for further details.
 
 --    From_With_Type (Flag159)
 --       Present in package and type entities. Indicates that the entity
@@ -2566,10 +2567,6 @@ package Einfo is
 --       an entity, then the Original_Array_Type field of this entity points
 --       to the original array type for which this is the packed array type.
 
---    Is_Postcondition_Proc (Flag253)
---       Present in procedures. Set if entity is a procedure generated by the
---       compiler for a postcondition.
-
 --    Is_Potentially_Use_Visible (Flag9)
 --       Present in all entities. Set if entity is potentially use visible,
 --       i.e. it is defined in a package that appears in a currently active
@@ -3268,7 +3265,7 @@ package Einfo is
 
 --    Package_Instantiation (Node26)
 --       Present in packages and generic packages. When present, this field
---       references an N_Package_Instantiation node associated with an
+--       references an N_Generic_Instantiation node associated with an
 --       instantiated package. In the case where the referenced node has
 --       been rewritten to an N_Package_Specification, the instantiation
 --       node is available from the Original_Node field of the package spec
@@ -3519,12 +3516,12 @@ package Einfo is
 --       by-reference-type or because it uses explicitly the secondary stack.
 
 --    Reverse_Bit_Order (Flag164) [base type only]
---       Present in all record type entities. Set if a valid pragma an
---       attribute representation clause for Bit_Order has reversed the order
---       of bits from the default value. When this flag is set, a component
---       clause must specify a set of bits entirely contained in a single
---       storage unit (Ada 95) or a single machine scalar (see Ada 2005
---       AI-133), or must occupy in integral number of storage units.
+--       Present in all record type entities. Set if entity has a Bit_Order
+--       aspect (set by an aspect clause or attribute definition clause) that
+--       has reversed the order of bits from the default value. When this flag
+--       is set, a component clause must specify a set of bits entirely within
+--       a single storage unit (Ada 95) or within a single machine scalar (see
+--       Ada 2005 AI-133), or must occupy an integral number of storage units.
 
 --    RM_Size (Uint13)
 --       Present in all type and subtype entities. Contains the value of
@@ -4947,7 +4944,7 @@ package Einfo is
    --    Master_Id                           (Node17)
    --    Directly_Designated_Type            (Node20)
    --    Associated_Storage_Pool             (Node22)   (base type only)
-   --    Associated_Collection               (Node23)   (base type only)
+   --    Finalization_Master                 (Node23)   (base type only)
    --    Has_Pragma_Controlled               (Flag27)   (base type only)
    --    Has_Storage_Size_Clause             (Flag23)   (base type only)
    --    Is_Access_Constant                  (Flag69)
@@ -4975,7 +4972,7 @@ package Einfo is
    --  E_Anonymous_Access_Type
    --    Storage_Size_Variable               (Node15)   ??? is this needed ???
    --    Directly_Designated_Type            (Node20)
-   --    Associated_Collection               (Node23)
+   --    Finalization_Master                 (Node23)
    --    (plus type attributes)
 
    --  E_Array_Type
@@ -5282,7 +5279,7 @@ package Einfo is
    --    Master_Id                           (Node17)
    --    Directly_Designated_Type            (Node20)
    --    Associated_Storage_Pool             (Node22)   (root type only)
-   --    Associated_Collection               (Node23)
+   --    Finalization_Master                 (Node23)   (root type only)
    --    (plus type attributes)
 
    --  E_Generic_In_Parameter
@@ -5522,7 +5519,6 @@ package Einfo is
    --    Is_Intrinsic_Subprogram             (Flag64)
    --    Is_Machine_Code_Subprogram          (Flag137)  (non-generic case only)
    --    Is_Null_Init_Proc                   (Flag178)
-   --    Is_Postcondition_Proc               (Flag253)  (non-generic case only)
    --    Is_Primitive                        (Flag218)
    --    Is_Primitive_Wrapper                (Flag195)  (non-generic case only)
    --    Is_Private_Descendant               (Flag53)
@@ -5979,7 +5975,6 @@ package Einfo is
    function Address_Taken                       (Id : E) return B;
    function Alias                               (Id : E) return E;
    function Alignment                           (Id : E) return U;
-   function Associated_Collection               (Id : E) return E;
    function Associated_Formal_Package           (Id : E) return E;
    function Associated_Node_For_Itype           (Id : E) return N;
    function Associated_Storage_Pool             (Id : E) return E;
@@ -6055,6 +6050,7 @@ package Einfo is
    function Extra_Formal                        (Id : E) return E;
    function Extra_Formals                       (Id : E) return E;
    function Can_Use_Internal_Rep                (Id : E) return B;
+   function Finalization_Master                 (Id : E) return E;
    function Finalize_Storage_Only               (Id : E) return B;
    function Finalizer                           (Id : E) return E;
    function First_Entity                        (Id : E) return E;
@@ -6218,7 +6214,6 @@ package Einfo is
    function Is_Package_Body_Entity              (Id : E) return B;
    function Is_Packed                           (Id : E) return B;
    function Is_Packed_Array_Type                (Id : E) return B;
-   function Is_Postcondition_Proc               (Id : E) return B;
    function Is_Potentially_Use_Visible          (Id : E) return B;
    function Is_Preelaborated                    (Id : E) return B;
    function Is_Primitive                        (Id : E) return B;
@@ -6569,7 +6564,6 @@ package Einfo is
    procedure Set_Address_Taken                   (Id : E; V : B := True);
    procedure Set_Alias                           (Id : E; V : E);
    procedure Set_Alignment                       (Id : E; V : U);
-   procedure Set_Associated_Collection           (Id : E; V : E);
    procedure Set_Associated_Formal_Package       (Id : E; V : E);
    procedure Set_Associated_Node_For_Itype       (Id : E; V : N);
    procedure Set_Associated_Storage_Pool         (Id : E; V : E);
@@ -6643,6 +6637,7 @@ package Einfo is
    procedure Set_Extra_Formal                    (Id : E; V : E);
    procedure Set_Extra_Formals                   (Id : E; V : E);
    procedure Set_Can_Use_Internal_Rep            (Id : E; V : B := True);
+   procedure Set_Finalization_Master             (Id : E; V : E);
    procedure Set_Finalize_Storage_Only           (Id : E; V : B := True);
    procedure Set_Finalizer                       (Id : E; V : E);
    procedure Set_First_Entity                    (Id : E; V : E);
@@ -6812,7 +6807,6 @@ package Einfo is
    procedure Set_Is_Package_Body_Entity          (Id : E; V : B := True);
    procedure Set_Is_Packed                       (Id : E; V : B := True);
    procedure Set_Is_Packed_Array_Type            (Id : E; V : B := True);
-   procedure Set_Is_Postcondition_Proc           (Id : E; V : B := True);
    procedure Set_Is_Potentially_Use_Visible      (Id : E; V : B := True);
    procedure Set_Is_Preelaborated                (Id : E; V : B := True);
    procedure Set_Is_Primitive                    (Id : E; V : B := True);
@@ -7266,7 +7260,6 @@ package Einfo is
    pragma Inline (Address_Taken);
    pragma Inline (Alias);
    pragma Inline (Alignment);
-   pragma Inline (Associated_Collection);
    pragma Inline (Associated_Formal_Package);
    pragma Inline (Associated_Node_For_Itype);
    pragma Inline (Associated_Storage_Pool);
@@ -7342,6 +7335,7 @@ package Einfo is
    pragma Inline (Extra_Formal);
    pragma Inline (Extra_Formals);
    pragma Inline (Can_Use_Internal_Rep);
+   pragma Inline (Finalization_Master);
    pragma Inline (Finalizer);
    pragma Inline (First_Entity);
    pragma Inline (First_Exit_Statement);
@@ -7541,7 +7535,6 @@ package Einfo is
    pragma Inline (Is_Overloadable);
    pragma Inline (Is_Packed);
    pragma Inline (Is_Packed_Array_Type);
-   pragma Inline (Is_Postcondition_Proc);
    pragma Inline (Is_Potentially_Use_Visible);
    pragma Inline (Is_Preelaborated);
    pragma Inline (Is_Primitive);
@@ -7711,7 +7704,6 @@ package Einfo is
    pragma Inline (Set_Address_Taken);
    pragma Inline (Set_Alias);
    pragma Inline (Set_Alignment);
-   pragma Inline (Set_Associated_Collection);
    pragma Inline (Set_Associated_Formal_Package);
    pragma Inline (Set_Associated_Node_For_Itype);
    pragma Inline (Set_Associated_Storage_Pool);
@@ -7786,6 +7778,7 @@ package Einfo is
    pragma Inline (Set_Extra_Formal);
    pragma Inline (Set_Extra_Formals);
    pragma Inline (Set_Can_Use_Internal_Rep);
+   pragma Inline (Set_Finalization_Master);
    pragma Inline (Set_Finalizer);
    pragma Inline (Set_First_Entity);
    pragma Inline (Set_First_Exit_Statement);
@@ -7953,7 +7946,6 @@ package Einfo is
    pragma Inline (Set_Is_Package_Body_Entity);
    pragma Inline (Set_Is_Packed);
    pragma Inline (Set_Is_Packed_Array_Type);
-   pragma Inline (Set_Is_Postcondition_Proc);
    pragma Inline (Set_Is_Potentially_Use_Visible);
    pragma Inline (Set_Is_Preelaborated);
    pragma Inline (Set_Is_Primitive);
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 6a6142d4121..39d73027840 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -2832,10 +2832,10 @@ package body Errout is
 
       elsif Msg = "size for& too small, minimum allowed is ^" then
 
-         --  Suppress "size too small" errors in CodePeer mode, since pragma
-         --  Pack is also ignored in this configuration.
+         --  Suppress "size too small" errors in CodePeer mode and ALFA mode,
+         --  since pragma Pack is also ignored in these configurations.
 
-         if CodePeer_Mode then
+         if CodePeer_Mode or ALFA_Mode then
             return True;
 
          --  When a size is wrong for a frozen type there is no explicit size
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index d6b53d442f6..037a8dcc6ea 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4664,6 +4664,12 @@ package body Exp_Aggr is
          Check_Same_Aggr_Bounds (N, 1);
       end if;
 
+      --  In formal verification mode, leave the aggregate non-expanded
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       --  STEP 2
 
       --  Here we test for is packed array aggregate that we can handle at
@@ -5093,6 +5099,16 @@ package body Exp_Aggr is
       --  semantics of Ada complicate the analysis and lead to anomalies in
       --  the gcc back-end if the aggregate is not expanded into assignments.
 
+      function Has_Visible_Private_Ancestor (Id : E) return Boolean;
+      --  If any ancestor of the current type is private, the aggregate
+      --  cannot be built in place. We canot rely on Has_Private_Ancestor,
+      --  because it will not be set when type and its parent are in the
+      --  same scope, and the parent component needs expansion.
+
+      function Top_Level_Aggregate (N : Node_Id) return Node_Id;
+      --  For nested aggregates return the ultimate enclosing aggregate; for
+      --  non-nested aggregates return N.
+
       ----------------------------------
       -- Component_Not_OK_For_Backend --
       ----------------------------------
@@ -5172,18 +5188,6 @@ package body Exp_Aggr is
          return False;
       end Component_Not_OK_For_Backend;
 
-      --  Remaining Expand_Record_Aggregate variables
-
-      Tag_Value : Node_Id;
-      Comp      : Entity_Id;
-      New_Comp  : Node_Id;
-
-      function Has_Visible_Private_Ancestor (Id : E) return Boolean;
-      --  If any ancestor of the current type is private, the aggregate
-      --  cannot be built in place. We canot rely on Has_Private_Ancestor,
-      --  because it will not be set when type and its parent are in the
-      --  same scope, and the parent component needs expansion.
-
       -----------------------------------
       --  Has_Visible_Private_Ancestor --
       -----------------------------------
@@ -5191,6 +5195,7 @@ package body Exp_Aggr is
       function Has_Visible_Private_Ancestor (Id : E) return Boolean is
          R  : constant Entity_Id := Root_Type (Id);
          T1 : Entity_Id := Id;
+
       begin
          loop
             if Is_Private_Type (T1) then
@@ -5205,6 +5210,32 @@ package body Exp_Aggr is
          end loop;
       end Has_Visible_Private_Ancestor;
 
+      -------------------------
+      -- Top_Level_Aggregate --
+      -------------------------
+
+      function Top_Level_Aggregate (N : Node_Id) return Node_Id is
+         Aggr : Node_Id;
+
+      begin
+         Aggr := N;
+         while Present (Parent (Aggr))
+           and then Nkind_In (Parent (Aggr), N_Component_Association,
+                                             N_Aggregate)
+         loop
+            Aggr := Parent (Aggr);
+         end loop;
+
+         return Aggr;
+      end Top_Level_Aggregate;
+
+      --  Local variables
+
+      Top_Level_Aggr : constant Node_Id := Top_Level_Aggregate (N);
+      Tag_Value      : Node_Id;
+      Comp           : Entity_Id;
+      New_Comp       : Node_Id;
+
    --  Start of processing for Expand_Record_Aggregate
 
    begin
@@ -5311,8 +5342,8 @@ package body Exp_Aggr is
 
       elsif Has_Mutable_Components (Typ)
         and then
-          (Nkind (Parent (N)) /= N_Object_Declaration
-            or else not Constant_Present (Parent (N)))
+          (Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
+            or else not Constant_Present (Parent (Top_Level_Aggr)))
       then
          Convert_To_Assignments (N, Typ);
 
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index c6d396ddccd..c03a040fdaf 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1813,11 +1813,11 @@ package body Exp_Attr is
       --  and then the Elab_Body/Spec attribute is replaced by a reference
       --  to this defining identifier.
 
-      when Attribute_Elab_Body |
-           Attribute_Elab_Spec =>
+      when Attribute_Elab_Body      |
+           Attribute_Elab_Spec      =>
 
          --  Leave attribute unexpanded in CodePeer mode: the gnat2scil
-         --  back-end knows how to handle this attribute directly.
+         --  back-end knows how to handle these attributes directly.
 
          if CodePeer_Mode then
             return;
@@ -1908,6 +1908,17 @@ package body Exp_Attr is
             Rewrite (N, New_Occurrence_Of (Ent, Loc));
          end Elab_Body;
 
+      --------------------
+      -- Elab_Subp_Body --
+      --------------------
+
+      --  Always ignored. In CodePeer mode, gnat2scil knows how to handle
+      --  this attribute directly, and if we are not in CodePeer mode it is
+      --  entirely ignored ???
+
+      when Attribute_Elab_Subp_Body =>
+         return;
+
       ----------------
       -- Elaborated --
       ----------------
@@ -5368,6 +5379,7 @@ package body Exp_Attr is
            Attribute_Small                        |
            Attribute_Storage_Unit                 |
            Attribute_Stub_Type                    |
+           Attribute_System_Allocator_Alignment   |
            Attribute_Target_Name                  |
            Attribute_Type_Class                   |
            Attribute_Type_Key                     |
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index fc55d1567cb..caf66cca0e0 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1097,8 +1097,9 @@ package body Exp_Ch11 is
                   --  any case this entire handling is relevant only if aborts
                   --  are allowed!
 
-               elsif Abort_Allowed then
-
+               elsif Abort_Allowed
+                 and then Exception_Mechanism /= Back_End_Exceptions
+               then
                   --  There are some special cases in which we do not do the
                   --  undefer. In particular a finalization (AT END) handler
                   --  wants to operate with aborts still deferred.
@@ -1122,7 +1123,6 @@ package body Exp_Ch11 is
                       (Others_Choice
                         and then
                           All_Others (First (Exception_Choices (Handler))))
-                    and then Abort_Allowed
                   then
                      Prepend_Call_To_Handler (RE_Abort_Undefer);
                   end if;
@@ -1665,6 +1665,20 @@ package body Exp_Ch11 is
       --  does not have a choice parameter specification, then we provide one.
 
       else
+         --  Bypass expansion to a run-time call when back-end exception
+         --  handling is active, unless the target is a VM, CodePeer or
+         --  GNATprove. In CodePeer, raising an exception is treated as an
+         --  error, while in GNATprove all code with exceptions falls outside
+         --  the subset of code which can be formally analyzed.
+
+         if VM_Target = No_VM
+           and then not CodePeer_Mode
+           and then not ALFA_Mode
+           and then Exception_Mechanism = Back_End_Exceptions
+         then
+            return;
+         end if;
+
          --  Find innermost enclosing exception handler (there must be one,
          --  since the semantics has already verified that this raise statement
          --  is valid, and a raise with no arguments is only permitted in the
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 9f182357ee7..a6890d72746 100644
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -230,7 +230,7 @@ package body Exp_Ch13 is
          return;
       end if;
 
-      --  Use the base type to perform the collection check
+      --  Use the base type to perform the check for finalization master
 
       Typ := Etype (Expr);
 
@@ -248,10 +248,10 @@ package body Exp_Ch13 is
 
       --  Do not create a custom Deallocate when freeing an object with
       --  suppressed finalization. In such cases the object is never attached
-      --  to a collection, so it does not need to be detached. Use a regular
-      --  free statement instead.
+      --  to a master, so it does not need to be detached. Use a regular free
+      --  statement instead.
 
-      if No (Associated_Collection (Typ)) then
+      if No (Finalization_Master (Typ)) then
          return;
       end if;
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 7f495ace586..361b2a4797f 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2616,7 +2616,7 @@ package body Exp_Ch3 is
                      Make_Raise_Statement (Loc)))));
             end;
          else
-            Set_Exception_Handlers (Handled_Stmt_Node, Empty_List);
+            Set_Exception_Handlers (Handled_Stmt_Node, No_List);
          end if;
 
          Set_Handled_Statement_Sequence (Body_Node, Handled_Stmt_Node);
@@ -5108,25 +5108,24 @@ package body Exp_Ch3 is
 
                begin
                   --  The re-assignment of the tag has to be done even if the
-                  --  object is a constant.
+                  --  object is a constant. The assignment must be analyzed
+                  --  after the declaration.
 
                   New_Ref :=
                     Make_Selected_Component (Loc,
-                       Prefix => New_Reference_To (Def_Id, Loc),
+                       Prefix => New_Occurrence_Of (Def_Id, Loc),
                        Selector_Name =>
                          New_Reference_To (First_Tag_Component (Full_Typ),
                                            Loc));
                   Set_Assignment_OK (New_Ref);
 
-                  Insert_After (Init_After,
+                  Insert_Action_After (Init_After,
                     Make_Assignment_Statement (Loc,
-                      Name => New_Ref,
+                      Name       => New_Ref,
                       Expression =>
                         Unchecked_Convert_To (RTE (RE_Tag),
                           New_Reference_To
-                            (Node
-                              (First_Elmt
-                                (Access_Disp_Table (Full_Typ))),
+                            (Node (First_Elmt (Access_Disp_Table (Full_Typ))),
                              Loc))));
                end;
 
@@ -5196,10 +5195,6 @@ package body Exp_Ch3 is
          if (Is_Possibly_Unaligned_Slice (Expr)
                or else (Is_Possibly_Unaligned_Object (Expr)
                           and then not Represented_As_Scalar (Etype (Expr))))
-
-            --  The exclusion of the unconstrained case is wrong, but for now
-            --  it is too much trouble ???
-
            and then not (Is_Array_Type (Etype (Expr))
                            and then not Is_Constrained (Etype (Expr)))
          then
@@ -5302,7 +5297,7 @@ package body Exp_Ch3 is
 
    --  If the last variant does not contain the Others choice, replace it with
    --  an N_Others_Choice node since Gigi always wants an Others. Note that we
-   --  do not bother to call Analyze on the modified variant part, since it's
+   --  do not bother to call Analyze on the modified variant part, since its
    --  only effect would be to compute the Others_Discrete_Choices node
    --  laboriously, and of course we already know the list of choices that
    --  corresponds to the others choice (it's the list we are replacing!)
@@ -5487,12 +5482,13 @@ package body Exp_Ch3 is
                   Build_Slice_Assignment (Typ);
                end if;
 
-            --  ??? This may not be necessary after all
+            --  ??? Now that masters acts as heterogeneous lists, it might be
+            --  worthwhile to revisit the global master approach.
 
             elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type
               and then Needs_Finalization (Directly_Designated_Type (Comp_Typ))
             then
-               Build_Finalization_Collection (Comp_Typ);
+               Build_Finalization_Master (Comp_Typ);
             end if;
          end if;
 
@@ -5586,8 +5582,8 @@ package body Exp_Ch3 is
          return;
       end if;
 
-      --  Generate the body of Finalize_Address. This routine is accessible
-      --  through the TSS mechanism.
+      --  Create the body of TSS primitive Finalize_Address. This automatically
+      --  sets the TSS entry for the class-wide type.
 
       Make_Finalize_Address_Body (Typ);
    end Expand_Freeze_Class_Wide_Type;
@@ -6315,13 +6311,17 @@ package body Exp_Ch3 is
          --  compiling a CPP tagged type.
 
          elsif not Restriction_Active (No_Dispatching_Calls) then
-            Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq);
-            Append_Freeze_Actions (Def_Id, Predef_List);
 
-            --  Create the body of Finalize_Address, a helper routine used in
-            --  conjunction with controlled objects on the heap.
+            --  Create the body of TSS primitive Finalize_Address. This must
+            --  be done before the bodies of all predefined primitives are
+            --  created. If Def_Id is limited, Stream_Input and Streap_Read
+            --  may produce build-in-place allocations and for that the
+            --  expander needs Finalize_Address.
 
             Make_Finalize_Address_Body (Def_Id);
+
+            Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq);
+            Append_Freeze_Actions (Def_Id, Predef_List);
          end if;
 
          --  Ada 2005 (AI-391): If any wrappers were created for nonoverridden
@@ -6369,7 +6369,7 @@ package body Exp_Ch3 is
 
            and then Directly_Designated_Type (Comp_Typ) /= Def_Id
          then
-            Build_Finalization_Collection
+            Build_Finalization_Master
              (Typ        => Comp_Typ,
               Ins_Node   => Parent (Def_Id),
               Encl_Scope => Scope (Def_Id));
@@ -6605,12 +6605,67 @@ package body Exp_Ch3 is
             --    Rep Clause "for Def_Id'Storage_Pool use a_Pool_Object"
             --    ---> Storage Pool is the specified one
 
-            elsif Present (Associated_Storage_Pool (Def_Id)) then
+            --  When compiling in Ada 2012 mode, ensure that the accessibility
+            --  level of the subpool access type is not deeper than that of the
+            --  pool_with_subpools. This check is not performed on .NET/JVM
+            --  since those targets do not support pools.
 
-               --  Nothing to do the associated storage pool has been attached
-               --  when analyzing the representation clause.
+            elsif Ada_Version >= Ada_2012
+              and then Present (Associated_Storage_Pool (Def_Id))
+              and then VM_Target = No_VM
+            then
+               declare
+                  Loc   : constant Source_Ptr := Sloc (Def_Id);
+                  Pool  : constant Entity_Id :=
+                            Associated_Storage_Pool (Def_Id);
+                  RSPWS : constant Entity_Id :=
+                            RTE (RE_Root_Storage_Pool_With_Subpools);
 
-               null;
+               begin
+                  --  It is known that the accessibility level of the access
+                  --  type is deeper than that of the pool.
+
+                  if Type_Access_Level (Def_Id) > Object_Access_Level (Pool)
+                    and then not Accessibility_Checks_Suppressed (Def_Id)
+                    and then not Accessibility_Checks_Suppressed (Pool)
+                  then
+                     --  Static case: the pool is known to be a descendant of
+                     --  Root_Storage_Pool_With_Subpools.
+
+                     if Is_Ancestor (RSPWS, Etype (Pool)) then
+                        Error_Msg_N
+                          ("?subpool access type has deeper accessibility " &
+                           "level than pool", Def_Id);
+
+                        Append_Freeze_Action (Def_Id,
+                          Make_Raise_Program_Error (Loc,
+                            Reason => PE_Accessibility_Check_Failed));
+
+                     --  Dynamic case: when the pool is of a class-wide type,
+                     --  it may or may not support subpools depending on the
+                     --  path of derivation. Generate:
+
+                     --    if Def_Id in RSPWS'Class then
+                     --       raise Program_Error;
+                     --    end if;
+
+                     elsif Is_Class_Wide_Type (Etype (Pool)) then
+                        Append_Freeze_Action (Def_Id,
+                          Make_If_Statement (Loc,
+                            Condition =>
+                              Make_In (Loc,
+                                Left_Opnd =>
+                                  New_Reference_To (Pool, Loc),
+                                Right_Opnd =>
+                                  New_Reference_To
+                                    (Class_Wide_Type (RSPWS), Loc)),
+
+                            Then_Statements => New_List (
+                              Make_Raise_Program_Error (Loc,
+                                Reason => PE_Accessibility_Check_Failed))));
+                     end if;
+                  end if;
+               end;
             end if;
 
             --  For access-to-controlled types (including class-wide types and
@@ -6626,38 +6681,34 @@ package body Exp_Ch3 is
             --  finalization support if not needed.
 
             if not Comes_From_Source (Def_Id)
-               and then not Has_Private_Declaration (Def_Id)
+              and then not Has_Private_Declaration (Def_Id)
             then
                null;
 
-            elsif (Needs_Finalization (Desig_Type)
-                    and then Convention (Desig_Type) /= Convention_Java
-                    and then Convention (Desig_Type) /= Convention_CIL)
-              or else
-                (Is_Incomplete_Or_Private_Type (Desig_Type)
-                  and then No (Full_View (Desig_Type))
-
-                  --  An exception is made for types defined in the run-time
-                  --  because Ada.Tags.Tag itself is such a type and cannot
-                  --  afford this unnecessary overhead that would generates a
-                  --  loop in the expansion scheme...
-
-                   and then not In_Runtime (Def_Id)
-
-                  --  Another exception is if Restrictions (No_Finalization)
-                  --  is active, since then we know nothing is controlled.
+            --  An exception is made for types defined in the run-time because
+            --  Ada.Tags.Tag itself is such a type and cannot afford this
+            --  unnecessary overhead that would generates a loop in the
+            --  expansion scheme. Another exception is if Restrictions
+            --  (No_Finalization) is active, since then we know nothing is
+            --  controlled.
 
-                   and then not Restriction_Active (No_Finalization))
+            elsif Restriction_Active (No_Finalization)
+              or else In_Runtime (Def_Id)
+            then
+               null;
 
-               --  If the designated type is not frozen yet, its controlled
-               --  status must be retrieved explicitly.
+            --  The machinery assumes that incomplete or private types are
+            --  always completed by a controlled full vies.
 
+            elsif Needs_Finalization (Desig_Type)
+              or else
+                (Is_Incomplete_Or_Private_Type (Desig_Type)
+                  and then No (Full_View (Desig_Type)))
               or else
                 (Is_Array_Type (Desig_Type)
-                  and then not Is_Frozen (Desig_Type)
                   and then Needs_Finalization (Component_Type (Desig_Type)))
             then
-               Build_Finalization_Collection (Def_Id);
+               Build_Finalization_Master (Def_Id);
             end if;
          end;
 
@@ -6838,7 +6889,7 @@ package body Exp_Ch3 is
                (Get_Rep_Item_For_Entity
                  (First_Subtype (T), Name_Default_Value)));
 
-      --  Othersie, for scalars, we must have normalize/initialize scalars
+      --  Otherwise, for scalars, we must have normalize/initialize scalars
       --  case, or if the node N is an 'Invalid_Value attribute node.
 
       elsif Is_Scalar_Type (T) then
@@ -6854,8 +6905,8 @@ package body Exp_Ch3 is
             Size_To_Use := Size;
          end if;
 
-         --  Maximum size to use is 64 bits, since we will create values
-         --  of type Unsigned_64 and the range must fit this type.
+         --  Maximum size to use is 64 bits, since we will create values of
+         --  type Unsigned_64 and the range must fit this type.
 
          if Size_To_Use /= No_Uint and then Size_To_Use > Uint_64 then
             Size_To_Use := Uint_64;
@@ -6883,7 +6934,7 @@ package body Exp_Ch3 is
 
             --  For signed integer types that have no negative values, either
             --  there is room for negative values, or there is not. If there
-            --  is, then all 1 bits may be interpreted as minus one, which is
+            --  is, then all 1-bits may be interpreted as minus one, which is
             --  certainly invalid. Alternatively it is treated as the largest
             --  positive value, in which case the observation for modular types
             --  still applies.
@@ -6897,8 +6948,8 @@ package body Exp_Ch3 is
             then
                Val := Make_Integer_Literal (Loc, 2 ** Size_To_Use - 1);
 
-               --  Resolve as Unsigned_64, because the largest number we
-               --  can generate is out of range of universal integer.
+               --  Resolve as Unsigned_64, because the largest number we can
+               --  generate is out of range of universal integer.
 
                Analyze_And_Resolve (Val, RTE (RE_Unsigned_64));
 
@@ -6910,10 +6961,10 @@ package body Exp_Ch3 is
                                   UI_Min (Uint_63, Size_To_Use - 1);
 
                begin
-                  --  Normally we like to use the most negative number. The
-                  --  one exception is when this number is in the known
-                  --  subtype range and the largest positive number is not in
-                  --  the known subtype range.
+                  --  Normally we like to use the most negative number. The one
+                  --  exception is when this number is in the known subtype
+                  --  range and the largest positive number is not in the known
+                  --  subtype range.
 
                   --  For this exceptional case, use largest positive value
 
@@ -6923,7 +6974,7 @@ package body Exp_Ch3 is
                   then
                      Val := Make_Integer_Literal (Loc, 2 ** Signed_Size - 1);
 
-                     --  Normal case of largest negative value
+                  --  Normal case of largest negative value
 
                   else
                      Val := Make_Integer_Literal (Loc, -(2 ** Signed_Size));
@@ -6992,14 +7043,14 @@ package body Exp_Ch3 is
 
          --  The final expression is obtained by doing an unchecked conversion
          --  of this result to the base type of the required subtype. We use
-         --  the base type to avoid the unchecked conversion from chopping
+         --  the base type to prevent the unchecked conversion from chopping
          --  bits, and then we set Kill_Range_Check to preserve the "bad"
          --  value.
 
          Result := Unchecked_Convert_To (Base_Type (T), Val);
 
-         --  Ensure result is not truncated, since we want the "bad" bits
-         --  and also kill range check on result.
+         --  Ensure result is not truncated, since we want the "bad" bits, and
+         --  also kill range check on result.
 
          if Nkind (Result) = N_Unchecked_Type_Conversion then
             Set_No_Truncation (Result);
@@ -7031,12 +7082,11 @@ package body Exp_Ch3 is
       --  Access type is initialized to null
 
       elsif Is_Access_Type (T) then
-         return
-           Make_Null (Loc);
+         return Make_Null (Loc);
 
-      --  No other possibilities should arise, since we should only be
-      --  calling Get_Simple_Init_Val if Needs_Simple_Initialization
-      --  returned True, indicating one of the above cases held.
+      --  No other possibilities should arise, since we should only be calling
+      --  Get_Simple_Init_Val if Needs_Simple_Initialization returned True,
+      --  indicating one of the above cases held.
 
       else
          raise Program_Error;
@@ -7085,7 +7135,7 @@ package body Exp_Ch3 is
          S1 := Scope (S1);
       end loop;
 
-      return Chars (S1) = Name_System or else Chars (S1) = Name_Ada;
+      return Is_RTU (S1, System) or else Is_RTU (S1, Ada);
    end In_Runtime;
 
    ----------------------------
@@ -8405,7 +8455,7 @@ package body Exp_Ch3 is
       end if;
 
       --  All tagged types receive their own Deep_Adjust and Deep_Finalize
-      --  regardless of whether they are controlled or contain controlled
+      --  regardless of whether they are controlled or may contain controlled
       --  components.
 
       --  Do not generate the routines if finalization is disabled
@@ -8420,12 +8470,10 @@ package body Exp_Ch3 is
 
       else
          if not Is_Limited_Type (Tag_Typ) then
-            Append_To (Res,
-              Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Adjust));
+            Append_To (Res, Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Adjust));
          end if;
 
-         Append_To (Res,
-           Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Finalize));
+         Append_To (Res, Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Finalize));
       end if;
 
       Predef_List := Res;
@@ -9034,9 +9082,9 @@ package body Exp_Ch3 is
       --  to be (implicitly) inherited in that case because it can lead to a VM
       --  exception.
 
-      --  Do not generate stream routines for type Finalization_Collection
-      --  because collection may never appear in types and therefore cannot be
-      --  read or written.
+      --  Do not generate stream routines for type Finalization_Master because
+      --  a master may never appear in types and therefore cannot be read or
+      --  written.
 
       return
           (not Is_Limited_Type (Typ)
@@ -9059,7 +9107,7 @@ package body Exp_Ch3 is
         and then RTE_Available (RE_Tag)
         and then No (Type_Without_Stream_Operation (Typ))
         and then RTE_Available (RE_Root_Stream_Type)
-        and then not Is_RTE (Typ, RE_Finalization_Collection);
+        and then not Is_RTE (Typ, RE_Finalization_Master);
    end Stream_Operation_OK;
 
 end Exp_Ch3;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9ec558cca2a..e3f9412393b 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -91,12 +91,13 @@ package body Exp_Ch4 is
    --  If a boolean array assignment can be done in place, build call to
    --  corresponding library procedure.
 
-   procedure Complete_Controlled_Allocation (Temp_Decl : Node_Id);
-   --  Subsidiary to Expand_N_Allocator and Expand_Allocator_Expression. Formal
-   --  Temp_Decl is the declaration of a temporary which hold the value of the
-   --  original allocator. Create a custom Allocate routine for the expression
-   --  of Temp_Decl. The routine does special processing for anonymous access
-   --  types.
+   function Current_Unit_First_Declaration return Node_Id;
+   --  Return the current unit's first declaration. If the declaration list is
+   --  empty, the routine generates a null statement and returns it.
+
+   function Current_Unit_Scope return Entity_Id;
+   --  Return the scope of the current unit. If the current unit is a body,
+   --  return the scope of the spec.
 
    procedure Displace_Allocator_Pointer (N : Node_Id);
    --  Ada 2005 (AI-251): Subsidiary procedure to Expand_N_Allocator and
@@ -375,118 +376,78 @@ package body Exp_Ch4 is
    end Build_Boolean_Array_Proc_Call;
 
    ------------------------------------
-   -- Complete_Controlled_Allocation --
+   -- Current_Unit_First_Declaration --
    ------------------------------------
 
-   procedure Complete_Controlled_Allocation (Temp_Decl : Node_Id) is
-      pragma Assert (Nkind (Temp_Decl) = N_Object_Declaration);
-
-      Ptr_Typ : constant Entity_Id := Etype (Defining_Identifier (Temp_Decl));
+   function Current_Unit_First_Declaration return Node_Id is
+      Sem_U : Node_Id := Unit (Cunit (Current_Sem_Unit));
+      Decl  : Node_Id;
+      Decls : List_Id;
 
-      function First_Declaration_Of_Current_Unit return Node_Id;
-      --  Return the current unit's first declaration. If the declaration list
-      --  is empty, the routine generates a null statement and returns it.
+   begin
+      if Nkind (Sem_U) = N_Package_Declaration then
+         Sem_U := Specification (Sem_U);
+         Decls := Visible_Declarations (Sem_U);
 
-      ---------------------------------------
-      -- First_Declaration_Of_Current_Unit --
-      ---------------------------------------
+         if No (Decls) then
+            Decl := Make_Null_Statement (Sloc (Sem_U));
+            Decls := New_List (Decl);
+            Set_Visible_Declarations (Sem_U, Decls);
 
-      function First_Declaration_Of_Current_Unit return Node_Id is
-         Sem_U : Node_Id := Unit (Cunit (Current_Sem_Unit));
-         Decl  : Node_Id;
-         Decls : List_Id;
-
-      begin
-         if Nkind (Sem_U) = N_Package_Declaration then
-            Sem_U := Specification (Sem_U);
-            Decls := Visible_Declarations (Sem_U);
-
-            if No (Decls) then
-               Decl  := Make_Null_Statement (Sloc (Sem_U));
-               Decls := New_List (Decl);
-               Set_Visible_Declarations (Sem_U, Decls);
-            else
-               Decl := First (Decls);
-            end if;
+         elsif Is_Empty_List (Decls) then
+            Decl := Make_Null_Statement (Sloc (Sem_U));
+            Append_To (Decls, Decl);
 
          else
-            Decls := Declarations (Sem_U);
-
-            if No (Decls) then
-               Decl  := Make_Null_Statement (Sloc (Sem_U));
-               Decls := New_List (Decl);
-               Set_Declarations (Sem_U, Decls);
-            else
-               Decl := First (Decls);
-            end if;
+            Decl := First (Decls);
          end if;
 
-         return Decl;
-      end First_Declaration_Of_Current_Unit;
-
-   --  Start of processing for Complete_Controlled_Allocation
-
-   begin
-      --  Certain run-time configurations and targets do not provide support
-      --  for controlled types.
-
-      if Restriction_Active (No_Finalization) then
-         return;
-
-      --  Do nothing if the access type may never allocate an object
+      else
+         Decls := Declarations (Sem_U);
 
-      elsif No_Pool_Assigned (Ptr_Typ) then
-         return;
+         if No (Decls) then
+            Decl := Make_Null_Statement (Sloc (Sem_U));
+            Decls := New_List (Decl);
+            Set_Declarations (Sem_U, Decls);
 
-      --  Access-to-controlled types are not supported on .NET/JVM
+         elsif Is_Empty_List (Decls) then
+            Decl := Make_Null_Statement (Sloc (Sem_U));
+            Append_To (Decls, Decl);
 
-      elsif VM_Target /= No_VM then
-         return;
+         else
+            Decl := First (Decls);
+         end if;
       end if;
 
-      --  Processing for anonymous access-to-controlled types. These access
-      --  types receive a special collection which appears on the declarations
-      --  of the enclosing semantic unit.
+      return Decl;
+   end Current_Unit_First_Declaration;
 
-      if Ekind (Ptr_Typ) = E_Anonymous_Access_Type
-        and then No (Associated_Collection (Ptr_Typ))
-        and then
-          (not Restriction_Active (No_Nested_Finalization)
-             or else Is_Library_Level_Entity (Ptr_Typ))
-      then
-         declare
-            Pool_Id : constant Entity_Id :=
-                        Get_Global_Pool_For_Access_Type (Ptr_Typ);
-            Scop    : Node_Id := Cunit_Entity (Current_Sem_Unit);
+   ------------------------
+   -- Current_Unit_Scope --
+   ------------------------
 
-         begin
-            --  Use the scope of the current semantic unit when analyzing
+   function Current_Unit_Scope return Entity_Id is
+      Scop_Id  : Entity_Id := Cunit_Entity (Current_Sem_Unit);
+      Subp_Bod : Node_Id;
 
-            if Ekind (Scop) = E_Subprogram_Body then
-               Scop := Corresponding_Spec (Parent (Parent (Parent (Scop))));
-            end if;
+   begin
+      if Ekind (Scop_Id) = E_Subprogram_Body then
 
-            Build_Finalization_Collection
-              (Typ        => Ptr_Typ,
-               Ins_Node   => First_Declaration_Of_Current_Unit,
-               Encl_Scope => Scop);
+         --  When processing subprogram bodies, the proper scope is always
+         --  that of the spec.
 
-            --  Decorate the anonymous access type and the allocator node
+         Subp_Bod := Scop_Id;
+         while Present (Subp_Bod)
+           and then Nkind (Subp_Bod) /= N_Subprogram_Body
+         loop
+            Subp_Bod := Parent (Subp_Bod);
+         end loop;
 
-            Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
-            Set_Storage_Pool (Expression (Temp_Decl), Pool_Id);
-         end;
+         Scop_Id := Corresponding_Spec (Subp_Bod);
       end if;
 
-      --  Since the temporary object reuses the original allocator, generate a
-      --  custom Allocate routine for the temporary.
-
-      if Present (Associated_Collection (Ptr_Typ)) then
-         Build_Allocate_Deallocate_Proc
-           (N           => Temp_Decl,
-            Is_Allocate => True);
-      end if;
-   end Complete_Controlled_Allocation;
+      return Scop_Id;
+   end Current_Unit_Scope;
 
    --------------------------------
    -- Displace_Allocator_Pointer --
@@ -703,6 +664,8 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_Allocator_Expression
 
    begin
+      --  WOuld be nice to comment the branches of this very long if ???
+
       if Is_Tagged_Type (T)
         or else Needs_Finalization (T)
       then
@@ -774,14 +737,13 @@ package body Exp_Ch4 is
             return;
          end if;
 
-         --    Actions inserted before:
-         --              Temp : constant ptr_T := new T'(Expression);
-         --   <no CW>    Temp._tag := T'tag;
-         --   <CTRL>     Adjust (Finalizable (Temp.all));
-         --   <CTRL>     Attach_To_Final_List (Finalizable (Temp.all));
+         --  Actions inserted before:
+         --    Temp : constant ptr_T := new T'(Expression);
+         --    Temp._tag = T'tag;  --  when not class-wide
+         --    [Deep_]Adjust (Temp.all);
 
-         --  We analyze by hand the new internal allocator to avoid
-         --  any recursion and inappropriate call to Initialize
+         --  We analyze by hand the new internal allocator to avoid any
+         --  recursion and inappropriate call to Initialize
 
          --  We don't want to remove side effects when the expression must be
          --  built in place. In the case of a build-in-place function call,
@@ -855,17 +817,17 @@ package body Exp_Ch4 is
                Set_No_Initialization (Expression (Temp_Decl));
                Insert_Action (N, Temp_Decl);
 
-               Complete_Controlled_Allocation (Temp_Decl);
+               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
                Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
 
-               --  Attach the object to the associated finalization collection.
+               --  Attach the object to the associated finalization master.
                --  This is done manually on .NET/JVM since those compilers do
                --  no support pools and can't benefit from internally generated
                --  Allocate / Deallocate procedures.
 
                if VM_Target /= No_VM
                  and then Is_Controlled (DesigT)
-                 and then Present (Associated_Collection (PtrT))
+                 and then Present (Finalization_Master (PtrT))
                then
                   Insert_Action (N,
                     Make_Attach_Call (
@@ -886,16 +848,16 @@ package body Exp_Ch4 is
                    Expression          => Node);
 
                Insert_Action (N, Temp_Decl);
-               Complete_Controlled_Allocation (Temp_Decl);
+               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
 
-               --  Attach the object to the associated finalization collection.
+               --  Attach the object to the associated finalization master.
                --  This is done manually on .NET/JVM since those compilers do
                --  no support pools and can't benefit from internally generated
                --  Allocate / Deallocate procedures.
 
                if VM_Target /= No_VM
                  and then Is_Controlled (DesigT)
-                 and then Present (Associated_Collection (PtrT))
+                 and then Present (Finalization_Master (PtrT))
                then
                   Insert_Action (N,
                     Make_Attach_Call (
@@ -931,8 +893,7 @@ package body Exp_Ch4 is
                --  Inherit the allocation-related attributes from the original
                --  access type.
 
-               Set_Associated_Collection (Def_Id,
-                 Associated_Collection (PtrT));
+               Set_Finalization_Master (Def_Id, Finalization_Master (PtrT));
 
                Set_Associated_Storage_Pool (Def_Id,
                  Associated_Storage_Pool (PtrT));
@@ -959,7 +920,7 @@ package body Exp_Ch4 is
                   Set_No_Initialization (Expression (Temp_Decl));
                   Insert_Action (N, Temp_Decl);
 
-                  Complete_Controlled_Allocation (Temp_Decl);
+                  Build_Allocate_Deallocate_Proc (Temp_Decl, True);
                   Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
 
                else
@@ -974,7 +935,7 @@ package body Exp_Ch4 is
                       Expression          => Node);
 
                   Insert_Action (N, Temp_Decl);
-                  Complete_Controlled_Allocation (Temp_Decl);
+                  Build_Allocate_Deallocate_Proc (Temp_Decl, True);
                end if;
 
                --  Generate an additional object containing the address of the
@@ -1085,19 +1046,18 @@ package body Exp_Ch4 is
             end if;
 
             --  Generate:
-            --    Set_Finalize_Address_Ptr
-            --      (Collection, <Finalize_Address>'Unrestricted_Access)
+            --    Set_Finalize_Address (<PtrT>FM, <T>FD'Unrestricted_Access);
 
             --  Since .NET/JVM compilers do not support address arithmetic,
             --  this call is skipped. The same is done for CodePeer because
-            --  Finalize_Address is never generated.
+            --  primitive Finalize_Address is never generated.
 
             if VM_Target = No_VM
               and then not CodePeer_Mode
-              and then Present (Associated_Collection (PtrT))
+              and then Present (Finalization_Master (PtrT))
             then
                Insert_Action (N,
-                 Make_Set_Finalize_Address_Ptr_Call
+                 Make_Set_Finalize_Address_Call
                    (Loc     => Loc,
                     Typ     => T,
                     Ptr_Typ => PtrT));
@@ -1136,17 +1096,17 @@ package body Exp_Ch4 is
          Set_No_Initialization (Expression (Temp_Decl));
          Insert_Action (N, Temp_Decl);
 
-         Complete_Controlled_Allocation (Temp_Decl);
+         Build_Allocate_Deallocate_Proc (Temp_Decl, True);
          Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
 
-         --  Attach the object to the associated finalization collection. This
-         --  is done manually on .NET/JVM since those compilers do no support
+         --  Attach the object to the associated finalization master. Thisis
+         --  done manually on .NET/JVM since those compilers do no support
          --  pools and cannot benefit from internally generated Allocate and
          --  Deallocate procedures.
 
          if VM_Target /= No_VM
            and then Is_Controlled (DesigT)
-           and then Present (Associated_Collection (PtrT))
+           and then Present (Finalization_Master (PtrT))
          then
             Insert_Action (N,
               Make_Attach_Call
@@ -1178,7 +1138,10 @@ package body Exp_Ch4 is
 
             Rewrite (Exp, New_Copy (Expression (Exp)));
          end if;
+
       else
+         Build_Allocate_Deallocate_Proc (N, True);
+
          --  If we have:
          --    type A is access T1;
          --    X : A := new T2'(...);
@@ -1225,7 +1188,8 @@ package body Exp_Ch4 is
                Insert_Action (Exp,
                  Make_Subtype_Declaration (Loc,
                    Defining_Identifier => ConstrT,
-                   Subtype_Indication  => Make_Subtype_From_Expr (Exp, T)));
+                   Subtype_Indication  =>
+                     Make_Subtype_From_Expr (Internal_Exp, T)));
                Freeze_Itype (ConstrT, Exp);
                Rewrite (Exp, OK_Convert_To (ConstrT, Internal_Exp));
             end;
@@ -3267,8 +3231,9 @@ package body Exp_Ch4 is
       Etyp  : constant Entity_Id  := Etype (Expression (N));
       Loc   : constant Source_Ptr := Sloc (N);
       Desig : Entity_Id;
-      Temp  : Entity_Id;
       Nod   : Node_Id;
+      Pool  : Entity_Id;
+      Temp  : Entity_Id;
 
       procedure Rewrite_Coextension (N : Node_Id);
       --  Static coextensions have the same lifetime as the entity they
@@ -3391,22 +3356,55 @@ package body Exp_Ch4 is
 
       Validate_Remote_Access_To_Class_Wide_Type (N);
 
-      --  Set the Storage Pool
+      --  Processing for anonymous access-to-controlled types. These access
+      --  types receive a special finalization master which appears in the
+      --  declarations of the enclosing semantic unit. This expansion is done
+      --  now to ensure that any additional types generated by this routine
+      --  or Expand_Allocator_Expression inherit the proper type attributes.
+
+      if Ekind (PtrT) = E_Anonymous_Access_Type
+        and then Needs_Finalization (Dtyp)
+      then
+         --  Anonymous access-to-controlled types allocate on the global pool.
+         --  Do not set this attribute on .NET/JVM since those targets do not
+         --  support pools.
+
+         if No (Associated_Storage_Pool (PtrT))
+           and then VM_Target = No_VM
+         then
+            Set_Associated_Storage_Pool (PtrT,
+              Get_Global_Pool_For_Access_Type (PtrT));
+         end if;
+
+         --  The finalization master must be inserted and analyzed as part of
+         --  the current semantic unit.
 
-      Set_Storage_Pool (N, Associated_Storage_Pool (Root_Type (PtrT)));
+         if No (Finalization_Master (PtrT)) then
+            Build_Finalization_Master
+              (Typ        => PtrT,
+               Ins_Node   => Current_Unit_First_Declaration,
+               Encl_Scope => Current_Unit_Scope);
+         end if;
+      end if;
 
-      if Present (Storage_Pool (N)) then
-         if Is_RTE (Storage_Pool (N), RE_SS_Pool) then
+      --  Set the storage pool and find the appropriate version of Allocate to
+      --  call.
+
+      Pool := Associated_Storage_Pool (Root_Type (PtrT));
+      Set_Storage_Pool (N, Pool);
+
+      if Present (Pool) then
+         if Is_RTE (Pool, RE_SS_Pool) then
             if VM_Target = No_VM then
                Set_Procedure_To_Call (N, RTE (RE_SS_Allocate));
             end if;
 
-         elsif Is_Class_Wide_Type (Etype (Storage_Pool (N))) then
+         elsif Is_Class_Wide_Type (Etype (Pool)) then
             Set_Procedure_To_Call (N, RTE (RE_Allocate_Any));
 
          else
             Set_Procedure_To_Call (N,
-              Find_Prim_Op (Etype (Storage_Pool (N)), Name_Allocate));
+              Find_Prim_Op (Etype (Pool), Name_Allocate));
          end if;
       end if;
 
@@ -3564,10 +3562,10 @@ package body Exp_Ch4 is
             --  do not support pools, this step is skipped.
 
             if VM_Target = No_VM
-              and then Present (Associated_Collection (PtrT))
+              and then Present (Finalization_Master (PtrT))
             then
                Build_Allocate_Deallocate_Proc
-                 (N           => Parent (N),
+                 (N           => N,
                   Is_Allocate => True);
             end if;
 
@@ -3805,14 +3803,13 @@ package body Exp_Ch4 is
                Nod := Relocate_Node (N);
 
                --  Here is the transformation:
-               --    input:  new T
-               --    output: Temp : constant ptr_T := new T;
-               --            Init (Temp.all, ...);
-               --    <CTRL>  Attach_To_Final_List (Finalizable (Temp.all));
-               --    <CTRL>  Initialize (Finalizable (Temp.all));
+               --    input:  new Ctrl_Typ
+               --    output: Temp : constant Ctrl_Typ_Ptr := new Ctrl_Typ;
+               --            Ctrl_TypIP (Temp.all, ...);
+               --            [Deep_]Initialize (Temp.all);
 
-               --  Here ptr_T is the pointer type for the allocator, and is the
-               --  subtype of the allocator.
+               --  Here Ctrl_Typ_Ptr is the pointer type for the allocator, and
+               --  is the subtype of the allocator.
 
                Temp_Decl :=
                  Make_Object_Declaration (Loc,
@@ -3824,7 +3821,7 @@ package body Exp_Ch4 is
                Set_Assignment_OK (Temp_Decl);
                Insert_Action (N, Temp_Decl, Suppress => All_Checks);
 
-               Complete_Controlled_Allocation (Temp_Decl);
+               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
 
                --  If the designated type is a task type or contains tasks,
                --  create block to activate created tasks, and insert
@@ -3858,35 +3855,35 @@ package body Exp_Ch4 is
                       (Obj_Ref => New_Copy_Tree (Init_Arg1),
                        Typ     => T));
 
-                  if Present (Associated_Collection (PtrT)) then
+                  if Present (Finalization_Master (PtrT)) then
 
                      --  Special processing for .NET/JVM, the allocated object
-                     --  is attached to the finalization collection. Generate:
+                     --  is attached to the finalization master. Generate:
 
-                     --    Attach (<PtrT>FC, Root_Controlled_Ptr (Init_Arg1));
+                     --    Attach (<PtrT>FM, Root_Controlled_Ptr (Init_Arg1));
 
                      --  Types derived from [Limited_]Controlled are the only
                      --  ones considered since they have fields Prev and Next.
 
-                     if VM_Target /= No_VM then
-                        if Is_Controlled (T) then
-                           Insert_Action (N,
-                             Make_Attach_Call
-                               (Obj_Ref => New_Copy_Tree (Init_Arg1),
-                                Ptr_Typ => PtrT));
-                        end if;
+                     if VM_Target /= No_VM
+                       and then Is_Controlled (T)
+                     then
+                        Insert_Action (N,
+                          Make_Attach_Call
+                            (Obj_Ref => New_Copy_Tree (Init_Arg1),
+                             Ptr_Typ => PtrT));
 
                      --  Default case, generate:
 
-                     --    Set_Finalize_Address_Ptr
-                     --      (Pool, <Finalize_Address>'Unrestricted_Access)
+                     --    Set_Finalize_Address
+                     --      (<PtrT>FM, <T>FD'Unrestricted_Access);
 
                      --  Do not generate the above for CodePeer compilations
-                     --  because Finalize_Address is never built.
+                     --  because primitive Finalize_Address is never built.
 
                      elsif not CodePeer_Mode then
                         Insert_Action (N,
-                          Make_Set_Finalize_Address_Ptr_Call
+                          Make_Set_Finalize_Address_Call
                             (Loc     => Loc,
                              Typ     => T,
                              Ptr_Typ => PtrT));
@@ -5545,25 +5542,6 @@ package body Exp_Ch4 is
       elsif Is_Integer_Type (Typ) then
          Apply_Divide_Check (N);
 
-         --  Check for 64-bit division available, or long shifts if the divisor
-         --  is a small power of 2 (since such divides will be converted into
-         --  long shifts).
-
-         if Esize (Ltyp) > 32
-           and then not Support_64_Bit_Divides_On_Target
-           and then
-             (not Rknow
-                or else not Support_Long_Shifts_On_Target
-                or else (Rval /= Uint_2  and then
-                         Rval /= Uint_4  and then
-                         Rval /= Uint_8  and then
-                         Rval /= Uint_16 and then
-                         Rval /= Uint_32 and then
-                         Rval /= Uint_64))
-         then
-            Error_Msg_CRT ("64-bit division", N);
-         end if;
-
       --  Deal with Vax_Float
 
       elsif Vax_Float (Typ) then
@@ -6193,6 +6171,12 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
+      --  CodePeer and GNATprove want to see the unexpanded N_Op_Expon node
+
+      if CodePeer_Mode or ALFA_Mode then
+         return;
+      end if;
+
       --  If either operand is of a private type, then we have the use of an
       --  intrinsic operator, and we get rid of the privateness, by using root
       --  types of underlying types for the actual operation. Otherwise the
@@ -6201,12 +6185,9 @@ package body Exp_Ch4 is
       --  different from the base type.
 
       if Is_Private_Type (Etype (Base))
-           or else
-         Is_Private_Type (Typ)
-           or else
-         Is_Private_Type (Exptyp)
-           or else
-         Rtyp /= Root_Type (Bastyp)
+        or else Is_Private_Type (Typ)
+        or else Is_Private_Type (Exptyp)
+        or else Rtyp /= Root_Type (Bastyp)
       then
          declare
             Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp));
@@ -7158,9 +7139,10 @@ package body Exp_Ch4 is
          end;
       end if;
 
-      --  Only array types need any other processing
+      --  Only array types need any other processing. In formal verification
+      --  mode, no other processing is done.
 
-      if not Is_Array_Type (Typ) then
+      if not Is_Array_Type (Typ) or else ALFA_Mode then
          return;
       end if;
 
@@ -7616,6 +7598,13 @@ package body Exp_Ch4 is
       Test         : Node_Id;
 
    begin
+      --  Do not expand quantified expressions in ALFA mode
+      --  why not???
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Decl :=
         Make_Object_Declaration (Loc,
           Defining_Identifier => Tnn,
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 165f9ae8a09..366140e9580 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -1511,6 +1512,7 @@ package body Exp_Ch5 is
 
    procedure Expand_N_Assignment_Statement (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
+      Crep : constant Boolean    := Change_Of_Representation (N);
       Lhs  : constant Node_Id    := Name (N);
       Rhs  : constant Node_Id    := Expression (N);
       Typ  : constant Entity_Id  := Underlying_Type (Etype (Lhs));
@@ -1780,7 +1782,7 @@ package body Exp_Ch5 is
          --  Skip discriminant check if change of representation. Will be
          --  done when the change of representation is expanded out.
 
-         if not Change_Of_Representation (N) then
+         if not Crep then
             Apply_Discriminant_Check (Rhs, Etype (Lhs), Lhs);
          end if;
 
@@ -1830,7 +1832,7 @@ package body Exp_Ch5 is
             --  Skip discriminant check if change of representation. Will be
             --  done when the change of representation is expanded out.
 
-            if not Change_Of_Representation (N) then
+            if not Crep then
                Apply_Discriminant_Check (Rhs, Etype (Lhs));
             end if;
 
@@ -1883,13 +1885,53 @@ package body Exp_Ch5 is
          Apply_Constraint_Check (Rhs, Etype (Lhs));
       end if;
 
-      --  Case of assignment to a bit packed array element
+      --  Case of assignment to a bit packed array element. If there is a
+      --  change of representation this must be expanded into components,
+      --  otherwise this is a bit-field assignment.
 
       if Nkind (Lhs) = N_Indexed_Component
         and then Is_Bit_Packed_Array (Etype (Prefix (Lhs)))
       then
-         Expand_Bit_Packed_Element_Set (N);
-         return;
+         --  Normal case, no change of representation
+
+         if not Crep then
+            Expand_Bit_Packed_Element_Set (N);
+            return;
+
+         --  Change of representation case
+
+         else
+            --  Generate the following, to force component-by-component
+            --  assignments in an efficient way. Otherwise each component
+            --  will require a temporary and two bit-field manipulations.
+
+            --  T1 : Elmt_Type;
+            --  T1 := RhS;
+            --  Lhs := T1;
+
+            declare
+               Tnn : constant Entity_Id := Make_Temporary (Loc, 'T');
+               Stats : List_Id;
+
+            begin
+               Stats :=
+                 New_List (
+                   Make_Object_Declaration (Loc,
+                     Defining_Identifier => Tnn,
+                     Object_Definition   =>
+                       New_Occurrence_Of (Etype (Lhs), Loc)),
+                   Make_Assignment_Statement (Loc,
+                     Name       => New_Occurrence_Of (Tnn, Loc),
+                     Expression => Relocate_Node (Rhs)),
+                   Make_Assignment_Statement (Loc,
+                     Name       => Relocate_Node (Lhs),
+                     Expression => New_Occurrence_Of (Tnn, Loc)));
+
+               Insert_Actions (N, Stats);
+               Rewrite (N, Make_Null_Statement (Loc));
+               Analyze (N);
+            end;
+         end if;
 
       --  Build-in-place function call case. Note that we're not yet doing
       --  build-in-place for user-written assignment statements (the assignment
@@ -2784,6 +2826,7 @@ package body Exp_Ch5 is
       Container     : constant Node_Id   := Name (I_Spec);
       Container_Typ : constant Entity_Id := Etype (Container);
       Cursor        : Entity_Id;
+      Iterator      : Entity_Id;
       New_Loop      : Node_Id;
       Stats         : List_Id := Statements (N);
 
@@ -2798,10 +2841,10 @@ package body Exp_Ch5 is
          --  the array.
 
          if Of_Present (I_Spec) then
-            Cursor := Make_Temporary (Loc, 'C');
+            Iterator := Make_Temporary (Loc, 'C');
 
             --  Generate:
-            --    Element : Component_Type renames Container (Cursor);
+            --    Element : Component_Type renames Container (Iterator);
 
             Prepend_To (Stats,
               Make_Object_Renaming_Declaration (Loc,
@@ -2812,21 +2855,21 @@ package body Exp_Ch5 is
                   Make_Indexed_Component (Loc,
                     Prefix => Relocate_Node (Container),
                     Expressions => New_List (
-                      New_Reference_To (Cursor, Loc)))));
+                      New_Reference_To (Iterator, Loc)))));
 
          --  for Index in Array loop
-         --
-         --  This case utilizes the already given cursor name
+
+         --  This case utilizes the already given iterator name
 
          else
-            Cursor := Id;
+            Iterator := Id;
          end if;
 
          --  Generate:
-         --    for Cursor in [reverse] Container'Range loop
-         --       Element : Component_Type renames Container (Cursor);
+         --    for Iterator in [reverse] Container'Range loop
+         --       Element : Component_Type renames Container (Iterator);
          --       --  for the "of" form
-         --
+
          --       <original loop statements>
          --    end loop;
 
@@ -2836,7 +2879,7 @@ package body Exp_Ch5 is
                Make_Iteration_Scheme (Loc,
                  Loop_Parameter_Specification =>
                    Make_Loop_Parameter_Specification (Loc,
-                     Defining_Identifier => Cursor,
+                     Defining_Identifier => Iterator,
                        Discrete_Subtype_Definition =>
                          Make_Attribute_Reference (Loc,
                            Prefix => Relocate_Node (Container),
@@ -2848,21 +2891,28 @@ package body Exp_Ch5 is
       --  Processing for containers
 
       else
+         --  For an iterator of the form "Of" then name is some expression,
+         --  which is transformed into a call to the default iterator.
+
+         --  For an iterator of the form "in" then name is a function call
+         --  that delivers an iterator.
+
          --  The for loop is expanded into a while loop which uses a container
          --  specific cursor to examine each element.
 
-         --    Cursor : Pack.Cursor := Container.First;
-         --    while Cursor /= Pack.No_Element loop
+         --    Iter : Iterator_Type := Container.Iterate;
+         --    Cursor : Cursor_type := First (Iter);
+         --    while Has_Element (Iter) loop
          --       declare
          --       --  the block is added when Element_Type is controlled
 
-         --          Obj : Pack.Element_Type := Element (Cursor);
+         --          Obj : Pack.Element_Type := Element (Iterator);
          --          --  for the "of" loop form
          --       begin
          --          <original loop statements>
          --       end;
 
-         --       Pack.Next (Cursor);
+         --       Cursor := Iter.Next (Cursor);
          --    end loop;
 
          --  If "reverse" is present, then the initialization of the cursor
@@ -2871,72 +2921,150 @@ package body Exp_Ch5 is
 
          declare
             Element_Type : constant Entity_Id := Etype (Id);
-            Pack         : constant Entity_Id :=
-                             Scope (Base_Type (Container_Typ));
+            Iter_Type    : Entity_Id;
+            Pack         : Entity_Id;
             Decl         : Node_Id;
-            Cntr         : Node_Id;
             Name_Init    : Name_Id;
             Name_Step    : Name_Id;
 
          begin
-            --  The "of" case uses an internally generated cursor
 
-            if Of_Present (I_Spec) then
-               Cursor := Make_Temporary (Loc, 'C');
+            --  The type of the iterator is the return type of the Iterate
+            --  function used. For the "of" form this is the default iterator
+            --  for the type, otherwise it is the type of the explicit
+            --  function used in the loop.
+
+            Iter_Type := Etype (Name (I_Spec));
+
+            if Is_Entity_Name (Container) then
+               Pack := Scope (Etype (Container));
+
             else
-               Cursor := Id;
+               Pack := Scope (Entity (Name (Container)));
             end if;
 
-            --  The code below only handles containers where Element is not a
-            --  primitive operation of the container. This excludes for now the
-            --  Hi-Lite formal containers.
+            --  The "of" case uses an internally generated cursor whose type
+            --  is found in the container package. The domain of iteration
+            --  is expanded into a call to the default Iterator function, but
+            --  this expansion does not take place in a quantifier expressions
+            --  that are analyzed with expansion disabled, and in that case the
+            --  type of the iterator must be obtained from the aspect.
 
             if Of_Present (I_Spec) then
+               declare
+                  Default_Iter : constant Entity_Id :=
+                                   Entity
+                                     (Find_Aspect
+                                       (Etype (Container),
+                                        Aspect_Default_Iterator));
 
-               --  Generate:
-               --    Id : Element_Type := Pack.Element (Cursor);
-
-               Decl :=
-                 Make_Object_Renaming_Declaration (Loc,
-                   Defining_Identifier => Id,
-                   Subtype_Mark =>
-                     New_Reference_To (Element_Type, Loc),
-                   Name =>
-                     Make_Indexed_Component (Loc,
-                       Prefix =>
-                         Make_Selected_Component (Loc,
-                           Prefix =>
-                             New_Reference_To (Pack, Loc),
-                           Selector_Name =>
-                             Make_Identifier (Loc, Chars => Name_Element)),
-                       Expressions => New_List (
-                         New_Reference_To (Cursor, Loc))));
+                  Container_Arg : Node_Id;
+                  Ent           : Entity_Id;
+
+               begin
+                  Cursor := Make_Temporary (Loc, 'I');
 
-               --  When the container holds controlled objects, wrap the loop
-               --  statements and element renaming declaration with a block.
-               --  This ensures that the transient result of Element (Cursor)
-               --  is cleaned up after each iteration of the loop.
+                  if Is_Iterator (Iter_Type) then
+                     null;
 
-               if Needs_Finalization (Element_Type) then
+                  else
+                     Iter_Type := Etype (Default_Iter);
+
+                     --  Rewrite domain of iteration as a call to the default
+                     --  iterator for the container type. If the container is
+                     --  a derived type and the aspect is inherited, convert
+                     --  container to parent type. The Cursor type is also
+                     --  inherited from the scope of the parent.
+
+                     if Base_Type (Etype (Container)) =
+                        Base_Type (Etype (First_Formal (Default_Iter)))
+                     then
+                        Container_Arg := New_Copy_Tree (Container);
+
+                     else
+                        Pack := Scope (Default_Iter);
+
+                        Container_Arg :=
+                          Make_Type_Conversion (Loc,
+                            Subtype_Mark =>
+                              New_Occurrence_Of
+                                (Etype (First_Formal (Default_Iter)), Loc),
+                            Expression => New_Copy_Tree (Container));
+                     end if;
+
+                     Rewrite (Name (I_Spec),
+                       Make_Function_Call (Loc,
+                         Name => New_Occurrence_Of (Default_Iter, Loc),
+                         Parameter_Associations =>
+                           New_List (Container_Arg)));
+                     Analyze_And_Resolve (Name (I_Spec));
+                  end if;
+
+                  --  Find cursor type in proper container package.
+
+                  Ent := First_Entity (Pack);
+                  while Present (Ent) loop
+                     if Chars (Ent) = Name_Cursor then
+                        Set_Etype (Cursor, Etype (Ent));
+                        exit;
+                     end if;
+                     Next_Entity (Ent);
+                  end loop;
 
                   --  Generate:
-                  --    declare
-                  --       Id : Element_Type := Pack.Element (Cursor);
-                  --    begin
-                  --       <original loop statements>
-                  --    end;
+                  --    Id : Element_Type renames Pack.Element (Cursor);
 
-                  Stats := New_List (
-                    Make_Block_Statement (Loc,
-                      Declarations => New_List (Decl),
-                      Handled_Statement_Sequence =>
-                        Make_Handled_Sequence_Of_Statements (Loc,
-                          Statements => Stats)));
-               else
-                  Prepend_To (Stats, Decl);
-               end if;
+                  Decl :=
+                    Make_Object_Renaming_Declaration (Loc,
+                      Defining_Identifier => Id,
+                      Subtype_Mark        =>
+                        New_Reference_To (Element_Type, Loc),
+                      Name                =>
+                        Make_Indexed_Component (Loc,
+                          Prefix      => Make_Selected_Component (Loc,
+                              Prefix        => New_Reference_To (Pack, Loc),
+                              Selector_Name =>
+                                Make_Identifier (Loc, Chars => Name_Element)),
+                          Expressions =>
+                            New_List (New_Occurrence_Of (Cursor, Loc))));
+
+                  --  If the container holds controlled objects, wrap the loop
+                  --  statements and element renaming declaration with a block.
+                  --  This ensures that the result of Element (Iterator) is
+                  --  cleaned up after each iteration of the loop.
+
+                  if Needs_Finalization (Element_Type) then
+
+                     --  Generate:
+                     --    declare
+                     --       Id : Element_Type := Pack.Element (Iterator);
+                     --    begin
+                     --       <original loop statements>
+                     --    end;
+
+                     Stats := New_List (
+                       Make_Block_Statement (Loc,
+                         Declarations               => New_List (Decl),
+                         Handled_Statement_Sequence =>
+                           Make_Handled_Sequence_Of_Statements (Loc,
+                              Statements => Stats)));
+
+                  --  Elements do not need finalization
+
+                  else
+                     Prepend_To (Stats, Decl);
+                  end if;
+               end;
+
+            --  X in Iterate (S) : type of iterator is type of explicitly
+            --  given Iterate function.
+
+            else
+               Cursor := Id;
             end if;
 
+            Iterator := Make_Temporary (Loc, 'I');
+
             --  Determine the advancement and initialization steps for the
             --  cursor.
 
@@ -2952,23 +3080,34 @@ package body Exp_Ch5 is
 
             --  For both iterator forms, add a call to the step operation to
             --  advance the cursor. Generate:
-            --
-            --    Pack.[Next | Prev] (Cursor);
 
-            Append_To (Stats,
-              Make_Procedure_Call_Statement (Loc,
-                Name =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>
-                      New_Reference_To (Pack, Loc),
-                    Selector_Name =>
-                      Make_Identifier (Loc, Name_Step)),
+            --     Cursor := Iterator.Next (Cursor);
+
+            --   or else
 
-                Parameter_Associations => New_List (
-                  New_Reference_To (Cursor, Loc))));
+            --     Cursor := Next (Cursor);
+
+            declare
+               Rhs : Node_Id;
+
+            begin
+               Rhs :=
+                 Make_Function_Call (Loc,
+                   Name                   =>
+                     Make_Selected_Component (Loc,
+                       Prefix        => New_Reference_To (Iterator, Loc),
+                       Selector_Name => Make_Identifier (Loc, Name_Step)),
+                   Parameter_Associations => New_List (
+                      New_Reference_To (Cursor, Loc)));
+
+               Append_To (Stats,
+                 Make_Assignment_Statement (Loc,
+                    Name       => New_Occurrence_Of (Cursor, Loc),
+                    Expression => Rhs));
+            end;
 
             --  Generate:
-            --    while Cursor /= Pack.No_Element loop
+            --    while Iterator.Has_Element loop
             --       <Stats>
             --    end loop;
 
@@ -2977,71 +3116,59 @@ package body Exp_Ch5 is
                 Iteration_Scheme =>
                   Make_Iteration_Scheme (Loc,
                     Condition =>
-                      Make_Op_Ne (Loc,
-                        Left_Opnd =>
-                          New_Reference_To (Cursor, Loc),
-                        Right_Opnd =>
+                      Make_Function_Call (Loc,
+                        Name                   =>
                           Make_Selected_Component (Loc,
-                            Prefix =>
-                              New_Reference_To (Pack, Loc),
-                            Selector_Name =>
-                              Make_Identifier (Loc, Name_No_Element)))),
+                           Prefix => New_Occurrence_Of (Pack, Loc),
+                           Selector_Name =>
+                             Make_Identifier (Loc,  Name_Has_Element)),
+
+                        Parameter_Associations =>
+                          New_List (
+                            New_Reference_To (Cursor, Loc)))),
                 Statements => Stats,
                 End_Label  => Empty);
 
-            Cntr := Relocate_Node (Container);
-
-            --  When the container is provided by a function call, create an
-            --  explicit renaming of the function result. Generate:
-            --
-            --    Cnn : Container_Typ renames Func_Call (...);
-            --
-            --  The renaming avoids the generation of a transient scope when
-            --  initializing the cursor and the premature finalization of the
-            --  container.
+            --  Create the declarations for Iterator and cursor and insert then
+            --  before the source loop. Generate:
 
-            if Nkind (Cntr) = N_Function_Call then
-               declare
-                  Ren_Id : constant Entity_Id := Make_Temporary (Loc, 'C');
+            --    I : Iterator_Type := Iterate (Container);
+            --    C : Pack.Cursor_Type := Container.[First | Last];
 
-               begin
-                  Insert_Action (N,
-                    Make_Object_Renaming_Declaration (Loc,
-                      Defining_Identifier => Ren_Id,
-                      Subtype_Mark =>
-                        New_Reference_To (Container_Typ, Loc),
-                      Name => Cntr));
+            declare
+               Decl1 : Node_Id;
+               Decl2 : Node_Id;
 
-                  Cntr := New_Reference_To (Ren_Id, Loc);
-               end;
-            end if;
+            begin
+               Decl1 :=
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Iterator,
+                   Object_Definition   => New_Occurrence_Of (Iter_Type, Loc),
+                   Expression          => Relocate_Node (Name (I_Spec)));
+               Set_Assignment_OK (Decl1);
 
-            --  Create the declaration of the cursor and insert it before the
-            --  source loop. Generate:
-            --
-            --    C : Pack.Cursor_Type := Container.[First | Last];
+               Decl2 :=
+                 Make_Object_Declaration (Loc,
+                   Defining_Identifier => Cursor,
+                   Object_Definition   =>
+                     New_Occurrence_Of (Etype (Cursor), Loc),
+                   Expression          =>
+                     Make_Selected_Component (Loc,
+                       Prefix        => New_Reference_To (Iterator, Loc),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Name_Init)));
 
-            Insert_Action (N,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Cursor,
-                Object_Definition =>
-                  Make_Selected_Component (Loc,
-                    Prefix =>
-                      New_Reference_To (Pack, Loc),
-                    Selector_Name =>
-                      Make_Identifier (Loc, Name_Cursor)),
+               Set_Assignment_OK (Decl2);
 
-                Expression =>
-                  Make_Selected_Component (Loc,
-                    Prefix => Cntr,
-                    Selector_Name =>
-                      Make_Identifier (Loc, Name_Init))));
+               Insert_Actions (N,
+                 New_List (Decl1, Decl2));
+            end;
 
-            --  The cursor is not modified in the source, but of course will
+            --  The Iterator is not modified in the source, but of course will
             --  be updated in the generated code. Indicate that it is actually
             --  set to prevent spurious warnings.
 
-            Set_Never_Set_In_Source (Cursor, False);
+            Set_Never_Set_In_Source (Iterator, False);
 
             --  If the range of iteration is given by a function call that
             --  returns a container, the finalization actions have been saved
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index cb6a6543ca4..8073ff568fd 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -110,14 +110,14 @@ package body Exp_Ch6 is
    --  Adds Extra_Actual as a named parameter association for the formal
    --  Extra_Formal in Subprogram_Call.
 
-   procedure Add_Collection_Actual_To_Build_In_Place_Call
+   procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
      (Func_Call : Node_Id;
       Func_Id   : Entity_Id;
       Ptr_Typ   : Entity_Id := Empty);
    --  Ada 2005 (AI-318-02): If the result type of a build-in-place call needs
    --  finalization actions, add an actual parameter which is a pointer to the
-   --  finalization collection of the caller. If Ptr_Typ is left Empty, this
-   --  will result in an automatic "null" value for the actual.
+   --  finalization master of the caller. If Ptr_Typ is left Empty, this will
+   --  result in an automatic "null" value for the actual.
 
    procedure Add_Task_Actuals_To_Build_In_Place_Call
      (Function_Call : Node_Id;
@@ -223,10 +223,6 @@ package body Exp_Ch6 is
    --  reference to the object itself, and the call becomes a call to the
    --  corresponding protected subprogram.
 
-   function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
-   --  Predicate to recognize stubbed procedures and null procedures, which
-   --  can be inlined unconditionally in all cases.
-
    procedure Expand_Simple_Function_Return (N : Node_Id);
    --  Expand simple return from function. In the case where we are returning
    --  from a function body this is called by Expand_N_Simple_Return_Statement.
@@ -340,30 +336,30 @@ package body Exp_Ch6 is
         (Function_Call, Alloc_Form_Formal, Alloc_Form_Actual);
    end Add_Alloc_Form_Actual_To_Build_In_Place_Call;
 
-   --------------------------------------------------
-   -- Add_Collection_Actual_To_Build_In_Place_Call --
-   --------------------------------------------------
+   -----------------------------------------------------------
+   -- Add_Finalization_Master_Actual_To_Build_In_Place_Call --
+   -----------------------------------------------------------
 
-   procedure Add_Collection_Actual_To_Build_In_Place_Call
+   procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call
      (Func_Call : Node_Id;
       Func_Id   : Entity_Id;
       Ptr_Typ   : Entity_Id := Empty)
    is
    begin
-      if not Needs_BIP_Collection (Func_Id) then
+      if not Needs_BIP_Finalization_Master (Func_Id) then
          return;
       end if;
 
       declare
          Formal : constant Entity_Id :=
-                    Build_In_Place_Formal (Func_Id, BIP_Collection);
+                    Build_In_Place_Formal (Func_Id, BIP_Finalization_Master);
          Loc    : constant Source_Ptr := Sloc (Func_Call);
 
          Actual    : Node_Id;
          Desig_Typ : Entity_Id;
 
       begin
-         --  Case where the context does not require an actual collection
+         --  Case where the context does not require an actual master
 
          if No (Ptr_Typ) then
             Actual := Make_Null (Loc);
@@ -372,9 +368,9 @@ package body Exp_Ch6 is
             Desig_Typ := Directly_Designated_Type (Ptr_Typ);
 
             --  Check for a library-level access type whose designated type has
-            --  supressed finalization. Such an access types lack a collection.
+            --  supressed finalization. Such an access types lack a master.
             --  Pass a null actual to the callee in order to signal a missing
-            --  collection.
+            --  master.
 
             if Is_Library_Level_Entity (Ptr_Typ)
               and then Finalize_Storage_Only (Desig_Typ)
@@ -385,28 +381,28 @@ package body Exp_Ch6 is
 
             elsif Needs_Finalization (Desig_Typ) then
 
-               --  The general mechanism of creating finalization collections
-               --  for anonymous access types is disabled by default, otherwise
-               --  collections will pop all over the place. Such types use
-               --  context-specific collections.
+               --  The general mechanism of creating finalization masters for
+               --  anonymous access types is disabled by default, otherwise
+               --  finalization masters will pop all over the place. Such types
+               --  use context-specific masters.
 
                if Ekind (Ptr_Typ) = E_Anonymous_Access_Type
-                 and then No (Associated_Collection (Ptr_Typ))
+                 and then No (Finalization_Master (Ptr_Typ))
                then
-                  Build_Finalization_Collection
+                  Build_Finalization_Master
                     (Typ        => Ptr_Typ,
                      Ins_Node   => Associated_Node_For_Itype (Ptr_Typ),
                      Encl_Scope => Scope (Ptr_Typ));
                end if;
 
-               --  Access-to-controlled types should always have a collection
+               --  Access-to-controlled types should always have a master
 
-               pragma Assert (Present (Associated_Collection (Ptr_Typ)));
+               pragma Assert (Present (Finalization_Master (Ptr_Typ)));
 
                Actual :=
                  Make_Attribute_Reference (Loc,
                    Prefix =>
-                     New_Reference_To (Associated_Collection (Ptr_Typ), Loc),
+                     New_Reference_To (Finalization_Master (Ptr_Typ), Loc),
                    Attribute_Name => Name_Unrestricted_Access);
 
             --  Tagged types
@@ -423,7 +419,7 @@ package body Exp_Ch6 is
 
          Add_Extra_Actual_To_Call (Func_Call, Formal, Actual);
       end;
-   end Add_Collection_Actual_To_Build_In_Place_Call;
+   end Add_Finalization_Master_Actual_To_Build_In_Place_Call;
 
    ------------------------------
    -- Add_Extra_Actual_To_Call --
@@ -559,15 +555,15 @@ package body Exp_Ch6 is
    function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String is
    begin
       case Kind is
-         when BIP_Alloc_Form       =>
+         when BIP_Alloc_Form          =>
             return "BIPalloc";
-         when BIP_Collection       =>
-            return "BIPcollection";
-         when BIP_Master           =>
+         when BIP_Finalization_Master =>
+            return "BIPfinalizationmaster";
+         when BIP_Master              =>
             return "BIPmaster";
-         when BIP_Activation_Chain =>
+         when BIP_Activation_Chain    =>
             return "BIPactivationchain";
-         when BIP_Object_Access    =>
+         when BIP_Object_Access       =>
             return "BIPaccess";
       end case;
    end BIP_Formal_Suffix;
@@ -2105,10 +2101,10 @@ package body Exp_Ch6 is
          end if;
       end if;
 
-      --  Detect the following code in Ada.Finalization.Heap_Management only
-      --  on .NET/JVM targets:
+      --  Detect the following code in System.Finalization_Masters only on
+      --  .NET/JVM targets:
       --
-      --    procedure Finalize (Collection : in out Finalization_Collection) is
+      --    procedure Finalize (Master : in out Finalization_Master) is
       --    begin
       --       . . .
       --       begin
@@ -2124,7 +2120,7 @@ package body Exp_Ch6 is
         and then Ekind (Scope (Curr_S)) = E_Procedure
         and then Chars (Scope (Curr_S)) = Name_Finalize
         and then Etype (First_Formal (Scope (Curr_S))) =
-                   RTE (RE_Finalization_Collection)
+                   RTE (RE_Finalization_Master)
       then
          declare
             Deep_Fin : constant Entity_Id :=
@@ -4393,20 +4389,20 @@ package body Exp_Ch6 is
          Ret_Typ    : Entity_Id;
          Alloc_Expr : Node_Id) return Node_Id;
       --  Create the statements necessary to allocate a return object on the
-      --  caller's collection. The collection is available through implicit
-      --  parameter BIPcollection.
+      --  caller's master. The master is available through implicit parameter
+      --  BIPfinalizationmaster.
       --
-      --    if BIPcollection /= null then
+      --    if BIPfinalizationmaster /= null then
       --       declare
       --          type Ptr_Typ is access Ret_Typ;
       --          for Ptr_Typ'Storage_Pool use
-      --                Base_Pool (BIPcollection.all).all;
+      --                Base_Pool (BIPfinalizationmaster.all).all;
       --          Local : Ptr_Typ;
       --
       --       begin
       --          procedure Allocate (...) is
       --          begin
-      --             Ada.Finalization.Heap_Management.Allocate (...);
+      --             System.Storage_Pools.Subpools.Allocate_Any (...);
       --          end Allocate;
       --
       --          Local := <Alloc_Expr>;
@@ -4439,17 +4435,18 @@ package body Exp_Ch6 is
       is
       begin
          --  Processing for build-in-place object allocation. This is disabled
-         --  on .NET/JVM because pools are not supported.
+         --  on .NET/JVM because the targets do not support pools.
 
          if VM_Target = No_VM
            and then Is_Build_In_Place_Function (Func_Id)
            and then Needs_Finalization (Ret_Typ)
          then
             declare
-               Collect : constant Entity_Id :=
-                           Build_In_Place_Formal (Func_Id, BIP_Collection);
-               Decls   : constant List_Id := New_List;
-               Stmts   : constant List_Id := New_List;
+               Decls      : constant List_Id := New_List;
+               Fin_Mas_Id : constant Entity_Id :=
+                              Build_In_Place_Formal
+                                (Func_Id, BIP_Finalization_Master);
+               Stmts      : constant List_Id := New_List;
 
                Local_Id : Entity_Id;
                Pool_Id  : Entity_Id;
@@ -4457,7 +4454,7 @@ package body Exp_Ch6 is
 
             begin
                --  Generate:
-               --    Pool_Id renames Base_Pool (BIPcollection.all).all;
+               --    Pool_Id renames Base_Pool (BIPfinalizationmaster.all).all;
 
                Pool_Id := Make_Temporary (Loc, 'P');
 
@@ -4474,11 +4471,12 @@ package body Exp_Ch6 is
                              New_Reference_To (RTE (RE_Base_Pool), Loc),
                            Parameter_Associations => New_List (
                              Make_Explicit_Dereference (Loc,
-                               Prefix => New_Reference_To (Collect, Loc)))))));
+                               Prefix =>
+                                 New_Reference_To (Fin_Mas_Id, Loc)))))));
 
                --  Create an access type which uses the storage pool of the
-               --  caller's collection. This additional type is necessary
-               --  because the collection cannot be associated with the type
+               --  caller's master. This additional type is necessary because
+               --  the finalization master cannot be associated with the type
                --  of the temporary. Otherwise the secondary stack allocation
                --  will fail.
 
@@ -4495,11 +4493,11 @@ package body Exp_Ch6 is
                        Subtype_Indication =>
                          New_Reference_To (Ret_Typ, Loc))));
 
-               --  Perform minor decoration in order to set the collection and
-               --  the storage pool attributes.
+               --  Perform minor decoration in order to set the master and the
+               --  storage pool attributes.
 
                Set_Ekind (Ptr_Typ, E_Access_Type);
-               Set_Associated_Collection   (Ptr_Typ, Collect);
+               Set_Finalization_Master     (Ptr_Typ, Fin_Mas_Id);
                Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
 
                --  Create the temporary, generate:
@@ -4534,12 +4532,12 @@ package body Exp_Ch6 is
                        New_Reference_To (Local_Id, Loc))));
 
                --  Wrap the allocation in a block. This is further conditioned
-               --  by checking the caller collection at runtime. A null value
-               --  indicates a non-existent collection, most likely due to a
-               --  Finalize_Storage_Only allocation.
+               --  by checking the caller finalization master at runtime. A
+               --  null value indicates a non-existent master, most likely due
+               --  to a Finalize_Storage_Only allocation.
 
                --  Generate:
-               --    if BIPcollection /= null then
+               --    if BIPfinalizationmaster /= null then
                --       declare
                --          <Decls>
                --       begin
@@ -4551,7 +4549,7 @@ package body Exp_Ch6 is
                  Make_If_Statement (Loc,
                    Condition       =>
                      Make_Op_Ne (Loc,
-                       Left_Opnd  => New_Reference_To (Collect, Loc),
+                       Left_Opnd  => New_Reference_To (Fin_Mas_Id, Loc),
                        Right_Opnd => Make_Null (Loc)),
 
                    Then_Statements => New_List (
@@ -7110,7 +7108,7 @@ package body Exp_Ch6 is
          Add_Alloc_Form_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
 
-         Add_Collection_Actual_To_Build_In_Place_Call
+         Add_Finalization_Master_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Acc_Type);
 
          Add_Task_Actuals_To_Build_In_Place_Call
@@ -7144,7 +7142,7 @@ package body Exp_Ch6 is
          Add_Alloc_Form_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Alloc_Form => Global_Heap);
 
-         Add_Collection_Actual_To_Build_In_Place_Call
+         Add_Finalization_Master_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Acc_Type);
 
          Add_Task_Actuals_To_Build_In_Place_Call
@@ -7157,28 +7155,28 @@ package body Exp_Ch6 is
            (Func_Call, Function_Id, Return_Object => Empty);
       end if;
 
-      --  If the build-in-place function call returns a controlled object, the
-      --  finalization collection will require a reference to routine Finalize_
-      --  Address of the designated type. Setting this attribute is done in the
-      --  same manner to expansion of allocators.
+      --  If the build-in-place function call returns a controlled object,
+      --  the finalization master will require a reference to routine
+      --  Finalize_Address of the designated type. Setting this attribute
+      --  is done in the same manner to expansion of allocators.
 
       if Needs_Finalization (Result_Subt) then
 
          --  Controlled types with supressed finalization do not need to
-         --  associate the address of their Finalize_Address primitives with a
-         --  collection since they do not need a collection to begin with.
+         --  associate the address of their Finalize_Address primitives with
+         --  a master since they do not need a master to begin with.
 
          if Is_Library_Level_Entity (Acc_Type)
            and then Finalize_Storage_Only (Result_Subt)
          then
             null;
 
-         --  Do not generate the call to Make_Set_Finalize_Address_Ptr for
+         --  Do not generate the call to Make_Set_Finalize_Address for
          --  CodePeer compilations because Finalize_Address is never built.
 
          elsif not CodePeer_Mode then
             Insert_Action (Allocator,
-              Make_Set_Finalize_Address_Ptr_Call (Loc,
+              Make_Set_Finalize_Address_Call (Loc,
                 Typ     => Etype (Function_Id),
                 Ptr_Typ => Acc_Type));
          end if;
@@ -7310,7 +7308,7 @@ package body Exp_Ch6 is
          Add_Alloc_Form_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
 
-         Add_Collection_Actual_To_Build_In_Place_Call
+         Add_Finalization_Master_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id);
 
          Add_Task_Actuals_To_Build_In_Place_Call
@@ -7334,7 +7332,7 @@ package body Exp_Ch6 is
          Add_Alloc_Form_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Alloc_Form => Secondary_Stack);
 
-         Add_Collection_Actual_To_Build_In_Place_Call
+         Add_Finalization_Master_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id);
 
          Add_Task_Actuals_To_Build_In_Place_Call
@@ -7412,7 +7410,7 @@ package body Exp_Ch6 is
       Add_Alloc_Form_Actual_To_Build_In_Place_Call
         (Func_Call, Func_Id, Alloc_Form => Caller_Allocation);
 
-      Add_Collection_Actual_To_Build_In_Place_Call
+      Add_Finalization_Master_Actual_To_Build_In_Place_Call
         (Func_Call, Func_Id);
 
       Add_Task_Actuals_To_Build_In_Place_Call
@@ -7625,7 +7623,7 @@ package body Exp_Ch6 is
          Establish_Transient_Scope (Object_Decl, Sec_Stack => True);
       end if;
 
-      Add_Collection_Actual_To_Build_In_Place_Call
+      Add_Finalization_Master_Actual_To_Build_In_Place_Call
         (Func_Call, Function_Id);
 
       if Nkind (Parent (Object_Decl)) = N_Extended_Return_Statement
@@ -7773,11 +7771,13 @@ package body Exp_Ch6 is
       end if;
    end Make_Build_In_Place_Call_In_Object_Declaration;
 
-   --------------------------
-   -- Needs_BIP_Collection --
-   --------------------------
+   -----------------------------------
+   -- Needs_BIP_Finalization_Master --
+   -----------------------------------
 
-   function Needs_BIP_Collection (Func_Id : Entity_Id) return Boolean is
+   function Needs_BIP_Finalization_Master
+     (Func_Id : Entity_Id) return Boolean
+   is
       pragma Assert (Is_Build_In_Place_Function (Func_Id));
       Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
 
@@ -7785,6 +7785,6 @@ package body Exp_Ch6 is
       return
         not Restriction_Active (No_Finalization)
           and then Needs_Finalization (Func_Typ);
-   end Needs_BIP_Collection;
+   end Needs_BIP_Finalization_Master;
 
 end Exp_Ch6;
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 0c50667d993..1896ce21069 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -68,9 +68,9 @@ package Exp_Ch6 is
       --  caller or callee, and if the callee, whether to use the secondary
       --  stack or the heap. See Create_Extra_Formals.
 
-      BIP_Collection,
+      BIP_Finalization_Master,
       --  Present if result type needs finalization. Pointer to caller's
-      --  finalization collection.
+      --  finalization master.
 
       BIP_Master,
       --  Present if result type contains tasks. Master associated with
@@ -119,6 +119,10 @@ package Exp_Ch6 is
    --  that requires handling as a build-in-place call or is a qualified
    --  expression applied to such a call; otherwise returns False.
 
+   function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
+   --  Predicate to recognize stubbed procedures and null procedures, which
+   --  can be inlined unconditionally in all cases.
+
    procedure Make_Build_In_Place_Call_In_Allocator
      (Allocator     : Node_Id;
       Function_Call : Node_Id);
@@ -163,8 +167,8 @@ package Exp_Ch6 is
    --  for which Is_Build_In_Place_Call is True, or an N_Qualified_Expression
    --  node applied to such a function call.
 
-   function Needs_BIP_Collection (Func_Id : Entity_Id) return Boolean;
+   function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
    --  Ada 2005 (AI-318-02): Return True if the function needs a finalization
-   --  collection implicit parameter.
+   --  master implicit parameter.
 
 end Exp_Ch6;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 0d81df24be7..730ac6b86dc 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -301,33 +301,6 @@ package body Exp_Ch7 is
    --  context does not contain the above constructs, the routine returns an
    --  empty list.
 
-   function Build_Exception_Handler
-     (Loc         : Source_Ptr;
-      E_Id        : Entity_Id;
-      Raised_Id   : Entity_Id;
-      For_Library : Boolean := False) return Node_Id;
-   --  Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
-   --  _Body. Create an exception handler of the following form:
-   --
-   --    when others =>
-   --       if not Raised_Id then
-   --          Raised_Id := True;
-   --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
-   --       end if;
-   --
-   --  If flag For_Library is set (and not in restricted profile):
-   --
-   --    when others =>
-   --       if not Raised_Id then
-   --          Raised_Id := True;
-   --          Save_Library_Occurrence (Get_Current_Excep.all.all);
-   --       end if;
-   --
-   --  E_Id denotes the defining identifier of a local exception occurrence.
-   --  Raised_Id is the entity of a local boolean flag. Flag For_Library is
-   --  used when operating at the library level, when enabled the current
-   --  exception will be saved to a global location.
-
    procedure Build_Finalizer
      (N           : Node_Id;
       Clean_Stmts : List_Id;
@@ -431,8 +404,8 @@ package body Exp_Ch7 is
    --  whether the inner logic should be dictated by state counters.
 
    function Make_Finalize_Address_Stmts (Typ : Entity_Id) return List_Id;
-   --  Subsidiary to Make_Finalize_Address_Body and Make_Deep_Array_Body.
-   --  Generate the following statements:
+   --  Subsidiary to Make_Finalize_Address_Body, Make_Deep_Array_Body and
+   --  Make_Deep_Record_Body. Generate the following statements:
    --
    --    declare
    --       type Acc_Typ is access all Typ;
@@ -777,9 +750,8 @@ package body Exp_Ch7 is
 
       return
         Make_Exception_Handler (Loc,
-          Exception_Choices => New_List (
-            Make_Others_Choice (Loc)),
-
+          Exception_Choices =>
+            New_List (Make_Others_Choice (Loc)),
           Statements => New_List (
             Make_If_Statement (Loc,
               Condition       =>
@@ -797,16 +769,17 @@ package body Exp_Ch7 is
                   Parameter_Associations => Actuals)))));
    end Build_Exception_Handler;
 
-   -----------------------------------
-   -- Build_Finalization_Collection --
-   -----------------------------------
+   -------------------------------
+   -- Build_Finalization_Master --
+   -------------------------------
 
-   procedure Build_Finalization_Collection
+   procedure Build_Finalization_Master
      (Typ        : Entity_Id;
       Ins_Node   : Node_Id := Empty;
       Encl_Scope : Entity_Id := Empty)
    is
       Desig_Typ : constant Entity_Id := Directly_Designated_Type (Typ);
+      Ptr_Typ   : Entity_Id := Root_Type (Base_Type (Typ));
 
       function In_Deallocation_Instance (E : Entity_Id) return Boolean;
       --  Determine whether entity E is inside a wrapper package created for
@@ -837,56 +810,69 @@ package body Exp_Ch7 is
          return False;
       end In_Deallocation_Instance;
 
-   --  Start of processing for Build_Finalization_Collection
+   --  Start of processing for Build_Finalization_Master
 
    begin
+      if Is_Private_Type (Ptr_Typ)
+        and then Present (Full_View (Ptr_Typ))
+      then
+         Ptr_Typ := Full_View (Ptr_Typ);
+      end if;
+
       --  Certain run-time configurations and targets do not provide support
       --  for controlled types.
 
       if Restriction_Active (No_Finalization) then
          return;
 
+      --  Do not process C, C++, CIL and Java types since it is assumend that
+      --  the non-Ada side will handle their clean up.
+
+      elsif Convention (Desig_Typ) = Convention_C
+        or else Convention (Desig_Typ) = Convention_CIL
+        or else Convention (Desig_Typ) = Convention_CPP
+        or else Convention (Desig_Typ) = Convention_Java
+      then
+         return;
+
       --  Various machinery such as freezing may have already created a
-      --  collection.
+      --  finalization master.
 
-      elsif Present (Associated_Collection (Typ)) then
+      elsif Present (Finalization_Master (Ptr_Typ)) then
          return;
 
       --  Do not process types that return on the secondary stack
 
-      --  ??? The need for a secondary stack should be revisited and perhaps
-      --  changed.
-
-      elsif Present (Associated_Storage_Pool (Typ))
-        and then Is_RTE (Associated_Storage_Pool (Typ), RE_SS_Pool)
+      elsif Present (Associated_Storage_Pool (Ptr_Typ))
+        and then Is_RTE (Associated_Storage_Pool (Ptr_Typ), RE_SS_Pool)
       then
          return;
 
       --  Do not process types which may never allocate an object
 
-      elsif No_Pool_Assigned (Typ) then
+      elsif No_Pool_Assigned (Ptr_Typ) then
          return;
 
       --  Do not process access types coming from Ada.Unchecked_Deallocation
       --  instances. Even though the designated type may be controlled, the
       --  access type will never participate in allocation.
 
-      elsif In_Deallocation_Instance (Typ) then
+      elsif In_Deallocation_Instance (Ptr_Typ) then
          return;
 
       --  Ignore the general use of anonymous access types unless the context
-      --  requires a collection.
+      --  requires a finalization master.
 
-      elsif Ekind (Typ) = E_Anonymous_Access_Type
+      elsif Ekind (Ptr_Typ) = E_Anonymous_Access_Type
         and then No (Ins_Node)
       then
          return;
 
       --  Do not process non-library access types when restriction No_Nested_
-      --  Finalization is in effect since collections are controlled objects.
+      --  Finalization is in effect since masters are controlled objects.
 
       elsif Restriction_Active (No_Nested_Finalization)
-        and then not Is_Library_Level_Entity (Typ)
+        and then not Is_Library_Level_Entity (Ptr_Typ)
       then
          return;
 
@@ -901,87 +887,78 @@ package body Exp_Ch7 is
       end if;
 
       declare
-         Loc     : constant Source_Ptr := Sloc (Typ);
-         Actions : constant List_Id := New_List;
-         Coll_Id : Entity_Id;
-         Pool_Id : Entity_Id;
+         Loc        : constant Source_Ptr := Sloc (Ptr_Typ);
+         Actions    : constant List_Id := New_List;
+         Fin_Mas_Id : Entity_Id;
+         Pool_Id    : Entity_Id;
 
       begin
          --  Generate:
-         --    Fnn : Finalization_Collection;
+         --    Fnn : aliased Finalization_Master;
 
-         --  Source access types use fixed names for their collections since
-         --  the collection is inserted only once in the same source unit and
-         --  there is no possible name overlap. Internally-generated access
-         --  types on the other hand use temporaries as collection names due
-         --  to possible name collisions.
+         --  Source access types use fixed master names since the master is
+         --  inserted in the same source unit only once. The only exception to
+         --  this are instances using the same access type as generic actual.
 
-         if Comes_From_Source (Typ) then
-            Coll_Id :=
+         if Comes_From_Source (Ptr_Typ)
+           and then not Inside_A_Generic
+         then
+            Fin_Mas_Id :=
               Make_Defining_Identifier (Loc,
-                Chars => New_External_Name (Chars (Typ), "FC"));
+                Chars => New_External_Name (Chars (Ptr_Typ), "FM"));
+
+         --  Internally generated access types use temporaries as their names
+         --  due to possible collision with identical names coming from other
+         --  packages.
+
          else
-            Coll_Id := Make_Temporary (Loc, 'F');
+            Fin_Mas_Id := Make_Temporary (Loc, 'F');
          end if;
 
          Append_To (Actions,
            Make_Object_Declaration (Loc,
-             Defining_Identifier => Coll_Id,
+             Defining_Identifier => Fin_Mas_Id,
+             Aliased_Present     => True,
              Object_Definition   =>
-               New_Reference_To (RTE (RE_Finalization_Collection), Loc)));
+               New_Reference_To (RTE (RE_Finalization_Master), Loc)));
 
          --  Storage pool selection and attribute decoration of the generated
-         --  collection. Since .NET/JVM compilers do not support pools, this
-         --  step is skipped.
+         --  master. Since .NET/JVM compilers do not support pools, this step
+         --  is skipped.
 
          if VM_Target = No_VM then
 
             --  If the access type has a user-defined pool, use it as the base
             --  storage medium for the finalization pool.
 
-            if Present (Associated_Storage_Pool (Typ)) then
-               Pool_Id := Associated_Storage_Pool (Typ);
-
-            --  Access subtypes must use the storage pool of their base type
-
-            elsif Ekind (Typ) = E_Access_Subtype then
-               declare
-                  Base_Typ : constant Entity_Id := Base_Type (Typ);
-
-               begin
-                  if No (Associated_Storage_Pool (Base_Typ)) then
-                     Pool_Id := Get_Global_Pool_For_Access_Type (Base_Typ);
-                     Set_Associated_Storage_Pool (Base_Typ, Pool_Id);
-                  else
-                     Pool_Id := Associated_Storage_Pool (Base_Typ);
-                  end if;
-               end;
+            if Present (Associated_Storage_Pool (Ptr_Typ)) then
+               Pool_Id := Associated_Storage_Pool (Ptr_Typ);
 
             --  The default choice is the global pool
 
             else
-               Pool_Id := Get_Global_Pool_For_Access_Type (Typ);
-               Set_Associated_Storage_Pool (Typ, Pool_Id);
+               Pool_Id := Get_Global_Pool_For_Access_Type (Ptr_Typ);
+               Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
             end if;
 
             --  Generate:
-            --    Set_Storage_Pool_Ptr (Fnn, Pool_Id'Unchecked_Access);
+            --    Set_Base_Pool (Fnn, Pool_Id'Unchecked_Access);
 
             Append_To (Actions,
               Make_Procedure_Call_Statement (Loc,
                 Name                   =>
-                  New_Reference_To (RTE (RE_Set_Storage_Pool_Ptr), Loc),
+                  New_Reference_To (RTE (RE_Set_Base_Pool), Loc),
                 Parameter_Associations => New_List (
-                  New_Reference_To (Coll_Id, Loc),
+                  New_Reference_To (Fin_Mas_Id, Loc),
                   Make_Attribute_Reference (Loc,
                     Prefix         => New_Reference_To (Pool_Id, Loc),
                     Attribute_Name => Name_Unrestricted_Access))));
          end if;
 
-         Set_Associated_Collection (Typ, Coll_Id);
+         Set_Finalization_Master (Ptr_Typ, Fin_Mas_Id);
 
-         --  A finalization collection created for an anonymous access type
-         --  must be inserted before a context-dependent node.
+         --  A finalization master created for an anonymous access type must be
+         --  inserted before a context-dependent node.
 
          if Present (Ins_Node) then
             Push_Scope (Encl_Scope);
@@ -999,11 +976,10 @@ package body Exp_Ch7 is
 
             Pop_Scope;
 
-         elsif Ekind (Typ) = E_Access_Subtype
-           or else (Ekind (Desig_Typ) = E_Incomplete_Type
-                     and then Has_Completion_In_Body (Desig_Typ))
+         elsif Ekind (Desig_Typ) = E_Incomplete_Type
+           and then Has_Completion_In_Body (Desig_Typ)
          then
-            Insert_Actions (Parent (Typ), Actions);
+            Insert_Actions (Parent (Ptr_Typ), Actions);
 
          --  If the designated type is not yet frozen, then append the actions
          --  to that type's freeze actions. The actions need to be appended to
@@ -1018,29 +994,29 @@ package body Exp_Ch7 is
          then
             Append_Freeze_Actions (Desig_Typ, Actions);
 
-         elsif Present (Freeze_Node (Typ))
-           and then not Analyzed (Freeze_Node (Typ))
+         elsif Present (Freeze_Node (Ptr_Typ))
+           and then not Analyzed (Freeze_Node (Ptr_Typ))
          then
-            Append_Freeze_Actions (Typ, Actions);
+            Append_Freeze_Actions (Ptr_Typ, Actions);
 
          --  If there's a pool created locally for the access type, then we
-         --  need to ensure that the collection gets created after the pool
-         --  object, because otherwise we can have a forward reference, so
-         --  we force the collection actions to be inserted and analyzed after
-         --  the pool entity. Note that both the access type and its designated
-         --  type may have already been frozen and had their freezing actions
-         --  analyzed at this point. (This seems a little unclean.???)
+         --  need to ensure that the master gets created after the pool object,
+         --  because otherwise we can have a forward reference, so we force the
+         --  master actions to be inserted and analyzed after the pool entity.
+         --  Note that both the access type and its designated type may have
+         --  already been frozen and had their freezing actions analyzed at
+         --  this point. (This seems a little unclean.???)
 
          elsif VM_Target = No_VM
-           and then Scope (Pool_Id) = Scope (Typ)
+           and then Scope (Pool_Id) = Scope (Ptr_Typ)
          then
             Insert_List_After_And_Analyze (Parent (Pool_Id), Actions);
 
          else
-            Insert_Actions (Parent (Typ), Actions);
+            Insert_Actions (Parent (Ptr_Typ), Actions);
          end if;
       end;
-   end Build_Finalization_Collection;
+   end Build_Finalization_Master;
 
    ---------------------
    -- Build_Finalizer --
@@ -1453,8 +1429,8 @@ package body Exp_Ch7 is
             --  The local exception does not need to be reraised for library-
             --  level finalizers. Generate:
             --
-            --    if Raised then
-            --       Raise_From_Controlled_Operation (E, Abort);
+            --    if Raised and then not Abort then
+            --       Raise_From_Controlled_Operation (E);
             --    end if;
 
             if not For_Package
@@ -1532,9 +1508,7 @@ package body Exp_Ch7 is
 
          --  Generate:
          --    procedure Fin_Id is
-         --       Abort  : constant Boolean :=
-         --                  Exception_Occurrence (Get_Current_Excep.all.all) =
-         --                    Standard'Abort_Signal'Identity;
+         --       Abort  : constant Boolean := Triggered_By_Abort;
          --         <or>
          --       Abort  : constant Boolean := False;  --  no abort
 
@@ -1933,15 +1907,15 @@ package body Exp_Ch7 is
                end if;
 
             --  Inspect the freeze node of an access-to-controlled type and
-            --  look for a delayed finalization collection. This case arises
-            --  when the freeze actions are inserted at a later time than the
+            --  look for a delayed finalization master. This case arises when
+            --  the freeze actions are inserted at a later time than the
             --  expansion of the context. Since Build_Finalizer is never called
-            --  on a single construct twice, the collection will be ultimately
+            --  on a single construct twice, the master will be ultimately
             --  left out and never finalized. This is also needed for freeze
             --  actions of designated types themselves, since in some cases the
-            --  finalization collection is associated with a designated type's
+            --  finalization master is associated with a designated type's
             --  freeze node rather than that of the access type (see handling
-            --  for freeze actions in Build_Finalization_Collection).
+            --  for freeze actions in Build_Finalization_Master).
 
             elsif Nkind (Decl) = N_Freeze_Entity
               and then Present (Actions (Decl))
@@ -1958,12 +1932,12 @@ package body Exp_Ch7 is
 
                   --  Freeze nodes are considered to be identical to packages
                   --  and blocks in terms of nesting. The difference is that
-                  --  a finalization collection created inside the freeze node
-                  --  is at the same nesting level as the node itself.
+                  --  a finalization master created inside the freeze node is
+                  --  at the same nesting level as the node itself.
 
                   Process_Declarations (Actions (Decl), Preprocess);
 
-                  --  The freeze node contains a finalization collection
+                  --  The freeze node contains a finalization master
 
                   if Preprocess
                     and then Top_Level
@@ -2086,11 +2060,12 @@ package body Exp_Ch7 is
          --  following cleanup code:
          --
          --    if BIPallocfrom > Secondary_Stack'Pos
-         --      and then BIPcollection /= null
+         --      and then BIPfinalizationmaster /= null
          --    then
          --       declare
          --          type Ptr_Typ is access Obj_Typ;
-         --          for Ptr_Typ'Storage_Pool use Base_Pool (BIPcollection);
+         --          for Ptr_Typ'Storage_Pool
+         --            use Base_Pool (BIPfinalizationmaster);
          --
          --       begin
          --          Free (Ptr_Typ (Temp));
@@ -2118,12 +2093,13 @@ package body Exp_Ch7 is
          function Build_BIP_Cleanup_Stmts
            (Func_Id : Entity_Id) return Node_Id
          is
-            Collect : constant Entity_Id :=
-                        Build_In_Place_Formal (Func_Id, BIP_Collection);
-            Decls   : constant List_Id := New_List;
-            Obj_Typ : constant Entity_Id := Etype (Func_Id);
-            Temp_Id : constant Entity_Id :=
-                        Entity (Prefix (Name (Parent (Obj_Id))));
+            Decls      : constant List_Id := New_List;
+            Fin_Mas_Id : constant Entity_Id :=
+                           Build_In_Place_Formal
+                             (Func_Id, BIP_Finalization_Master);
+            Obj_Typ    : constant Entity_Id := Etype (Func_Id);
+            Temp_Id    : constant Entity_Id :=
+                           Entity (Prefix (Name (Parent (Obj_Id))));
 
             Cond      : Node_Id;
             Free_Blk  : Node_Id;
@@ -2133,7 +2109,7 @@ package body Exp_Ch7 is
 
          begin
             --  Generate:
-            --    Pool_Id renames Base_Pool (BIPcollection.all).all;
+            --    Pool_Id renames Base_Pool (BIPfinalizationmaster.all).all;
 
             Pool_Id := Make_Temporary (Loc, 'P');
 
@@ -2150,10 +2126,10 @@ package body Exp_Ch7 is
                           New_Reference_To (RTE (RE_Base_Pool), Loc),
                         Parameter_Associations => New_List (
                           Make_Explicit_Dereference (Loc,
-                            Prefix => New_Reference_To (Collect, Loc)))))));
+                            Prefix => New_Reference_To (Fin_Mas_Id, Loc)))))));
 
             --  Create an access type which uses the storage pool of the
-            --  caller's collection.
+            --  caller's finalization master.
 
             --  Generate:
             --    type Ptr_Typ is access Obj_Typ;
@@ -2167,11 +2143,11 @@ package body Exp_Ch7 is
                   Make_Access_To_Object_Definition (Loc,
                     Subtype_Indication => New_Reference_To (Obj_Typ, Loc))));
 
-            --  Perform minor decoration in order to set the collection and the
+            --  Perform minor decoration in order to set the master and the
             --  storage pool attributes.
 
             Set_Ekind (Ptr_Typ, E_Access_Type);
-            Set_Associated_Collection   (Ptr_Typ, Collect);
+            Set_Finalization_Master     (Ptr_Typ, Fin_Mas_Id);
             Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
 
             --  Create an explicit free statement. Note that the free uses the
@@ -2203,18 +2179,18 @@ package body Exp_Ch7 is
                     Statements => New_List (Free_Stmt)));
 
             --  Generate:
-            --    if BIPcollection /= null then
+            --    if BIPfinalizationmaster /= null then
 
             Cond :=
               Make_Op_Ne (Loc,
-                Left_Opnd  => New_Reference_To (Collect, Loc),
+                Left_Opnd  => New_Reference_To (Fin_Mas_Id, Loc),
                 Right_Opnd => Make_Null (Loc));
 
             --  For constrained or tagged results escalate the condition to
             --  include the allocation format. Generate:
             --
             --    if BIPallocform > Secondary_Stack'Pos
-            --      and then BIPcollection /= null
+            --      and then BIPfinalizationmaster /= null
             --    then
 
             if not Is_Constrained (Obj_Typ)
@@ -2300,6 +2276,10 @@ package body Exp_Ch7 is
 
                      if Is_Controlled (Typ) then
                         Init := Find_Prim_Op (Typ, Name_Initialize);
+
+                        if Present (Init) then
+                           Init := Ultimate_Alias (Init);
+                        end if;
                      end if;
 
                      return
@@ -2352,6 +2332,12 @@ package body Exp_Ch7 is
                Utyp := Typ;
             end if;
 
+            if Is_Private_Type (Utyp)
+              and then Present (Full_View (Utyp))
+            then
+               Utyp := Full_View (Utyp);
+            end if;
+
             --  The init procedures are arranged as follows:
 
             --    Object : Controlled_Type;
@@ -2590,11 +2576,13 @@ package body Exp_Ch7 is
             --  If we are dealing with a return object of a build-in-place
             --  function, generate the following cleanup statements:
             --
-            --    if BIPallocfrom > Secondary_Stack'Pos then
+            --    if BIPallocfrom > Secondary_Stack'Pos
+            --      and then BIPfinalizationmaster /= null
+            --    then
             --       declare
             --          type Ptr_Typ is access Obj_Typ;
             --          for Ptr_Typ'Storage_Pool use
-            --                Base_Pool (BIPcollection.all).all;
+            --                Base_Pool (BIPfinalizationmaster.all).all;
             --
             --       begin
             --          Free (Ptr_Typ (Temp));
@@ -2602,17 +2590,15 @@ package body Exp_Ch7 is
             --    end if;
             --
             --  The generated code effectively detaches the temporary from the
-            --  caller finalization chain and deallocates the object. This is
+            --  caller finalization master and deallocates the object. This is
             --  disabled on .NET/JVM because pools are not supported.
 
-            --  H505-021 This needs to be revisited on .NET/JVM
-
             if VM_Target = No_VM and then Is_Return_Object (Obj_Id) then
                declare
                   Func_Id : constant Entity_Id := Enclosing_Function (Obj_Id);
                begin
                   if Is_Build_In_Place_Function (Func_Id)
-                    and then Needs_BIP_Collection (Func_Id)
+                    and then Needs_BIP_Finalization_Master (Func_Id)
                   then
                      Append_To (Fin_Stmts, Build_BIP_Cleanup_Stmts (Func_Id));
                   end if;
@@ -2988,58 +2974,9 @@ package body Exp_Ch7 is
         and then VM_Target = No_VM
         and then not For_Package
       then
-         declare
-            Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
+         A_Expr := New_Reference_To (RTE (RE_Triggered_By_Abort), Loc);
 
-         begin
-            --  Generate:
-            --    Temp : constant Exception_Occurrence_Access :=
-            --             Get_Current_Excep.all;
-
-            Append_To (Result,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Temp_Id,
-                Constant_Present    => True,
-                Object_Definition   =>
-                  New_Reference_To (RTE (RE_Exception_Occurrence_Access), Loc),
-                Expression          =>
-                  Make_Function_Call (Loc,
-                    Name =>
-                      Make_Explicit_Dereference (Loc,
-                        Prefix =>
-                          New_Reference_To
-                            (RTE (RE_Get_Current_Excep), Loc)))));
-
-            --  Generate:
-            --    Temp /= null
-            --      and then Exception_Identity (Temp.all) =
-            --                 Standard'Abort_Signal'Identity;
-
-            A_Expr :=
-              Make_And_Then (Loc,
-                Left_Opnd  =>
-                  Make_Op_Ne (Loc,
-                    Left_Opnd  => New_Reference_To (Temp_Id, Loc),
-                    Right_Opnd => Make_Null (Loc)),
-
-                Right_Opnd =>
-                  Make_Op_Eq (Loc,
-                    Left_Opnd =>
-                      Make_Function_Call (Loc,
-                        Name                   =>
-                          New_Reference_To (RTE (RE_Exception_Identity), Loc),
-                        Parameter_Associations => New_List (
-                          Make_Explicit_Dereference (Loc,
-                            Prefix => New_Reference_To (Temp_Id, Loc)))),
-
-                    Right_Opnd =>
-                      Make_Attribute_Reference (Loc,
-                        Prefix         =>
-                          New_Reference_To (Stand.Abort_Signal, Loc),
-                        Attribute_Name => Name_Identity)));
-         end;
-
-      --  No abort or .NET/JVM
+      --  No abort, .NET/JVM or library-level finalizers
 
       else
          A_Expr := New_Reference_To (Standard_False, Loc);
@@ -3089,40 +3026,48 @@ package body Exp_Ch7 is
       E_Id      : Entity_Id;
       Raised_Id : Entity_Id) return Node_Id
    is
-      Params  : List_Id;
-      Proc_Id : Entity_Id;
+      Stmt : Node_Id;
 
    begin
-      --  The default parameter is the local exception occurrence
-
-      Params := New_List (New_Reference_To (E_Id, Loc));
-
-      --  Standard run-time, .NET/JVM targets, this case handles finalization
-      --  exceptions raised during an abort.
+      --  Standard run-time and .NET/JVM targets use the specialized routine
+      --  Raise_From_Controlled_Operation.
 
       if RTE_Available (RE_Raise_From_Controlled_Operation) then
-         Proc_Id := RTE (RE_Raise_From_Controlled_Operation);
-         Append_To (Params, New_Reference_To (Abort_Id, Loc));
+         Stmt :=
+           Make_Procedure_Call_Statement (Loc,
+              Name                   =>
+                New_Reference_To
+                  (RTE (RE_Raise_From_Controlled_Operation), Loc),
+              Parameter_Associations =>
+                New_List (New_Reference_To (E_Id, Loc)));
 
       --  Restricted runtime: exception messages are not supported and hence
-      --  Raise_From_Controlled_Operation is not supported.
+      --  Raise_From_Controlled_Operation is not supported. Raise Program_Error
+      --  instead.
 
       else
-         Proc_Id := RTE (RE_Reraise_Occurrence);
+         Stmt :=
+           Make_Raise_Program_Error (Loc,
+             Reason => PE_Finalize_Raised_Exception);
       end if;
 
       --  Generate:
-      --    if Raised_Id then
-      --       <Proc_Id> (<Params>);
+      --    if Raised_Id and then not Abort_Id then
+      --       Raise_From_Controlled_Operation (E_Id);
+      --         <or>
+      --       raise Program_Error;  --  restricted runtime
       --    end if;
 
       return
         Make_If_Statement (Loc,
-          Condition       => New_Reference_To (Raised_Id, Loc),
-          Then_Statements => New_List (
-            Make_Procedure_Call_Statement (Loc,
-              Name                   => New_Reference_To (Proc_Id, Loc),
-              Parameter_Associations => Params)));
+          Condition       =>
+            Make_And_Then (Loc,
+              Left_Opnd  => New_Reference_To (Raised_Id, Loc),
+              Right_Opnd =>
+                Make_Op_Not (Loc,
+                  Right_Opnd => New_Reference_To (Abort_Id, Loc))),
+
+          Then_Statements => New_List (Stmt));
    end Build_Raise_Statement;
 
    -----------------------------
@@ -4328,8 +4273,8 @@ package body Exp_Ch7 is
 
                --    exception
                --       when others =>
-               --          if not Rnn then
-               --             Rnn := True;
+               --          if not Raised then
+               --             Raised := True;
                --             Save_Occurrence
                --               (Enn, Get_Current_Excep.all.all);
                --          end if;
@@ -4408,8 +4353,8 @@ package body Exp_Ch7 is
          end loop;
 
          --  Generate:
-         --    if Rnn then
-         --       Raise_From_Controlled_Operation (E, Abort);
+         --    if Raised and then not Abort then
+         --       Raise_From_Controlled_Operation (E);
          --    end if;
 
          if Built
@@ -4563,19 +4508,10 @@ package body Exp_Ch7 is
             Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
          end if;
 
-      --  For types that are both controlled and have controlled components,
-      --  generate a call to Deep_Adjust.
-
-      elsif Is_Controlled (Utyp)
-        and then Has_Controlled_Component (Utyp)
-      then
-         Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
-
-      --  For types that are not controlled themselves, but contain controlled
-      --  components or can be extended by types with controlled components,
-      --  create a call to Deep_Adjust.
+      --  Class-wide types, interfaces and types with controlled components
 
       elsif Is_Class_Wide_Type (Typ)
+        or else Is_Interface (Typ)
         or else Has_Controlled_Component (Utyp)
       then
          if Is_Tagged_Type (Utyp) then
@@ -4584,11 +4520,22 @@ package body Exp_Ch7 is
             Adj_Id := TSS (Utyp, TSS_Deep_Adjust);
          end if;
 
-      --  For types that are derived from Controlled and do not have controlled
-      --  components, build a call to Adjust.
+      --  Derivations from [Limited_]Controlled
+
+      elsif Is_Controlled (Utyp) then
+         if Has_Controlled_Component (Utyp) then
+            Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
+         else
+            Adj_Id := Find_Prim_Op (Utyp, Name_Of (Adjust_Case));
+         end if;
+
+      --  Tagged types
+
+      elsif Is_Tagged_Type (Utyp) then
+         Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
 
       else
-         Adj_Id := Find_Prim_Op (Utyp, Name_Of (Adjust_Case));
+         raise Program_Error;
       end if;
 
       if Present (Adj_Id) then
@@ -4632,7 +4579,7 @@ package body Exp_Ch7 is
           Name                   =>
             New_Reference_To (RTE (RE_Attach), Loc),
           Parameter_Associations => New_List (
-            New_Reference_To (Associated_Collection (Ptr_Typ), Loc),
+            New_Reference_To (Finalization_Master (Ptr_Typ), Loc),
             Unchecked_Convert_To (RTE (RE_Root_Controlled_Ptr), Obj_Ref)));
    end Make_Attach_Call;
 
@@ -4693,12 +4640,7 @@ package body Exp_Ch7 is
       --  controlled elements. Generate:
       --
       --    declare
-      --       Temp   : constant Exception_Occurrence_Access :=
-      --                  Get_Current_Excep.all;
-      --       Abort  : constant Boolean :=
-      --                  Temp /= null
-      --                    and then Exception_Identity (Temp_Id.all) =
-      --                               Standard'Abort_Signal'Identity;
+      --       Abort  : constant Boolean := Triggered_By_Abort;
       --         <or>
       --       Abort  : constant Boolean := False;  --  no abort
       --
@@ -4724,8 +4666,8 @@ package body Exp_Ch7 is
       --          ...
       --       end loop;
       --
-      --       if Raised then
-      --          Raise_From_Controlled_Operation (E, Abort);
+      --       if Raised and then not Abort then
+      --          Raise_From_Controlled_Operation (E);
       --       end if;
       --    end;
 
@@ -4749,12 +4691,7 @@ package body Exp_Ch7 is
       --             exception
       --                when others =>
       --                   declare
-      --                      Temp   : constant Exception_Occurrence_Access :=
-      --                                 Get_Current_Excep.all;
-      --                      Abort  : constant Boolean :=
-      --                        Temp /= null
-      --                          and then Exception_Identity (Temp_Id.all) =
-      --                                     Standard'Abort_Signal'Identity;
+      --                      Abort  : constant Boolean := Triggered_By_Abort;
       --                        <or>
       --                      Abort  : constant Boolean := False; --  no abort
       --                      E      : Exception_Occurence;
@@ -4790,8 +4727,8 @@ package body Exp_Ch7 is
       --                      end loop;
       --                   end;
 
-      --                   if Raised then
-      --                      Raise_From_Controlled_Operation (E, Abort);
+      --                   if Raised and then not Abort then
+      --                      Raise_From_Controlled_Operation (E);
       --                   end if;
 
       --                   raise;
@@ -4946,9 +4883,7 @@ package body Exp_Ch7 is
          --  the conditional raise:
 
          --    declare
-         --       Abort  : constant Boolean :=
-         --                  Exception_Occurrence (Get_Current_Excep.all.all) =
-         --                    Standard'Abort_Signal'Identity;
+         --       Abort  : constant Boolean := Triggered_By_Abort;
          --         <or>
          --       Abort  : constant Boolean := False;  --  no abort
 
@@ -4958,8 +4893,8 @@ package body Exp_Ch7 is
          --    begin
          --       <core loop>
 
-         --       if Raised then  --  Expection handlers allowed
-         --          Raise_From_Controlled_Operation (E, Abort);
+         --       if Raised and then not Abort then  --  Expection handlers OK
+         --          Raise_From_Controlled_Operation (E);
          --       end if;
          --    end;
 
@@ -5233,9 +5168,7 @@ package body Exp_Ch7 is
          --  raised flag and the conditional raise.
 
          --    declare
-         --       Abort  : constant Boolean :=
-         --                  Exception_Occurrence (Get_Current_Excep.all.all) =
-         --                    Standard'Abort_Signal'Identity;
+         --       Abort  : constant Boolean := Triggered_By_Abort;
          --         <or>
          --       Abort  : constant Boolean := False;  --  no abort
 
@@ -5250,11 +5183,11 @@ package body Exp_Ch7 is
 
          --       <final loop>
 
-         --       if Raised then  --  Exception handlers allowed
-         --          Raise_From_Controlled_Operation (E, Abort);
+         --       if Raised and then not Abort then  --  Exception handlers OK
+         --          Raise_From_Controlled_Operation (E);
          --       end if;
 
-         --       raise;          --  Exception handlers allowed
+         --       raise;  --  Exception handlers OK
          --    end;
 
          Stmts := New_List (Build_Counter_Assignment, Final_Loop);
@@ -5496,8 +5429,6 @@ package body Exp_Ch7 is
       --  have discriminants and contain variant parts. Generate:
       --
       --    begin
-      --       Root_Controlled (V).Finalized := False;
-      --
       --       begin
       --          [Deep_]Adjust (V.Comp_1);
       --       exception
@@ -5540,8 +5471,8 @@ package body Exp_Ch7 is
       --          end;
       --       end if;
       --
-      --       if Raised then
-      --          Raise_From_Controlled_Object (E, Abort);
+      --       if Raised and then not Abort then
+      --          Raise_From_Controlled_Operation (E);
       --       end if;
       --    end;
 
@@ -5550,22 +5481,13 @@ package body Exp_Ch7 is
       --  may have discriminants and contain variant parts. Generate:
       --
       --    declare
-      --       Temp   : constant Exception_Occurrence_Access :=
-      --                  Get_Current_Excep.all;
-      --       Abort  : constant Boolean :=
-      --                  Temp /= null
-      --                    and then Exception_Identity (Temp_Id.all) =
-      --                               Standard'Abort_Signal'Identity;
+      --       Abort  : constant Boolean := Triggered_By_Abort;
       --         <or>
       --       Abort  : constant Boolean := False;  --  no abort
       --       E      : Exception_Occurence;
       --       Raised : Boolean := False;
       --
       --    begin
-      --       if Root_Controlled (V).Finalized then
-      --          return;
-      --       end if;
-      --
       --       if F then
       --          begin
       --             Finalize (V);  --  If applicable
@@ -5629,10 +5551,8 @@ package body Exp_Ch7 is
       --             end if;
       --       end;
       --
-      --       Root_Controlled (V).Finalized := True;
-      --
-      --       if Raised then
-      --          Raise_From_Controlled_Object (E, Abort);
+      --       if Raised and then not Abort then
+      --          Raise_From_Controlled_Operation (E);
       --       end if;
       --    end;
 
@@ -6033,9 +5953,7 @@ package body Exp_Ch7 is
 
          --  Generate:
          --    declare
-         --       Abort  : constant Boolean :=
-         --                  Exception_Occurrence (Get_Current_Excep.all.all) =
-         --                    Standard'Abort_Signal'Identity;
+         --       Abort  : constant Boolean := Triggered_By_Abort;
          --         <or>
          --       Abort  : constant Boolean := False;  --  no abort
 
@@ -6043,12 +5961,10 @@ package body Exp_Ch7 is
          --       Raised : Boolean := False;
 
          --    begin
-         --       Root_Controlled (V).Finalized := False;
-
          --       <adjust statements>
 
-         --       if Raised then
-         --          Raise_From_Controlled_Operation (E, Abort);
+         --       if Raised and then not Abort then
+         --          Raise_From_Controlled_Operation (E);
          --       end if;
          --    end;
 
@@ -6619,9 +6535,7 @@ package body Exp_Ch7 is
 
          --  Generate:
          --    declare
-         --       Abort  : constant Boolean :=
-         --                  Exception_Occurrence (Get_Current_Excep.all.all) =
-         --                    Standard'Abort_Signal'Identity;
+         --       Abort  : constant Boolean := Triggered_By_Abort;
          --         <or>
          --       Abort  : constant Boolean := False;  --  no abort
 
@@ -6629,15 +6543,10 @@ package body Exp_Ch7 is
          --       Raised : Boolean := False;
 
          --    begin
-         --       if V.Finalized then
-         --          return;
-         --       end if;
-
          --       <finalize statements>
-         --       V.Finalized := True;
 
-         --       if Raised then
-         --          Raise_From_Controlled_Operation (E, Abort);
+         --       if Raised and then not Abort then
+         --          Raise_From_Controlled_Operation (E);
          --       end if;
          --    end;
 
@@ -6849,17 +6758,7 @@ package body Exp_Ch7 is
             Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
          end if;
 
-      --  For types that are both controlled and have controlled components,
-      --  generate a call to Deep_Finalize.
-
-      elsif Is_Controlled (Utyp)
-        and then Has_Controlled_Component (Utyp)
-      then
-         Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
-
-      --  For types that are not controlled themselves, but contain controlled
-      --  components or can be extended by types with controlled components,
-      --  create a call to Deep_Finalize.
+      --  Class-wide types, interfaces and types with controlled components
 
       elsif Is_Class_Wide_Type (Typ)
         or else Is_Interface (Typ)
@@ -6871,11 +6770,22 @@ package body Exp_Ch7 is
             Fin_Id := TSS (Utyp, TSS_Deep_Finalize);
          end if;
 
-      --  For types that are derived from Controlled and do not have controlled
-      --  components, build a call to Finalize.
+      --  Derivations from [Limited_]Controlled
+
+      elsif Is_Controlled (Utyp) then
+         if Has_Controlled_Component (Utyp) then
+            Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
+         else
+            Fin_Id := Find_Prim_Op (Utyp, Name_Of (Finalize_Case));
+         end if;
+
+      --  Tagged types
+
+      elsif Is_Tagged_Type (Utyp) then
+         Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
 
       else
-         Fin_Id := Find_Prim_Op (Utyp, Name_Of (Finalize_Case));
+         raise Program_Error;
       end if;
 
       if Present (Fin_Id) then
@@ -6927,13 +6837,30 @@ package body Exp_Ch7 is
    --------------------------------
 
    procedure Make_Finalize_Address_Body (Typ : Entity_Id) is
+      Is_Task : constant Boolean :=
+                  Ekind (Typ) = E_Record_Type
+                    and then Is_Concurrent_Record_Type (Typ)
+                    and then Ekind (Corresponding_Concurrent_Type (Typ)) =
+                               E_Task_Type;
+      Loc     : constant Source_Ptr := Sloc (Typ);
+      Proc_Id : Entity_Id;
+      Stmts   : List_Id;
+
    begin
+      --  The corresponding records of task types are not controlled by design.
+      --  For the sake of completeness, create an empty Finalize_Address to be
+      --  used in task class-wide allocations.
+
+      if Is_Task then
+         null;
+
       --  Nothing to do if the type is not controlled or it already has a
       --  TSS entry for Finalize_Address. Skip class-wide subtypes which do not
       --  come from source. These are usually generated for completeness and
       --  do not need the Finalize_Address primitive.
 
-      if not Needs_Finalization (Typ)
+      elsif not Needs_Finalization (Typ)
+        or else Is_Abstract_Type (Typ)
         or else Present (TSS (Typ, TSS_Finalize_Address))
         or else
           (Is_Class_Wide_Type (Typ)
@@ -6943,48 +6870,49 @@ package body Exp_Ch7 is
          return;
       end if;
 
-      declare
-         Loc     : constant Source_Ptr := Sloc (Typ);
-         Proc_Id : Entity_Id;
+      Proc_Id :=
+        Make_Defining_Identifier (Loc,
+          Make_TSS_Name (Typ, TSS_Finalize_Address));
 
-      begin
-         Proc_Id :=
-           Make_Defining_Identifier (Loc,
-             Make_TSS_Name (Typ, TSS_Finalize_Address));
+      --  Generate:
+      --    procedure <Typ>FD (V : System.Address) is
+      --    begin
+      --       null;                            --  for tasks
+      --
+      --       declare                          --  for all other types
+      --          type Pnn is access all Typ;
+      --          for Pnn'Storage_Size use 0;
+      --       begin
+      --          [Deep_]Finalize (Pnn (V).all);
+      --       end;
+      --    end TypFD;
 
-         --  Generate:
-         --    procedure TypFD (V : System.Address) is
-         --    begin
-         --       declare
-         --          type Pnn is access all Typ;
-         --          for Pnn'Storage_Size use 0;
-         --       begin
-         --          [Deep_]Finalize (Pnn (V).all);
-         --       end;
-         --    end TypFD;
+      if Is_Task then
+         Stmts := New_List (Make_Null_Statement (Loc));
+      else
+         Stmts := Make_Finalize_Address_Stmts (Typ);
+      end if;
 
-         Discard_Node (
-           Make_Subprogram_Body (Loc,
-             Specification =>
-               Make_Procedure_Specification (Loc,
-                 Defining_Unit_Name => Proc_Id,
+      Discard_Node (
+        Make_Subprogram_Body (Loc,
+          Specification =>
+            Make_Procedure_Specification (Loc,
+              Defining_Unit_Name => Proc_Id,
 
-                 Parameter_Specifications => New_List (
-                   Make_Parameter_Specification (Loc,
-                     Defining_Identifier =>
-                       Make_Defining_Identifier (Loc, Name_V),
-                     Parameter_Type =>
-                       New_Reference_To (RTE (RE_Address), Loc)))),
+              Parameter_Specifications => New_List (
+                Make_Parameter_Specification (Loc,
+                  Defining_Identifier =>
+                    Make_Defining_Identifier (Loc, Name_V),
+                  Parameter_Type =>
+                    New_Reference_To (RTE (RE_Address), Loc)))),
 
-             Declarations => No_List,
+          Declarations => No_List,
 
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements =>
-                   Make_Finalize_Address_Stmts (Typ))));
+          Handled_Statement_Sequence =>
+            Make_Handled_Sequence_Of_Statements (Loc,
+              Statements => Stmts)));
 
-         Set_TSS (Typ, Proc_Id);
-      end;
+      Set_TSS (Typ, Proc_Id);
    end Make_Finalize_Address_Body;
 
    ---------------------------------
@@ -7230,7 +7158,7 @@ package body Exp_Ch7 is
    --  Generate:
 
    --    when E : others =>
-   --      Raise_From_Controlled_Operation (E, False);
+   --      Raise_From_Controlled_Operation (E);
 
    --  or:
 
@@ -7262,8 +7190,7 @@ package body Exp_Ch7 is
                New_Reference_To
                  (RTE (RE_Raise_From_Controlled_Operation), Loc),
              Parameter_Associations => New_List (
-               New_Reference_To (E_Occ, Loc),
-               New_Reference_To (Standard_False, Loc)));
+               New_Reference_To (E_Occ, Loc)));
 
       --  Restricted runtime: exception messages are not supported
 
@@ -7415,11 +7342,11 @@ package body Exp_Ch7 is
               Statements => Make_Deep_Record_Body (Finalize_Case, Typ, True)));
    end Make_Local_Deep_Finalize;
 
-   ----------------------------------------
-   -- Make_Set_Finalize_Address_Ptr_Call --
-   ----------------------------------------
+   ------------------------------------
+   -- Make_Set_Finalize_Address_Call --
+   ------------------------------------
 
-   function Make_Set_Finalize_Address_Ptr_Call
+   function Make_Set_Finalize_Address_Call
      (Loc     : Source_Ptr;
       Typ     : Entity_Id;
       Ptr_Typ : Entity_Id) return Node_Id
@@ -7478,22 +7405,19 @@ package body Exp_Ch7 is
       end if;
 
       --  Generate:
-      --    Set_Finalize_Address_Ptr
-      --      (<Ptr_Typ>FC, <Utyp>FD'Unrestricted_Access);
+      --    Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access);
 
       return
         Make_Procedure_Call_Statement (Loc,
           Name                   =>
-            New_Reference_To (RTE (RE_Set_Finalize_Address_Ptr), Loc),
-
+            New_Reference_To (RTE (RE_Set_Finalize_Address), Loc),
           Parameter_Associations => New_List (
-            New_Reference_To (Associated_Collection (Ptr_Typ), Loc),
-
+            New_Reference_To (Finalization_Master (Ptr_Typ), Loc),
             Make_Attribute_Reference (Loc,
               Prefix         =>
                 New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc),
               Attribute_Name => Name_Unrestricted_Access)));
-   end Make_Set_Finalize_Address_Ptr_Call;
+   end Make_Set_Finalize_Address_Call;
 
    --------------------------
    -- Make_Transient_Block --
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index bcc5526897a..dbebd8ae52a 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -40,15 +40,42 @@ package Exp_Ch7 is
    --  Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
    --  that take care of finalization management at run-time.
 
-   procedure Build_Finalization_Collection
+   function Build_Exception_Handler
+     (Loc         : Source_Ptr;
+      E_Id        : Entity_Id;
+      Raised_Id   : Entity_Id;
+      For_Library : Boolean := False) return Node_Id;
+   --  Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
+   --  _Body. Create an exception handler of the following form:
+   --
+   --    when others =>
+   --       if not Raised_Id then
+   --          Raised_Id := True;
+   --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
+   --       end if;
+   --
+   --  If flag For_Library is set (and not in restricted profile):
+   --
+   --    when others =>
+   --       if not Raised_Id then
+   --          Raised_Id := True;
+   --          Save_Library_Occurrence (Get_Current_Excep.all.all);
+   --       end if;
+   --
+   --  E_Id denotes the defining identifier of a local exception occurrence.
+   --  Raised_Id is the entity of a local boolean flag. Flag For_Library is
+   --  used when operating at the library level, when enabled the current
+   --  exception will be saved to a global location.
+
+   procedure Build_Finalization_Master
      (Typ        : Entity_Id;
       Ins_Node   : Node_Id := Empty;
       Encl_Scope : Entity_Id := Empty);
-   --  Build a finalization collection for an access type. The designated type
-   --  may not necessarely be controlled or need finalization actions. The
-   --  routine creates a wrapper around a user-defined storage pool or the
-   --  general storage pool for access types. Ins_Nod and Encl_Scope are used
-   --  in conjunction with anonymous access types. Ins_Node designates the
+   --  Build a finalization master for an access type. The designated type may
+   --  not necessarely be controlled or need finalization actions. The routine
+   --  creates a wrapper around a user-defined storage pool or the general
+   --  storage pool for access types. Ins_Nod and Encl_Scope are used in
+   --  conjunction with anonymous access types. Ins_Node designates the
    --  insertion point before which the collection should be added. Encl_Scope
    --  is the scope of the context, either the enclosing record or the scope
    --  of the related function.
@@ -84,8 +111,8 @@ package Exp_Ch7 is
    --  Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
    --  Deep_Record_Body. Generate the following conditional raise statement:
    --
-   --    if Raised_Id then
-   --       Raise_From_Controlled_Operation (E_Id, Abort_Id);
+   --    if Raised_Id and then not Abort_Id then
+   --       Raise_From_Controlled_Operation (E_Id);
    --    end if;
    --
    --  Abort_Id is a local boolean flag which is set when the finalization was
@@ -173,13 +200,13 @@ package Exp_Ch7 is
    --  Create a special version of Deep_Finalize with identifier Nam. The
    --  routine has state information and can parform partial finalization.
 
-   function Make_Set_Finalize_Address_Ptr_Call
+   function Make_Set_Finalize_Address_Call
      (Loc     : Source_Ptr;
       Typ     : Entity_Id;
       Ptr_Typ : Entity_Id) return Node_Id;
    --  Generate the following call:
    --
-   --    Set_Finalize_Address_Ptr (<Ptr_Typ>FC, <Typ>FD'Unrestricted_Access);
+   --    Set_Finalize_Address (<Ptr_Typ>FM, <Typ>FD'Unrestricted_Access);
    --
    --  where Finalize_Address is the corresponding TSS primitive of type Typ
    --  and Ptr_Typ is the access type of the related allocation. Loc is the
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index a55a7f51698..57193cbf74f 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4878,6 +4878,12 @@ package body Exp_Ch9 is
       Ldecl2 : Node_Id;
 
    begin
+      --  In formal verification mode, do not expand tasking constructs
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       if Expander_Active then
 
          --  If we have no handled statement sequence, we may need to build
@@ -5290,6 +5296,12 @@ package body Exp_Ch9 is
       Tasknm : Node_Id;
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Aggr := Make_Aggregate (Loc, Component_Associations => New_List);
       Count := 0;
 
@@ -5421,6 +5433,12 @@ package body Exp_Ch9 is
    --  Start of processing for Expand_N_Accept_Statement
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       --  If accept statement is not part of a list, then its parent must be
       --  an accept alternative, and, as described above, we do not do any
       --  expansion for such accept statements at this level.
@@ -5848,6 +5866,7 @@ package body Exp_Ch9 is
       Enqueue_Call      : Node_Id;
       Formals           : List_Id;
       Hdle              : List_Id;
+      Handler_Stmt      : Node_Id;
       Index             : Node_Id;
       Lim_Typ_Stmts     : List_Id;
       N_Orig            : Node_Id;
@@ -5859,9 +5878,7 @@ package body Exp_Ch9 is
       ProtP_Stmts       : List_Id;
       Stmt              : Node_Id;
       Stmts             : List_Id;
-      Target_Undefer    : RE_Id;
       TaskE_Stmts       : List_Id;
-      Undefer_Args      : List_Id := No_List;
 
       B   : Entity_Id;  --  Call status flag
       Bnn : Entity_Id;  --  Communication block
@@ -5872,6 +5889,12 @@ package body Exp_Ch9 is
       T   : Entity_Id;  --  Additional status flag
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Process_Statements_For_Controlled_Objects (Trig);
       Process_Statements_For_Controlled_Objects (Abrt);
 
@@ -6352,13 +6375,7 @@ package body Exp_Ch9 is
 
             --  Create the inner block to protect the abortable part
 
-            Hdle := New_List (
-              Make_Implicit_Exception_Handler (Loc,
-                Exception_Choices =>
-                  New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
-                Statements => New_List (
-                  Make_Procedure_Call_Statement (Loc,
-                    Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)))));
+            Hdle := New_List (Build_Abort_Block_Handler (Loc));
 
             Prepend_To (Astats,
               Make_Procedure_Call_Statement (Loc,
@@ -6494,8 +6511,7 @@ package body Exp_Ch9 is
          Append_To (Stmts,
            Make_Implicit_If_Statement (N,
              Condition => Make_Function_Call (Loc,
-               Name => New_Reference_To (
-                 RTE (RE_Enqueued), Loc),
+               Name => New_Reference_To (RTE (RE_Enqueued), Loc),
                Parameter_Associations => New_List (
                  New_Reference_To (Cancel_Param, Loc))),
              Then_Statements => Astats));
@@ -6513,13 +6529,25 @@ package body Exp_Ch9 is
          --  See 4jexcept.ads for an explanation.
 
          if VM_Target = No_VM then
-            Target_Undefer := RE_Abort_Undefer;
+            if Exception_Mechanism = Back_End_Exceptions then
+
+               --  Aborts are not deferred at beginning of exception handlers
+               --  in ZCX.
+
+               Handler_Stmt := Make_Null_Statement (Loc);
+
+            else
+               Handler_Stmt := Make_Procedure_Call_Statement (Loc,
+                 Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
+                 Parameter_Associations => No_List);
+            end if;
          else
-            Target_Undefer := RE_Update_Exception;
-            Undefer_Args :=
-              New_List (Make_Function_Call (Loc,
-                          Name => New_Occurrence_Of
-                                    (RTE (RE_Current_Target_Exception), Loc)));
+            Handler_Stmt := Make_Procedure_Call_Statement (Loc,
+              Name => New_Reference_To (RTE (RE_Update_Exception), Loc),
+              Parameter_Associations => New_List (
+                Make_Function_Call (Loc,
+                  Name => New_Occurrence_Of
+                            (RTE (RE_Current_Target_Exception), Loc))));
          end if;
 
          Stmts := New_List (
@@ -6542,11 +6570,7 @@ package body Exp_Ch9 is
 
                      Exception_Choices =>
                        New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
-                     Statements => New_List (
-                       Make_Procedure_Call_Statement (Loc,
-                         Name => New_Reference_To (
-                           RTE (Target_Undefer), Loc),
-                         Parameter_Associations => Undefer_Args)))))),
+                     Statements => New_List (Handler_Stmt))))),
 
          --  if not Cancelled (Bnn) then
          --     triggered statements
@@ -6602,14 +6626,7 @@ package body Exp_Ch9 is
 
          --  Create the inner block to protect the abortable part
 
-         Hdle :=  New_List (
-           Make_Implicit_Exception_Handler (Loc,
-             Exception_Choices =>
-               New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
-             Statements =>
-               New_List (
-                 Make_Procedure_Call_Statement (Loc,
-                   Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)))));
+         Hdle :=  New_List (Build_Abort_Block_Handler (Loc));
 
          Prepend_To (Astats,
            Make_Procedure_Call_Statement (Loc,
@@ -6827,6 +6844,12 @@ package body Exp_Ch9 is
       S : Entity_Id;  --  Primitive operation slot
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Process_Statements_For_Controlled_Objects (N);
 
       if Ada_Version >= Ada_2005
@@ -7143,6 +7166,12 @@ package body Exp_Ch9 is
    procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Rewrite (N,
         Make_Procedure_Call_Statement (Loc,
           Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc),
@@ -7162,6 +7191,12 @@ package body Exp_Ch9 is
       Typ : Entity_Id;
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       if Is_RTE (Base_Type (Etype (Expression (N))), RO_CA_Time) then
          Typ := RTE (RO_CA_Delay_Until);
       else
@@ -7182,6 +7217,12 @@ package body Exp_Ch9 is
 
    procedure Expand_N_Entry_Body (N : Node_Id) is
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       --  Associate discriminals with the next protected operation body to be
       --  expanded.
 
@@ -7203,6 +7244,12 @@ package body Exp_Ch9 is
       Index   : Node_Id;
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       if No_Run_Time_Mode then
          Error_Msg_CRT ("entry call", N);
          return;
@@ -7259,6 +7306,12 @@ package body Exp_Ch9 is
       Acc_Ent    : Entity_Id;
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Formal := First_Formal (Entry_Ent);
       Last_Decl := N;
 
@@ -7527,6 +7580,12 @@ package body Exp_Ch9 is
    --  Start of processing for Expand_N_Protected_Body
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       if No_Run_Time_Mode then
          Error_Msg_CRT ("protected body", N);
          return;
@@ -9079,6 +9138,12 @@ package body Exp_Ch9 is
    --  Start of processing for Expand_N_Requeue_Statement
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       --  Extract the components of the entry call
 
       Extract_Entry (N, Concval, Ename, Index);
@@ -9665,6 +9730,12 @@ package body Exp_Ch9 is
    --  Start of processing for Expand_N_Selective_Accept
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       Process_Statements_For_Controlled_Objects (N);
 
       --  First insert some declarations before the select. The first is:
@@ -10295,6 +10366,12 @@ package body Exp_Ch9 is
       --  Used to determine the proper location of wrapper body insertions
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       --  Add renaming declarations for discriminals and a declaration for the
       --  entry family index (if applicable).
 
@@ -10991,6 +11068,11 @@ package body Exp_Ch9 is
    --       end if;
    --    end;
 
+   --  The triggering statement and the sequence of timed statements have not
+   --  been analyzed yet (see Analyzed_Timed_Entry_Call). They may contain
+   --  local declarations, and therefore the copies that are made during
+   --  expansion must be disjoint, as for any other inlining.
+
    procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
 
@@ -11036,6 +11118,12 @@ package body Exp_Ch9 is
       S : Entity_Id;  --  Primitive operation slot
 
    begin
+      --  Do not expand tasking constructs in formal verification mode
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       --  Under the Ravenscar profile, timed entry calls are excluded. An error
       --  was already reported on spec, so do not attempt to expand the call.
 
@@ -11284,7 +11372,7 @@ package body Exp_Ch9 is
          --       <timed-statements>
          --    end if;
 
-         N_Stats := New_Copy_List_Tree (E_Stats);
+         N_Stats := Copy_Separate_List (E_Stats);
 
          Prepend_To (N_Stats,
            Make_If_Statement (Loc,
@@ -11327,7 +11415,7 @@ package body Exp_Ch9 is
          --    <dispatching-call>;
          --    <triggering-statements>
 
-         Lim_Typ_Stmts := New_Copy_List_Tree (E_Stats);
+         Lim_Typ_Stmts := Copy_Separate_List (E_Stats);
          Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (E_Call));
 
          --  Generate:
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e7614aa8ac1..b77bb0b89ac 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -2051,7 +2051,8 @@ package body Exp_Disp is
    --        F : out Boolean)
    --     is
    --     begin
-   --        null;
+   --        F := False;
+   --        C := Ada.Tags.POK_Function;
    --     end _Disp_Asynchronous_Select;
 
    --  For protected types, generate:
@@ -2116,13 +2117,13 @@ package body Exp_Disp is
       if Is_Interface (Typ) then
          return
            Make_Subprogram_Body (Loc,
-             Specification =>
-               Make_Disp_Asynchronous_Select_Spec (Typ),
-             Declarations =>
-               New_List,
+             Specification => Make_Disp_Asynchronous_Select_Spec (Typ),
+             Declarations  => New_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 New_List (Make_Null_Statement (Loc))));
+                 New_List (Make_Assignment_Statement (Loc,
+                   Name       => Make_Identifier (Loc, Name_uF),
+                   Expression => New_Reference_To (Standard_False, Loc)))));
       end if;
 
       if Is_Concurrent_Record_Type (Typ) then
@@ -2262,6 +2263,14 @@ package body Exp_Disp is
                     Expression =>
                       New_Reference_To (Com_Block, Loc))));
 
+            --  Generate:
+            --    F := False;
+
+            Append_To (Stmts,
+              Make_Assignment_Statement (Loc,
+                Name       => Make_Identifier (Loc, Name_uF),
+                Expression => New_Reference_To (Standard_False, Loc)));
+
          else
             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
 
@@ -2300,15 +2309,17 @@ package body Exp_Disp is
       else
          --  Ensure that the statements list is non-empty
 
-         Append_To (Stmts, Make_Null_Statement (Loc));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uF),
+             Expression => New_Reference_To (Standard_False, Loc)));
       end if;
 
       return
         Make_Subprogram_Body (Loc,
-          Specification =>
+          Specification              =>
             Make_Disp_Asynchronous_Select_Spec (Typ),
-          Declarations =>
-            Decls,
+          Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
    end Make_Disp_Asynchronous_Select_Body;
@@ -2391,7 +2402,8 @@ package body Exp_Disp is
    --        F : out Boolean)
    --     is
    --     begin
-   --        null;
+   --        F := False;
+   --        C := Ada.Tags.POK_Function;
    --     end _Disp_Conditional_Select;
 
    --  For protected types, generate:
@@ -2474,7 +2486,9 @@ package body Exp_Disp is
                No_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 New_List (Make_Null_Statement (Loc))));
+                 New_List (Make_Assignment_Statement (Loc,
+                   Name       => Make_Identifier (Loc, Name_uF),
+                   Expression => New_Reference_To (Standard_False, Loc)))));
       end if;
 
       if Is_Concurrent_Record_Type (Typ) then
@@ -2675,17 +2689,23 @@ package body Exp_Disp is
          end if;
 
       else
-         --  Ensure that the statements list is non-empty
+         --  Initialize out parameters
 
-         Append_To (Stmts, Make_Null_Statement (Loc));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uF),
+             Expression => New_Reference_To (Standard_False, Loc)));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uC),
+             Expression => New_Reference_To (RTE (RE_POK_Function), Loc)));
       end if;
 
       return
         Make_Subprogram_Body (Loc,
-          Specification =>
+          Specification              =>
             Make_Disp_Conditional_Select_Spec (Typ),
-          Declarations =>
-            Decls,
+          Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
    end Make_Disp_Conditional_Select_Body;
@@ -3235,7 +3255,8 @@ package body Exp_Disp is
    --        F : out Boolean)
    --     is
    --     begin
-   --        null;
+   --        F := False;
+   --        C := Ada.Tags.POK_Function;
    --     end _Disp_Timed_Select;
 
    --  For protected types, generate:
@@ -3294,7 +3315,7 @@ package body Exp_Disp is
    --           P,
    --           D,
    --           M,
-   --           D);
+   --           F);
    --     end _Disp_Time_Select;
 
    function Make_Disp_Timed_Select_Body
@@ -3321,7 +3342,10 @@ package body Exp_Disp is
                New_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 New_List (Make_Null_Statement (Loc))));
+                 New_List (
+                   Make_Assignment_Statement (Loc,
+                     Name       => Make_Identifier (Loc, Name_uF),
+                     Expression => New_Reference_To (Standard_False, Loc)))));
       end if;
 
       if Is_Concurrent_Record_Type (Typ) then
@@ -3335,10 +3359,8 @@ package body Exp_Disp is
 
          Append_To (Decls,
            Make_Object_Declaration (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Name_uI),
-             Object_Definition =>
-               New_Reference_To (Standard_Integer, Loc)));
+             Defining_Identifier => Make_Defining_Identifier (Loc, Name_uI),
+             Object_Definition   => New_Reference_To (Standard_Integer, Loc)));
 
          --  Generate:
          --    C := Get_Prim_Op_Kind (tag! (<type>VP), S);
@@ -3367,7 +3389,7 @@ package body Exp_Disp is
          else
             Tag_Node :=
               Make_Attribute_Reference (Loc,
-                Prefix => New_Reference_To (Typ, Loc),
+                Prefix         => New_Reference_To (Typ, Loc),
                 Attribute_Name => Name_Tag);
          end if;
 
@@ -3376,8 +3398,7 @@ package body Exp_Disp is
              Name       => Make_Identifier (Loc, Name_uI),
              Expression =>
                Make_Function_Call (Loc,
-                 Name =>
-                   New_Reference_To (RTE (RE_Get_Entry_Index), Loc),
+                 Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc),
                  Parameter_Associations =>
                    New_List (
                      Tag_Node,
@@ -3500,17 +3521,22 @@ package body Exp_Disp is
          end if;
 
       else
-         --  Ensure that the statements list is non-empty
+         --  Initialize out parameters
 
-         Append_To (Stmts, Make_Null_Statement (Loc));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uF),
+             Expression => New_Reference_To (Standard_False, Loc)));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uC),
+             Expression => New_Reference_To (RTE (RE_POK_Function), Loc)));
       end if;
 
       return
         Make_Subprogram_Body (Loc,
-          Specification =>
-            Make_Disp_Timed_Select_Spec (Typ),
-          Declarations =>
-            Decls,
+          Specification              => Make_Disp_Timed_Select_Spec (Typ),
+          Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
    end Make_Disp_Timed_Select_Body;
@@ -3699,6 +3725,50 @@ package body Exp_Disp is
       is
          Comp : Entity_Id;
 
+         function Is_Actual_For_Formal_Incomplete_Type
+           (T : Entity_Id) return Boolean;
+         --  In Ada 2012, if a nested generic has an incomplete formal type,
+         --  the actual may be (and usually is) a private type whose completion
+         --  appears later. It is safe to build the dispatch table in this
+         --  case, gigi will have full views available.
+
+         ------------------------------------------
+         -- Is_Actual_For_Formal_Incomplete_Type --
+         ------------------------------------------
+
+         function Is_Actual_For_Formal_Incomplete_Type
+           (T : Entity_Id) return Boolean
+         is
+            Gen_Par : Entity_Id;
+            F       : Node_Id;
+
+         begin
+            if not Is_Generic_Instance (Current_Scope)
+              or else not Used_As_Generic_Actual (T)
+            then
+               return False;
+
+            else
+               Gen_Par := Generic_Parent (Parent (Current_Scope));
+            end if;
+
+            F :=
+              First
+                (Generic_Formal_Declarations
+                     (Unit_Declaration_Node (Gen_Par)));
+            while Present (F) loop
+               if Ekind (Defining_Identifier (F)) = E_Incomplete_Type then
+                  return True;
+               end if;
+
+               Next (F);
+            end loop;
+
+            return False;
+         end Is_Actual_For_Formal_Incomplete_Type;
+
+      --  Start of processing for Check_Premature_Freezing
+
       begin
          if Present (N)
            and then Is_Private_Type (Typ)
@@ -3720,6 +3790,8 @@ package body Exp_Disp is
             if not Is_Tagged_Type (Typ)
               and then Present (Comp)
               and then not Is_Frozen (Comp)
+              and then
+                not Is_Actual_For_Formal_Incomplete_Type (Comp)
             then
                Error_Msg_Sloc := Sloc (Subp);
                Error_Msg_Node_2 := Subp;
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index af06000216b..ad3f432b98c 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -2084,8 +2084,7 @@ package body Exp_Dist is
    is
       N : constant Name_Id := Chars (Def);
 
-      Overload_Order : constant Int :=
-                         Overload_Counter_Table.Get (N) + 1;
+      Overload_Order : constant Int := Overload_Counter_Table.Get (N) + 1;
 
    begin
       Overload_Counter_Table.Set (N, Overload_Order);
@@ -10429,12 +10428,11 @@ package body Exp_Dist is
 
                   --  A variant part
 
-                  declare
-                     Discriminant_Type : constant Entity_Id :=
-                                           Etype (Name (Field));
+                  Variant_Part : declare
+                     Disc_Type : constant Entity_Id := Etype (Name (Field));
 
                      Is_Enum : constant Boolean :=
-                                 Is_Enumeration_Type (Discriminant_Type);
+                                 Is_Enumeration_Type (Disc_Type);
 
                      Union_TC_Params : List_Id;
 
@@ -10452,6 +10450,8 @@ package body Exp_Dist is
                      Dummy_Counter : Int := 0;
 
                      Choice_Index : Int := 0;
+                     --  Index of current choice in TypeCode, used to identify
+                     --  it as the default choice if it is a "when others".
 
                      procedure Add_Params_For_Variant_Components;
                      --  Add a struct TypeCode and a corresponding member name
@@ -10465,8 +10465,7 @@ package body Exp_Dist is
                      -- Add_Params_For_Variant_Components --
                      ---------------------------------------
 
-                     procedure Add_Params_For_Variant_Components
-                     is
+                     procedure Add_Params_For_Variant_Components is
                         S_Name : constant Name_Id :=
                                    New_External_Name (U_Name, 'S', -1);
 
@@ -10491,6 +10490,8 @@ package body Exp_Dist is
                         Add_String_Parameter (Name_Str, Union_TC_Params);
                      end Add_Params_For_Variant_Components;
 
+                  --  Start of processing for Variant_Part
+
                   begin
                      Get_Name_String (U_Name);
                      Name_Str := String_From_Name_Buffer;
@@ -10510,8 +10511,7 @@ package body Exp_Dist is
                      --  Build union parameters
 
                      Add_TypeCode_Parameter
-                       (Build_TypeCode_Call
-                          (Loc, Discriminant_Type, Decls),
+                       (Build_TypeCode_Call (Loc, Disc_Type, Decls),
                         Union_TC_Params);
 
                      Add_Long_Parameter (Default, Union_TC_Params);
@@ -10536,72 +10536,65 @@ package body Exp_Dist is
                                  begin
                                     while J <= H loop
                                        if Is_Enum then
-                                          Expr := New_Occurrence_Of (
-                                            Get_Enum_Lit_From_Pos (
-                                              Discriminant_Type, J, Loc), Loc);
+                                          Expr := Get_Enum_Lit_From_Pos
+                                                    (Disc_Type, J, Loc);
                                        else
                                           Expr :=
                                             Make_Integer_Literal (Loc, J);
                                        end if;
+
+                                       Set_Etype (Expr, Disc_Type);
                                        Append_To (Union_TC_Params,
                                          Build_To_Any_Call (Expr, Decls));
 
                                        Add_Params_For_Variant_Components;
                                        J := J + Uint_1;
                                     end loop;
+
+                                    Choice_Index :=
+                                      Choice_Index + UI_To_Int (H - L) + 1;
                                  end;
 
                               when N_Others_Choice =>
 
-                                 --  This variant possess a default choice.
-                                 --  We must therefore set the default
-                                 --  parameter to the current choice index. The
-                                 --  default parameter is by construction the
-                                 --  fourth in the Union_TC_Params list.
-
-                                 declare
-                                    Default_Node : constant Node_Id :=
-                                                     Pick (Union_TC_Params, 4);
-
-                                    New_Default_Node : constant Node_Id :=
-                                      Make_Function_Call (Loc,
-                                       Name =>
-                                         New_Occurrence_Of
-                                           (RTE (RE_TA_I32), Loc),
-                                       Parameter_Associations =>
-                                         New_List (
-                                           Make_Integer_Literal
-                                             (Loc, Choice_Index)));
-                                 begin
-                                    Insert_Before (
-                                      Default_Node,
-                                      New_Default_Node);
+                                 --  This variant has a default choice. We must
+                                 --  therefore set the default parameter to the
+                                 --  current choice index. This parameter is by
+                                 --  construction the 4th in Union_TC_Params.
 
-                                    Remove (Default_Node);
-                                 end;
+                                 Replace
+                                   (Pick (Union_TC_Params, 4),
+                                    Make_Function_Call (Loc,
+                                      Name =>
+                                        New_Occurrence_Of
+                                          (RTE (RE_TA_I32), Loc),
+                                      Parameter_Associations =>
+                                        New_List (
+                                          Make_Integer_Literal (Loc,
+                                            Intval => Choice_Index))));
 
-                                 --  Add a placeholder member label
-                                 --  for the default case.
-                                 --  It must be of the discriminant type.
+                                 --  Add a placeholder member label for the
+                                 --  default case, which must have the
+                                 --  discriminant type.
 
                                  declare
                                     Exp : constant Node_Id :=
-                                      Make_Attribute_Reference (Loc,
-                                       Prefix => New_Occurrence_Of
-                                         (Discriminant_Type, Loc),
-                                       Attribute_Name => Name_First);
+                                            Make_Attribute_Reference (Loc,
+                                              Prefix => New_Occurrence_Of
+                                                          (Disc_Type, Loc),
+                                              Attribute_Name => Name_First);
                                  begin
-                                    Set_Etype (Exp, Discriminant_Type);
+                                    Set_Etype (Exp, Disc_Type);
                                     Append_To (Union_TC_Params,
                                       Build_To_Any_Call (Exp, Decls));
                                  end;
 
                                  Add_Params_For_Variant_Components;
+                                 Choice_Index := Choice_Index + 1;
 
-                              when others =>
-
-                                 --  Case of an explicit choice
+                              --  Case of an explicit choice
 
+                              when others =>
                                  declare
                                     Exp : constant Node_Id :=
                                             New_Copy_Tree (Choice);
@@ -10611,15 +10604,15 @@ package body Exp_Dist is
                                  end;
 
                                  Add_Params_For_Variant_Components;
+                                 Choice_Index := Choice_Index + 1;
                            end case;
 
                            Next (Choice);
-                           Choice_Index := Choice_Index + 1;
                         end loop;
 
                         Next_Non_Pragma (Variant);
                      end loop;
-                  end;
+                  end Variant_Part;
                end if;
             end TC_Rec_Add_Process_Element;
 
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 778996bc023..07035478bff 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -974,29 +974,7 @@ package body Exp_Intr is
                      Obj_Ref => Deref,
                      Typ     => Desig_T)),
                  Exception_Handlers => New_List (
-                   Make_Exception_Handler (Loc,
-                     Exception_Choices => New_List (
-                       Make_Others_Choice (Loc)),
-                     Statements => New_List (
-                       Make_Assignment_Statement (Loc,
-                         Name =>
-                           New_Reference_To (Raised_Id, Loc),
-                         Expression =>
-                           New_Reference_To (Standard_True, Loc)),
-                       Make_Procedure_Call_Statement (Loc,
-                         Name =>
-                           New_Reference_To (RTE (RE_Save_Occurrence), Loc),
-                         Parameter_Associations => New_List (
-                           New_Reference_To (E_Id, Loc),
-                           Make_Explicit_Dereference (Loc,
-                             Prefix =>
-                               Make_Function_Call (Loc,
-                                 Name =>
-                                   Make_Explicit_Dereference (Loc,
-                                     Prefix =>
-                                       New_Reference_To
-                                         (RTE (RE_Get_Current_Excep),
-                                          Loc))))))))))));
+                   Build_Exception_Handler (Loc, E_Id, Raised_Id)))));
 
          --  For .NET/JVM, detach the object from the containing finalization
          --  collection before finalizing it.
@@ -1229,13 +1207,13 @@ package body Exp_Intr is
       --  Generate a test of whether any earlier finalization raised an
       --  exception, and in that case raise Program_Error with the previous
       --  exception occurrence.
-      --
+
       --  Generate:
-      --    if Raised then
-      --       Reraise_Occurrence (E);                      --  for .NET and
-      --                                                    --  restricted RTS
+      --    if Raised and then not Abort then
+      --       raise Program_Error;                  --  for .NET and
+      --                                             --  restricted RTS
       --         <or>
-      --       Raise_From_Controlled_Operation (E, Abort);  --  all other cases
+      --       Raise_From_Controlled_Operation (E);  --  all other cases
       --    end if;
 
       if Present (Raised_Id) then
diff --git a/gcc/ada/exp_sel.adb b/gcc/ada/exp_sel.adb
index 5596f8a10f9..27245cff50a 100644
--- a/gcc/ada/exp_sel.adb
+++ b/gcc/ada/exp_sel.adb
@@ -57,27 +57,43 @@ package body Exp_Sel is
               Statements =>
                 New_List (
                   Make_Implicit_Label_Declaration (Loc,
-                    Defining_Identifier =>
-                      Cln_Blk_Ent,
-                    Label_Construct =>
-                      Blk),
+                    Defining_Identifier => Cln_Blk_Ent,
+                    Label_Construct     => Blk),
                   Blk),
 
               Exception_Handlers =>
-                New_List (
-                  Make_Implicit_Exception_Handler (Loc,
-                    Exception_Choices =>
-                      New_List (
-                        New_Reference_To (Stand.Abort_Signal, Loc)),
-                    Statements =>
-                      New_List (
-                        Make_Procedure_Call_Statement (Loc,
-                          Name =>
-                            New_Reference_To (RTE (
-                              RE_Abort_Undefer), Loc),
-                          Parameter_Associations => No_List))))));
+                New_List (Build_Abort_Block_Handler (Loc))));
    end Build_Abort_Block;
 
+   -------------------------------
+   -- Build_Abort_Block_Handler --
+   -------------------------------
+
+   function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id is
+      Stmt : Node_Id;
+
+   begin
+      if Exception_Mechanism = Back_End_Exceptions then
+
+         --  With ZCX, aborts are not defered in handlers
+
+         Stmt := Make_Null_Statement (Loc);
+      else
+         --  With FE SJLJ, aborts are defered at the beginning of Abort_Signal
+         --  handlers.
+
+         Stmt :=
+           Make_Procedure_Call_Statement (Loc,
+             Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc),
+             Parameter_Associations => No_List);
+      end if;
+
+      return Make_Implicit_Exception_Handler (Loc,
+        Exception_Choices =>
+          New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
+        Statements        => New_List (Stmt));
+   end Build_Abort_Block_Handler;
+
    -------------
    -- Build_B --
    -------------
@@ -125,8 +141,9 @@ package body Exp_Sel is
    is
       Cleanup_Block : constant Node_Id :=
                         Make_Block_Statement (Loc,
-                          Identifier   => New_Reference_To (Blk_Ent, Loc),
-                          Declarations => No_List,
+                          Identifier                 =>
+                            New_Reference_To (Blk_Ent, Loc),
+                          Declarations               => No_List,
                           Handled_Statement_Sequence =>
                             Make_Handled_Sequence_Of_Statements (Loc,
                               Statements => Stmts),
diff --git a/gcc/ada/exp_sel.ads b/gcc/ada/exp_sel.ads
index a68459de9d2..440a0ea2c38 100644
--- a/gcc/ada/exp_sel.ads
+++ b/gcc/ada/exp_sel.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -39,10 +39,21 @@ package Exp_Sel is
    --    begin
    --       Blk
    --    exception
-   --       when Abort_Signal => Abort_Undefer;
+   --       when Abort_Signal => Abort_Undefer / null;
    --    end;
    --  Abr_Blk_Ent is the name of the generated block, Cln_Blk_Ent is the name
    --  of the encapsulated cleanup block, Blk is the actual block name.
+   --  The exception handler code is built by Build_Abort_Block_Handler.
+
+   function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id;
+   --  Generate if front-end exception:
+   --    when others =>
+   --      Abort_Under;
+   --  or if back-end exception:
+   --    when others =>
+   --      null;
+   --  This is an exception handler to stop propagation of aborts, without
+   --  modifying the deferal level.
 
    function Build_B
      (Loc   : Source_Ptr;
diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
index 985f8656c66..fe02747705b 100644
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -867,7 +867,7 @@ package body Exp_Strm is
       Dcls : constant List_Id := New_List;
       --  Declarations for the 'Read body
 
-      Stms : List_Id := New_List;
+      Stms : constant List_Id := New_List;
       --  Statements for the 'Read body
 
       Disc : Entity_Id;
@@ -895,9 +895,6 @@ package body Exp_Strm is
       --  Statements within the block where we have the constrained temporary
 
    begin
-
-      Disc := First_Discriminant (Typ);
-
       --  A mutable type cannot be a tagged type, so we generate a new name
       --  for the stream procedure.
 
@@ -905,6 +902,23 @@ package body Exp_Strm is
         Make_Defining_Identifier (Loc,
           Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
 
+      if Is_Unchecked_Union (Typ) then
+
+         --  If this is an unchecked union, the stream procedure is erroneous,
+         --  because there are no discriminants to read.
+
+         --  This should generate a warning ???
+
+         Append_To (Stms,
+           Make_Raise_Program_Error (Loc,
+             Reason => PE_Unchecked_Union_Restriction));
+
+         Build_Stream_Procedure (Loc, Typ, Decl, Pnam, Stms, Outp => True);
+         return;
+      end if;
+
+      Disc := First_Discriminant (Typ);
+
       Out_Formal :=
         Make_Selected_Component (Loc,
           Prefix        => New_Occurrence_Of (Pnam, Loc),
@@ -957,6 +971,14 @@ package body Exp_Strm is
 
       Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read);
 
+      --  Save original statement sequence for component assignments, and
+      --  replace it with Stms.
+
+      Constrained_Stms := Statements (Handled_Statement_Sequence (Decl));
+      Set_Handled_Statement_Sequence (Decl,
+        Make_Handled_Sequence_Of_Statements (Loc,
+          Statements => Stms));
+
       --  If Typ has controlled components (i.e. if it is classwide
       --  or Has_Controlled), or components constrained using the discriminants
       --  of Typ, then we need to ensure that all component assignments
@@ -974,13 +996,10 @@ package body Exp_Strm is
                 Make_Index_Or_Discriminant_Constraint (Loc,
                   Constraints => Cstr))));
 
-      Constrained_Stms := Statements (Handled_Statement_Sequence (Decl));
-      Append_To (Stms,
-        Make_Block_Statement (Loc,
-          Declarations               => Dcls,
-          Handled_Statement_Sequence => Parent (Constrained_Stms)));
+      --  AI05-023-1: Insert discriminant check prior to initialization of the
+      --  constrained temporary.
 
-      Append_To (Constrained_Stms,
+      Append_To (Stms,
         Make_Implicit_If_Statement (Pnam,
           Condition =>
             Make_Attribute_Reference (Loc,
@@ -988,28 +1007,20 @@ package body Exp_Strm is
               Attribute_Name => Name_Constrained),
           Then_Statements => Discriminant_Checks));
 
+      --  Now insert back original component assignments, wrapped in a block
+      --  in which V is the constrained temporary.
+
+      Append_To (Stms,
+        Make_Block_Statement (Loc,
+          Declarations               => Dcls,
+          Handled_Statement_Sequence => Parent (Constrained_Stms)));
+
       Append_To (Constrained_Stms,
         Make_Assignment_Statement (Loc,
           Name       => Out_Formal,
           Expression => Make_Identifier (Loc, Name_V)));
 
-      if Is_Unchecked_Union (Typ) then
-
-         --  If this is an unchecked union, the stream procedure is erroneous,
-         --  because there are no discriminants to read.
-
-         --  This should generate a warning ???
-
-         Stms :=
-           New_List (
-             Make_Raise_Program_Error (Loc,
-               Reason => PE_Unchecked_Union_Restriction));
-      end if;
-
       Set_Declarations (Decl, Tmps_For_Discs);
-      Set_Handled_Statement_Sequence (Decl,
-        Make_Handled_Sequence_Of_Statements (Loc,
-          Statements => Stms));
    end Build_Mutable_Record_Read_Procedure;
 
    ------------------------------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 55090e72de3..d712570d920 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -327,10 +327,14 @@ package body Exp_Util is
      (N           : Node_Id;
       Is_Allocate : Boolean)
    is
-      Expr      : constant Node_Id   := Expression (N);
-      Ptr_Typ   : constant Entity_Id := Etype (Expr);
-      Desig_Typ : constant Entity_Id :=
-                    Available_View (Designated_Type (Ptr_Typ));
+      Desig_Typ    : Entity_Id;
+      Expr         : Node_Id;
+      Pool_Id      : Entity_Id;
+      Proc_To_Call : Node_Id := Empty;
+      Ptr_Typ      : Entity_Id;
+
+      function Find_Finalize_Address (Typ : Entity_Id) return Entity_Id;
+      --  Locate TSS primitive Finalize_Address in type Typ
 
       function Find_Object (E : Node_Id) return Node_Id;
       --  Given an arbitrary expression of an allocator, try to find an object
@@ -340,6 +344,77 @@ package body Exp_Util is
       --  Determine whether subprogram Subp denotes a custom allocate or
       --  deallocate.
 
+      ---------------------------
+      -- Find_Finalize_Address --
+      ---------------------------
+
+      function Find_Finalize_Address (Typ : Entity_Id) return Entity_Id is
+         Utyp : Entity_Id := Typ;
+
+      begin
+         --  Handle protected class-wide or task class-wide types
+
+         if Is_Class_Wide_Type (Utyp) then
+            if Is_Concurrent_Type (Root_Type (Utyp)) then
+               Utyp := Root_Type (Utyp);
+
+            elsif Is_Private_Type (Root_Type (Utyp))
+              and then Present (Full_View (Root_Type (Utyp)))
+              and then Is_Concurrent_Type (Full_View (Root_Type (Utyp)))
+            then
+               Utyp := Full_View (Root_Type (Utyp));
+            end if;
+         end if;
+
+         --  Handle private types
+
+         if Is_Private_Type (Utyp)
+           and then Present (Full_View (Utyp))
+         then
+            Utyp := Full_View (Utyp);
+         end if;
+
+         --  Handle protected and task types
+
+         if Is_Concurrent_Type (Utyp)
+           and then Present (Corresponding_Record_Type (Utyp))
+         then
+            Utyp := Corresponding_Record_Type (Utyp);
+         end if;
+
+         Utyp := Underlying_Type (Base_Type (Utyp));
+
+         --  Deal with non-tagged derivation of private views. If the parent is
+         --  now known to be protected, the finalization routine is the one
+         --  defined on the corresponding record of the ancestor (corresponding
+         --  records do not automatically inherit operations, but maybe they
+         --  should???)
+
+         if Is_Untagged_Derivation (Typ) then
+            if Is_Protected_Type (Typ) then
+               Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
+            else
+               Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
+
+               if Is_Protected_Type (Utyp) then
+                  Utyp := Corresponding_Record_Type (Utyp);
+               end if;
+            end if;
+         end if;
+
+         --  If the underlying_type is a subtype, we are dealing with the
+         --  completion of a private type. We need to access the base type and
+         --  generate a conversion to it.
+
+         if Utyp /= Base_Type (Utyp) then
+            pragma Assert (Is_Private_Type (Typ));
+
+            Utyp := Base_Type (Utyp);
+         end if;
+
+         return TSS (Utyp, TSS_Finalize_Address);
+      end Find_Finalize_Address;
+
       -----------------
       -- Find_Object --
       -----------------
@@ -375,8 +450,7 @@ package body Exp_Util is
       function Is_Allocate_Deallocate_Proc (Subp : Entity_Id) return Boolean is
       begin
          --  Look for a subprogram body with only one statement which is a
-         --  call to one of the Allocate / Deallocate routines in package
-         --  Ada.Finalization.Heap_Management.
+         --  call to Allocate_Any_Controlled / Deallocate_Any_Controlled.
 
          if Ekind (Subp) = E_Procedure
            and then Nkind (Parent (Parent (Subp))) = N_Subprogram_Body
@@ -394,8 +468,8 @@ package body Exp_Util is
                   Proc := Entity (Name (First (Statements (HSS))));
 
                   return
-                    Is_RTE (Proc, RE_Allocate)
-                      or else Is_RTE (Proc, RE_Deallocate);
+                    Is_RTE (Proc, RE_Allocate_Any_Controlled)
+                      or else Is_RTE (Proc, RE_Deallocate_Any_Controlled);
                end if;
             end;
          end if;
@@ -406,18 +480,91 @@ package body Exp_Util is
    --  Start of processing for Build_Allocate_Deallocate_Proc
 
    begin
-      --  The allocation / deallocation of a non-controlled object does not
-      --  need the machinery created by this routine.
+      --  Obtain the attributes of the allocation / deallocation
+
+      if Nkind (N) = N_Free_Statement then
+         Expr := Expression (N);
+         Ptr_Typ := Base_Type (Etype (Expr));
+         Proc_To_Call := Procedure_To_Call (N);
+
+      else
+         if Nkind (N) = N_Object_Declaration then
+            Expr := Expression (N);
+         else
+            Expr := N;
+         end if;
 
-      if not Needs_Finalization (Desig_Typ) then
+         Ptr_Typ := Base_Type (Etype (Expr));
+
+         --  The allocator may have been rewritten into something else
+
+         if Nkind (Expr) = N_Allocator then
+            Proc_To_Call := Procedure_To_Call (Expr);
+         end if;
+      end if;
+
+      Pool_Id := Associated_Storage_Pool (Ptr_Typ);
+      Desig_Typ := Available_View (Designated_Type (Ptr_Typ));
+
+      --  Handle concurrent types
+
+      if Is_Concurrent_Type (Desig_Typ)
+        and then Present (Corresponding_Record_Type (Desig_Typ))
+      then
+         Desig_Typ := Corresponding_Record_Type (Desig_Typ);
+      end if;
+
+      --  Do not process allocations / deallocations without a pool
+
+      if No (Pool_Id) then
          return;
 
-      --  The allocator or free statement has already been expanded and already
-      --  has a custom Allocate / Deallocate routine.
+      --  Do not process allocations on / deallocations from the secondary
+      --  stack.
+
+      elsif Is_RTE (Pool_Id, RE_SS_Pool) then
+         return;
+
+      --  Do not replicate the machinery if the allocator / free has already
+      --  been expanded and has a custom Allocate / Deallocate.
+
+      elsif Present (Proc_To_Call)
+        and then Is_Allocate_Deallocate_Proc (Proc_To_Call)
+      then
+         return;
+      end if;
+
+      if Needs_Finalization (Desig_Typ) then
+
+         --  Certain run-time configurations and targets do not provide support
+         --  for controlled types.
+
+         if Restriction_Active (No_Finalization) then
+            return;
+
+         --  Do nothing if the access type may never allocate / deallocate
+         --  objects.
+
+         elsif No_Pool_Assigned (Ptr_Typ) then
+            return;
+
+         --  Access-to-controlled types are not supported on .NET/JVM since
+         --  these targets cannot support pools and address arithmetic.
+
+         elsif VM_Target /= No_VM then
+            return;
+         end if;
+
+         --  The allocation / deallocation of a controlled object must be
+         --  chained on / detached from a finalization master.
+
+         pragma Assert (Present (Finalization_Master (Ptr_Typ)));
+
+      --  The only other kind of allocation / deallocation supported by this
+      --  routine is on / from a subpool.
 
       elsif Nkind (Expr) = N_Allocator
-        and then Present (Procedure_To_Call (Expr))
-        and then Is_Allocate_Deallocate_Proc (Procedure_To_Call (Expr))
+        and then No (Subpool_Handle_Name (Expr))
       then
          return;
       end if;
@@ -430,137 +577,200 @@ package body Exp_Util is
          Size_Id : constant Entity_Id := Make_Temporary (Loc, 'S');
 
          Actuals      : List_Id;
-         Collect_Act  : Node_Id;
-         Collect_Id   : Entity_Id;
-         Collect_Typ  : Entity_Id;
+         Fin_Addr_Id  : Entity_Id;
+         Fin_Mas_Act  : Node_Id;
+         Fin_Mas_Id   : Entity_Id;
          Proc_To_Call : Entity_Id;
+         Subpool      : Node_Id := Empty;
 
       begin
-         --  When dealing with an access subtype, use the collection of the
-         --  base type.
+         --  Step 1: Construct all the actuals for the call to library routine
+         --  Allocate_Any_Controlled / Deallocate_Any_Controlled.
 
-         if Ekind (Ptr_Typ) = E_Access_Subtype then
-            Collect_Typ := Base_Type (Ptr_Typ);
-         else
-            Collect_Typ := Ptr_Typ;
-         end if;
+         --  a) Storage pool
 
-         Collect_Id  := Associated_Collection (Collect_Typ);
-         Collect_Act := New_Reference_To (Collect_Id, Loc);
+         Actuals := New_List (New_Reference_To (Pool_Id, Loc));
 
-         --  Handle the case where the collection is actually a pointer to a
-         --  collection. This case arises in build-in-place functions.
+         if Is_Allocate then
 
-         if Is_Access_Type (Etype (Collect_Id)) then
-            Collect_Act :=
-              Make_Explicit_Dereference (Loc,
-                Prefix => Collect_Act);
-         end if;
+            --  b) Subpool
 
-         --  Create the actuals for the call to Allocate / Deallocate
+            if Nkind (Expr) = N_Allocator then
+               Subpool := Subpool_Handle_Name (Expr);
+            end if;
 
-         Actuals := New_List (
-           Collect_Act,
-           New_Reference_To (Addr_Id, Loc),
-           New_Reference_To (Size_Id, Loc),
-           New_Reference_To (Alig_Id, Loc));
+            if Present (Subpool) then
+               Append_To (Actuals, New_Reference_To (Entity (Subpool), Loc));
+            else
+               Append_To (Actuals, Make_Null (Loc));
+            end if;
 
-         --  Generate a run-time check to determine whether a class-wide object
-         --  is truly controlled.
+            --  c) Finalization master
 
-         if Is_Class_Wide_Type (Desig_Typ)
-           or else Is_Generic_Actual_Type (Desig_Typ)
-         then
-            declare
-               Flag_Id   : constant Entity_Id := Make_Temporary (Loc, 'F');
-               Flag_Expr : Node_Id;
-               Param     : Node_Id;
-               Temp      : Node_Id;
+            if Needs_Finalization (Desig_Typ) then
+               Fin_Mas_Id  := Finalization_Master (Ptr_Typ);
+               Fin_Mas_Act := New_Reference_To (Fin_Mas_Id, Loc);
 
-            begin
-               if Is_Allocate then
-                  Temp := Find_Object (Expression (Expr));
+               --  Handle the case where the master is actually a pointer to a
+               --  master. This case arises in build-in-place functions.
+
+               if Is_Access_Type (Etype (Fin_Mas_Id)) then
+                  Append_To (Actuals, Fin_Mas_Act);
                else
-                  Temp := Expr;
+                  Append_To (Actuals,
+                    Make_Attribute_Reference (Loc,
+                      Prefix         => Fin_Mas_Act,
+                      Attribute_Name => Name_Unrestricted_Access));
                end if;
+            else
+               Append_To (Actuals, Make_Null (Loc));
+            end if;
 
-               --  Processing for generic actuals
+            --  d) Finalize_Address
 
-               if Is_Generic_Actual_Type (Desig_Typ) then
-                  Flag_Expr :=
-                    New_Reference_To (Boolean_Literals
-                      (Needs_Finalization (Base_Type (Desig_Typ))), Loc);
+            --  Primitive Finalize_Address is never generated in CodePeer mode
+            --  since it contains an Unchecked_Conversion.
 
-               --  Processing for subtype indications
+            if Needs_Finalization (Desig_Typ)
+              and then not CodePeer_Mode
+            then
+               Fin_Addr_Id := Find_Finalize_Address (Desig_Typ);
+               pragma Assert (Present (Fin_Addr_Id));
 
-               elsif Nkind (Temp) in N_Has_Entity
-                 and then Is_Type (Entity (Temp))
-               then
-                  Flag_Expr :=
-                    New_Reference_To (Boolean_Literals
-                      (Needs_Finalization (Entity (Temp))), Loc);
+               Append_To (Actuals,
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Reference_To (Fin_Addr_Id, Loc),
+                   Attribute_Name => Name_Unrestricted_Access));
+            else
+               Append_To (Actuals, Make_Null (Loc));
+            end if;
+         end if;
 
-               --  Generate a runtime check to test the controlled state of an
-               --  object for the purposes of allocation / deallocation.
+         --  e) Address
+         --  f) Storage_Size
+         --  g) Alignment
 
-               else
-                  --  The following case arises when allocating through an
-                  --  interface class-wide type, generate:
-                  --
-                  --    Temp.all
+         Append_To (Actuals, New_Reference_To (Addr_Id, Loc));
+         Append_To (Actuals, New_Reference_To (Size_Id, Loc));
+         Append_To (Actuals, New_Reference_To (Alig_Id, Loc));
 
-                  if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
-                     Param :=
-                       Make_Explicit_Dereference (Loc,
-                         Prefix =>
-                           Relocate_Node (Temp));
+         --  h) Is_Controlled
 
-                  --  Generate:
-                  --    Temp'Tag
+         --  Generate a run-time check to determine whether a class-wide object
+         --  is truly controlled.
+
+         if Needs_Finalization (Desig_Typ) then
+            if Is_Class_Wide_Type (Desig_Typ)
+              or else Is_Generic_Actual_Type (Desig_Typ)
+            then
+               declare
+                  Flag_Id   : constant Entity_Id := Make_Temporary (Loc, 'F');
+                  Flag_Expr : Node_Id;
+                  Param     : Node_Id;
+                  Temp      : Node_Id;
 
+               begin
+                  if Is_Allocate then
+                     Temp := Find_Object (Expression (Expr));
                   else
-                     Param :=
-                       Make_Attribute_Reference (Loc,
-                         Prefix =>
-                           Relocate_Node (Temp),
-                         Attribute_Name => Name_Tag);
+                     Temp := Expr;
                   end if;
 
-                  --  Generate:
-                  --    Needs_Finalization (Param)
+                  --  Processing for generic actuals
 
-                  Flag_Expr :=
-                    Make_Function_Call (Loc,
-                      Name =>
-                        New_Reference_To (RTE (RE_Needs_Finalization), Loc),
-                      Parameter_Associations => New_List (Param));
-               end if;
+                  if Is_Generic_Actual_Type (Desig_Typ) then
+                     Flag_Expr :=
+                       New_Reference_To (Boolean_Literals
+                         (Needs_Finalization (Base_Type (Desig_Typ))), Loc);
 
-               --  Create the temporary which represents the finalization state
-               --  of the expression. Generate:
-               --
-               --    F : constant Boolean := <Flag_Expr>;
+                  --  Processing for subtype indications
 
-               Insert_Action (N,
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Flag_Id,
-                   Constant_Present => True,
-                   Object_Definition =>
-                     New_Reference_To (Standard_Boolean, Loc),
-                   Expression => Flag_Expr));
+                  elsif Nkind (Temp) in N_Has_Entity
+                    and then Is_Type (Entity (Temp))
+                  then
+                     Flag_Expr :=
+                       New_Reference_To (Boolean_Literals
+                         (Needs_Finalization (Entity (Temp))), Loc);
 
-               --  The flag acts as the fifth actual
+                  --  Generate a runtime check to test the controlled state of
+                  --  an object for the purposes of allocation / deallocation.
 
-               Append_To (Actuals, New_Reference_To (Flag_Id, Loc));
-            end;
+                  else
+                     --  The following case arises when allocating through an
+                     --  interface class-wide type, generate:
+                     --
+                     --    Temp.all
+
+                     if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
+                        Param :=
+                          Make_Explicit_Dereference (Loc,
+                            Prefix =>
+                              Relocate_Node (Temp));
+
+                     --  Generate:
+                     --    Temp'Tag
+
+                     else
+                        Param :=
+                          Make_Attribute_Reference (Loc,
+                            Prefix =>
+                              Relocate_Node (Temp),
+                            Attribute_Name => Name_Tag);
+                     end if;
+
+                     --  Generate:
+                     --    Needs_Finalization (<Param>)
+
+                     Flag_Expr :=
+                       Make_Function_Call (Loc,
+                         Name =>
+                           New_Reference_To (RTE (RE_Needs_Finalization), Loc),
+                         Parameter_Associations => New_List (Param));
+                  end if;
+
+                  --  Create the temporary which represents the finalization
+                  --  state of the expression. Generate:
+                  --
+                  --    F : constant Boolean := <Flag_Expr>;
+
+                  Insert_Action (N,
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Flag_Id,
+                      Constant_Present => True,
+                      Object_Definition =>
+                        New_Reference_To (Standard_Boolean, Loc),
+                      Expression => Flag_Expr));
+
+                  --  The flag acts as the last actual
+
+                  Append_To (Actuals, New_Reference_To (Flag_Id, Loc));
+               end;
+
+            --  The object is statically known to be controlled
+
+            else
+               Append_To (Actuals, New_Reference_To (Standard_True, Loc));
+            end if;
+         else
+            Append_To (Actuals, New_Reference_To (Standard_False, Loc));
          end if;
 
+         --  i) On_Subpool
+
+         if Is_Allocate then
+            Append_To (Actuals,
+              New_Reference_To (Boolean_Literals (Present (Subpool)), Loc));
+         end if;
+
+         --  Step 2: Build a wrapper Allocate / Deallocate which internally
+         --  calls Allocate_Any_Controlled / Deallocate_Any_Controlled.
+
          --  Select the proper routine to call
 
          if Is_Allocate then
-            Proc_To_Call := RTE (RE_Allocate);
+            Proc_To_Call := RTE (RE_Allocate_Any_Controlled);
          else
-            Proc_To_Call := RTE (RE_Deallocate);
+            Proc_To_Call := RTE (RE_Deallocate_Any_Controlled);
          end if;
 
          --  Create a custom Allocate / Deallocate routine which has identical
@@ -611,10 +821,6 @@ package body Exp_Util is
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
                  Statements => New_List (
-
-                  --  Allocate / Deallocate
-                  --    (<Ptr_Typ collection>, A, S, L[, F]);
-
                    Make_Procedure_Call_Statement (Loc,
                      Name =>
                        New_Reference_To (Proc_To_Call, Loc),
@@ -3028,6 +3234,11 @@ package body Exp_Util is
                N_Task_Body_Stub                         |
                N_Task_Type_Declaration                  |
 
+               --  Use clauses can appear in lists of declarations
+
+               N_Use_Package_Clause                     |
+               N_Use_Type_Clause                        |
+
                --  Freeze entity behaves like a declaration or statement
 
                N_Freeze_Entity
@@ -3241,6 +3452,7 @@ package body Exp_Util is
                N_Formal_Ordinary_Fixed_Point_Definition |
                N_Formal_Package_Declaration             |
                N_Formal_Private_Type_Definition         |
+               N_Formal_Incomplete_Type_Definition      |
                N_Formal_Signed_Integer_Type_Definition  |
                N_Function_Call                          |
                N_Function_Specification                 |
@@ -3328,8 +3540,6 @@ package body Exp_Util is
                N_Unconstrained_Array_Definition         |
                N_Unused_At_End                          |
                N_Unused_At_Start                        |
-               N_Use_Package_Clause                     |
-               N_Use_Type_Clause                        |
                N_Variant                                |
                N_Variant_Part                           |
                N_Validate_Unchecked_Conversion          |
@@ -3749,7 +3959,7 @@ package body Exp_Util is
           and then Nkind (Rel_Node) /= N_Simple_Return_Statement
 
          --  Do not consider transient objects allocated on the heap since they
-         --  are attached to a finalization collection.
+         --  are attached to a finalization master.
 
           and then not Is_Allocated (Obj_Id)
 
@@ -5189,6 +5399,16 @@ package body Exp_Util is
       if Restriction_Active (No_Finalization) then
          return False;
 
+      --  C, C++, CIL and Java types are not considered controlled. It is
+      --  assumed that the non-Ada side will handle their clean up.
+
+      elsif Convention (T) = Convention_C
+        or else Convention (T) = Convention_CIL
+        or else Convention (T) = Convention_CPP
+        or else Convention (T) = Convention_Java
+      then
+         return False;
+
       else
          --  Class-wide types are treated as controlled because derivations
          --  from the root type can introduce controlled components.
@@ -5483,9 +5703,17 @@ package body Exp_Util is
                  Statements => L));
       end Wrap_Statements_In_Block;
 
+      --  Local variables
+
+      Block : Node_Id;
+
    --  Start of processing for Process_Statements_For_Controlled_Objects
 
    begin
+      --  Whenever a non-handled statement list is wrapped in a block, the
+      --  block must be explicitly analyzed to redecorate all entities in the
+      --  list and ensure that a finalizer is properly built.
+
       case Nkind (N) is
          when N_Elsif_Part             |
               N_If_Statement           |
@@ -5500,8 +5728,10 @@ package body Exp_Util is
               and then Requires_Cleanup_Actions
                          (Then_Statements (N), False, False)
             then
-               Set_Then_Statements (N, New_List (
-                 Wrap_Statements_In_Block (Then_Statements (N))));
+               Block := Wrap_Statements_In_Block (Then_Statements (N));
+               Set_Then_Statements (N, New_List (Block));
+
+               Analyze (Block);
             end if;
 
             --  Check the "else statements" for conditional entry calls, if
@@ -5515,8 +5745,10 @@ package body Exp_Util is
               and then Requires_Cleanup_Actions
                          (Else_Statements (N), False, False)
             then
-               Set_Else_Statements (N, New_List (
-                 Wrap_Statements_In_Block (Else_Statements (N))));
+               Block := Wrap_Statements_In_Block (Else_Statements (N));
+               Set_Else_Statements (N, New_List (Block));
+
+               Analyze (Block);
             end if;
 
          when N_Abortable_Part             |
@@ -5532,8 +5764,10 @@ package body Exp_Util is
               and then not Are_Wrapped (Statements (N))
               and then Requires_Cleanup_Actions (Statements (N), False, False)
             then
-               Set_Statements (N, New_List (
-                 Wrap_Statements_In_Block (Statements (N))));
+               Block := Wrap_Statements_In_Block (Statements (N));
+               Set_Statements (N, New_List (Block));
+
+               Analyze (Block);
             end if;
 
          when others                       =>
@@ -6414,29 +6648,31 @@ package body Exp_Util is
                return True;
             end if;
 
-         --  Inspect the freeze node of an access-to-controlled type and
-         --  look for a delayed finalization collection. This case arises
-         --  when the freeze actions are inserted at a later time than the
-         --  expansion of the context. Since Build_Finalizer is never called
-         --  on a single construct twice, the collection will be ultimately
-         --  left out and never finalized. This is also needed for freeze
-         --  actions of designated types themselves, since in some cases the
-         --  finalization collection is associated with a designated type's
-         --  freeze node rather than that of the access type (see handling
-         --  for freeze actions in Build_Finalization_Collection).
+         --  Inspect the freeze node of an access-to-controlled type and look
+         --  for a delayed finalization master. This case arises when the
+         --  freeze actions are inserted at a later time than the expansion of
+         --  the context. Since Build_Finalizer is never called on a single
+         --  construct twice, the master will be ultimately left out and never
+         --  finalized. This is also needed for freeze actions of designated
+         --  types themselves, since in some cases the finalization master is
+         --  associated with a designated type's freeze node rather than that
+         --  of the access type (see handling for freeze actions in
+         --  Build_Finalization_Master).
 
          elsif Nkind (Decl) = N_Freeze_Entity
            and then Present (Actions (Decl))
          then
             Typ := Entity (Decl);
 
-            if (Is_Access_Type (Typ)
+            if ((Is_Access_Type (Typ)
                   and then not Is_Access_Subprogram_Type (Typ)
                   and then Needs_Finalization
                              (Available_View (Designated_Type (Typ))))
-              or else
-               (Is_Type (Typ)
-                  and then Needs_Finalization (Typ))
+               or else
+                (Is_Type (Typ)
+                   and then Needs_Finalization (Typ)))
+              and then Requires_Cleanup_Actions
+                         (Actions (Decl), For_Package, Nested_Constructs)
             then
                return True;
             end if;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index c7b5b8f8e6c..1f0ee42fc5d 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -198,25 +198,16 @@ package Exp_Util is
      (N           : Node_Id;
       Is_Allocate : Boolean);
    --  Create a custom Allocate/Deallocate to be associated with an allocation
-   --  or deallocation of a controlled or class-wide object. In the case of
-   --  allocation, N is the declaration of the temporary variable which
-   --  represents the expression of the original allocator node, otherwise N
-   --  must be a free statement. If flag Is_Allocate is set, the generated
-   --  routine is allocate, deallocate otherwise. The generated routine is:
+   --  or deallocation:
    --
-   --     F : constant Boolean :=                          --  CW case
-   --           Ada.Tags.Needs_Finalization (<Expr>'Tag);  --  CW case
+   --    1) controlled objects
+   --    2) class-wide objects
+   --    3) any kind of object on a subpool
    --
-   --     procedure Allocate / Deallocate
-   --       (P : Storage_Pool;
-   --        A : [out] Address;  --  out is present for Allocate
-   --        S : Storage_Count;
-   --        L : Storage_Count)
-   --     is
-   --     begin
-   --        Allocate / Deallocate
-   --          (<Ptr_Typ collection>, A, S, L, [Needs_Header => F]);
-   --     end Allocate;
+   --  N must be an allocator or the declaration of a temporary variable which
+   --  represents the expression of the original allocator node, otherwise N
+   --  must be a free statement. If flag Is_Allocate is set, the generated
+   --  routine is allocate, deallocate otherwise.
 
    function Build_Runtime_Call (Loc : Source_Ptr; RE : RE_Id) return Node_Id;
    --  Build an N_Procedure_Call_Statement calling the given runtime entity.
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 9bd0e9c1eb3..4862518137c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1259,6 +1259,13 @@ package body Freeze is
 
                End_Package_Scope (E);
 
+               if Is_Generic_Instance (E)
+                 and then Has_Delayed_Freeze (E)
+               then
+                  Set_Has_Delayed_Freeze (E, False);
+                  Expand_N_Package_Declaration (Unit_Declaration_Node (E));
+               end if;
+
             elsif Ekind (E) in Task_Kind
               and then
                 (Nkind (Parent (E)) = N_Task_Type_Declaration
@@ -1432,27 +1439,24 @@ package body Freeze is
                end loop;
             end;
 
-         --  We add finalization collections to access types whose designated
-         --  types require finalization. This is normally done when freezing
-         --  the type, but this misses recursive type definitions where the
-         --  later members of the recursion introduce controlled components
-         --  (such as can happen when incomplete types are involved), as well
-         --  cases where a component type is private and the controlled full
-         --  type occurs after the access type is frozen. Cases that don't
-         --  need a finalization collection are generic formal types (the
-         --  actual type will have it) and types with Java and CIL conventions,
-         --  since those are used for API bindings. (Are there any other cases
-         --  that should be excluded here???)
+         --  We add finalization masters to access types whose designated types
+         --  require finalization. This is normally done when freezing the
+         --  type, but this misses recursive type definitions where the later
+         --  members of the recursion introduce controlled components (such as
+         --  can happen when incomplete types are involved), as well cases
+         --  where a component type is private and the controlled full type
+         --  occurs after the access type is frozen. Cases that don't need a
+         --  finalization master are generic formal types (the actual type will
+         --  have it) and types with Java and CIL conventions, since those are
+         --  used for API bindings. (Are there any other cases that should be
+         --  excluded here???)
 
          elsif Is_Access_Type (E)
            and then Comes_From_Source (E)
            and then not Is_Generic_Type (E)
            and then Needs_Finalization (Designated_Type (E))
-           and then No (Associated_Collection (E))
-           and then Convention (Designated_Type (E)) /= Convention_Java
-           and then Convention (Designated_Type (E)) /= Convention_CIL
          then
-            Build_Finalization_Collection (E);
+            Build_Finalization_Master (E);
          end if;
 
          Next_Entity (E);
@@ -2029,7 +2033,7 @@ package body Freeze is
             Next_Entity (Comp);
          end loop;
 
-         --  Deal with pragma Bit_Order setting non-standard bit order
+         --  Deal with Bit_Order aspect specifying a non-default bit order
 
          if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
             if not Placed_Component then
@@ -2242,12 +2246,13 @@ package body Freeze is
 
            and then RM_Size (Rec) >= Scalar_Component_Total_RM_Size
 
-           --  Never do implicit packing in CodePeer mode since we don't do
-           --  any packing in this mode, since this generates over-complex
-           --  code that confuses CodePeer, and in general, CodePeer does not
-           --  care about the internal representation of objects.
+           --  Never do implicit packing in CodePeer or ALFA modes since
+           --  we don't do any packing in these modes, since this generates
+           --  over-complex code that confuses static analysis, and in
+           --  general, neither CodePeer not GNATprove care about the
+           --  internal representation of objects.
 
-           and then not CodePeer_Mode
+           and then not (CodePeer_Mode or ALFA_Mode)
          then
             --  If implicit packing enabled, do it
 
@@ -2297,6 +2302,16 @@ package body Freeze is
       elsif Inside_A_Generic and then External_Ref_In_Generic (Test_E) then
          return No_List;
 
+      --  AI05-0213: A formal incomplete type does not freeze the actual. In
+      --  the instance, the same applies to the subtype renaming the actual.
+
+      elsif Is_Private_Type (E)
+        and then Is_Generic_Actual_Type (E)
+        and then No (Full_View (Base_Type (E)))
+        and then Ada_Version >= Ada_2012
+      then
+         return No_List;
+
       --  Do not freeze a global entity within an inner scope created during
       --  expansion. A call to subprogram E within some internal procedure
       --  (a stream attribute for example) might require freezing E, but the
@@ -2385,6 +2400,7 @@ package body Freeze is
                if Nkind (Ritem) = N_Aspect_Specification
                  and then Entity (Ritem) = E
                  and then Is_Delayed_Aspect (Ritem)
+                 and then Scope (E) = Current_Scope
                then
                   Aitem := Aspect_Rep_Item (Ritem);
 
@@ -2804,7 +2820,7 @@ package body Freeze is
 
                --  Note: we inhibit this check for objects that do not come
                --  from source because there is at least one case (the
-               --  expansion of x'class'input where x is abstract) where we
+               --  expansion of x'Class'Input where x is abstract) where we
                --  legitimately generate an abstract object.
 
                if Is_Abstract_Type (Etype (E))
@@ -3050,7 +3066,7 @@ package body Freeze is
                     and then not Is_Limited_Composite (E)
                     and then not Is_Packed (Root_Type (E))
                     and then not Has_Component_Size_Clause (Root_Type (E))
-                    and then not CodePeer_Mode
+                    and then not (CodePeer_Mode or ALFA_Mode)
                   then
                      Get_Index_Bounds (First_Index (E), Lo, Hi);
 
@@ -3696,7 +3712,7 @@ package body Freeze is
             --     package Pkg is
             --        type T is tagged private;
             --        type DT is new T with private;
-            --        procedure Prim (X : in out T; Y : in out DT'class);
+            --        procedure Prim (X : in out T; Y : in out DT'Class);
             --     private
             --        type T is tagged null record;
             --        Obj : T;
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index c6dd8cb5991..2dad57a3b3b 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -98,6 +98,13 @@ begin
 
    CStand.Create_Standard;
 
+   --  If the -gnatd.H flag is present, we are only interested in the Standard
+   --  package, so the frontend has done its job here.
+
+   if Debug_Flag_Dot_HH then
+      return;
+   end if;
+
    --  Check possible symbol definitions specified by -gnateD switches
 
    Prepcomp.Process_Command_Line_Symbol_Definitions;
diff --git a/gcc/ada/g-comlin.ads b/gcc/ada/g-comlin.ads
index 0c4c96ea35d..ec842800386 100644
--- a/gcc/ada/g-comlin.ads
+++ b/gcc/ada/g-comlin.ads
@@ -492,11 +492,12 @@ package GNAT.Command_Line is
 
    Invalid_Parameter : exception;
    --  Raised when a parameter is missing, or an attempt is made to obtain a
-   --  parameter for a switch that does not allow a parameter
+   --  parameter for a switch that does not allow a parameter.
 
    -----------------------------------------
    -- Expansion of command line arguments --
    -----------------------------------------
+
    --  These subprograms take care of of expanding globbing patterns on the
    --  command line. On Unix, such expansion is done by the shell before your
    --  application is called. But on Windows you must do this expansion
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 65ee531793d..be89eb4591e 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -241,8 +241,7 @@ GNAT_ADA_OBJS =	\
  ada/g-spchge.o	\
  ada/g-speche.o	\
  ada/g-u3spch.o	\
- ada/get_alfa.o \
- ada/get_scos.o	\
+ ada/get_alfa.o	\
  ada/get_targ.o	\
  ada/gnat.o	\
  ada/gnatvsn.o	\
@@ -293,6 +292,7 @@ GNAT_ADA_OBJS =	\
  ada/s-conca9.o	\
  ada/s-crc32.o	\
  ada/s-crtl.o	\
+ ada/s-excdeb.o	\
  ada/s-except.o	\
  ada/s-exctab.o	\
  ada/s-htable.o	\
@@ -475,6 +475,7 @@ GNATBIND_OBJS = \
  ada/s-conca9.o   \
  ada/s-crc32.o    \
  ada/s-crtl.o     \
+ ada/s-excdeb.o   \
  ada/s-except.o   \
  ada/s-exctab.o   \
  ada/s-htable.o   \
@@ -1201,7 +1202,7 @@ ada/a-except.o  : ada/a-except.adb ada/a-except.ads
 	$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \
 	 $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
 
-ada/s-except.o  : ada/s-except.adb ada/s-except.ads
+ada/s-excdeb.o  : ada/s-excdeb.adb ada/s-excdeb.ads
 	$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 \
 	 $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
 
@@ -1336,7 +1337,7 @@ ada/a-elchha.o : ada/ada.ads ada/a-except.ads ada/a-elchha.ads \
 ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
    ada/a-exexda.adb ada/a-exextr.adb ada/a-elchha.ads ada/a-excpol.adb \
    ada/a-exstat.adb ada/a-unccon.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-except.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
+   ada/s-excdeb.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-traent.ads 
 
 ada/a-ioexce.o : ada/ada.ads ada/a-except.ads ada/a-ioexce.ads \
@@ -1397,16 +1398,17 @@ ada/alloc.o : ada/alloc.ads ada/system.ads
 ada/aspects.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/aspects.adb \
    ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
-   ada/gnat.ads ada/g-htable.ads ada/hostparm.ads ada/interfac.ads \
-   ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads \
-   ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
-   ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
-   ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \
-   ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads \
-   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
-   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
+   ada/einfo.adb ada/gnat.ads ada/g-htable.ads ada/hostparm.ads \
+   ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
+   ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
+   ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
+   ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
+   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads \
+   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
+   ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
+   ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
+   ada/widechar.ads 
 
 ada/atree.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@@ -1981,24 +1983,25 @@ ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/lib.ads ada/lib-load.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
-   ada/scans.ads ada/scil_ll.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
-   ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads \
-   ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \
-   ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
-   ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_disp.ads \
-   ada/sem_eval.ads ada/sem_mech.ads ada/sem_prag.ads ada/sem_res.ads \
-   ada/sem_scil.ads ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
-   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
-   ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
-   ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
-   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
-   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
-   ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
-   ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
-   ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads ada/validsw.ads ada/widechar.ads 
+   ada/rtsfind.adb ada/scans.ads ada/scil_ll.ads ada/sem.ads ada/sem.adb \
+   ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads \
+   ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \
+   ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
+   ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
+   ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads ada/sem_mech.ads \
+   ada/sem_prag.ads ada/sem_res.ads ada/sem_scil.ads ada/sem_type.ads \
+   ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
+   ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \
+   ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
+   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+   ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+   ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
+   ada/widechar.ads 
 
 ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@@ -2131,16 +2134,18 @@ ada/exp_ch7.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads \
    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
-   ada/lib-sort.adb ada/namet.ads ada/namet.adb ada/nlists.ads \
-   ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
-   ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
-   ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
+   ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
+   ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
+   ada/opt.ads ada/output.ads ada/put_alfa.ads ada/restrict.ads \
+   ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
+   ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
    ada/sem_aux.adb ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \
    ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \
    ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
-   ada/sem_ch9.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads \
-   ada/sem_type.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
-   ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
+   ada/sem_ch9.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_prag.ads \
+   ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
+   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+   ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
    ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
    ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
@@ -2250,20 +2255,20 @@ ada/exp_code.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
 ada/exp_dbug.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
    ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
-   ada/exp_dbug.ads ada/exp_dbug.adb ada/gnat.ads ada/g-htable.ads \
-   ada/hostparm.ads ada/interfac.ads ada/namet.ads ada/namet.adb \
-   ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
-   ada/output.ads ada/rident.ads ada/sem_aux.ads ada/sem_aux.adb \
-   ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
-   ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
-   ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
-   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
-   ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
-   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
-   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/types.ads \
-   ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads ada/urealp.adb ada/widechar.ads 
+   ada/exp_dbug.ads ada/exp_dbug.adb ada/exp_tss.ads ada/gnat.ads \
+   ada/g-htable.ads ada/hostparm.ads ada/interfac.ads ada/namet.ads \
+   ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
+   ada/opt.ads ada/output.ads ada/rident.ads ada/sem_aux.ads \
+   ada/sem_aux.adb ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads \
+   ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+   ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
+   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+   ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
+   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
+   ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads 
 
 ada/exp_disp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@@ -2536,26 +2541,22 @@ ada/exp_smem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
 
 ada/exp_strm.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
-   ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
-   ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
-   ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/exp_strm.ads \
-   ada/exp_strm.adb ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
-   ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
-   ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
-   ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
-   ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
-   ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
-   ada/sem_aux.ads ada/sem_aux.adb ada/sem_util.ads ada/sinfo.ads \
-   ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
-   ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
-   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
+   ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
+   ada/elists.ads ada/exp_strm.ads ada/exp_strm.adb ada/exp_tss.ads \
+   ada/exp_util.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
+   ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/namet.ads \
+   ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
+   ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
+   ada/rtsfind.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_util.ads \
+   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+   ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
+   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+   ada/s-rident.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
-   ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
+   ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
+   ada/urealp.ads ada/widechar.ads 
 
 ada/exp_tss.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@@ -2801,12 +2802,6 @@ ada/get_alfa.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
    ada/s-string.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.ads \
    ada/unchdeal.ads 
 
-ada/get_scos.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
-   ada/get_scos.ads ada/get_scos.adb ada/gnat.ads ada/g-table.ads \
-   ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \
-   ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \
-   ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
-
 ada/get_targ.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \
    ada/get_targ.adb ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \
    ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
@@ -3090,15 +3085,17 @@ ada/lib-writ.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
 ada/lib-xref.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alfa.ads ada/alfa.adb ada/alloc.ads \
    ada/aspects.ads ada/atree.ads ada/atree.adb ada/casing.ads \
-   ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
-   ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
-   ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/exp_code.ads \
-   ada/exp_tss.ads ada/expander.ads ada/fname.ads ada/fname-uf.ads \
-   ada/gnat.ads ada/g-hesorg.ads ada/g-hesorg.adb ada/g-htable.ads \
-   ada/g-table.ads ada/g-table.adb ada/gnatvsn.ads ada/hlo.ads \
-   ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \
-   ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
-   ada/lib-util.ads ada/lib-util.adb ada/lib-xref.ads ada/lib-xref.adb \
+   ada/checks.ads ada/csets.ads ada/debug.ads ada/debug_a.ads \
+   ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
+   ada/err_vars.ads ada/errout.ads ada/errout.adb ada/erroutc.ads \
+   ada/erroutc.adb ada/exp_ch11.ads ada/exp_code.ads ada/exp_disp.ads \
+   ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
+   ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
+   ada/g-hesorg.ads ada/g-hesorg.adb ada/g-htable.ads ada/g-table.ads \
+   ada/g-table.adb ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
+   ada/inline.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
+   ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads \
+   ada/lib-util.adb ada/lib-xref.ads ada/lib-xref.adb \
    ada/lib-xref-alfa.adb ada/namet.ads ada/namet.adb ada/nlists.ads \
    ada/nlists.adb ada/nmake.ads ada/opt.ads ada/osint.ads ada/osint-c.ads \
    ada/output.ads ada/par_sco.ads ada/put_alfa.ads ada/put_alfa.adb \
@@ -3107,18 +3104,20 @@ ada/lib-xref.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/sem_aux.adb ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \
    ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \
    ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
-   ada/sem_ch9.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_util.ads \
+   ada/sem_ch9.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_prag.ads \
+   ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
    ada/sem_warn.ads ada/sem_warn.adb ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
-   ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \
-   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
-   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
-   ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads \
-   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/targparm.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
-   ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads ada/widechar.ads 
+   ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
+   ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
+   ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
+   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
+   ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+   ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \
+   ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
 
 ada/lib.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
    ada/alloc.ads ada/aspects.ads ada/atree.ads ada/atree.adb \
@@ -3139,19 +3138,19 @@ ada/lib.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
 ada/live.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
    ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
-   ada/einfo.adb ada/fname.ads ada/gnat.ads ada/g-hesorg.ads \
-   ada/g-htable.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
-   ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/live.ads ada/live.adb \
-   ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
-   ada/opt.ads ada/output.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
-   ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
-   ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
-   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
-   ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
-   ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
-   ada/urealp.ads ada/widechar.ads 
+   ada/einfo.adb ada/exp_tss.ads ada/fname.ads ada/gnat.ads \
+   ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads ada/interfac.ads \
+   ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/live.ads \
+   ada/live.adb ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb \
+   ada/nmake.ads ada/opt.ads ada/output.ads ada/sem_util.ads ada/sinfo.ads \
+   ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
+   ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
+   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
+   ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
+   ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
 
 ada/namet-sp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnat.ads \
@@ -3257,32 +3256,32 @@ ada/par.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
    ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
    ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
    ada/errout.ads ada/errout.adb ada/erroutc.ads ada/erroutc.adb \
-   ada/fname.ads ada/fname-uf.ads ada/gnat.ads ada/g-hesorg.ads \
-   ada/g-htable.ads ada/g-speche.ads ada/gnatvsn.ads ada/hostparm.ads \
-   ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
-   ada/lib-load.ads ada/lib-sort.adb ada/namet.ads ada/namet.adb \
-   ada/namet-sp.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
-   ada/nmake.adb ada/opt.ads ada/osint.ads ada/output.ads ada/par.ads \
-   ada/par.adb ada/par-ch10.adb ada/par-ch11.adb ada/par-ch12.adb \
-   ada/par-ch13.adb ada/par-ch2.adb ada/par-ch3.adb ada/par-ch4.adb \
-   ada/par-ch5.adb ada/par-ch6.adb ada/par-ch7.adb ada/par-ch8.adb \
-   ada/par-ch9.adb ada/par-endh.adb ada/par-labl.adb ada/par-load.adb \
-   ada/par-prag.adb ada/par-sync.adb ada/par-tchk.adb ada/par-util.adb \
-   ada/par_sco.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
-   ada/scans.ads ada/scans.adb ada/scn.ads ada/scng.ads ada/scng.adb \
-   ada/sem_aux.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
-   ada/sinfo-cn.ads ada/sinput.ads ada/sinput.adb ada/sinput-l.ads \
-   ada/snames.ads ada/snames.adb ada/stand.ads ada/stringt.ads \
-   ada/stringt.adb ada/style.ads ada/style.adb ada/styleg.ads \
-   ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
-   ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-exctab.adb \
-   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
-   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads \
-   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
-   ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
-   ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
+   ada/exp_tss.ads ada/fname.ads ada/fname-uf.ads ada/gnat.ads \
+   ada/g-hesorg.ads ada/g-htable.ads ada/g-speche.ads ada/gnatvsn.ads \
+   ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
+   ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
+   ada/namet.adb ada/namet-sp.ads ada/nlists.ads ada/nlists.adb \
+   ada/nmake.ads ada/nmake.adb ada/opt.ads ada/osint.ads ada/output.ads \
+   ada/par.ads ada/par.adb ada/par-ch10.adb ada/par-ch11.adb \
+   ada/par-ch12.adb ada/par-ch13.adb ada/par-ch2.adb ada/par-ch3.adb \
+   ada/par-ch4.adb ada/par-ch5.adb ada/par-ch6.adb ada/par-ch7.adb \
+   ada/par-ch8.adb ada/par-ch9.adb ada/par-endh.adb ada/par-labl.adb \
+   ada/par-load.adb ada/par-prag.adb ada/par-sync.adb ada/par-tchk.adb \
+   ada/par-util.adb ada/par_sco.ads ada/restrict.ads ada/restrict.adb \
+   ada/rident.ads ada/scans.ads ada/scans.adb ada/scn.ads ada/scng.ads \
+   ada/scng.adb ada/sem_aux.ads ada/sem_util.ads ada/sinfo.ads \
+   ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads ada/sinput.adb \
+   ada/sinput-l.ads ada/snames.ads ada/snames.adb ada/stand.ads \
+   ada/stringt.ads ada/stringt.adb ada/style.ads ada/style.adb \
+   ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
+   ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
+   ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
+   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
+   ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
    ada/widechar.ads 
 
@@ -3358,11 +3357,17 @@ ada/put_alfa.o : ada/ada.ads ada/a-unccon.ads ada/a-uncdea.ads \
    ada/s-stalib.ads ada/s-string.ads ada/s-unstyp.ads ada/types.ads \
    ada/unchconv.ads ada/unchdeal.ads 
 
-ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
-   ada/g-table.adb ada/par_sco.ads ada/put_scos.ads ada/put_scos.adb \
-   ada/scos.ads ada/scos.adb ada/system.ads ada/s-exctab.ads \
-   ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
-   ada/unchconv.ads ada/unchdeal.ads 
+ada/put_scos.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
+   ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnat.ads \
+   ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/interfac.ads \
+   ada/namet.ads ada/namet.adb ada/opt.ads ada/output.ads ada/par_sco.ads \
+   ada/put_scos.ads ada/put_scos.adb ada/scos.ads ada/scos.adb \
+   ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads \
+   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
+   ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
+   ada/widechar.ads 
 
 ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@@ -3439,7 +3444,7 @@ ada/s-addope.o : ada/ada.ads ada/a-unccon.ads ada/system.ads \
 
 ada/s-assert.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/system.ads ada/s-assert.ads ada/s-assert.adb ada/s-exctab.ads \
-   ada/s-exctab.adb ada/s-except.ads ada/s-htable.ads ada/s-parame.ads \
+   ada/s-exctab.adb ada/s-excdeb.ads ada/s-htable.ads ada/s-parame.ads \
    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
    ada/s-stoele.adb ada/s-traent.ads 
 
@@ -3480,8 +3485,13 @@ ada/s-crc32.o : ada/interfac.ads ada/system.ads ada/s-crc32.ads \
 
 ada/s-crtl.o : ada/system.ads ada/s-crtl.ads ada/s-parame.ads 
 
-ada/s-except.o : ada/ada.ads ada/a-unccon.ads ada/system.ads \
-   ada/s-except.ads ada/s-except.adb ada/s-stalib.ads 
+ada/s-excdeb.o : ada/ada.ads ada/a-unccon.ads ada/system.ads \
+   ada/s-excdeb.ads ada/s-excdeb.adb ada/s-stalib.ads 
+
+ada/s-except.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
+   ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-except.ads \
+   ada/s-htable.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads 
 
 ada/s-exctab.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \
@@ -3648,10 +3658,16 @@ ada/scng.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
    ada/widechar.ads 
 
-ada/scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
-   ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \
-   ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \
-   ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
+ada/scos.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
+   ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnat.ads \
+   ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/interfac.ads \
+   ada/namet.ads ada/namet.adb ada/opt.ads ada/output.ads ada/scos.ads \
+   ada/scos.adb ada/snames.ads ada/system.ads ada/s-exctab.ads \
+   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
+   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
+   ada/unchdeal.ads ada/widechar.ads 
 
 ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
    ada/alloc.ads ada/aspects.ads ada/atree.ads ada/atree.adb \
@@ -4046,42 +4062,42 @@ ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/validsw.ads ada/warnsw.ads ada/widechar.ads 
 
 ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
-   ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
-   ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
-   ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
-   ada/elists.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
-   ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads ada/exp_ch11.ads \
-   ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_code.ads ada/exp_disp.ads \
-   ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
-   ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
-   ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads \
-   ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
-   ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
-   ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
-   ada/namet.adb ada/namet-sp.ads ada/nlists.ads ada/nlists.adb \
-   ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/par_sco.ads \
-   ada/put_alfa.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
-   ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_aggr.ads \
-   ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_case.ads \
-   ada/sem_case.adb ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch11.ads \
-   ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads \
-   ada/sem_ch4.ads ada/sem_ch4.adb ada/sem_ch5.ads ada/sem_ch6.ads \
-   ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_disp.ads \
-   ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads \
-   ada/sem_eval.adb ada/sem_intr.ads ada/sem_prag.ads ada/sem_res.ads \
-   ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
-   ada/sem_warn.ads ada/sem_warn.adb ada/sinfo.ads ada/sinfo.adb \
-   ada/sinfo-cn.ads ada/sinput.ads ada/snames.ads ada/stand.ads \
-   ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
-   ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
-   ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
-   ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
-   ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
-   ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
-   ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
-   ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
-   ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
-   ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
+   ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/aspects.adb \
+   ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads \
+   ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
+   ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
+   ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads \
+   ada/exp_ch11.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_code.ads \
+   ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \
+   ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
+   ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \
+   ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
+   ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
+   ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads \
+   ada/namet.ads ada/namet.adb ada/namet-sp.ads ada/nlists.ads \
+   ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
+   ada/par_sco.ads ada/put_alfa.ads ada/restrict.ads ada/restrict.adb \
+   ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb \
+   ada/sem_aggr.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_aux.adb \
+   ada/sem_case.ads ada/sem_case.adb ada/sem_cat.ads ada/sem_ch10.ads \
+   ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \
+   ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch4.adb ada/sem_ch5.ads \
+   ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
+   ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \
+   ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_prag.ads \
+   ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
+   ada/sem_util.adb ada/sem_warn.ads ada/sem_warn.adb ada/sinfo.ads \
+   ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads ada/snames.ads \
+   ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
+   ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
+   ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+   ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
+   ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+   ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+   ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+   ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+   ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
 
 ada/sem_ch5.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
@@ -4444,14 +4460,14 @@ ada/sem_intr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
    ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
    ada/einfo.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
-   ada/erroutc.ads ada/erroutc.adb ada/fname.ads ada/gnat.ads \
-   ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads \
-   ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
-   ada/lib-sort.adb ada/namet.ads ada/namet.adb ada/nlists.ads \
-   ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads ada/rident.ads \
-   ada/scans.ads ada/sem_aux.ads ada/sem_aux.adb ada/sem_eval.ads \
-   ada/sem_intr.ads ada/sem_intr.adb ada/sem_util.ads ada/sinfo.ads \
-   ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+   ada/erroutc.ads ada/erroutc.adb ada/exp_tss.ads ada/fname.ads \
+   ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \
+   ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
+   ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/namet.adb \
+   ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads \
+   ada/rident.ads ada/scans.ads ada/sem_aux.ads ada/sem_aux.adb \
+   ada/sem_eval.ads ada/sem_intr.ads ada/sem_intr.adb ada/sem_util.ads \
+   ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
    ada/stringt.ads ada/stringt.adb ada/stylesw.ads ada/system.ads \
    ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
    ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
@@ -4829,9 +4845,9 @@ ada/snames.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
 ada/sprint.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
    ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
-   ada/einfo.adb ada/fname.ads ada/gnat.ads ada/g-hesorg.ads \
-   ada/g-htable.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
-   ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/namet.ads \
+   ada/einfo.adb ada/exp_tss.ads ada/fname.ads ada/gnat.ads \
+   ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads ada/interfac.ads \
+   ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/namet.ads \
    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \
    ada/output.ads ada/output.adb ada/rtsfind.ads ada/sem_eval.ads \
    ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index 044085592ea..ef98039f295 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -274,8 +274,16 @@ INCLUDES = -I- -I. -I.. -I$(srcdir)/ada -I$(srcdir) -I$(srcdir)/config \
 
 ADA_INCLUDES = -I- -I. -I$(srcdir)/ada
 
-INCLUDES_FOR_SUBDIR = -I. -I.. -I../.. -I$(fsrcdir)/ada \
-	-I$(fsrcdir)/../include -I$(fsrcdir)
+INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. -iquote $(fsrcdir)/ada \
+	-I$(fsrcdir)/../include
+
+ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
+  # On Windows native the tconfig.h files used by C runtime files needs to have
+  # the gcc source dir in its include dir list
+  INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. -iquote $(fsrcdir)/ada \
+        -I$(fsrcdir)/../include -I$(fsrcdir)
+endif
+
 ADA_INCLUDES_FOR_SUBDIR = -I. -I$(fsrcdir)/ada
 
 # Avoid a lot of time thinking about remaking Makefile.in and *.def.
@@ -412,7 +420,26 @@ ATOMICS_TARGET_PAIRS += \
   a-stzunb.adb<a-stzunb-shared.adb \
   a-stzunb.ads<a-stzunb-shared.ads \
   a-szunau.adb<a-szunau-shared.adb \
-  a-szuzti.adb<a-szuzti-shared.adb \
+  a-szuzti.adb<a-szuzti-shared.adb
+
+ATOMICS_BUILTINS_TARGET_PAIRS += \
+  s-atocou.adb<s-atocou-builtin.adb
+
+ATOMICS_X86_TARGET_PAIRS += \
+  s-atocou.adb<s-atocou-x86.adb
+
+# Special version of units for x86 and x86-64 platforms.
+
+X86_TARGET_PAIRS = \
+  a-numaux.ads<a-numaux-x86.ads \
+  a-numaux.adb<a-numaux-x86.adb \
+  g-bytswa.adb<g-bytswa-x86.adb \
+  s-atocou.adb<s-atocou-x86.adb
+
+X86_64_TARGET_PAIRS = \
+  a-numaux.ads<a-numaux-x86.ads \
+  a-numaux.adb<a-numaux-x86.adb \
+  g-bytswa.adb<g-bytswa-x86.adb \
   s-atocou.adb<s-atocou-builtin.adb
 
 LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)ada/gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
@@ -466,7 +493,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
   endif
 endif
 
-ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
+ifeq ($(strip $(filter-out e500% powerpc% wrs vxworks,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
@@ -489,7 +516,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-trasym.ads<g-trasym-unimplemented.ads \
   g-trasym.adb<g-trasym-unimplemented.adb \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
@@ -521,7 +549,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
       system.ads<system-vxworks-ppc-rtp.ads
 
       EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
-      EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+      EXTRA_LIBGNAT_OBJS+=affinity.o
+      EXTRA_LIBGNAT_SRCS+=affinity.c
     else
       ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
         LIBGNAT_TARGET_PAIRS += \
@@ -532,7 +561,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
         system.ads<system-vxworks-ppc-kernel.ads
 
         EH_MECHANISM=-gcc
-        EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+        EXTRA_LIBGNAT_OBJS+=affinity.o
+        EXTRA_LIBGNAT_SRCS+=affinity.c
       else
         LIBGNAT_TARGET_PAIRS += \
         s-interr.adb<s-interr-hwint.adb \
@@ -587,7 +617,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
   g-trasym.ads<g-trasym-unimplemented.ads \
   g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-ppc-vthread.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
@@ -622,7 +653,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
 endif
 
 # vxworks MILS
-ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(targ))),)
+ifeq ($(strip $(filter-out e500% powerpc% wrs vxworksmils,$(targ))),)
   # target pairs for vthreads runtime
   LIBGNAT_TARGET_PAIRS = \
   a-elchha.adb<a-elchha-vx6-raven-cert.adb \
@@ -651,6 +682,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(targ))),)
   g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-ppc.ads \
   $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS) \
   $(DUMMY_SOCKETS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=\
@@ -706,7 +738,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
   g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-vxworks-x86.ads \
   $(ATOMICS_TARGET_PAIRS) \
-  s-atocou.adb<s-atocou-x86.adb
+  $(ATOMICS_X86_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
@@ -805,7 +837,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
   g-trasym.ads<g-trasym-unimplemented.ads \
   g-trasym.adb<g-trasym-unimplemented.adb \
   $(ATOMICS_TARGET_PAIRS) \
-  s-atocou.adb<s-atocou-x86.adb
+  $(ATOMICS_X86_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
@@ -837,7 +869,8 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
       system.ads<system-vxworks-x86-rtp.ads
 
       EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
-      EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+      EXTRA_LIBGNAT_SRCS+=affinity.o
+      EXTRA_LIBGNAT_SRCS+=affinity.c
     else
       ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
         LIBGNAT_TARGET_PAIRS += \
@@ -846,7 +879,8 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
         s-vxwext.ads<s-vxwext-kernel.ads \
         s-vxwext.adb<s-vxwext-kernel-smp.adb \
         system.ads<system-vxworks-x86-kernel.ads
-        EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+        EXTRA_LIBGNAT_OBJS+=affinity.o
+        EXTRA_LIBGNAT_SRCS+=affinity.c
       else
         LIBGNAT_TARGET_PAIRS += \
         s-interr.adb<s-interr-hwint.adb \
@@ -968,7 +1002,8 @@ ifeq ($(strip $(filter-out sparc% sun solaris%,$(targ))),)
 
   LIBGNAT_TARGET_PAIRS_64 = \
   system.ads<system-solaris-sparcv9.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
     ifeq ($(strip $(MULTISUBDIR)),/sparcv9)
@@ -1038,30 +1073,14 @@ ifeq ($(strip $(filter-out %86 %x86_64 solaris2%,$(arch) $(osys))),)
   g-soliop.ads<g-soliop-solaris.ads \
   $(ATOMICS_TARGET_PAIRS)
 
-  LIBGNAT_TARGET_PAIRS_32 = \
-  g-bytswa.adb<g-bytswa-x86.adb \
-  s-atocou.adb<s-atocou-x86.adb \
-  system.ads<system-solaris-x86.ads
-
-  LIBGNAT_TARGET_PAIRS_64 = \
-  system.ads<system-solaris-x86_64.ads
-
-  ifeq ($(strip $(filter-out %86 solaris2%,$(arch) $(osys))),)
-    ifeq ($(strip $(MULTISUBDIR)),/amd64)
-      LIBGNAT_TARGET_PAIRS = \
-      $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64)
-    else
-      LIBGNAT_TARGET_PAIRS = \
-      $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32)
-    endif
+  ifeq ($(strip $(MULTISUBDIR)),/amd64)
+    LIBGNAT_TARGET_PAIRS += \
+    $(X86_64_TARGET_PAIRS) \
+    system.ads<system-solaris-x86_64.ads
   else
-    ifeq ($(strip $(MULTISUBDIR)),/32)
-      LIBGNAT_TARGET_PAIRS = \
-      $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32)
-    else
-      LIBGNAT_TARGET_PAIRS = \
-      $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64)
-    endif
+    LIBGNAT_TARGET_PAIRS += \
+    $(X86_TARGET_PAIRS) \
+    system.ads<system-solaris-x86.ads
   endif
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-specific-solaris.adb
@@ -1080,13 +1099,15 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
   a-intnam.ads<a-intnam-linux.ads \
   a-numaux.adb<a-numaux-x86.adb \
   a-numaux.ads<a-numaux-x86.ads \
+  a-synbar.adb<a-synbar-posix.adb \
+  a-synbar.ads<a-synbar-posix.ads \
   g-bytswa.adb<g-bytswa-x86.adb \
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-posix.adb \
   s-tpopsp.adb<s-tpopsp-tls.adb \
   g-sercom.adb<g-sercom-linux.adb \
   $(ATOMICS_TARGET_PAIRS) \
-  s-atocou.adb<s-atocou-x86.adb
+  $(ATOMICS_X86_TARGET_PAIRS)
 
   ifeq ($(strip $(filter-out marte,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS += \
@@ -1166,7 +1187,7 @@ ifeq ($(strip $(filter-out %86 kfreebsd%,$(arch) $(osys))),)
   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
   system.ads<system-freebsd-x86.ads \
   $(ATOMICS_TARGET_PAIRS) \
-  s-atocou.adb<s-atocou-x86.adb
+  $(ATOMICS_X86_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS =  \
     mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
@@ -1223,7 +1244,7 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
   s-tpopsp.adb<s-tpopsp-posix.adb \
   system.ads<system-freebsd-x86.ads \
   $(ATOMICS_TARGET_PAIRS) \
-  s-atocou.adb<s-atocou-x86.adb
+  $(ATOMICS_X86_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS = \
   mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb
@@ -1285,6 +1306,8 @@ endif
 ifeq ($(strip $(filter-out mips sgi irix6%,$(targ))),)
   LIBGNAT_TARGET_PAIRS = \
   a-intnam.ads<a-intnam-irix.ads \
+  a-synbar.adb<a-synbar-posix.adb \
+  a-synbar.ads<a-synbar-posix.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-irix.adb \
   s-mastop.adb<s-mastop-irix.adb \
@@ -1379,7 +1402,8 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
   s-taprop.adb<s-taprop-posix.adb \
   s-taspri.ads<s-taspri-posix.ads \
   s-tpopsp.adb<s-tpopsp-posix.adb \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   LIBGNAT_TARGET_PAIRS_32 = \
   system.ads<system-aix.ads
@@ -1441,7 +1465,8 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
   s-traceb.adb<s-traceb-mastop.adb \
   system.ads<system-tru64.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-specific-tru64.adb
 
@@ -1508,7 +1533,8 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
       s-vaflop.adb<s-vaflop-vms-ia64.adb \
       system.ads<system-vms-ia64.ads \
       s-parame.ads<s-parame-vms-ia64.ads \
-      $(ATOMICS_TARGET_PAIRS)
+      $(ATOMICS_TARGET_PAIRS) \
+      $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
     TOOLS_TARGET_PAIRS= \
       mlib-tgt-specific.adb<mlib-tgt-specific-vms-ia64.adb \
@@ -1528,9 +1554,9 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
         s-vaflop.adb<s-vaflop-vms-alpha.adb \
         system.ads<system-vms_64.ads \
 	s-parame.ads<s-parame-vms-alpha.ads \
-        $(ATOMICS_TARGET_PAIRS)
+        $(ATOMICS_TARGET_PAIRS) \
+        $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
-    EXTRA_GNATRTL_NONTASKING_OBJS = s-atocou.o
     TOOLS_TARGET_PAIRS= \
       mlib-tgt-specific.adb<mlib-tgt-specific-vms-alpha.adb \
       symbols.adb<symbols-vms.adb \
@@ -1548,7 +1574,7 @@ adamsg.o: adamsg.msg
   GNATLIB_SHARED=gnatlib-shared-vms
   EXTRA_LIBGNAT_SRCS+=adamsg.msg
   EXTRA_LIBGNAT_OBJS+=adamsg.o
-  EXTRA_GNATRTL_NONTASKING_OBJS+-s-po32gl.o
+  EXTRA_GNATRTL_NONTASKING_OBJS+=s-po32gl.o
   EXTRA_GNATRTL_TASKING_OBJS=s-tpopde.o
   EXTRA_GNATTOOLS = \
      ../../gnatsym$(exeext)
@@ -1582,7 +1608,7 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
   g-stsifd.adb<g-stsifd-sockets.adb \
   g-soliop.ads<g-soliop-mingw.ads \
   $(ATOMICS_TARGET_PAIRS) \
-  s-atocou.adb<s-atocou-x86.adb
+  $(ATOMICS_X86_TARGET_PAIRS)
 
   ifeq ($(strip $(filter-out rtx_w32 rtx_rtss,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS += \
@@ -1617,7 +1643,6 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
     s-osprim.adb<s-osprim-mingw.adb \
     s-taprop.adb<s-taprop-mingw.adb
 
-    EH_MECHANISM=-gcc
     ifeq ($(strip $(filter-out x86_64%,$(arch))),)
       ifeq ($(strip $(MULTISUBDIR)),/32)
 	LIBGNAT_TARGET_PAIRS += \
@@ -1649,6 +1674,8 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
     # ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
     # auto-import support for array/record will be done.
     GNATLIB_SHARED = gnatlib-shared-win32
+
+    EH_MECHANISM=-gcc
   endif
 
   TOOLS_TARGET_PAIRS= \
@@ -1774,13 +1801,16 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
   a-exetim.adb<a-exetim-posix.adb \
   a-exetim.ads<a-exetim-default.ads \
   a-intnam.ads<a-intnam-linux.ads \
+  a-synbar.adb<a-synbar-posix.adb \
+  a-synbar.ads<a-synbar-posix.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-posix.adb \
   s-linux.ads<s-linux.ads \
   s-osinte.adb<s-osinte-posix.adb \
   s-tpopsp.adb<s-tpopsp-tls.adb \
   g-sercom.adb<g-sercom-linux.adb \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   ifeq ($(strip $(filter-out xenomai,$(THREAD_KIND))),)
     LIBGNAT_TARGET_PAIRS = \
@@ -1971,6 +2001,8 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
   a-exetim.ads<a-exetim-default.ads \
   a-intnam.ads<a-intnam-linux.ads \
   a-numaux.ads<a-numaux-libc-x86.ads \
+  a-synbar.adb<a-synbar-posix.adb \
+  a-synbar.ads<a-synbar-posix.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-posix.adb \
   s-linux.ads<s-linux.ads \
@@ -1984,7 +2016,8 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
   s-taspri.ads<s-taspri-posix-noaltstack.ads \
   g-sercom.adb<g-sercom-linux.adb \
   system.ads<system-linux-ia64.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS =  \
     mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
@@ -2011,7 +2044,8 @@ ifeq ($(strip $(filter-out ia64% hp hpux%,$(targ))),)
   s-taspri.ads<s-taspri-posix-noaltstack.ads \
   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
   system.ads<system-hpux-ia64.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS = \
   mlib-tgt-specific.adb<mlib-tgt-specific-ia64-hpux.adb
@@ -2042,7 +2076,8 @@ ifeq ($(strip $(filter-out alpha% linux%,$(arch) $(osys))),)
   g-trasym.ads<g-trasym-unimplemented.ads \
   g-trasym.adb<g-trasym-unimplemented.adb \
   system.ads<system-linux-alpha.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS =  \
     mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
@@ -2063,6 +2098,8 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
   a-intnam.ads<a-intnam-linux.ads \
   a-numaux.adb<a-numaux-x86.adb \
   a-numaux.ads<a-numaux-x86.ads \
+  a-synbar.adb<a-synbar-posix.adb \
+  a-synbar.ads<a-synbar-posix.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-posix.adb \
   s-linux.ads<s-linux.ads \
@@ -2076,7 +2113,8 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
   s-taspri.ads<s-taspri-posix.ads \
   g-sercom.adb<g-sercom-linux.adb \
   system.ads<system-linux-x86_64.ads \
-  $(ATOMICS_TARGET_PAIRS)
+  $(ATOMICS_TARGET_PAIRS) \
+  $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
   TOOLS_TARGET_PAIRS =  \
     mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
@@ -2133,7 +2171,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
     g-trasym.adb<g-trasym-unimplemented.adb \
     a-numaux.ads<a-numaux-x86.ads \
     a-numaux.adb<a-numaux-x86.adb \
-    $(ATOMICS_TARGET_PAIRS)
+    $(ATOMICS_TARGET_PAIRS) \
+    $(ATOMICS_BUILTINS_TARGET_PAIRS)
     ifeq ($(strip $(MULTISUBDIR)),/i386)
       LIBGNAT_TARGET_PAIRS += \
       system.ads<system-darwin-x86.ads
@@ -2163,7 +2202,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
   endif
 
   TOOLS_TARGET_PAIRS =  \
-    mlib-tgt-specific.adb<mlib-tgt-specific-darwin.adb
+    mlib-tgt-specific.adb<mlib-tgt-specific-darwin.adb \
+    indepsw.adb<indepsw-darwin.adb
 
   EH_MECHANISM=-gcc
   GNATLIB_SHARED = gnatlib-shared-darwin
@@ -2223,8 +2263,8 @@ LIBGNAT_OBJS = adadecode.o adaint.o argv.o cio.o cstreams.o ctrl_c.o	\
 
 include $(fsrcdir)/ada/Makefile.rtl
 
-GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o a-nllrar.o a-nlrear.o \
-  a-nucoar.o a-nurear.o i-forbla.o i-forlap.o s-gearop.o
+GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o \
+  a-nucoar.o i-forbla.o i-forlap.o s-gearop.o
 
 GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS) $(GNATRTL_TASKING_OBJS) \
   $(GNATRTL_LINEARALGEBRA_OBJS) g-trasym.o memtrack.o
@@ -2427,7 +2467,7 @@ install-gnatlib: ../stamp-gnatlib-$(RTSDIR)
 	          $(LN_S) $(fsrcpfx)ada/$(word 2,$(subst <, ,$(PAIR))) \
 	                $(RTSDIR)/$(word 1,$(subst <, ,$(PAIR)));)
 # Copy tsystem.h
-	$(CP) $(srcdir)/tsystem.h rts
+	$(CP) $(srcdir)/tsystem.h $(RTSDIR)
 # Copy generated target dependent sources
 	$(RM) $(RTSDIR)/s-oscons.ads
 	(cd $(RTSDIR); $(LN_S) ../s-oscons.ads s-oscons.ads)
@@ -2734,11 +2774,11 @@ a-except.o  : a-except.adb a-except.ads
 	$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \
 	      $(NO_REORDER_ADAFLAGS) $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
 
-# compile s-except.o without optimization and with debug info to let the
+# compile s-excdeb.o without optimization and with debug info to let the
 # debugger set breakpoints and inspect subprogram parameters on exception
 # related events.
 
-s-except.o  : s-except.adb s-except.ads
+s-excdeb.o  : s-excdeb.adb s-excdeb.ads s-except.ads
 	$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \
 	      $< $(OUTPUT_OPTION)
 
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 26ba3fb1f1b..dbe2dc4393b 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -377,6 +377,7 @@ enum standard_datatypes
   ADT_longjmp_decl,
   ADT_update_setjmp_buf_decl,
   ADT_raise_nodefer_decl,
+  ADT_reraise_zcx_decl,
   ADT_begin_handler_decl,
   ADT_end_handler_decl,
   ADT_others_decl,
@@ -422,6 +423,7 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
 #define longjmp_decl gnat_std_decls[(int) ADT_longjmp_decl]
 #define update_setjmp_buf_decl gnat_std_decls[(int) ADT_update_setjmp_buf_decl]
 #define raise_nodefer_decl gnat_std_decls[(int) ADT_raise_nodefer_decl]
+#define reraise_zcx_decl gnat_std_decls[(int) ADT_reraise_zcx_decl]
 #define begin_handler_decl gnat_std_decls[(int) ADT_begin_handler_decl]
 #define others_decl gnat_std_decls[(int) ADT_others_decl]
 #define all_others_decl gnat_std_decls[(int) ADT_all_others_decl]
@@ -954,7 +956,7 @@ extern Pos get_target_double_size (void);
 extern Pos get_target_long_double_size (void);
 extern Pos get_target_pointer_size (void);
 extern Pos get_target_maximum_default_alignment (void);
-extern Pos get_target_default_allocator_alignment (void);
+extern Pos get_target_system_allocator_alignment (void);
 extern Pos get_target_maximum_allowed_alignment (void);
 extern Pos get_target_maximum_alignment (void);
 extern Nat get_float_words_be (void);
diff --git a/gcc/ada/gcc-interface/targtyps.c b/gcc/ada/gcc-interface/targtyps.c
index b31fee311e7..78df4dd1ace 100644
--- a/gcc/ada/gcc-interface/targtyps.c
+++ b/gcc/ada/gcc-interface/targtyps.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                                  Body                                    *
  *                                                                          *
- *          Copyright (C) 1992-2010, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2011, 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- *
@@ -149,7 +149,7 @@ get_target_maximum_default_alignment (void)
   return BIGGEST_ALIGNMENT / BITS_PER_UNIT;
 }
 
-/* Standard'Default_Allocator_Alignment.  Alignment guaranteed to be honored
+/* Standard'System_Allocator_Alignment.  Alignment guaranteed to be honored
    by the default allocator (System.Memory.Alloc or malloc if we have no
    run-time library at hand).
 
@@ -172,7 +172,7 @@ get_target_maximum_default_alignment (void)
 #endif
 
 Pos
-get_target_default_allocator_alignment (void)
+get_target_system_allocator_alignment (void)
 {
   return MALLOC_ALIGNMENT / BITS_PER_UNIT;
 }
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index b0b83b3383b..8e0ccd41701 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -165,6 +165,9 @@ static GTY(()) struct elab_info *elab_info_list;
    are in an exception handler.  Not used in the zero-cost case.  */
 static GTY(()) VEC(tree,gc) *gnu_except_ptr_stack;
 
+/* In ZCX case, current exception pointer.  Used to re-raise it.  */
+static GTY(()) tree gnu_incoming_exc_ptr;
+
 /* Stack for storing the current elaboration procedure decl.  */
 static GTY(()) VEC(tree,gc) *gnu_elab_proc_stack;
 
@@ -448,6 +451,12 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
 			   Empty);
   DECL_IGNORED_P (end_handler_decl) = 1;
 
+  reraise_zcx_decl
+    = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE,
+			   ftype, NULL_TREE, false, true, true, true, NULL,
+			   Empty);
+  DECL_IGNORED_P (reraise_zcx_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
      this procedure will never be called in this mode.  */
@@ -559,8 +568,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
     longest_float_type_node = TREE_TYPE (long_long_float_type);
 
   /* Dummy objects to materialize "others" and "all others" in the exception
-     tables.  These are exported by a-exexpr.adb, so see this unit for the
-     types to use.  */
+     tables.  These are exported by a-exexpr-gcc.adb, so see this unit for
+     the types to use.  */
   others_decl
     = create_var_decl (get_identifier ("OTHERS"),
 		       get_identifier ("__gnat_others_value"),
@@ -3760,7 +3769,7 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   tree gnu_expr;
   tree gnu_etype;
   tree gnu_current_exc_ptr;
-  tree gnu_incoming_exc_ptr;
+  tree prev_gnu_incoming_exc_ptr;
   Node_Id gnat_temp;
 
   /* We build a TREE_LIST of nodes representing what exception types this
@@ -3832,6 +3841,7 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   gnu_current_exc_ptr
     = build_call_expr (built_in_decls [BUILT_IN_EH_POINTER],
 		       1, integer_zero_node);
+  prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr;
   gnu_incoming_exc_ptr = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
 					  ptr_type_node, gnu_current_exc_ptr,
 					  false, false, false, false,
@@ -3846,6 +3856,8 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
   add_stmt_list (Statements (gnat_node));
   gnat_poplevel ();
 
+  gnu_incoming_exc_ptr = prev_gnu_incoming_exc_ptr;
+
   return build2 (CATCH_EXPR, void_type_node, gnu_etypes_list,
 		 end_stmt_group ());
 }
@@ -5452,7 +5464,27 @@ gnat_to_gnu (Node_Id gnat_node)
 	gnu_result = Exception_Handler_to_gnu_zcx (gnat_node);
       else
 	gcc_unreachable ();
+      break;
+
+    case N_Raise_Statement:
+      /* Only for reraise in back-end exceptions mode.  */
+      gcc_assert (No (Name (gnat_node))
+		  && Exception_Mechanism == Back_End_Exceptions);
+
+      start_stmt_group ();
+      gnat_pushlevel ();
 
+      /* Clear the current exception pointer so that the occurrence won't be
+	 deallocated.  */
+      gnu_expr = create_var_decl (get_identifier ("SAVED_EXPTR"), NULL_TREE,
+				  ptr_type_node, gnu_incoming_exc_ptr,
+				  false, false, false, false, NULL, gnat_node);
+
+      add_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_incoming_exc_ptr,
+				 convert (ptr_type_node, integer_zero_node)));
+      add_stmt (build_call_1_expr (reraise_zcx_decl, gnu_expr));
+      gnat_poplevel ();
+      gnu_result = end_stmt_group ();
       break;
 
     case N_Push_Constraint_Error_Label:
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 5f3f03a3e0d..25e293dd3e6 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -1907,13 +1907,13 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
      stored just in front.  */
 
   unsigned int data_align = TYPE_ALIGN (data_type);
-  unsigned int default_allocator_alignment
-      = get_target_default_allocator_alignment () * BITS_PER_UNIT;
+  unsigned int system_allocator_alignment
+      = get_target_system_allocator_alignment () * BITS_PER_UNIT;
 
   tree aligning_type
-    = ((data_align > default_allocator_alignment)
+    = ((data_align > system_allocator_alignment)
        ? make_aligning_type (data_type, data_align, data_size,
-			     default_allocator_alignment,
+			     system_allocator_alignment,
 			     POINTER_SIZE / BITS_PER_UNIT)
        : NULL_TREE);
 
@@ -1986,12 +1986,12 @@ maybe_wrap_free (tree data_ptr, tree data_type)
      return value, stored in front of the data block at allocation time.  */
 
   unsigned int data_align = TYPE_ALIGN (data_type);
-  unsigned int default_allocator_alignment
-      = get_target_default_allocator_alignment () * BITS_PER_UNIT;
+  unsigned int system_allocator_alignment
+      = get_target_system_allocator_alignment () * BITS_PER_UNIT;
 
   tree free_ptr;
 
-  if (data_align > default_allocator_alignment)
+  if (data_align > system_allocator_alignment)
     {
       /* DATA_FRONT_PTR (void *)
 	 = (void *)DATA_PTR - (void *)sizeof (void *))  */
diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb
index e9c17bd07aa..923eb35e072 100644
--- a/gcc/ada/get_scos.adb
+++ b/gcc/ada/get_scos.adb
@@ -23,8 +23,14 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with SCOs;  use SCOs;
-with Types; use Types;
+pragma Ada_2005;
+--  This unit is not part of the compiler proper, it is used in tools that
+--  read SCO information from ALI files (Xcov and sco_test). Ada 2005
+--  constructs may therefore be used freely (and are indeed).
+
+with SCOs;   use SCOs;
+with Snames; use Snames;
+with Types;  use Types;
 
 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
 
@@ -160,6 +166,7 @@ procedure Get_SCOs is
       Check ('-');
       Get_Source_Location (Loc2);
    end Get_Source_Location_Range;
+
    --------------
    -- Skip_EOL --
    --------------
@@ -192,6 +199,10 @@ procedure Get_SCOs is
       end loop;
    end Skip_Spaces;
 
+   Buf : String (1 .. 32_768);
+   N   : Natural;
+   --  Scratch buffer, and index into it
+
 --  Start of processing for Get_Scos
 
 begin
@@ -227,32 +238,24 @@ begin
 
             --  Scan out dependency number and file name
 
-            declare
-               Ptr : String_Ptr := new String (1 .. 32768);
-               N   : Integer;
-
-            begin
-               Skip_Spaces;
-               Dnum := Get_Int;
-
-               Skip_Spaces;
+            Skip_Spaces;
+            Dnum := Get_Int;
 
-               N := 0;
-               while Nextc > ' ' loop
-                  N := N + 1;
-                  Ptr.all (N) := Getc;
-               end loop;
+            Skip_Spaces;
 
-               --  Make new unit table entry (will fill in To later)
+            N := 0;
+            while Nextc > ' ' loop
+               N := N + 1;
+               Buf (N) := Getc;
+            end loop;
 
-               SCO_Unit_Table.Append (
-                 (File_Name => new String'(Ptr.all (1 .. N)),
-                  Dep_Num   => Dnum,
-                  From      => SCO_Table.Last + 1,
-                  To        => 0));
+            --  Make new unit table entry (will fill in To later)
 
-               Free (Ptr);
-            end;
+            SCO_Unit_Table.Append (
+              (File_Name => new String'(Buf (1 .. N)),
+               Dep_Num   => Dnum,
+               From      => SCO_Table.Last + 1,
+               To        => 0));
 
          --  Statement entry
 
@@ -260,6 +263,7 @@ begin
             declare
                Typ : Character;
                Key : Character;
+               Pid : Pragma_Id;
 
             begin
                --  If continuation, reset Last indication in last entry
@@ -289,16 +293,42 @@ begin
                      Typ := ' ';
                   else
                      Skipc;
+                     if Typ = 'P' then
+                        Pid := Unknown_Pragma;
+
+                        if Nextc not in '1' .. '9' then
+                           N := 1;
+                           loop
+                              Buf (N) := Getc;
+                              exit when Nextc = ':';
+                              N := N + 1;
+                           end loop;
+                           Skipc;
+
+                           begin
+                              Pid :=
+                                Pragma_Id'Value ("pragma_" & Buf (1 .. N));
+                           exception
+                              when Constraint_Error =>
+
+                                 --  Pid remains set to Unknown_Pragma
+
+                                 null;
+                           end;
+                        end if;
+                     end if;
                   end if;
 
                   Get_Source_Location_Range (Loc1, Loc2);
 
-                  Add_SCO
-                    (C1   => Key,
-                     C2   => Typ,
-                     From => Loc1,
-                     To   => Loc2,
-                     Last => At_EOL);
+                  SCO_Table.Append
+                    ((C1          => Key,
+                      C2          => Typ,
+                      From        => Loc1,
+                      To          => Loc2,
+                      Last        => At_EOL,
+                      Pragma_Sloc => No_Location,
+                      Pragma_Name => Pid));
 
                   exit when At_EOL;
                   Key := 's';
@@ -307,7 +337,7 @@ begin
 
          --  Decision entry
 
-         when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' =>
+         when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
             Dtyp := C;
             Skip_Spaces;
 
@@ -325,12 +355,13 @@ begin
                   Get_Source_Location (Loc);
                end if;
 
-               Add_SCO
-                 (C1   => Dtyp,
-                  C2   => ' ',
-                  From => Loc,
-                  To   => No_Source_Location,
-                  Last => False);
+               SCO_Table.Append
+                 ((C1     => Dtyp,
+                   C2     => ' ',
+                   From   => Loc,
+                   To     => No_Source_Location,
+                   Last   => False,
+                   others => <>));
             end;
 
             --  Loop through terms in complex expression
@@ -341,11 +372,12 @@ begin
                   Cond := C;
                   Skipc;
                   Get_Source_Location_Range (Loc1, Loc2);
-                  Add_SCO
-                    (C2   => Cond,
-                     From => Loc1,
-                     To   => Loc2,
-                     Last => False);
+                  SCO_Table.Append
+                    ((C2     => Cond,
+                      From   => Loc1,
+                      To     => Loc2,
+                      Last   => False,
+                      others => <>));
 
                elsif C = '!' or else
                      C = '&' or else
@@ -357,12 +389,28 @@ begin
                      Loc : Source_Location;
                   begin
                      Get_Source_Location (Loc);
-                     Add_SCO (C1 => C, From => Loc, Last => False);
+                     SCO_Table.Append
+                       ((C1     => C,
+                         From   => Loc,
+                         Last   => False,
+                         others => <>));
                   end;
 
                elsif C = ' ' then
                   Skip_Spaces;
 
+               elsif C = 'T' or else C = 'F' then
+
+                  --  Chaining indicator: skip for now???
+
+                  declare
+                     Loc1, Loc2 : Source_Location;
+                     pragma Unreferenced (Loc1, Loc2);
+                  begin
+                     Skipc;
+                     Get_Source_Location_Range (Loc1, Loc2);
+                  end;
+
                else
                   raise Data_Error;
                end if;
diff --git a/gcc/ada/get_targ.ads b/gcc/ada/get_targ.ads
index 07a9ab2db6f..6cdbf7509a4 100644
--- a/gcc/ada/get_targ.ads
+++ b/gcc/ada/get_targ.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -95,6 +95,10 @@ package Get_Targ is
    function Get_Strict_Alignment return Nat;
    pragma Import (C, Get_Strict_Alignment, "get_target_strict_alignment");
 
+   function Get_System_Allocator_Alignment return Nat;
+   pragma Import (C, Get_System_Allocator_Alignment,
+                  "get_target_system_allocator_alignment");
+
    function Get_Double_Float_Alignment return Nat;
    pragma Import (C, Get_Double_Float_Alignment,
                   "get_target_double_float_alignment");
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 653a10c1990..f371afafa45 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -324,11 +324,7 @@ procedure Gnat1drv is
       --  Set and check exception mechanism
 
       if Targparm.ZCX_By_Default_On_Target then
-         if Targparm.GCC_ZCX_Support_On_Target then
-            Exception_Mechanism := Back_End_Exceptions;
-         else
-            Osint.Fail ("Zero Cost Exceptions not supported on this target");
-         end if;
+         Exception_Mechanism := Back_End_Exceptions;
       end if;
 
       --  Set proper status for overflow checks. We turn on overflow checks if
@@ -448,6 +444,18 @@ procedure Gnat1drv is
 
          Debug_Flag_HH := True;
 
+         --  Disable Expressions_With_Actions nodes
+
+         --  The gnat2why backend does not deal with Expressions_With_Actions
+         --  in all places (in particular assertions). It is difficult to
+         --  determine in the frontend which cases are allowed, so we disable
+         --  Expressions_With_Actions entirely. Even in the cases where
+         --  gnat2why deals with Expressions_With_Actions, it is easier to
+         --  deal with the original constructs (quantified, conditional and
+         --  case expressions) instead of the rewritten ones.
+
+         Use_Expression_With_Actions := False;
+
          --  Enable assertions and debug pragmas, since they give valuable
          --  extra information for formal verification.
 
@@ -459,8 +467,8 @@ procedure Gnat1drv is
 
          Reset_Style_Check_Options;
 
-         --  Suppress compiler warnings, since what we are
-         --  interested in here is what formal verification can find out.
+         --  Suppress compiler warnings, since what we are interested in here
+         --  is what formal verification can find out.
 
          Warning_Mode := Suppress;
 
@@ -468,11 +476,12 @@ procedure Gnat1drv is
 
          Global_Discard_Names := True;
 
-         --  Always perform semantics and generate ALI files in ALFA mode,
-         --  so that a gnatmake -c -k will proceed further when possible.
+         --  We would prefer to suppress the expansion of tagged types and
+         --  dispatching calls, so that one day GNATprove can handle them
+         --  directly. Unfortunately, this is causing problems in some cases,
+         --  so keep this expansion for the time being. To be investigated ???
 
-         Force_ALI_Tree_File := True;
-         Try_Semantics := True;
+         Tagged_Type_Expansion := True;
       end if;
    end Adjust_Global_Switches;
 
@@ -776,9 +785,34 @@ begin
       Original_Operating_Mode := Operating_Mode;
       Frontend;
 
-      --  Exit with errors if the main source could not be parsed
+      --  Exit with errors if the main source could not be parsed. Also, when
+      --  -gnatd.H is present, the source file is not set.
 
       if Sinput.Main_Source_File = No_Source_File then
+
+         --  Handle -gnatd.H debug mode
+
+         if Debug_Flag_Dot_HH then
+
+            --  For -gnatd.H, lock all the tables to keep the convention that
+            --  the backend needs to unlock the tables it wants to touch.
+
+            Atree.Lock;
+            Elists.Lock;
+            Fname.UF.Lock;
+            Inline.Lock;
+            Lib.Lock;
+            Nlists.Lock;
+            Sem.Lock;
+            Sinput.Lock;
+            Namet.Lock;
+            Stringt.Lock;
+
+            --  And all we need to do is to call the back end
+
+            Back_End.Call_Back_End (Back_End.Generate_Object);
+         end if;
+
          Errout.Finalize (Last_Call => True);
          Errout.Output_Messages;
          Exit_Program (E_Errors);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index a7f13a14122..faf3e839a27 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -239,6 +239,7 @@ Implementation Defined Attributes
 * Elaborated::
 * Elab_Body::
 * Elab_Spec::
+* Elab_Subp_Body::
 * Emax::
 * Enabled::
 * Enum_Rep::
@@ -269,6 +270,7 @@ Implementation Defined Attributes
 * Small::
 * Storage_Unit::
 * Stub_Type::
+* System_Allocator_Alignment::
 * Target_Name::
 * Tick::
 * To_Address::
@@ -525,7 +527,7 @@ isolate and clearly document any sections of your program that make use
 of these features in a non-portable manner.
 
 @ifset PROEDITION
-For ease of exposition, ``GNAT Pro'' will be referred to simply as
+For ease of exposition, ``@value{EDITION}'' will be referred to simply as
 ``GNAT'' in the remainder of this document.
 @end ifset
 
@@ -5072,23 +5074,23 @@ Syntax:
 @smallexample @c ada
 pragma Test_Case (
    [Name     =>] static_string_Expression
-  ,[Mode     =>] (Normal | Robustness)
+  ,[Mode     =>] (Nominal | Robustness)
  [, Requires =>  Boolean_Expression]
  [, Ensures  =>  Boolean_Expression]);
 @end smallexample
 
 @noindent
 The @code{Test_Case} pragma allows defining fine-grain specifications
-for use by testing and verification tools. The compiler only checks its
+for use by testing and verification tools. The compiler checks its
 validity but the presence of pragma @code{Test_Case} does not lead to
 any modification of the code generated by the compiler.
 
 @code{Test_Case} pragmas may only appear immediately following the
-(separate) declaration of a subprogram. Only other pragmas may intervene
-(that is appear between the subprogram declaration and its
-postconditions).
+(separate) declaration of a subprogram in a package declaration, inside
+a package spec unit. Only other pragmas may intervene (that is appear
+between the subprogram declaration and a test case).
 
-The compiler checks that boolean expression given in @code{Requires} and
+The compiler checks that boolean expressions given in @code{Requires} and
 @code{Ensures} are valid, where the rules for @code{Requires} are the
 same as the rule for an expression in @code{Precondition} and the rules
 for @code{Ensures} are the same as the rule for an expression in
@@ -5101,7 +5103,7 @@ package Math_Functions is
    ...
    function Sqrt (Arg : Float) return Float;
    pragma Test_Case (Name     => "Test 1",
-                     Mode     => Normal,
+                     Mode     => Nominal,
                      Requires => Arg < 100,
                      Ensures  => Sqrt'Result < 10);
    ...
@@ -5111,10 +5113,10 @@ end Math_Functions;
 @noindent
 The meaning of a test case is that, if the associated subprogram is
 executed in a context where @code{Requires} holds, then @code{Ensures}
-should hold when the subprogram returns. Mode @code{Normal} indicates
-that the input context should satisfy the normal precondition of the
+should hold when the subprogram returns. Mode @code{Nominal} indicates
+that the input context should satisfy the precondition of the
 subprogram, and the output context should then satisfy its
-postcondition. More @code{Robustness} indicates that the normal pre- and
+postcondition. More @code{Robustness} indicates that the pre- and
 postcondition of the subprogram should be ignored for this test case.
 
 @node Pragma Thread_Local_Storage
@@ -5719,6 +5721,7 @@ consideration, you should minimize the use of these attributes.
 * Elaborated::
 * Elab_Body::
 * Elab_Spec::
+* Elab_Subp_Body::
 * Emax::
 * Enabled::
 * Enum_Rep::
@@ -5750,6 +5753,7 @@ consideration, you should minimize the use of these attributes.
 * Small::
 * Storage_Unit::
 * Stub_Type::
+* System_Allocator_Alignment::
 * Target_Name::
 * Tick::
 * To_Address::
@@ -5875,7 +5879,7 @@ the containing record @var{R}.
 @code{Standard'Compiler_Version} (@code{Standard} is the only allowed
 prefix) yields a static string identifying the version of the compiler
 being used to compile the unit containing the attribute reference. A
-typical result would be something like "GNAT Pro 6.3.0w (20090221)".
+typical result would be something like "@value{EDITION} @value{gnat_version} (20090221)".
 
 @node Code_Address
 @unnumberedsec Code_Address
@@ -5966,6 +5970,17 @@ which it is useful to be able to call this elaboration procedure from
 Ada code, e.g.@: if it is necessary to do selective re-elaboration to fix
 some error.
 
+@node Elab_Subp_Body
+@unnumberedsec Elab_Subp_Body
+@findex Elab_Subp_Body
+@noindent
+This attribute can only be applied to a library level subprogram
+name and is only allowed in CodePeer mode. It returns the entity
+for the corresponding elaboration procedure for elaborating the body
+of the referenced subprogram unit. This is used in the main generated
+elaboration procedure by the binder in CodePeer mode only and is unrecognized
+otherwise.
+
 @node Emax
 @unnumberedsec Emax
 @cindex Ada 83 attributes
@@ -6477,6 +6492,18 @@ type @code{RACW_Stub_Type} declared in the internal implementation-defined
 unit @code{System.Partition_Interface}. Use of this attribute will create
 an implicit dependency on this unit.
 
+@node System_Allocator_Alignment
+@unnumberedsec System_Allocator_Alignment
+@cindex Alignment, allocator
+@findex System_Allocator_Alignment
+@noindent
+@code{Standard'System_Allocator_Alignment} (@code{Standard} is the only
+permissible prefix) provides the observable guaranted to be honored by
+the system allocator (malloc). This is a static value that can be used
+in user storage pools based on malloc either to reject allocation
+with alignment too large or to enable a realignment circuitry if the
+alignment request is larger than this value.
+
 @node Target_Name
 @unnumberedsec Target_Name
 @findex Target_Name
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 7f2d655540e..de51c76781e 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -7,7 +7,7 @@
 @c                                                                            o
 @c                             G N A T _ U G N                                o
 @c                                                                            o
-@c                     Copyright (C) 1992-2011, AdaCore                       o
+@c           Copyright (C) 1992-2011, Free Software Foundation, Inc.          o
 @c                                                                            o
 @c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
 
@@ -5780,12 +5780,14 @@ This switch disables warnings for exception usage when pragma Restrictions
 (No_Exception_Propagation) is in effect.
 
 @item -gnatwy
-@emph{Activate warnings for Ada 2005 compatibility issues.}
+@emph{Activate warnings for Ada compatibility issues.}
 @cindex @option{-gnatwy} (@command{gcc})
-@cindex Ada 2005 compatibility issues warnings
-For the most part Ada 2005 is upwards compatible with Ada 95,
-but there are some exceptions (for example the fact that
-@code{interface} is now a reserved word in Ada 2005). This
+@cindex Ada compatibility issues warnings
+For the most part, newer versions of Ada are upwards compatible
+with older versions. For example, Ada 2005 programs will almost
+always work when compiled as Ada 2012.
+However there are some exceptions (for example the fact that
+@code{some} is now a reserved word in Ada 2012). This
 switch activates several warnings to help in identifying
 and correcting such incompatibilities. The default is that
 these warnings are generated. Note that at one point Ada 2005
@@ -5793,11 +5795,11 @@ was called Ada 0Y, hence the choice of character.
 This warning can also be turned on using @option{-gnatwa}.
 
 @item -gnatwY
-@emph{Disable warnings for Ada 2005 compatibility issues.}
+@emph{Disable warnings for Ada compatibility issues.}
 @cindex @option{-gnatwY} (@command{gcc})
-@cindex Ada 2005 compatibility issues warnings
-This switch suppresses several warnings intended to help in identifying
-incompatibilities between Ada 95 and Ada 2005.
+@cindex Ada compatibility issues warnings
+This switch suppresses the warnings intended to help in identifying
+incompatibilities between Ada language versions.
 
 @item -gnatwz
 @emph{Activate warnings on unchecked conversions.}
@@ -7636,7 +7638,10 @@ preprocessing is triggered and parameterized.
 @cindex @option{-gnatep} (@command{gcc})
 This switch indicates to the compiler the file name (without directory
 information) of the preprocessor data file to use. The preprocessor data file
-should be found in the source directories.
+should be found in the source directories. Note that when the compiler is
+called by a builder (@command{gnatmake} or @command{gprbuild}) with a project
+file, if the object directory is not also a source directory, the builder needs
+to be called with @option{-x}.
 
 @noindent
 A preprocessing data file is a text file with significant lines indicating
@@ -7758,11 +7763,11 @@ found in the GCC documentation.
 Use of these @option{-m} switches may in some cases result in improved
 code performance.
 
-The GNAT Pro technology is tested and qualified without any
+The @value{EDITION} technology is tested and qualified without any
 @option{-m} switches,
 so generally the most reliable approach is to avoid the use of these
 switches. However, we generally expect most of these switches to work
-successfully with GNAT Pro, and many customers have reported successful
+successfully with @value{EDITION}, and many customers have reported successful
 use of these options.
 
 Our general advice is to avoid the use of @option{-m} switches unless
@@ -18944,7 +18949,7 @@ program, in which case the execution of that program is simply suspended
 until the connection between the debugger and gdbserver is established.
 
 For more information on how to use gdbserver, @ref{Top, Server, Using
-the gdbserver Program, gdb, Debugging with GDB}.  GNAT Pro provides support
+the gdbserver Program, gdb, Debugging with GDB}.  @value{EDITION} provides support
 for gdbserver on x86-linux, x86-windows and x86_64-linux.
 
 @node GNAT Abnormal Termination or Failure to Terminate
@@ -21110,7 +21115,7 @@ of the DECset package.
    &\cr
 \+\it Tool
    &\it Product with HP Ada
-   & \it Product with GNAT Pro\cr
+   & \it Product with @value{EDITION}\cr
 \smallskip
 \+Code Management System
    &HP CMS
@@ -21167,7 +21172,7 @@ of the DECset package.
 @c the TeX version above for the printed version
 @flushleft
 @c @multitable @columnfractions .3 .4 .4
-@multitable {Source Code Analyzer /}{Tool with HP Ada}{Tool with GNAT Pro}
+@multitable {Source Code Analyzer /}{Tool with HP Ada}{Tool with @value{EDITION}}
 @item @i{Tool}
 @tab @i{Tool with HP Ada}
 @tab @i{Tool with @value{EDITION}}
@@ -21319,6 +21324,10 @@ information about several specific platforms.
 @item @b{ppc-aix}
 @item @code{@ @ }@i{rts-native (default)}
 @item @code{@ @ @ @ }Tasking    @tab native AIX threads
+@item @code{@ @ @ @ }Exceptions @tab ZCX
+@*
+@item @code{@ @ }@i{rts-sjlj}
+@item @code{@ @ @ @ }Tasking    @tab native AIX threads
 @item @code{@ @ @ @ }Exceptions @tab SJLJ
 @*
 @item @b{ppc-darwin}
@@ -21361,6 +21370,10 @@ information about several specific platforms.
 @item @b{x86-solaris}
 @item @code{@ @ }@i{rts-native (default)}
 @item @code{@ @ @ @ }Tasking    @tab native Solaris threads
+@item @code{@ @ @ @ }Exceptions @tab ZCX
+@*
+@item @code{@ @ }@i{rts-sjlj}
+@item @code{@ @ @ @ }Tasking    @tab native Solaris threads library
 @item @code{@ @ @ @ }Exceptions @tab SJLJ
 @*
 @item @b{x86-windows}
@@ -21368,7 +21381,7 @@ information about several specific platforms.
 @item @code{@ @ @ @ }Tasking    @tab native Win32 threads
 @item @code{@ @ @ @ }Exceptions @tab ZCX
 @*
-@item @code{@ @ }@i{rts-sjlj (default)}
+@item @code{@ @ }@i{rts-sjlj}
 @item @code{@ @ @ @ }Tasking    @tab native Win32 threads
 @item @code{@ @ @ @ }Exceptions @tab SJLJ
 @*
@@ -26435,7 +26448,7 @@ in 64-bit address space are acceptable.
 @noindent
 64-bit @value{EDITION} for Open VMS takes advantage of the freedom given in the
 Ada standard with respect to the type of @code{System.Address}. Previous
-versions of GNAT Pro have defined this type as private and implemented it as a
+versions of @value{EDITION} have defined this type as private and implemented it as a
 modular type.
 
 In order to allow defining @code{System.Short_Address} as a proper subtype,
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index ec9c4e97b44..051082f640f 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -202,6 +202,9 @@ procedure GNATCmd is
    --  indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
    --  should be invoked for all sources of all projects.
 
+   Max_OpenVMS_Logical_Length : constant Integer := 255;
+   --  The maximum length of OpenVMS logicals
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -1420,6 +1423,15 @@ begin
       Add_Str_To_Name_Buffer (Argument (J));
    end loop;
 
+   --  On OpenVMS, setenv creates a logical whose length is limited to
+   --  255 bytes.
+
+   if OpenVMS and then Name_Len > Max_OpenVMS_Logical_Length then
+      Name_Buffer (Max_OpenVMS_Logical_Length - 2
+                     .. Max_OpenVMS_Logical_Length) := "...";
+      Name_Len := Max_OpenVMS_Logical_Length;
+   end if;
+
    Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
 
    --  Add the directory where the GNAT driver is invoked in front of the path,
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 1fdf36adff9..87498d85f30 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -508,6 +508,7 @@ package body Impunit is
    Non_Imp_File_Names_12 : constant File_List := (
      "s-multip",    -- System.Multiprocessors
      "s-mudido",    -- System.Multiprocessors.Dispatching_Domains
+     "s-stposu",    -- System.Storage_Pools.Subpools
      "a-cobove",    -- Ada.Containers.Bounded_Vectors
      "a-cbdlli",    -- Ada.Containers.Bounded_Doubly_Linked_Lists
      "a-cborse",    -- Ada.Containers.Bounded_Ordered_Sets
@@ -520,10 +521,12 @@ package body Impunit is
      "a-cbmutr",    -- Ada.Containers.Bounded_Multiway_Trees
      "a-extiin",    -- Ada.Execution_Time.Interrupts
      "a-iteint",    -- Ada.Iterator_Interfaces
+     "a-synbar",    -- Ada.Synchronous_Barriers
+     "a-undesu",    -- Ada.Unchecked_Deallocate_Subpool
 
-   -----------------------------------------
-   -- GNAT Defined Additions to Ada 20012 --
-   -----------------------------------------
+   ----------------------------------------
+   -- GNAT Defined Additions to Ada 2012 --
+   ----------------------------------------
 
      "a-cofove",    -- Ada.Containers.Formal_Vectors
      "a-cfdlli",    -- Ada.Containers.Formal_Doubly_Linked_Lists
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index ec534e1f3f2..0eb8dce6f4f 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -496,8 +496,10 @@ package body Inline is
          return;
       end if;
 
-      --  If the instance appears within a generic subprogram there is nothing
-      --  to finalize either.
+      --  If the instance is within a generic unit, no finalization code
+      --  can be generated. Note that at this point all bodies have been
+      --  analyzed, and the scope stack itself is not present, and the flag
+      --  Inside_A_Generic is not set.
 
       declare
          S : Entity_Id;
@@ -505,7 +507,7 @@ package body Inline is
       begin
          S := Scope (Inst);
          while Present (S) and then S /= Standard_Standard loop
-            if Is_Generic_Subprogram (S) then
+            if Is_Generic_Unit (S) then
                return;
             end if;
 
diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb
index 58c4eccadb8..32439a02a07 100644
--- a/gcc/ada/lib-xref-alfa.adb
+++ b/gcc/ada/lib-xref-alfa.adb
@@ -25,6 +25,7 @@
 
 with ALFA;        use ALFA;
 with Einfo;       use Einfo;
+with Nmake;       use Nmake;
 with Put_ALFA;
 with GNAT.HTable;
 
@@ -143,6 +144,22 @@ package body ALFA is
    type Entity_Hashed_Range is range 0 .. 255;
    --  Size of hash table headers
 
+   ---------------------
+   -- Local Variables --
+   ---------------------
+
+   package Drefs is new Table.Table (
+     Table_Component_Type => Xref_Entry,
+     Table_Index_Type     => Xref_Entry_Number,
+     Table_Low_Bound      => 1,
+     Table_Initial        => Alloc.Xrefs_Initial,
+     Table_Increment      => Alloc.Xrefs_Increment,
+     Table_Name           => "Drefs");
+   --  Table of cross-references for reads and writes through explicit
+   --  dereferences, that are output as reads/writes to the special variable
+   --  "HEAP". These references are added to the regular references when
+   --  computing ALFA cross-references.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -165,20 +182,25 @@ package body ALFA is
    --  Hash function for hash table
 
    procedure Traverse_Declarations_Or_Statements
-     (L       : List_Id;
-      Process : Node_Processing);
+     (L            : List_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean);
    procedure Traverse_Handled_Statement_Sequence
-     (N       : Node_Id;
-      Process : Node_Processing);
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean);
    procedure Traverse_Package_Body
-     (N       : Node_Id;
-      Process : Node_Processing);
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean);
    procedure Traverse_Package_Declaration
-     (N       : Node_Id;
-      Process : Node_Processing);
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean);
    procedure Traverse_Subprogram_Body
-     (N       : Node_Id;
-      Process : Node_Processing);
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean);
    --  Traverse the corresponding constructs, calling Process on all
    --  declarations.
 
@@ -201,7 +223,8 @@ package body ALFA is
 
       From := ALFA_Scope_Table.Last + 1;
 
-      Traverse_Compilation_Unit (Cunit (U), Detect_And_Add_ALFA_Scope'Access);
+      Traverse_Compilation_Unit (Cunit (U), Detect_And_Add_ALFA_Scope'Access,
+                                 Inside_Stubs => False);
 
       --  Update scope numbers
 
@@ -276,10 +299,10 @@ package body ALFA is
       end if;
 
       case Ekind (E) is
-         when E_Function =>
+         when E_Function | E_Generic_Function =>
             Typ := 'V';
 
-         when E_Procedure =>
+         when E_Procedure | E_Generic_Procedure =>
             Typ := 'U';
 
          when E_Subprogram_Body =>
@@ -302,7 +325,7 @@ package body ALFA is
                end if;
             end;
 
-         when E_Package | E_Package_Body =>
+         when E_Package | E_Package_Body | E_Generic_Package =>
             Typ := 'K';
 
          when E_Void =>
@@ -394,7 +417,9 @@ package body ALFA is
       --  when we eliminate duplicate reference entries as well as references
       --  not suitable for local cross-references.
 
-      Rnums : array (0 .. Nrefs) of Nat;
+      Nrefs_Add : constant Nat := Drefs.Last;
+
+      Rnums : array (0 .. Nrefs + Nrefs_Add) of Nat;
       --  This array contains numbers of references in the Xrefs table. This
       --  list is sorted in output order. The extra 0'th entry is convenient
       --  for the call to sort. When we sort the table, we move the entries in
@@ -500,6 +525,8 @@ package body ALFA is
          Rnums (Nat (To)) := Rnums (Nat (From));
       end Move;
 
+      Heap : Entity_Id;
+
       --  Start of processing for Add_ALFA_Xrefs
    begin
 
@@ -514,6 +541,31 @@ package body ALFA is
          Rnums (J) := J;
       end loop;
 
+      --  Add dereferences to the set of regular references, by creating a
+      --  special "HEAP" variable for these special references.
+
+      Name_Len := Name_Of_Heap_Variable'Length;
+      Name_Buffer (1 .. Name_Len) := Name_Of_Heap_Variable;
+
+      Atree.Unlock;
+      Nlists.Unlock;
+      Heap := Make_Defining_Identifier (Standard_Location, Name_Enter);
+      Atree.Lock;
+      Nlists.Lock;
+
+      Set_Ekind         (Heap, E_Variable);
+      Set_Is_Internal   (Heap, True);
+      Set_Has_Fully_Qualified_Name (Heap);
+
+      for J in Drefs.First .. Drefs.Last loop
+         Xrefs.Increment_Last;
+         Xrefs.Table (Xrefs.Last)     := Drefs.Table (J);
+         Xrefs.Table (Xrefs.Last).Ent := Heap;
+
+         Nrefs         := Nrefs + 1;
+         Rnums (Nrefs) := Xrefs.Last;
+      end loop;
+
       --  Eliminate entries not appropriate for ALFA. Done prior to sorting
       --  cross-references, as it discards useless references which do not have
       --  a proper format for the comparison function (like no location).
@@ -756,16 +808,29 @@ package body ALFA is
                  new String'(Unique_Name (XE.Ent));
             end if;
 
-            ALFA_Xref_Table.Append (
-              (Entity_Name => Cur_Entity_Name,
-               Entity_Line => Int (Get_Logical_Line_Number (XE.Def)),
-               Etype       => Get_Entity_Type (XE.Ent),
-               Entity_Col  => Int (Get_Column_Number (XE.Def)),
-               File_Num    => Dependency_Num (XE.Lun),
-               Scope_Num   => Get_Scope_Num (XE.Ref_Scope),
-               Line        => Int (Get_Logical_Line_Number (XE.Loc)),
-               Rtype       => XE.Typ,
-               Col         => Int (Get_Column_Number (XE.Loc))));
+            if XE.Ent = Heap then
+               ALFA_Xref_Table.Append (
+                 (Entity_Name => Cur_Entity_Name,
+                  Entity_Line => 0,
+                  Etype       => Get_Entity_Type (XE.Ent),
+                  Entity_Col  => 0,
+                  File_Num    => Dependency_Num (XE.Lun),
+                  Scope_Num   => Get_Scope_Num (XE.Ref_Scope),
+                  Line        => Int (Get_Logical_Line_Number (XE.Loc)),
+                  Rtype       => XE.Typ,
+                  Col         => Int (Get_Column_Number (XE.Loc))));
+            else
+               ALFA_Xref_Table.Append (
+                 (Entity_Name => Cur_Entity_Name,
+                  Entity_Line => Int (Get_Logical_Line_Number (XE.Def)),
+                  Etype       => Get_Entity_Type (XE.Ent),
+                  Entity_Col  => Int (Get_Column_Number (XE.Def)),
+                  File_Num    => Dependency_Num (XE.Lun),
+                  Scope_Num   => Get_Scope_Num (XE.Ref_Scope),
+                  Line        => Int (Get_Logical_Line_Number (XE.Loc)),
+                  Rtype       => XE.Typ,
+                  Col         => Int (Get_Column_Number (XE.Loc))));
+            end if;
          end Add_One_Xref;
       end loop;
 
@@ -829,38 +894,22 @@ package body ALFA is
             declare
                Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S);
 
-               Body_Entity : Entity_Id;
-               Spec_Entity : Entity_Id;
-               Spec_Scope  : Scope_Index;
+               Spec_Entity : constant Entity_Id :=
+                               Unique_Entity (Srec.Scope_Entity);
+               Spec_Scope  : constant Scope_Index :=
+                               Entity_Hash_Table.Get (Spec_Entity);
 
             begin
-               if Ekind (Srec.Scope_Entity) = E_Subprogram_Body then
-                  Body_Entity := Parent (Parent (Srec.Scope_Entity));
-               elsif Ekind (Srec.Scope_Entity) = E_Package_Body then
-                  Body_Entity := Parent (Srec.Scope_Entity);
-               else
-                  Body_Entity := Empty;
-               end if;
+               --  Spec of generic may be missing, in which case Spec_Scope is
+               --  zero.
 
-               if Present (Body_Entity) then
-                  if Nkind (Body_Entity) = N_Defining_Program_Unit_Name then
-                     Body_Entity := Parent (Body_Entity);
-                  elsif Nkind (Body_Entity) = N_Subprogram_Body_Stub then
-                     Body_Entity :=
-                       Proper_Body (Unit (Library_Unit (Body_Entity)));
-                  end if;
-
-                  Spec_Entity := Corresponding_Spec (Body_Entity);
-                  Spec_Scope := Entity_Hash_Table.Get (Spec_Entity);
-
-                  --  Spec of generic may be missing
-
-                  if Spec_Scope /= 0 then
-                     Srec.Spec_File_Num :=
-                       ALFA_Scope_Table.Table (Spec_Scope).File_Num;
-                     Srec.Spec_Scope_Num :=
-                       ALFA_Scope_Table.Table (Spec_Scope).Scope_Num;
-                  end if;
+               if Spec_Entity /= Srec.Scope_Entity
+                 and then Spec_Scope /= 0
+               then
+                  Srec.Spec_File_Num :=
+                    ALFA_Scope_Table.Table (Spec_Scope).File_Num;
+                  Srec.Spec_Scope_Num :=
+                    ALFA_Scope_Table.Table (Spec_Scope).Scope_Num;
                end if;
             end;
          end loop;
@@ -887,6 +936,84 @@ package body ALFA is
       end if;
    end Detect_And_Add_ALFA_Scope;
 
+   -------------------------------------
+   -- Enclosing_Subprogram_Or_Package --
+   -------------------------------------
+
+   function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id is
+      Result : Entity_Id;
+
+   begin
+      --  If N is the defining identifier for a subprogram, then return the
+      --  enclosing subprogram or package, not this subprogram.
+
+      if Nkind_In (N, N_Defining_Identifier, N_Defining_Operator_Symbol)
+        and then Nkind (Parent (N)) in N_Subprogram_Specification
+      then
+         Result := Parent (Parent (Parent (N)));
+      else
+         Result := N;
+      end if;
+
+      loop
+         exit when No (Result);
+
+         case Nkind (Result) is
+            when N_Package_Specification =>
+               Result := Defining_Unit_Name (Result);
+               exit;
+
+            when N_Package_Body =>
+               Result := Defining_Unit_Name (Result);
+               exit;
+
+            when N_Subprogram_Specification =>
+               Result := Defining_Unit_Name (Result);
+               exit;
+
+            when N_Subprogram_Declaration =>
+               Result := Defining_Unit_Name (Specification (Result));
+               exit;
+
+            when N_Subprogram_Body =>
+               Result := Defining_Unit_Name (Specification (Result));
+               exit;
+
+            --  The enclosing subprogram for a pre- or postconditions should be
+            --  the subprogram to which the pragma is attached. This is not
+            --  always the case in the AST, as the pragma may be declared after
+            --  the declaration of the subprogram. Return Empty in this case.
+
+            when N_Pragma =>
+               if Get_Pragma_Id (Result) = Pragma_Precondition
+                    or else
+                  Get_Pragma_Id (Result) = Pragma_Postcondition
+               then
+                  return Empty;
+               else
+                  Result := Parent (Result);
+               end if;
+
+            when others =>
+               Result := Parent (Result);
+         end case;
+      end loop;
+
+      if Nkind (Result) = N_Defining_Program_Unit_Name then
+         Result := Defining_Identifier (Result);
+      end if;
+
+      --  Do no return a scope without a proper location
+
+      if Present (Result)
+        and then Sloc (Result) = No_Location
+      then
+         return Empty;
+      end if;
+
+      return Result;
+   end Enclosing_Subprogram_Or_Package;
+
    -----------------
    -- Entity_Hash --
    -----------------
@@ -897,6 +1024,47 @@ package body ALFA is
         Entity_Hashed_Range (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1));
    end Entity_Hash;
 
+   --------------------------
+   -- Generate_Dereference --
+   --------------------------
+
+   procedure Generate_Dereference
+     (N   : Node_Id;
+      Typ : Character := 'r')
+   is
+      Indx      : Nat;
+      Ref       : Source_Ptr;
+      Ref_Scope : Entity_Id;
+
+   begin
+      Ref := Original_Location (Sloc (N));
+
+      if Ref > No_Location then
+         Drefs.Increment_Last;
+         Indx := Drefs.Last;
+
+         Ref_Scope := Enclosing_Subprogram_Or_Package (N);
+
+         --  Entity is filled later on with the special "HEAP" variable
+
+         Drefs.Table (Indx).Ent := Empty;
+
+         Drefs.Table (Indx).Def := No_Location;
+         Drefs.Table (Indx).Loc := Ref;
+         Drefs.Table (Indx).Typ := Typ;
+
+         --  It is as if the special "HEAP" was defined in every scope where it
+         --  is referenced.
+
+         Drefs.Table (Indx).Eun := Get_Source_Unit (Ref);
+         Drefs.Table (Indx).Lun := Get_Source_Unit (Ref);
+
+         Drefs.Table (Indx).Ref_Scope := Ref_Scope;
+         Drefs.Table (Indx).Ent_Scope := Ref_Scope;
+         Drefs.Table (Indx).Ent_Scope_File := Get_Source_Unit (Ref_Scope);
+      end if;
+   end Generate_Dereference;
+
    ------------------------------------
    -- Traverse_All_Compilation_Units --
    ------------------------------------
@@ -904,7 +1072,7 @@ package body ALFA is
    procedure Traverse_All_Compilation_Units (Process : Node_Processing) is
    begin
       for U in Units.First .. Last_Unit loop
-         Traverse_Compilation_Unit (Cunit (U), Process);
+         Traverse_Compilation_Unit (Cunit (U), Process, Inside_Stubs => False);
       end loop;
    end Traverse_All_Compilation_Units;
 
@@ -913,8 +1081,9 @@ package body ALFA is
    -------------------------------
 
    procedure Traverse_Compilation_Unit
-     (CU      : Node_Id;
-      Process : Node_Processing)
+     (CU           : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean)
    is
       Lu : Node_Id;
 
@@ -938,16 +1107,16 @@ package body ALFA is
       --  Traverse the unit
 
       if Nkind (Lu) = N_Subprogram_Body then
-         Traverse_Subprogram_Body (Lu, Process);
+         Traverse_Subprogram_Body (Lu, Process, Inside_Stubs);
 
       elsif Nkind (Lu) = N_Subprogram_Declaration then
          null;
 
       elsif Nkind (Lu) = N_Package_Declaration then
-         Traverse_Package_Declaration (Lu, Process);
+         Traverse_Package_Declaration (Lu, Process, Inside_Stubs);
 
       elsif Nkind (Lu) = N_Package_Body then
-         Traverse_Package_Body (Lu, Process);
+         Traverse_Package_Body (Lu, Process, Inside_Stubs);
 
       --  ??? TBD
 
@@ -972,8 +1141,9 @@ package body ALFA is
    -----------------------------------------
 
    procedure Traverse_Declarations_Or_Statements
-     (L       : List_Id;
-      Process : Node_Processing)
+     (L            : List_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean)
    is
       N : Node_Id;
 
@@ -996,7 +1166,7 @@ package body ALFA is
             --  Package declaration
 
             when N_Package_Declaration =>
-               Traverse_Package_Declaration (N, Process);
+               Traverse_Package_Declaration (N, Process, Inside_Stubs);
 
             --  Generic package declaration ??? TBD
 
@@ -1007,7 +1177,21 @@ package body ALFA is
 
             when N_Package_Body =>
                if Ekind (Defining_Entity (N)) /= E_Generic_Package then
-                  Traverse_Package_Body (N, Process);
+                  Traverse_Package_Body (N, Process, Inside_Stubs);
+               end if;
+
+            when N_Package_Body_Stub =>
+               if Present (Library_Unit (N)) then
+                  declare
+                     Body_N : constant Node_Id := Get_Body_From_Stub (N);
+                  begin
+                     if Inside_Stubs
+                       and then
+                         Ekind (Defining_Entity (Body_N)) /= E_Generic_Package
+                     then
+                        Traverse_Package_Body (Body_N, Process, Inside_Stubs);
+                     end if;
+                  end;
                end if;
 
             --  Subprogram declaration
@@ -1024,22 +1208,38 @@ package body ALFA is
 
             when N_Subprogram_Body =>
                if not Is_Generic_Subprogram (Defining_Entity (N)) then
-                  Traverse_Subprogram_Body (N, Process);
+                  Traverse_Subprogram_Body (N, Process, Inside_Stubs);
+               end if;
+
+            when N_Subprogram_Body_Stub =>
+               if Present (Library_Unit (N)) then
+                  declare
+                     Body_N : constant Node_Id := Get_Body_From_Stub (N);
+                  begin
+                     if Inside_Stubs
+                       and then
+                         not Is_Generic_Subprogram (Defining_Entity (Body_N))
+                     then
+                        Traverse_Subprogram_Body
+                          (Body_N, Process, Inside_Stubs);
+                     end if;
+                  end;
                end if;
 
             --  Block statement
 
             when N_Block_Statement =>
-               Traverse_Declarations_Or_Statements (Declarations (N), Process);
+               Traverse_Declarations_Or_Statements
+                 (Declarations (N), Process, Inside_Stubs);
                Traverse_Handled_Statement_Sequence
-                 (Handled_Statement_Sequence (N), Process);
+                 (Handled_Statement_Sequence (N), Process, Inside_Stubs);
 
             when N_If_Statement =>
 
                --  Traverse the statements in the THEN part
 
                Traverse_Declarations_Or_Statements
-                 (Then_Statements (N), Process);
+                 (Then_Statements (N), Process, Inside_Stubs);
 
                --  Loop through ELSIF parts if present
 
@@ -1050,7 +1250,7 @@ package body ALFA is
                   begin
                      while Present (Elif) loop
                         Traverse_Declarations_Or_Statements
-                          (Then_Statements (Elif), Process);
+                          (Then_Statements (Elif), Process, Inside_Stubs);
                         Next (Elif);
                      end loop;
                   end;
@@ -1059,7 +1259,7 @@ package body ALFA is
                --  Finally traverse the ELSE statements if present
 
                Traverse_Declarations_Or_Statements
-                 (Else_Statements (N), Process);
+                 (Else_Statements (N), Process, Inside_Stubs);
 
             --  Case statement
 
@@ -1073,7 +1273,7 @@ package body ALFA is
                   Alt := First (Alternatives (N));
                   while Present (Alt) loop
                      Traverse_Declarations_Or_Statements
-                       (Statements (Alt), Process);
+                       (Statements (Alt), Process, Inside_Stubs);
                      Next (Alt);
                   end loop;
                end;
@@ -1082,12 +1282,13 @@ package body ALFA is
 
             when N_Extended_Return_Statement =>
                Traverse_Handled_Statement_Sequence
-                 (Handled_Statement_Sequence (N), Process);
+                 (Handled_Statement_Sequence (N), Process, Inside_Stubs);
 
             --  Loop
 
             when N_Loop_Statement =>
-               Traverse_Declarations_Or_Statements (Statements (N), Process);
+               Traverse_Declarations_Or_Statements
+                 (Statements (N), Process, Inside_Stubs);
 
             when others =>
                null;
@@ -1102,20 +1303,22 @@ package body ALFA is
    -----------------------------------------
 
    procedure Traverse_Handled_Statement_Sequence
-     (N       : Node_Id;
-      Process : Node_Processing)
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean)
    is
       Handler : Node_Id;
 
    begin
       if Present (N) then
-         Traverse_Declarations_Or_Statements (Statements (N), Process);
+         Traverse_Declarations_Or_Statements
+           (Statements (N), Process, Inside_Stubs);
 
          if Present (Exception_Handlers (N)) then
             Handler := First (Exception_Handlers (N));
             while Present (Handler) loop
                Traverse_Declarations_Or_Statements
-                 (Statements (Handler), Process);
+                 (Statements (Handler), Process, Inside_Stubs);
                Next (Handler);
             end loop;
          end if;
@@ -1127,12 +1330,14 @@ package body ALFA is
    ---------------------------
 
    procedure Traverse_Package_Body
-     (N       : Node_Id;
-      Process : Node_Processing) is
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean) is
    begin
-      Traverse_Declarations_Or_Statements (Declarations (N), Process);
+      Traverse_Declarations_Or_Statements
+        (Declarations (N), Process, Inside_Stubs);
       Traverse_Handled_Statement_Sequence
-        (Handled_Statement_Sequence (N), Process);
+        (Handled_Statement_Sequence (N), Process, Inside_Stubs);
    end Traverse_Package_Body;
 
    ----------------------------------
@@ -1140,15 +1345,16 @@ package body ALFA is
    ----------------------------------
 
    procedure Traverse_Package_Declaration
-     (N       : Node_Id;
-      Process : Node_Processing)
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean)
    is
       Spec : constant Node_Id := Specification (N);
    begin
       Traverse_Declarations_Or_Statements
-        (Visible_Declarations (Spec), Process);
+        (Visible_Declarations (Spec), Process, Inside_Stubs);
       Traverse_Declarations_Or_Statements
-        (Private_Declarations (Spec), Process);
+        (Private_Declarations (Spec), Process, Inside_Stubs);
    end Traverse_Package_Declaration;
 
    ------------------------------
@@ -1156,12 +1362,14 @@ package body ALFA is
    ------------------------------
 
    procedure Traverse_Subprogram_Body
-     (N       : Node_Id;
-      Process : Node_Processing) is
+     (N            : Node_Id;
+      Process      : Node_Processing;
+      Inside_Stubs : Boolean) is
    begin
-      Traverse_Declarations_Or_Statements (Declarations (N), Process);
+      Traverse_Declarations_Or_Statements
+        (Declarations (N), Process, Inside_Stubs);
       Traverse_Handled_Statement_Sequence
-        (Handled_Statement_Sequence (N), Process);
+        (Handled_Statement_Sequence (N), Process, Inside_Stubs);
    end Traverse_Subprogram_Body;
 
 end ALFA;
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index b50327304d2..b280ce5d4a7 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -112,9 +112,6 @@ package body Lib.Xref is
    --  Local Subprograms --
    ------------------------
 
-   function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id;
-   --  Return the closest enclosing subprogram of package
-
    procedure Generate_Prim_Op_References (Typ : Entity_Id);
    --  For a tagged type, generate implicit references to its primitive
    --  operations, for source navigation. This is done right before emitting
@@ -124,84 +121,6 @@ package body Lib.Xref is
    function Lt (T1, T2 : Xref_Entry) return Boolean;
    --  Order cross-references
 
-   -------------------------------------
-   -- Enclosing_Subprogram_Or_Package --
-   -------------------------------------
-
-   function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id is
-      Result : Entity_Id;
-
-   begin
-      --  If N is the defining identifier for a subprogram, then return the
-      --  enclosing subprogram or package, not this subprogram.
-
-      if Nkind_In (N, N_Defining_Identifier, N_Defining_Operator_Symbol)
-        and then Nkind (Parent (N)) in N_Subprogram_Specification
-      then
-         Result := Parent (Parent (Parent (N)));
-      else
-         Result := N;
-      end if;
-
-      loop
-         exit when No (Result);
-
-         case Nkind (Result) is
-            when N_Package_Specification =>
-               Result := Defining_Unit_Name (Result);
-               exit;
-
-            when N_Package_Body =>
-               Result := Defining_Unit_Name (Result);
-               exit;
-
-            when N_Subprogram_Specification =>
-               Result := Defining_Unit_Name (Result);
-               exit;
-
-            when N_Subprogram_Declaration =>
-               Result := Defining_Unit_Name (Specification (Result));
-               exit;
-
-            when N_Subprogram_Body =>
-               Result := Defining_Unit_Name (Specification (Result));
-               exit;
-
-            --  The enclosing subprogram for a pre- or postconditions should be
-            --  the subprogram to which the pragma is attached. This is not
-            --  always the case in the AST, as the pragma may be declared after
-            --  the declaration of the subprogram. Return Empty in this case.
-
-            when N_Pragma =>
-               if Get_Pragma_Id (Result) = Pragma_Precondition
-                    or else
-                  Get_Pragma_Id (Result) = Pragma_Postcondition
-               then
-                  return Empty;
-               else
-                  Result := Parent (Result);
-               end if;
-
-            when others =>
-               Result := Parent (Result);
-         end case;
-      end loop;
-
-      if Nkind (Result) = N_Defining_Program_Unit_Name then
-         Result := Defining_Identifier (Result);
-      end if;
-
-      --  Do no return a scope without a proper location
-
-      if Present (Result)
-        and then Sloc (Result) = No_Location
-      then
-         return Empty;
-      end if;
-
-      return Result;
-   end Enclosing_Subprogram_Or_Package;
-
    -------------------------
    -- Generate_Definition --
    -------------------------
@@ -946,8 +865,8 @@ package body Lib.Xref is
          Ref := Original_Location (Sloc (Nod));
          Def := Original_Location (Sloc (Ent));
 
-         Ref_Scope := Enclosing_Subprogram_Or_Package (N);
-         Ent_Scope := Enclosing_Subprogram_Or_Package (Ent);
+         Ref_Scope := ALFA.Enclosing_Subprogram_Or_Package (N);
+         Ent_Scope := ALFA.Enclosing_Subprogram_Or_Package (Ent);
 
          Xrefs.Increment_Last;
          Indx := Xrefs.Last;
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index ecee22a3377..e8a4f3940a5 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -590,11 +590,22 @@ package Lib.Xref is
 
    package ALFA is
 
+      function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id;
+      --  Return the closest enclosing subprogram of package
+
+      procedure Generate_Dereference
+        (N   : Node_Id;
+         Typ : Character := 'r');
+      --  This procedure is called to record a dereference. N is the location
+      --  of the dereference.
+
       type Node_Processing is access procedure (N : Node_Id);
 
       procedure Traverse_Compilation_Unit
-        (CU      : Node_Id;
-         Process : Node_Processing);
+        (CU           : Node_Id;
+         Process      : Node_Processing;
+         Inside_Stubs : Boolean);
+      --  This procedure is undocumented ???
 
       procedure Traverse_All_Compilation_Units (Process : Node_Processing);
       --  Call Process on all declarations through all compilation units
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index a383d7c0fa7..c7e1d070d0f 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -5908,7 +5908,7 @@ package body Make is
          --  are not supposed to change.
 
          Osint.Source_File_Data (Cache => True);
-         Osint.Add_Default_Search_Dirs;
+
          Queue_Library_Project_Sources;
       end if;
 
@@ -5931,40 +5931,6 @@ package body Make is
            ("nothing to do for a main project that is externally built");
       end if;
 
-      --  Get the target parameters, which are only needed for a couple of
-      --  cases in gnatmake. Protect against an exception, such as the case of
-      --  system.ads missing from the library, and fail gracefully.
-
-      begin
-         Targparm.Get_Target_Parameters;
-      exception
-         when Unrecoverable_Error =>
-            Make_Failed ("*** make failed.");
-      end;
-
-      --  Special processing for VM targets
-
-      if Targparm.VM_Target /= No_VM then
-
-         --  Set proper processing commands
-
-         case Targparm.VM_Target is
-            when Targparm.JVM_Target =>
-
-               --  Do not check for an object file (".o") when compiling to
-               --  JVM machine since ".class" files are generated instead.
-
-               Check_Object_Consistency := False;
-               Gcc := new String'("jvm-gnatcompile");
-
-            when Targparm.CLI_Target =>
-               Gcc := new String'("dotnet-gnatcompile");
-
-            when Targparm.No_VM =>
-               raise Program_Error;
-         end case;
-      end if;
-
       --  If no project file is used, we just put the gcc switches
       --  from the command line in the Gcc_Switches table.
 
@@ -6011,54 +5977,6 @@ package body Make is
       Gnatbind_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
       Gnatlink_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
 
-      --  If we have specified -j switch both from the project file
-      --  and on the command line, the one from the command line takes
-      --  precedence.
-
-      if Saved_Maximum_Processes = 0 then
-         Saved_Maximum_Processes := Maximum_Processes;
-      end if;
-
-      if Debug.Debug_Flag_M then
-         Write_Line ("Maximum number of simultaneous compilations =" &
-                     Saved_Maximum_Processes'Img);
-      end if;
-
-      --  Allocate as many temporary mapping file names as the maximum number
-      --  of compilations processed, for each possible project.
-
-      declare
-         Data : Project_Compilation_Access;
-         Proj : Project_List;
-
-      begin
-         Proj := Project_Tree.Projects;
-         while Proj /= null loop
-            Data := new Project_Compilation_Data'
-              (Mapping_File_Names        => new Temp_Path_Names
-                                              (1 .. Saved_Maximum_Processes),
-               Last_Mapping_File_Names   => 0,
-               Free_Mapping_File_Indexes => new Free_File_Indexes
-                                              (1 .. Saved_Maximum_Processes),
-               Last_Free_Indexes         => 0);
-
-            Project_Compilation_Htable.Set
-              (Project_Compilation, Proj.Project, Data);
-            Proj := Proj.Next;
-         end loop;
-
-         Data := new Project_Compilation_Data'
-           (Mapping_File_Names        => new Temp_Path_Names
-                                           (1 .. Saved_Maximum_Processes),
-            Last_Mapping_File_Names   => 0,
-            Free_Mapping_File_Indexes => new Free_File_Indexes
-                                           (1 .. Saved_Maximum_Processes),
-            Last_Free_Indexes         => 0);
-
-         Project_Compilation_Htable.Set
-           (Project_Compilation, No_Project, Data);
-      end;
-
       Bad_Compilation.Init;
 
       --  If project files are used, create the mapping of all the sources, so
@@ -6116,7 +6034,101 @@ package body Make is
             Compute_Builder  => Is_First_Main,
             Current_Work_Dir => Current_Work_Dir.all);
 
-         Is_First_Main := False;
+         if Is_First_Main then
+
+            --  Put the default source dirs in the source path only now, so
+            --  that we take the correct ones in the case where --RTS= is
+            --  specified in the Builder switches.
+
+            Osint.Add_Default_Search_Dirs;
+
+            --  Get the target parameters, which are only needed for a couple
+            --  of cases in gnatmake. Protect against an exception, such as the
+            --  case of system.ads missing from the library, and fail
+            --  gracefully.
+
+            begin
+               Targparm.Get_Target_Parameters;
+            exception
+               when Unrecoverable_Error =>
+                  Make_Failed ("*** make failed.");
+            end;
+
+            --  Special processing for VM targets
+
+            if Targparm.VM_Target /= No_VM then
+
+               --  Set proper processing commands
+
+               case Targparm.VM_Target is
+                  when Targparm.JVM_Target =>
+
+                     --  Do not check for an object file (".o") when compiling
+                     --  to JVM machine since ".class" files are generated
+                     --  instead.
+
+                     Check_Object_Consistency := False;
+                     Gcc := new String'("jvm-gnatcompile");
+
+                  when Targparm.CLI_Target =>
+                     Gcc := new String'("dotnet-gnatcompile");
+
+                  when Targparm.No_VM =>
+                     raise Program_Error;
+               end case;
+            end if;
+
+            --  If we have specified -j switch both from the project file
+            --  and on the command line, the one from the command line takes
+            --  precedence.
+
+            if Saved_Maximum_Processes = 0 then
+               Saved_Maximum_Processes := Maximum_Processes;
+            end if;
+
+            if Debug.Debug_Flag_M then
+               Write_Line ("Maximum number of simultaneous compilations =" &
+                           Saved_Maximum_Processes'Img);
+            end if;
+
+            --  Allocate as many temporary mapping file names as the maximum
+            --  number of compilations processed, for each possible project.
+
+            declare
+               Data : Project_Compilation_Access;
+               Proj : Project_List;
+
+            begin
+               Proj := Project_Tree.Projects;
+               while Proj /= null loop
+                  Data := new Project_Compilation_Data'
+                    (Mapping_File_Names        => new Temp_Path_Names
+                       (1 .. Saved_Maximum_Processes),
+                     Last_Mapping_File_Names   => 0,
+                     Free_Mapping_File_Indexes => new Free_File_Indexes
+                       (1 .. Saved_Maximum_Processes),
+                     Last_Free_Indexes         => 0);
+
+                  Project_Compilation_Htable.Set
+                    (Project_Compilation, Proj.Project, Data);
+                  Proj := Proj.Next;
+               end loop;
+
+               Data := new Project_Compilation_Data'
+                 (Mapping_File_Names        => new Temp_Path_Names
+                    (1 .. Saved_Maximum_Processes),
+                  Last_Mapping_File_Names   => 0,
+                  Free_Mapping_File_Indexes => new Free_File_Indexes
+                    (1 .. Saved_Maximum_Processes),
+                  Last_Free_Indexes         => 0);
+
+               Project_Compilation_Htable.Set
+                 (Project_Compilation, No_Project, Data);
+            end;
+
+            Is_First_Main := False;
+         end if;
+
          Executable_Obsolete := False;
 
          Compute_Executable
@@ -6609,7 +6621,7 @@ package body Make is
          Add_Object_Directories (Main_Project, Project_Tree);
 
          Recursive_Compute_Depth (Main_Project);
-         Compute_All_Imported_Projects (Project_Tree);
+         Compute_All_Imported_Projects (Main_Project, Project_Tree);
 
       else
 
@@ -7361,15 +7373,15 @@ package body Make is
 
          end if;
 
-      --  Then check if we are dealing with -cargs/-bargs/-largs/-margs
+      --  Then check if we are dealing with -cargs/-bargs/-largs/-margs. These
+      --  options are taken as is when found in package Compiler, Binder or
+      --  Linker of the main project file.
 
-      elsif Argv = "-bargs"
-              or else
-            Argv = "-cargs"
-              or else
-            Argv = "-largs"
-              or else
-            Argv = "-margs"
+      elsif (And_Save or else Program_Args = None)
+        and then (Argv = "-bargs" or else
+                  Argv = "-cargs" or else
+                  Argv = "-largs" or else
+                  Argv = "-margs")
       then
          case Argv (2) is
             when 'c' => Program_Args := Compiler;
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 0286267dcc2..848db592a1a 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -32,12 +32,11 @@ with Hostparm;
 with Osint;    use Osint;
 with Output;   use Output;
 with Opt;      use Opt;
+with Prj.Com;
 with Prj.Err;
 with Prj.Ext;
 with Prj.Util; use Prj.Util;
 with Sinput.P;
-with Snames;   use Snames;
-with Table;
 with Tempdir;
 
 with Ada.Command_Line;           use Ada.Command_Line;
@@ -681,6 +680,118 @@ package body Makeutl is
       return False;
    end File_Not_A_Source_Of;
 
+   ---------------------
+   -- Get_Directories --
+   ---------------------
+
+   procedure Get_Directories
+     (Project_Tree : Project_Tree_Ref;
+      For_Project  : Project_Id;
+      Activity     : Activity_Type;
+      Languages    : Name_Ids)
+   is
+
+      procedure Recursive_Add
+        (Project  : Project_Id;
+         Tree     : Project_Tree_Ref;
+         Extended : in out Boolean);
+      --  Add all the source directories of a project to the path only if
+      --  this project has not been visited. Calls itself recursively for
+      --  projects being extended, and imported projects.
+
+      procedure Add_Dir (Value : Path_Name_Type);
+      --  Add directory Value in table Directories, if it is defined and not
+      --  already there.
+
+      -------------
+      -- Add_Dir --
+      -------------
+
+      procedure Add_Dir (Value : Path_Name_Type) is
+         Add_It : Boolean := True;
+
+      begin
+         if Value /= No_Path then
+            for Index in 1 .. Directories.Last loop
+               if Directories.Table (Index) = Value then
+                  Add_It := False;
+                  exit;
+               end if;
+            end loop;
+
+            if Add_It then
+               Directories.Increment_Last;
+               Directories.Table (Directories.Last) := Value;
+            end if;
+         end if;
+      end Add_Dir;
+
+      -------------------
+      -- Recursive_Add --
+      -------------------
+
+      procedure Recursive_Add
+        (Project  : Project_Id;
+         Tree     : Project_Tree_Ref;
+         Extended : in out Boolean)
+      is
+         Current   : String_List_Id;
+         Dir       : String_Element;
+         OK        : Boolean := False;
+         Lang_Proc : Language_Ptr := Project.Languages;
+      begin
+         --  Add to path all directories of this project
+
+         if Activity = Compilation then
+            Lang_Loop :
+            while Lang_Proc /= No_Language_Index loop
+               for J in Languages'Range loop
+                  OK := Lang_Proc.Name = Languages (J);
+                  exit Lang_Loop when OK;
+               end loop;
+
+               Lang_Proc := Lang_Proc.Next;
+            end loop Lang_Loop;
+
+            if OK then
+               Current := Project.Source_Dirs;
+
+               while Current /= Nil_String loop
+                  Dir := Tree.Shared.String_Elements.Table (Current);
+                  Add_Dir (Path_Name_Type (Dir.Value));
+                  Current := Dir.Next;
+               end loop;
+            end if;
+
+         elsif Project.Library then
+            if Activity = SAL_Binding and then Extended then
+               Add_Dir (Project.Object_Directory.Display_Name);
+
+            else
+               Add_Dir (Project.Library_ALI_Dir.Display_Name);
+            end if;
+
+         else
+            Add_Dir (Project.Object_Directory.Display_Name);
+         end if;
+
+         if Project.Extends = No_Project then
+            Extended := False;
+         end if;
+      end Recursive_Add;
+
+      procedure For_All_Projects is
+        new For_Every_Project_Imported (Boolean, Recursive_Add);
+
+      Extended : Boolean := True;
+
+      --  Start of processing for Get_Directories
+
+   begin
+      Directories.Init;
+      For_All_Projects (For_Project, Project_Tree, Extended);
+   end Get_Directories;
+
    ------------------
    -- Get_Switches --
    ------------------
@@ -1449,13 +1560,22 @@ package body Makeutl is
 
                         if Is_Absolute_Path (Main) then
                            Main_Id := Create_Name (Base);
+
+                        --  Not an absolute path
+
                         else
+                           --  Always resolve links here, so that users can be
+                           --  specify any name on the command line. If the
+                           --  project itself uses links, the user will be
+                           --  using -eL anyway, and thus files are also stored
+                           --  with resolved names.
+
                            declare
                               Absolute : constant String :=
                                            Normalize_Pathname
                                              (Name           => Main,
                                               Directory      => "",
-                                              Resolve_Links  => False,
+                                              Resolve_Links  => True,
                                               Case_Sensitive => False);
                            begin
                               File.File := Create_Name (Absolute);
@@ -3208,4 +3328,33 @@ package body Makeutl is
       end if;
    end Compute_Builder_Switches;
 
+   ---------------------
+   -- Write_Path_File --
+   ---------------------
+
+   procedure Write_Path_File (FD : File_Descriptor) is
+      Last   : Natural;
+      Status : Boolean;
+
+   begin
+      Name_Len := 0;
+
+      for Index in Directories.First .. Directories.Last loop
+         Add_Str_To_Name_Buffer (Get_Name_String (Directories.Table (Index)));
+         Add_Char_To_Name_Buffer (ASCII.LF);
+      end loop;
+
+      Last := Write (FD, Name_Buffer (1)'Address, Name_Len);
+
+      if Last = Name_Len then
+         Close (FD, Status);
+      else
+         Status := False;
+      end if;
+
+      if not Status then
+         Prj.Com.Fail ("could not write temporary file");
+      end if;
+   end Write_Path_File;
+
 end Makeutl;
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index f3ac998b6ae..ceb38bdf39f 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -33,6 +33,8 @@ with Opt;
 with Osint;
 with Prj;      use Prj;
 with Prj.Tree;
+with Snames;   use Snames;
+with Table;
 with Types;    use Types;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
@@ -65,6 +67,16 @@ package Makeutl is
    Create_Map_File_Switch : constant String := "--create-map-file";
    --  Switch to create a map file when an executable is linked
 
+   package Directories is new Table.Table
+     (Table_Component_Type => Path_Name_Type,
+      Table_Index_Type     => Integer,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 200,
+      Table_Increment      => 100,
+      Table_Name           => "Makegpr.Directories");
+   --  Table of all the source or object directories, filled up by
+   --  Get_Directories.
+
    procedure Add
      (Option : String_Access;
       To     : in out String_List_Access;
@@ -159,6 +171,31 @@ package Makeutl is
    --  is printed last. Both N1 and N2 are printed in quotation marks. The two
    --  forms differ only in taking Name_Id or File_name_Type arguments.
 
+   type Name_Ids is array (Positive range <>) of Name_Id;
+   No_Names : constant Name_Ids := (1 .. 0 => No_Name);
+   --  Name_Ids is used for list of language names in procedure Get_Directories
+   --  below.
+
+   Ada_Only : constant Name_Ids := (1 => Name_Ada);
+   --  Used to invoke Get_Directories in gnatmake
+
+   type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
+
+   procedure Get_Directories
+     (Project_Tree : Project_Tree_Ref;
+      For_Project  : Project_Id;
+      Activity     : Activity_Type;
+      Languages    : Name_Ids);
+   --  Put in table Directories the source (when Sources is True) or
+   --  object/library (when Sources is False) directories of project
+   --  For_Project and of all the project it imports directly or indirectly.
+   --  The source directories of imported projects are only included if one
+   --  of the declared languages is in the list Languages.
+
+   procedure Write_Path_File (FD : File_Descriptor);
+   --  Write in the specified open path file the directories in table
+   --  Directories, then closed the path file.
+
    procedure Get_Switches
      (Source       : Source_Id;
       Pkg_Name     : Name_Id;
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 9ac12e74061..9020705d49b 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -25,6 +25,7 @@
 
 with ALI;      use ALI;
 with Gnatvsn;  use Gnatvsn;
+with Makeutl;  use Makeutl;
 with MLib.Fil; use MLib.Fil;
 with MLib.Tgt; use MLib.Tgt;
 with MLib.Utl; use MLib.Utl;
@@ -802,6 +803,9 @@ package body MLib.Prj is
          end loop;
       end Process_Imported_Libraries;
 
+      Path_FD : File_Descriptor := Invalid_FD;
+      --  Used for setting the source and object paths
+
    --  Start of processing for Build_Library
 
    begin
@@ -1044,10 +1048,54 @@ package body MLib.Prj is
 
             --  Set the paths
 
-            Set_Ada_Paths
-              (Project             => For_Project,
-               In_Tree             => In_Tree,
-               Including_Libraries => True);
+            --  First the source path
+
+            if For_Project.Include_Path_File = No_Path then
+               Get_Directories
+                 (Project_Tree => In_Tree,
+                  For_Project  => For_Project,
+                  Activity     => Compilation,
+                  Languages    => Ada_Only);
+
+               Create_New_Path_File
+                 (In_Tree.Shared, Path_FD, For_Project.Include_Path_File);
+
+               Write_Path_File (Path_FD);
+               Path_FD := Invalid_FD;
+            end if;
+
+            if Current_Source_Path_File_Of (In_Tree.Shared) /=
+                                                For_Project.Include_Path_File
+            then
+               Set_Current_Source_Path_File_Of
+                 (In_Tree.Shared, For_Project.Include_Path_File);
+               Set_Path_File_Var
+                 (Project_Include_Path_File,
+                  Get_Name_String (For_Project.Include_Path_File));
+            end if;
+
+            --  Then, the object path
+
+            Get_Directories
+              (Project_Tree => In_Tree,
+               For_Project  => For_Project,
+               Activity     => SAL_Binding,
+               Languages    => Ada_Only);
+
+            declare
+               Path_File_Name : Path_Name_Type;
+
+            begin
+               Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
+
+               Write_Path_File (Path_FD);
+               Path_FD := Invalid_FD;
+
+               Set_Path_File_Var
+                 (Project_Objects_Path_File, Get_Name_String (Path_File_Name));
+               Set_Current_Source_Path_File_Of
+                 (In_Tree.Shared, Path_File_Name);
+            end;
 
             --  Display the gnatbind command, if not in quiet output
 
@@ -1066,9 +1114,9 @@ package body MLib.Prj is
                   Arguments (1 .. Argument_Number),
                   Success);
 
-            else
-               --  Otherwise create a temporary response file
+            --  Otherwise create a temporary response file
 
+            else
                declare
                   FD            : File_Descriptor;
                   Path          : Path_Name_Type;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index a9c2d9f7570..96c868a9992 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -537,8 +537,8 @@ package Opt is
                            Front_End_Setjmp_Longjmp_Exceptions;
    --  GNAT
    --  Set to the appropriate value depending on the default as given in
-   --  system.ads (ZCX_By_Default, GCC_ZCX_Support). The C convention is there
-   --  to make this variable accessible to gigi.
+   --  system.ads (ZCX_By_Default). The C convention is there to make this
+   --  variable accessible to gigi.
 
    Exception_Tracebacks : Boolean := False;
    --  GNATBIND
@@ -1877,7 +1877,7 @@ package Opt is
    ALFA_Mode : Boolean := False;
    --  Specific compiling mode targeting formal verification through the
    --  generation of Why code for those parts of the input code that belong to
-   --  the ALFA subset of Ada. Set by debuf flag -gnatd.F.
+   --  the ALFA subset of Ada. Set by debug flag -gnatd.F.
 
 private
 
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 49962d8c515..b8b760cce4e 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -531,10 +531,39 @@ package body Ch12 is
            (Decl_Node, P_Known_Discriminant_Part_Opt);
       end if;
 
-      T_Is;
+      if Token = Tok_Semicolon then
+
+         --  Ada 2012: Incomplete formal type
+
+         Scan; -- past semicolon
+
+         if Ada_Version < Ada_2012 then
+            Error_Msg_N
+              ("`formal incomplete type` is an Ada 2012 feature", Decl_Node);
+            Error_Msg_N
+              ("\unit must be compiled with -gnat2012 switch", Decl_Node);
+         end if;
+
+         Set_Formal_Type_Definition
+           (Decl_Node,
+            New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr));
+         return Decl_Node;
+
+      else
+         T_Is;
+      end if;
 
       Def_Node := P_Formal_Type_Definition;
 
+      if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition
+        and then Ada_Version < Ada_2012
+      then
+         Error_Msg_N
+           ("`formal incomplete type` is an Ada 2012 feature", Decl_Node);
+         Error_Msg_N
+           ("\unit must be compiled with -gnat2012 switch", Decl_Node);
+      end if;
+
       if Def_Node /= Error then
          Set_Formal_Type_Definition (Decl_Node, Def_Node);
          P_Aspect_Specifications (Decl_Node);
@@ -563,6 +592,7 @@ package body Ch12 is
 
    --  FORMAL_TYPE_DEFINITION ::=
    --    FORMAL_PRIVATE_TYPE_DEFINITION
+   --  | FORMAL_INCOMPLETE_TYPE_DEFINITION
    --  | FORMAL_DERIVED_TYPE_DEFINITION
    --  | FORMAL_DISCRETE_TYPE_DEFINITION
    --  | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION
@@ -704,10 +734,22 @@ package body Ch12 is
                return Error;
             end if;
 
-         when Tok_Private |
-              Tok_Tagged  =>
+         when Tok_Private  =>
             return P_Formal_Private_Type_Definition;
 
+         when  Tok_Tagged  =>
+            if Next_Token_Is (Tok_Semicolon) then
+               Typedef_Node :=
+                 New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr);
+               Set_Tagged_Present (Typedef_Node);
+
+               Scan;  --  past tagged
+               return Typedef_Node;
+
+            else
+               return P_Formal_Private_Type_Definition;
+            end if;
+
          when Tok_Range =>
             return P_Formal_Signed_Integer_Type_Definition;
 
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 4892c8cc807..67d52f67907 100644
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -76,6 +76,16 @@ package body Ch2 is
             end if;
          end if;
 
+         --  Similarly, warn about Ada 2012 reserved words
+
+         if Ada_Version in Ada_95 .. Ada_2005
+           and then Warn_On_Ada_2012_Compatibility
+         then
+            if Token_Name = Name_Some then
+               Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
+            end if;
+         end if;
+
          Ident_Node := Token_Node;
          Scan; -- past Identifier
          return Ident_Node;
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 0d62eb8b0fa..897b8c96b4e 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -229,6 +229,16 @@ package body Ch3 is
             end if;
          end if;
 
+         --  Similarly, warn about Ada 2012 reserved words
+
+         if Ada_Version in Ada_95 .. Ada_2005
+           and then Warn_On_Ada_2012_Compatibility
+         then
+            if Token_Name = Name_Some then
+               Error_Msg_N ("& is a reserved word in Ada 2012?", Token_Node);
+            end if;
+         end if;
+
       --  If we have a reserved identifier, manufacture an identifier with
       --  a corresponding name after posting an appropriate error message
 
@@ -1073,7 +1083,11 @@ package body Ch3 is
    begin
       Constr_Node := P_Constraint_Opt;
 
-      if No (Constr_Node) then
+      if No (Constr_Node)
+        or else
+          (Nkind (Constr_Node) = N_Range_Constraint
+             and then Nkind (Range_Expression (Constr_Node)) = N_Error)
+      then
          return Subtype_Mark;
       else
          if Not_Null_Present then
@@ -1125,16 +1139,6 @@ package body Ch3 is
          Discard_Junk_Node (P_Array_Type_Definition);
          return Error;
 
-      --  If Some becomes a keyword, the following is needed to make it
-      --  acceptable in older versions of Ada.
-
-      elsif Token = Tok_Some
-        and then Ada_Version < Ada_2012
-      then
-         Scan_Reserved_Identifier (False);
-         Scan;
-         return Token_Node;
-
       else
          Type_Node := P_Qualified_Simple_Name_Resync;
 
@@ -2668,9 +2672,12 @@ package body Ch3 is
             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
          end if;
 
-         if Aliased_Present then
-            Error_Msg_SP ("ALIASED not allowed here");
-         end if;
+         --  AI95-406 makes "aliased" legal (and useless) in this context so
+         --  followintg code which used to be needed is commented out.
+
+         --  if Aliased_Present then
+         --     Error_Msg_SP ("ALIASED not allowed here");
+         --  end if;
 
          Set_Subtype_Indication     (CompDef_Node, Empty);
          Set_Aliased_Present        (CompDef_Node, False);
@@ -3443,9 +3450,12 @@ package body Ch3 is
                   Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
                end if;
 
-               if Aliased_Present then
-                  Error_Msg_SP ("ALIASED not allowed here");
-               end if;
+               --  AI95-406 makes "aliased" legal (and useless) here, so the
+               --  following code which used to be required is commented out.
+
+               --  if Aliased_Present then
+               --     Error_Msg_SP ("ALIASED not allowed here");
+               --  end if;
 
                Set_Subtype_Indication (CompDef_Node, Empty);
                Set_Aliased_Present    (CompDef_Node, False);
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index cbe68cfddaa..f2758ae125b 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1432,19 +1432,9 @@ package body Ch4 is
          --  that doesn't belong to us!
 
          if Token in Token_Class_Eterm then
-
-            --  If Some becomes a keyword, the following is needed to make it
-            --  acceptable in older versions of Ada.
-
-            if Token = Tok_Some
-              and then Ada_Version < Ada_2012
-            then
-               Scan_Reserved_Identifier (False);
-            else
-               Error_Msg_AP
-                 ("expecting expression or component association");
-               exit;
-            end if;
+            Error_Msg_AP
+              ("expecting expression or component association");
+            exit;
          end if;
 
          --  Deal with misused box
@@ -2564,13 +2554,7 @@ package body Ch4 is
       if Token = Tok_All then
          Set_All_Present (Node1);
 
-      --  We treat Some as a non-reserved keyword, so it appears to the scanner
-      --  as an identifier. If Some is made into a reserved word, the check
-      --  below is against Tok_Some.
-
-      elsif Token /= Tok_Identifier
-        or else Chars (Token_Node) /= Name_Some
-      then
+      elsif Token /= Tok_Some then
          Error_Msg_AP ("missing quantifier");
          raise Error_Resync;
       end if;
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index 84833cd8dd3..12f7015f6a5 100644
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -123,7 +123,7 @@ package body Endh is
    function Explicit_Start_Label (SS_Index : Nat) return Boolean;
    --  Determines whether the specified entry in the scope stack has an
    --  explicit start label (i.e. one other than one that was created by
-   --  the parser when no explicit label was present)
+   --  the parser when no explicit label was present).
 
    procedure Output_End_Deleted;
    --  Output a message complaining that the current END structure does not
@@ -240,7 +240,7 @@ package body Endh is
                End_Type := E_Loop;
 
             --  FOR or WHILE allowed (signalling error) to substitute for LOOP
-            --  if on the same line as the END
+            --  if on the same line as the END.
 
             elsif (Token = Tok_For or else Token = Tok_While)
               and then not Token_Is_At_Start_Of_Line
@@ -374,11 +374,16 @@ package body Endh is
                   Set_Comes_From_Source (End_Labl, False);
                   End_Labl_Present := False;
 
-                  --  Do style check for missing label
+                  --  Do style check for label permitted but not present. Note:
+                  --  for the case of a block statement, the label is required
+                  --  to be repeated, and this legality rule is enforced
+                  --  independently.
 
                   if Style_Check
                     and then End_Type = E_Name
                     and then Explicit_Start_Label (Scope.Last)
+                    and then Nkind (Parent (Scope.Table (Scope.Last).Labl))
+                               /= N_Block_Statement
                   then
                      Style.No_End_Name (Scope.Table (Scope.Last).Labl);
                   end if;
@@ -799,25 +804,25 @@ package body Endh is
       --  In the following test we protect the call to Comes_From_Source
       --  against lines containing previously reported syntax errors.
 
-      elsif (Etyp = E_Loop
-         or else Etyp = E_Name
-         or else Etyp = E_Suspicious_Is
-         or else Etyp = E_Bad_Is)
+      elsif (Etyp = E_Loop          or else
+             Etyp = E_Name          or else
+             Etyp = E_Suspicious_Is or else
+             Etyp = E_Bad_Is)
          and then Comes_From_Source (L)
       then
          return True;
+
       else
          return False;
       end if;
    end Explicit_Start_Label;
 
    ------------------------
-   -- Output End Deleted --
+   -- Output_End_Deleted --
    ------------------------
 
    procedure Output_End_Deleted is
    begin
-
       if End_Type = E_Loop then
          Error_Msg_SC ("no LOOP for this `END LOOP`!");
 
@@ -842,23 +847,23 @@ package body Endh is
    end Output_End_Deleted;
 
    -------------------------
-   -- Output End Expected --
+   -- Output_End_Expected --
    -------------------------
 
    procedure Output_End_Expected (Ins : Boolean) is
       End_Type : SS_End_Type;
 
    begin
-      --  Suppress message if this was a potentially junk entry (e.g. a
-      --  record entry where no record keyword was present.
+      --  Suppress message if this was a potentially junk entry (e.g. a record
+      --  entry where no record keyword was present).
 
       if Scope.Table (Scope.Last).Junk then
          return;
       end if;
 
       End_Type := Scope.Table (Scope.Last).Etyp;
-      Error_Msg_Col    := Scope.Table (Scope.Last).Ecol;
-      Error_Msg_Sloc   := Scope.Table (Scope.Last).Sloc;
+      Error_Msg_Col  := Scope.Table (Scope.Last).Ecol;
+      Error_Msg_Sloc := Scope.Table (Scope.Last).Sloc;
 
       if Explicit_Start_Label (Scope.Last) then
          Error_Msg_Node_1 := Scope.Table (Scope.Last).Labl;
@@ -903,11 +908,11 @@ package body Endh is
          Error_Msg_SC -- CODEFIX
            ("`END SELECT;` expected@ for SELECT#!");
 
-      --  All remaining cases are cases with a name (we do not treat
-      --  the suspicious is cases specially for a replaced end, only
-      --  for an inserted end).
+      --  All remaining cases are cases with a name (we do not treat the
+      --  suspicious is cases specially for a replaced end, only for an
+      --  inserted end).
 
-      elsif End_Type = E_Name or else (not Ins) then
+      elsif End_Type = E_Name or else not Ins then
          if Error_Msg_Node_1 = Empty then
             Error_Msg_SC -- CODEFIX
               ("`END;` expected@ for BEGIN#!");
@@ -918,7 +923,7 @@ package body Endh is
 
       --  The other possibility is a missing END for a subprogram with a
       --  suspicious IS (that probably should have been a semicolon). The
-      --  Missing IS confirms the suspicion!
+      --  missing IS confirms the suspicion!
 
       else -- End_Type = E_Suspicious_Is or E_Bad_Is
          Scope.Table (Scope.Last).Etyp := E_Bad_Is;
@@ -926,15 +931,15 @@ package body Endh is
    end Output_End_Expected;
 
    ------------------------
-   -- Output End Missing --
+   -- Output_End_Missing --
    ------------------------
 
    procedure Output_End_Missing is
       End_Type : SS_End_Type;
 
    begin
-      --  Suppress message if this was a potentially junk entry (e.g. a
-      --  record entry where no record keyword was present.
+      --  Suppress message if this was a potentially junk entry (e.g. a record
+      --  entry where no record keyword was present).
 
       if Scope.Table (Scope.Last).Junk then
          return;
@@ -987,7 +992,7 @@ package body Endh is
    end Output_End_Missing;
 
    ---------------------
-   -- Pop End Context --
+   -- Pop_End_Context --
    ---------------------
 
    procedure Pop_End_Context is
@@ -1041,7 +1046,7 @@ package body Endh is
          --  We also reserve an end with a name before the end of file if the
          --  name is the one we expect at the outer level.
 
-         if (Token = Tok_EOF or else
+         if (Token = Tok_EOF  or else
              Token = Tok_With or else
              Token = Tok_Separate)
            and then End_Type >= E_Name
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 5a8a6956d60..f361a9cd67f 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -124,7 +124,8 @@ package body Par_SCO is
       From        : Source_Ptr;
       To          : Source_Ptr;
       Last        : Boolean;
-      Pragma_Sloc : Source_Ptr := No_Location);
+      Pragma_Sloc : Source_Ptr := No_Location;
+      Pragma_Name : Pragma_Id  := Unknown_Pragma);
    --  Append an entry to SCO_Table with fields set as per arguments
 
    procedure Traverse_Declarations_Or_Statements  (L : List_Id);
@@ -916,7 +917,8 @@ package body Par_SCO is
       From        : Source_Ptr;
       To          : Source_Ptr;
       Last        : Boolean;
-      Pragma_Sloc : Source_Ptr := No_Location)
+      Pragma_Sloc : Source_Ptr := No_Location;
+      Pragma_Name : Pragma_Id  := Unknown_Pragma)
    is
       function To_Source_Location (S : Source_Ptr) return Source_Location;
       --  Converts Source_Ptr value to Source_Location (line/col) format
@@ -939,13 +941,14 @@ package body Par_SCO is
    --  Start of processing for Set_Table_Entry
 
    begin
-      Add_SCO
-        (C1          => C1,
-         C2          => C2,
-         From        => To_Source_Location (From),
-         To          => To_Source_Location (To),
-         Last        => Last,
-         Pragma_Sloc => Pragma_Sloc);
+      SCO_Table.Append
+        ((C1          => C1,
+          C2          => C2,
+          From        => To_Source_Location (From),
+          To          => To_Source_Location (To),
+          Last        => Last,
+          Pragma_Sloc => Pragma_Sloc,
+          Pragma_Name => Pragma_Name));
    end Set_Table_Entry;
 
    -----------------------------------------
@@ -957,6 +960,7 @@ package body Par_SCO is
    --  since they are shared by recursive calls to this procedure.
 
    type SC_Entry is record
+      N    : Node_Id;
       From : Source_Ptr;
       To   : Source_Ptr;
       Typ  : Character;
@@ -1080,9 +1084,10 @@ package body Par_SCO is
             declare
                SCE         : SC_Entry renames SC.Table (J);
                Pragma_Sloc : Source_Ptr := No_Location;
+               Pragma_Name : Pragma_Id  := Unknown_Pragma;
             begin
                --  For the case of a statement SCO for a pragma controlled by
-               --  Set_SCO_Pragma_Enable, set Pragma_Sloc so that the SCO (and
+               --  Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
                --  those of any nested decision) is emitted only if the pragma
                --  is enabled.
 
@@ -1090,6 +1095,10 @@ package body Par_SCO is
                   Pragma_Sloc := SCE.From;
                   Condition_Pragma_Hash_Table.Set
                     (Pragma_Sloc, SCO_Table.Last + 1);
+                  Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
+
+               elsif SCE.Typ = 'P' then
+                  Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
                end if;
 
                Set_Table_Entry
@@ -1098,7 +1107,8 @@ package body Par_SCO is
                   From        => SCE.From,
                   To          => SCE.To,
                   Last        => (J = SC_Last),
-                  Pragma_Sloc => Pragma_Sloc);
+                  Pragma_Sloc => Pragma_Sloc,
+                  Pragma_Name => Pragma_Name);
             end;
          end loop;
 
@@ -1134,7 +1144,7 @@ package body Par_SCO is
          T : Source_Ptr;
       begin
          Sloc_Range (N, F, T);
-         SC.Append ((F, T, Typ));
+         SC.Append ((N, F, T, Typ));
       end Extend_Statement_Sequence;
 
       procedure Extend_Statement_Sequence
@@ -1147,7 +1157,7 @@ package body Par_SCO is
       begin
          Sloc_Range (From, F, Dummy);
          Sloc_Range (To, Dummy, T);
-         SC.Append ((F, T, Typ));
+         SC.Append ((From, F, T, Typ));
       end Extend_Statement_Sequence;
 
       -----------------------------
@@ -1204,7 +1214,6 @@ package body Par_SCO is
                when N_Subprogram_Declaration =>
                   Process_Decisions_Defer
                     (Parameter_Specifications (Specification (N)), 'X');
-                  Set_Statement_Entry;
 
                --  Generic subprogram declaration
 
@@ -1213,7 +1222,6 @@ package body Par_SCO is
                     (Generic_Formal_Declarations (N), 'X');
                   Process_Decisions_Defer
                     (Parameter_Specifications (Specification (N)), 'X');
-                  Set_Statement_Entry;
 
                --  Task or subprogram body
 
@@ -1423,9 +1431,8 @@ package body Par_SCO is
                            --  must generate a P entry for the decision. Note
                            --  that this is done unconditionally at this stage.
                            --  Output for disabled pragmas is suppressed later
-                           --  on, when we output the decision line in
-                           --  Put_SCOs, depending on marker sets by
-                           --  Set_SCO_Pragma_Disabled.
+                           --  on when we output the decision line in Put_SCOs,
+                           --  depending on setting by Set_SCO_Pragma_Enabled.
 
                            if Nam = Name_Check then
                               Next (Arg);
diff --git a/gcc/ada/par_sco.ads b/gcc/ada/par_sco.ads
index 5bcad0c30b5..450d76938cb 100644
--- a/gcc/ada/par_sco.ads
+++ b/gcc/ada/par_sco.ads
@@ -50,9 +50,9 @@ package Par_SCO is
    --  original tree associated with Cond.
 
    procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr);
-   --  This procedure is called from Sem_Prag when a pragma is disabled (i.e.
-   --  when the Pragma_Enabled flag is unset). Loc is the Sloc of the N_Pragma
-   --  node. This is used to disable the corresponding SCO table entry. Note
+   --  This procedure is called from Sem_Prag when a pragma is enabled (i.e.
+   --  when the Pragma_Enabled flag is set). Loc is the Sloc of the N_Pragma
+   --  node. This is used to enable the corresponding statement SCO entry. Note
    --  that we use the Sloc as the key here, since in the generic case, the
    --  analysis is on a copy of the node, which is different from the node
    --  seen by Par_SCO in the parse tree (but the Sloc values are the same).
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index d584f6cb89f..0f8608b359c 100644
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -183,6 +183,8 @@ package body Prj.Attr is
    --  Configuration - Compiling
 
    "Sadriver#" &
+   "Salanguage_kind#" &
+   "Sadependency_kind#" &
    "Larequired_switches#" &
    "Laleading_required_switches#" &
    "Latrailing_required_switches#" &
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index db8312a196d..76a028e66cd 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -382,8 +382,9 @@ package body Prj.Conf is
 
       --  Local variables
 
-      Name   : Name_Id;
-      Naming : Project_Node_Id;
+      Name     : Name_Id;
+      Naming   : Project_Node_Id;
+      Compiler : Project_Node_Id;
 
    --  Start of processing for Add_Default_GNAT_Naming_Scheme
 
@@ -433,6 +434,12 @@ package body Prj.Conf is
 
          Create_Attribute (Name_Default_Language, "ada");
 
+         Compiler := Create_Package (Project_Tree, Config_File, "compiler");
+         Create_Attribute
+           (Name_Language_Kind, "unit_based", "ada", Pkg => Compiler);
+         Create_Attribute
+           (Name_Dependency_Kind, "ALI_File", "ada", Pkg => Compiler);
+
          Naming := Create_Package (Project_Tree, Config_File, "naming");
          Create_Attribute (Name_Spec_Suffix, ".ads", "ada",     Pkg => Naming);
          Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
@@ -717,26 +724,31 @@ package body Prj.Conf is
          IDE : constant Package_Id :=
                  Value_Of (Name_Ide, Project.Decl.Packages, Shared);
 
-         Prj_Iter : Project_List;
-         List     : String_List_Id;
-         Elem     : String_Element;
-         Lang     : Name_Id;
-         Variable : Variable_Value;
-         Name     : Name_Id;
-         Count    : Natural;
-         Result   : Argument_List_Access;
-
-         Check_Default : Boolean;
+         procedure Add_Config_Switches_For_Project
+           (Project    : Project_Id;
+            Tree       : Project_Tree_Ref;
+            With_State : in out Integer);
+         --  Add all --config switches for this project. This is also called
+         --  for aggregate projects.
+
+         procedure Add_Config_Switches_For_Project
+           (Project    : Project_Id;
+            Tree       : Project_Tree_Ref;
+            With_State : in out Integer)
+         is
+            pragma Unreferenced (With_State);
+            Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
+
+            Variable      : Variable_Value;
+            Check_Default : Boolean;
+            Lang          : Name_Id;
+            List          : String_List_Id;
+            Elem          : String_Element;
 
-      begin
-         Prj_Iter := Project_Tree.Projects;
-         while Prj_Iter /= null loop
-            if Might_Have_Sources (Prj_Iter.Project) then
+         begin
+            if Might_Have_Sources (Project) then
                Variable :=
-                 Value_Of
-                   (Name_Languages,
-                    Prj_Iter.Project.Decl.Attributes,
-                    Shared);
+                 Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
 
                if Variable = Nil_Variable_Value
                  or else Variable.Default
@@ -745,13 +757,13 @@ package body Prj.Conf is
                   --  project, or if it extends a project with no Languages,
                   --  check for Default_Language.
 
-                  Check_Default := Prj_Iter.Project.Extends = No_Project;
+                  Check_Default := Project.Extends = No_Project;
 
                   if not Check_Default then
                      Variable :=
                        Value_Of
                          (Name_Languages,
-                          Prj_Iter.Project.Extends.Decl.Attributes,
+                          Project.Extends.Decl.Attributes,
                           Shared);
                      Check_Default :=
                        Variable /= Nil_Variable_Value
@@ -762,7 +774,7 @@ package body Prj.Conf is
                      Variable :=
                        Value_Of
                          (Name_Default_Language,
-                          Prj_Iter.Project.Decl.Attributes,
+                          Project.Decl.Attributes,
                           Shared);
 
                      if Variable /= Nil_Variable_Value
@@ -798,9 +810,28 @@ package body Prj.Conf is
                   end loop;
                end if;
             end if;
+         end Add_Config_Switches_For_Project;
 
-            Prj_Iter := Prj_Iter.Next;
-         end loop;
+         procedure For_Every_Imported_Project is new For_Every_Project_Imported
+           (State => Integer, Action => Add_Config_Switches_For_Project);
+         --  Document this procedure ???
+
+         --  Local variables
+
+         Name     : Name_Id;
+         Count    : Natural;
+         Result   : Argument_List_Access;
+         Variable : Variable_Value;
+         Dummy    : Integer := 0;
+
+      --  Start of processing for Get_Config_Switches
+
+      begin
+         For_Every_Imported_Project
+           (By         => Project,
+            Tree       => Project_Tree,
+            With_State => Dummy,
+            Include_Aggregated => True);
 
          Name  := Language_Htable.Get_First;
          Count := 0;
@@ -814,6 +845,7 @@ package body Prj.Conf is
          Count := 1;
          Name  := Language_Htable.Get_First;
          while Name /= No_Name loop
+
             --  Check if IDE'Compiler_Command is declared for the language.
             --  If it is, use its value to invoke gprconfig.
 
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 0c66142e0d4..40f4ae5cb13 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -102,9 +102,6 @@ package body Prj.Env is
    --  Add Object_Dir to object path table. Make sure it is not duplicate
    --  and it is the last one in the current table.
 
-   procedure Set_Path_File_Var (Name : String; Value : String);
-   --  Call Setenv, after calling To_Host_File_Spec
-
    ----------------------
    -- Ada_Include_Path --
    ----------------------
@@ -1776,22 +1773,6 @@ package body Prj.Env is
       Free (Buffer);
    end Set_Ada_Paths;
 
-   -----------------------
-   -- Set_Path_File_Var --
-   -----------------------
-
-   procedure Set_Path_File_Var (Name : String; Value : String) is
-      Host_Spec : String_Access := To_Host_File_Spec (Value);
-   begin
-      if Host_Spec = null then
-         Prj.Com.Fail
-           ("could not convert file name """ & Value & """ to host spec");
-      else
-         Setenv (Name, Host_Spec.all);
-         Free (Host_Spec);
-      end if;
-   end Set_Path_File_Var;
-
    ---------------------
    -- Add_Directories --
    ---------------------
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 52cbdac9fa0..0f1699a579d 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -151,9 +151,9 @@ package body Prj.Nmsc is
    --  be discarded as soon as we have finished processing the project
 
    type Tree_Processing_Data is record
-      Tree           : Project_Tree_Ref;
-      Node_Tree      : Prj.Tree.Project_Node_Tree_Ref;
-      Flags          : Prj.Processing_Flags;
+      Tree      : Project_Tree_Ref;
+      Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
+      Flags     : Prj.Processing_Flags;
    end record;
    --  Temporary data which is needed while parsing a project. It does not need
    --  to be kept in memory once a project has been fully loaded, but is
@@ -281,14 +281,10 @@ package body Prj.Nmsc is
    --  Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
    --  converted to lower-case at the same time.
 
-   procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
-   --  Check that a name is a valid Ada unit name
-
-   procedure Check_Package_Naming
+   procedure Check_Abstract_Project
      (Project : Project_Id;
       Data    : in out Tree_Processing_Data);
-   --  Check the naming scheme part of Data, and initialize the naming scheme
-   --  data in the config of the various languages.
+   --  Check abstract projects attributes
 
    procedure Check_Configuration
      (Project : Project_Id;
@@ -313,10 +309,11 @@ package body Prj.Nmsc is
    --  Check the library attributes of project Project in project tree
    --  and modify its data Data accordingly.
 
-   procedure Check_Abstract_Project
+   procedure Check_Package_Naming
      (Project : Project_Id;
       Data    : in out Tree_Processing_Data);
-   --  Check abstract projects attributes
+   --  Check the naming scheme part of Data, and initialize the naming scheme
+   --  data in the config of the various languages.
 
    procedure Check_Programming_Languages
      (Project : Project_Id;
@@ -331,6 +328,9 @@ package body Prj.Nmsc is
    --  Check if project Project in project tree Data.Tree is a Stand-Alone
    --  Library project, and modify its data Data accordingly if it is one.
 
+   procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
+   --  Check that a name is a valid unit name
+
    function Compute_Directory_Last (Dir : String) return Natural;
    --  Return the index of the last significant character in Dir. This is used
    --  to avoid duplicate '/' (slash) characters at the end of directory names.
@@ -1010,52 +1010,6 @@ package body Prj.Nmsc is
       Free (Project_Path_For_Aggregate);
    end Process_Aggregated_Projects;
 
-   ----------------------------
-   -- Check_Abstract_Project --
-   ----------------------------
-
-   procedure Check_Abstract_Project
-     (Project : Project_Id;
-      Data    : in out Tree_Processing_Data)
-   is
-      Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
-
-      Source_Dirs      : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Source_Dirs,
-                              Project.Decl.Attributes, Shared);
-      Source_Files     : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Source_Files,
-                              Project.Decl.Attributes, Shared);
-      Source_List_File : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Source_List_File,
-                              Project.Decl.Attributes, Shared);
-      Languages        : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Languages,
-                              Project.Decl.Attributes, Shared);
-
-   begin
-      if Project.Source_Dirs /= Nil_String then
-         if Source_Dirs.Values  = Nil_String
-           and then Source_Files.Values = Nil_String
-           and then Languages.Values = Nil_String
-           and then Source_List_File.Default
-         then
-            Project.Source_Dirs := Nil_String;
-
-         else
-            Error_Msg
-              (Data.Flags,
-               "at least one of Source_Files, Source_Dirs or Languages "
-               & "must be declared empty for an abstract project",
-               Project.Location, Project);
-         end if;
-      end if;
-   end Check_Abstract_Project;
-
    -----------
    -- Check --
    -----------
@@ -1112,188 +1066,51 @@ package body Prj.Nmsc is
       Debug_Decrease_Indent ("done check");
    end Check;
 
-   --------------------
-   -- Check_Ada_Name --
-   --------------------
-
-   procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
-      The_Name        : String := Name;
-      Real_Name       : Name_Id;
-      Need_Letter     : Boolean := True;
-      Last_Underscore : Boolean := False;
-      OK              : Boolean := The_Name'Length > 0;
-      First           : Positive;
-
-      function Is_Reserved (Name : Name_Id) return Boolean;
-      function Is_Reserved (S    : String)  return Boolean;
-      --  Check that the given name is not an Ada 95 reserved word. The reason
-      --  for the Ada 95 here is that we do not want to exclude the case of an
-      --  Ada 95 unit called Interface (for example). In Ada 2005, such a unit
-      --  name would be rejected anyway by the compiler. That means there is no
-      --  requirement that the project file parser reject this.
-
-      -----------------
-      -- Is_Reserved --
-      -----------------
-
-      function Is_Reserved (S : String) return Boolean is
-      begin
-         Name_Len := 0;
-         Add_Str_To_Name_Buffer (S);
-         return Is_Reserved (Name_Find);
-      end Is_Reserved;
-
-      -----------------
-      -- Is_Reserved --
-      -----------------
-
-      function Is_Reserved (Name : Name_Id) return Boolean is
-      begin
-         if Get_Name_Table_Byte (Name) /= 0
-           and then Name /= Name_Project
-           and then Name /= Name_Extends
-           and then Name /= Name_External
-           and then Name not in Ada_2005_Reserved_Words
-         then
-            Unit := No_Name;
-            Debug_Output ("Ada reserved word: ", Name);
-            return True;
+   ----------------------------
+   -- Check_Abstract_Project --
+   ----------------------------
 
-         else
-            return False;
-         end if;
-      end Is_Reserved;
+   procedure Check_Abstract_Project
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data)
+   is
+      Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
 
-   --  Start of processing for Check_Ada_Name
+      Source_Dirs      : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Source_Dirs,
+                              Project.Decl.Attributes, Shared);
+      Source_Files     : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Source_Files,
+                              Project.Decl.Attributes, Shared);
+      Source_List_File : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Source_List_File,
+                              Project.Decl.Attributes, Shared);
+      Languages        : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Languages,
+                              Project.Decl.Attributes, Shared);
 
    begin
-      To_Lower (The_Name);
-
-      Name_Len := The_Name'Length;
-      Name_Buffer (1 .. Name_Len) := The_Name;
-
-      --  Special cases of children of packages A, G, I and S on VMS
-
-      if OpenVMS_On_Target
-        and then Name_Len > 3
-        and then Name_Buffer (2 .. 3) = "__"
-        and then
-          ((Name_Buffer (1) = 'a') or else
-           (Name_Buffer (1) = 'g') or else
-           (Name_Buffer (1) = 'i') or else
-           (Name_Buffer (1) = 's'))
-      then
-         Name_Buffer (2) := '.';
-         Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
-         Name_Len := Name_Len - 1;
-      end if;
-
-      Real_Name := Name_Find;
-
-      if Is_Reserved (Real_Name) then
-         return;
-      end if;
-
-      First := The_Name'First;
-
-      for Index in The_Name'Range loop
-         if Need_Letter then
-
-            --  We need a letter (at the beginning, and following a dot),
-            --  but we don't have one.
-
-            if Is_Letter (The_Name (Index)) then
-               Need_Letter := False;
-
-            else
-               OK := False;
-
-               if Current_Verbosity = High then
-                  Debug_Indent;
-                  Write_Int  (Types.Int (Index));
-                  Write_Str  (": '");
-                  Write_Char (The_Name (Index));
-                  Write_Line ("' is not a letter.");
-               end if;
-
-               exit;
-            end if;
-
-         elsif Last_Underscore
-           and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
+      if Project.Source_Dirs /= Nil_String then
+         if Source_Dirs.Values  = Nil_String
+           and then Source_Files.Values = Nil_String
+           and then Languages.Values = Nil_String
+           and then Source_List_File.Default
          then
-            --  Two underscores are illegal, and a dot cannot follow
-            --  an underscore.
-
-            OK := False;
-
-            if Current_Verbosity = High then
-               Debug_Indent;
-               Write_Int  (Types.Int (Index));
-               Write_Str  (": '");
-               Write_Char (The_Name (Index));
-               Write_Line ("' is illegal here.");
-            end if;
-
-            exit;
-
-         elsif The_Name (Index) = '.' then
-
-            --  First, check if the name before the dot is not a reserved word
-
-            if Is_Reserved (The_Name (First .. Index - 1)) then
-               return;
-            end if;
-
-            First := Index + 1;
-
-            --  We need a letter after a dot
-
-            Need_Letter := True;
-
-         elsif The_Name (Index) = '_' then
-            Last_Underscore := True;
+            Project.Source_Dirs := Nil_String;
 
          else
-            --  We need an letter or a digit
-
-            Last_Underscore := False;
-
-            if not Is_Alphanumeric (The_Name (Index)) then
-               OK := False;
-
-               if Current_Verbosity = High then
-                  Debug_Indent;
-                  Write_Int  (Types.Int (Index));
-                  Write_Str  (": '");
-                  Write_Char (The_Name (Index));
-                  Write_Line ("' is not alphanumeric.");
-               end if;
-
-               exit;
-            end if;
-         end if;
-      end loop;
-
-      --  Cannot end with an underscore or a dot
-
-      OK := OK and then not Need_Letter and then not Last_Underscore;
-
-      if OK then
-         if First /= Name'First and then
-           Is_Reserved (The_Name (First .. The_Name'Last))
-         then
-            return;
+            Error_Msg
+              (Data.Flags,
+               "at least one of Source_Files, Source_Dirs or Languages "
+               & "must be declared empty for an abstract project",
+               Project.Location, Project);
          end if;
-
-         Unit := Real_Name;
-
-      else
-         --  Signal a problem with No_Name
-
-         Unit := No_Name;
       end if;
-   end Check_Ada_Name;
+   end Check_Abstract_Project;
 
    -------------------------
    -- Check_Configuration --
@@ -1492,10 +1309,29 @@ package body Prj.Nmsc is
 
                      if Lang_Index /= No_Language_Index then
                         case Current_Array.Name is
-                        when Name_Dependency_Switches =>
 
-                           --  Attribute Dependency_Switches (<language>)
+                        --  Attribute Dependency_Kind (<language>)
+
+                        when Name_Dependency_Kind =>
+                           Get_Name_String (Element.Value.Value);
+
+                           begin
+                              Lang_Index.Config.Dependency_Kind :=
+                                Dependency_File_Kind'Value
+                                  (Name_Buffer (1 .. Name_Len));
+
+                           exception
+                              when Constraint_Error =>
+                                 Error_Msg
+                                   (Data.Flags,
+                                    "illegal value for Dependency_Kind",
+                                    Element.Value.Location,
+                                    Project);
+                           end;
 
+                        --  Attribute Dependency_Switches (<language>)
+
+                        when Name_Dependency_Switches =>
                            if Lang_Index.Config.Dependency_Kind = None then
                               Lang_Index.Config.Dependency_Kind := Makefile;
                            end if;
@@ -1509,10 +1345,9 @@ package body Prj.Nmsc is
                                    In_Tree   => Data.Tree);
                            end if;
 
-                        when Name_Dependency_Driver =>
-
-                           --  Attribute Dependency_Driver (<language>)
+                        --  Attribute Dependency_Driver (<language>)
 
+                        when Name_Dependency_Driver =>
                            if Lang_Index.Config.Dependency_Kind = None then
                               Lang_Index.Config.Dependency_Kind := Makefile;
                            end if;
@@ -1526,10 +1361,28 @@ package body Prj.Nmsc is
                                    In_Tree   => Data.Tree);
                            end if;
 
-                        when Name_Include_Switches =>
+                        --  Attribute Language_Kind (<language>)
+
+                        when Name_Language_Kind =>
+                           Get_Name_String (Element.Value.Value);
+
+                           begin
+                              Lang_Index.Config.Kind :=
+                                Language_Kind'Value
+                                  (Name_Buffer (1 .. Name_Len));
+
+                           exception
+                              when Constraint_Error =>
+                                 Error_Msg
+                                   (Data.Flags,
+                                    "illegal value for Language_Kind",
+                                    Element.Value.Location,
+                                    Project);
+                           end;
 
-                           --  Attribute Include_Switches (<language>)
+                        --  Attribute Include_Switches (<language>)
 
+                        when Name_Include_Switches =>
                            List := Element.Value.Values;
 
                            if List = Nil_String then
@@ -1542,24 +1395,21 @@ package body Prj.Nmsc is
                                 From_List => List,
                                 In_Tree   => Data.Tree);
 
-                        when Name_Include_Path =>
-
-                           --  Attribute Include_Path (<language>)
+                        --  Attribute Include_Path (<language>)
 
+                        when Name_Include_Path =>
                            Lang_Index.Config.Include_Path :=
                              Element.Value.Value;
 
-                        when Name_Include_Path_File =>
-
-                           --  Attribute Include_Path_File (<language>)
+                        --  Attribute Include_Path_File (<language>)
 
+                        when Name_Include_Path_File =>
                            Lang_Index.Config.Include_Path_File :=
-                               Element.Value.Value;
-
-                        when Name_Driver =>
+                             Element.Value.Value;
 
-                           --  Attribute Driver (<language>)
+                        --  Attribute Driver (<language>)
 
+                        when Name_Driver =>
                            Lang_Index.Config.Compiler_Driver :=
                              File_Name_Type (Element.Value.Value);
 
@@ -1638,10 +1488,9 @@ package body Prj.Nmsc is
                                 From_List => Element.Value.Values,
                                 In_Tree   => Data.Tree);
 
-                        when Name_Pic_Option =>
-
-                           --  Attribute Compiler_Pic_Option (<language>)
+                        --  Attribute Compiler_Pic_Option (<language>)
 
+                        when Name_Pic_Option =>
                            List := Element.Value.Values;
 
                            if List = Nil_String then
@@ -1656,10 +1505,9 @@ package body Prj.Nmsc is
                                 From_List => List,
                                 In_Tree   => Data.Tree);
 
-                        when Name_Mapping_File_Switches =>
-
-                           --  Attribute Mapping_File_Switches (<language>)
+                        --  Attribute Mapping_File_Switches (<language>)
 
+                        when Name_Mapping_File_Switches =>
                            List := Element.Value.Values;
 
                            if List = Nil_String then
@@ -1674,24 +1522,21 @@ package body Prj.Nmsc is
                                 From_List => List,
                                 In_Tree   => Data.Tree);
 
-                        when Name_Mapping_Spec_Suffix =>
-
-                           --  Attribute Mapping_Spec_Suffix (<language>)
+                        --  Attribute Mapping_Spec_Suffix (<language>)
 
+                        when Name_Mapping_Spec_Suffix =>
                            Lang_Index.Config.Mapping_Spec_Suffix :=
                              File_Name_Type (Element.Value.Value);
 
-                        when Name_Mapping_Body_Suffix =>
-
-                           --  Attribute Mapping_Body_Suffix (<language>)
+                        --  Attribute Mapping_Body_Suffix (<language>)
 
+                        when Name_Mapping_Body_Suffix =>
                            Lang_Index.Config.Mapping_Body_Suffix :=
                              File_Name_Type (Element.Value.Value);
 
-                        when Name_Config_File_Switches =>
-
-                           --  Attribute Config_File_Switches (<language>)
+                        --  Attribute Config_File_Switches (<language>)
 
+                        when Name_Config_File_Switches =>
                            List := Element.Value.Values;
 
                            if List = Nil_String then
@@ -1706,70 +1551,57 @@ package body Prj.Nmsc is
                                 From_List => List,
                                 In_Tree   => Data.Tree);
 
-                        when Name_Objects_Path =>
-
-                           --  Attribute Objects_Path (<language>)
+                        --  Attribute Objects_Path (<language>)
 
+                        when Name_Objects_Path =>
                            Lang_Index.Config.Objects_Path :=
                              Element.Value.Value;
 
-                        when Name_Objects_Path_File =>
-
-                           --  Attribute Objects_Path_File (<language>)
+                        --  Attribute Objects_Path_File (<language>)
 
+                        when Name_Objects_Path_File =>
                            Lang_Index.Config.Objects_Path_File :=
                              Element.Value.Value;
 
-                        when Name_Config_Body_File_Name =>
-
-                           --  Attribute Config_Body_File_Name (<language>)
+                        --  Attribute Config_Body_File_Name (<language>)
 
+                        when Name_Config_Body_File_Name =>
                            Lang_Index.Config.Config_Body :=
                              Element.Value.Value;
 
-                        when Name_Config_Body_File_Name_Index =>
-
-                           --  Attribute Config_Body_File_Name_Index
-                           --     ( < Language > )
+                        --  Attribute Config_Body_File_Name_Index (< Language>)
 
+                        when Name_Config_Body_File_Name_Index =>
                            Lang_Index.Config.Config_Body_Index :=
                              Element.Value.Value;
 
-                        when Name_Config_Body_File_Name_Pattern =>
-
-                           --  Attribute Config_Body_File_Name_Pattern
-                           --    (<language>)
+                        --  Attribute Config_Body_File_Name_Pattern(<language>)
 
+                        when Name_Config_Body_File_Name_Pattern =>
                            Lang_Index.Config.Config_Body_Pattern :=
                              Element.Value.Value;
 
-                        when Name_Config_Spec_File_Name =>
-
                            --  Attribute Config_Spec_File_Name (<language>)
 
+                        when Name_Config_Spec_File_Name =>
                            Lang_Index.Config.Config_Spec :=
                              Element.Value.Value;
 
-                        when Name_Config_Spec_File_Name_Index =>
-
-                           --  Attribute Config_Spec_File_Name_Index
-                           --    ( < Language > )
+                        --  Attribute Config_Spec_File_Name_Index (<language>)
 
+                        when Name_Config_Spec_File_Name_Index =>
                            Lang_Index.Config.Config_Spec_Index :=
                              Element.Value.Value;
 
-                        when Name_Config_Spec_File_Name_Pattern =>
-
-                           --  Attribute Config_Spec_File_Name_Pattern
-                           --    (<language>)
+                        --  Attribute Config_Spec_File_Name_Pattern(<language>)
 
+                        when Name_Config_Spec_File_Name_Pattern =>
                            Lang_Index.Config.Config_Spec_Pattern :=
                              Element.Value.Value;
 
-                        when Name_Config_File_Unique =>
-
-                           --  Attribute Config_File_Unique (<language>)
+                        --  Attribute Config_File_Unique (<language>)
 
+                        when Name_Config_File_Unique =>
                            begin
                               Lang_Index.Config.Config_File_Unique :=
                                 Boolean'Value
@@ -2575,7 +2407,7 @@ package body Prj.Nmsc is
 
       Lang_Index := Project.Languages;
       while Lang_Index /= No_Language_Index loop
-         if Lang_Index.Name = Name_Ada then
+         if Lang_Index.Config.Kind = Unit_Based then
             Lang_Index.Config.Naming_Data.Casing := Casing;
             Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
 
@@ -2627,7 +2459,7 @@ package body Prj.Nmsc is
                Prev_Index.Next := Lang_Index.Next;
             end if;
 
-         elsif Lang_Index.Name = Name_Ada then
+         elsif Lang_Index.Config.Kind = Unit_Based then
             Prev_Index := Lang_Index;
 
             --  For unit based languages, Dot_Replacement, Spec_Suffix and
@@ -2636,21 +2468,24 @@ package body Prj.Nmsc is
             if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
                Error_Msg
                  (Data.Flags,
-                  "Dot_Replacement not specified for Ada",
+                  "Dot_Replacement not specified for " &
+                  Get_Name_String (Lang_Index.Name),
                   No_Location, Project);
             end if;
 
             if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
                Error_Msg
                  (Data.Flags,
-                  "Spec_Suffix not specified for Ada",
+                  "Spec_Suffix not specified for " &
+                  Get_Name_String (Lang_Index.Name),
                   No_Location, Project);
             end if;
 
             if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
                Error_Msg
                  (Data.Flags,
-                  "Body_Suffix not specified for Ada",
+                  "Body_Suffix not specified for " &
+                  Get_Name_String (Lang_Index.Name),
                   No_Location, Project);
             end if;
 
@@ -2908,683 +2743,12 @@ package body Prj.Nmsc is
       end if;
    end Check_Interfaces;
 
-   --------------------------
-   -- Check_Package_Naming --
-   --------------------------
-
-   procedure Check_Package_Naming
-     (Project : Project_Id;
-      Data    : in out Tree_Processing_Data)
-   is
-      Shared    : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
-      Naming_Id : constant Package_Id :=
-                    Util.Value_Of
-                      (Name_Naming, Project.Decl.Packages, Shared);
-      Naming    : Package_Element;
-
-      Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
-
-      procedure Check_Naming;
-      --  Check the validity of the Naming package (suffixes valid, ...)
-
-      procedure Check_Common
-        (Dot_Replacement : in out File_Name_Type;
-         Casing          : in out Casing_Type;
-         Casing_Defined  : out Boolean;
-         Separate_Suffix : in out File_Name_Type;
-         Sep_Suffix_Loc  : out Source_Ptr);
-      --  Check attributes common
-
-      procedure Process_Exceptions_File_Based
-        (Lang_Id : Language_Ptr;
-         Kind    : Source_Kind);
-      procedure Process_Exceptions_Unit_Based
-        (Lang_Id : Language_Ptr;
-         Kind    : Source_Kind);
-      --  Process the naming exceptions for the two types of languages
-
-      procedure Initialize_Naming_Data;
-      --  Initialize internal naming data for the various languages
-
-      ------------------
-      -- Check_Common --
-      ------------------
-
-      procedure Check_Common
-        (Dot_Replacement : in out File_Name_Type;
-         Casing          : in out Casing_Type;
-         Casing_Defined  : out Boolean;
-         Separate_Suffix : in out File_Name_Type;
-         Sep_Suffix_Loc  : out Source_Ptr)
-      is
-         Dot_Repl      : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Dot_Replacement,
-                              Naming.Decl.Attributes,
-                              Shared);
-         Casing_String : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Casing,
-                              Naming.Decl.Attributes,
-                              Shared);
-         Sep_Suffix    : constant Variable_Value :=
-                           Util.Value_Of
-                             (Name_Separate_Suffix,
-                              Naming.Decl.Attributes,
-                              Shared);
-         Dot_Repl_Loc  : Source_Ptr;
-
-      begin
-         Sep_Suffix_Loc := No_Location;
-
-         if not Dot_Repl.Default then
-            pragma Assert
-              (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
-
-            if Length_Of_Name (Dot_Repl.Value) = 0 then
-               Error_Msg
-                 (Data.Flags, "Dot_Replacement cannot be empty",
-                  Dot_Repl.Location, Project);
-            end if;
-
-            Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
-            Dot_Repl_Loc    := Dot_Repl.Location;
-
-            declare
-               Repl : constant String := Get_Name_String (Dot_Replacement);
-
-            begin
-               --  Dot_Replacement cannot
-               --   - be empty
-               --   - start or end with an alphanumeric
-               --   - be a single '_'
-               --   - start with an '_' followed by an alphanumeric
-               --   - contain a '.' except if it is "."
-
-               if Repl'Length = 0
-                 or else Is_Alphanumeric (Repl (Repl'First))
-                 or else Is_Alphanumeric (Repl (Repl'Last))
-                 or else (Repl (Repl'First) = '_'
-                           and then
-                             (Repl'Length = 1
-                               or else
-                                 Is_Alphanumeric (Repl (Repl'First + 1))))
-                 or else (Repl'Length > 1
-                           and then
-                             Index (Source => Repl, Pattern => ".") /= 0)
-               then
-                  Error_Msg
-                    (Data.Flags,
-                     '"' & Repl &
-                     """ is illegal for Dot_Replacement.",
-                     Dot_Repl_Loc, Project);
-               end if;
-            end;
-         end if;
-
-         if Dot_Replacement /= No_File then
-            Write_Attr
-              ("Dot_Replacement", Get_Name_String (Dot_Replacement));
-         end if;
-
-         Casing_Defined := False;
-
-         if not Casing_String.Default then
-            pragma Assert
-              (Casing_String.Kind = Single, "Casing is not a string");
-
-            declare
-               Casing_Image : constant String :=
-                                Get_Name_String (Casing_String.Value);
-
-            begin
-               if Casing_Image'Length = 0 then
-                  Error_Msg
-                    (Data.Flags,
-                     "Casing cannot be an empty string",
-                     Casing_String.Location, Project);
-               end if;
-
-               Casing := Value (Casing_Image);
-               Casing_Defined := True;
-
-            exception
-               when Constraint_Error =>
-                  Name_Len := Casing_Image'Length;
-                  Name_Buffer (1 .. Name_Len) := Casing_Image;
-                  Err_Vars.Error_Msg_Name_1 := Name_Find;
-                  Error_Msg
-                    (Data.Flags,
-                     "%% is not a correct Casing",
-                     Casing_String.Location, Project);
-            end;
-         end if;
-
-         Write_Attr ("Casing", Image (Casing));
-
-         if not Sep_Suffix.Default then
-            if Length_Of_Name (Sep_Suffix.Value) = 0 then
-               Error_Msg
-                 (Data.Flags,
-                  "Separate_Suffix cannot be empty",
-                  Sep_Suffix.Location, Project);
-
-            else
-               Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
-               Sep_Suffix_Loc  := Sep_Suffix.Location;
-
-               Check_Illegal_Suffix
-                 (Project, Separate_Suffix,
-                  Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
-                  Data);
-            end if;
-         end if;
-
-         if Separate_Suffix /= No_File then
-            Write_Attr
-              ("Separate_Suffix", Get_Name_String (Separate_Suffix));
-         end if;
-      end Check_Common;
-
-      -----------------------------------
-      -- Process_Exceptions_File_Based --
-      -----------------------------------
-
-      procedure Process_Exceptions_File_Based
-        (Lang_Id : Language_Ptr;
-         Kind    : Source_Kind)
-      is
-         Lang           : constant Name_Id := Lang_Id.Name;
-         Exceptions     : Array_Element_Id;
-         Exception_List : Variable_Value;
-         Element_Id     : String_List_Id;
-         Element        : String_Element;
-         File_Name      : File_Name_Type;
-         Source         : Source_Id;
-
-      begin
-         case Kind is
-            when Impl | Sep =>
-               Exceptions :=
-                 Value_Of
-                   (Name_Implementation_Exceptions,
-                    In_Arrays => Naming.Decl.Arrays,
-                    Shared    => Shared);
-
-            when Spec =>
-               Exceptions :=
-                 Value_Of
-                   (Name_Specification_Exceptions,
-                    In_Arrays => Naming.Decl.Arrays,
-                    Shared    => Shared);
-         end case;
-
-         Exception_List :=
-           Value_Of
-             (Index    => Lang,
-              In_Array => Exceptions,
-              Shared   => Shared);
-
-         if Exception_List /= Nil_Variable_Value then
-            Element_Id := Exception_List.Values;
-            while Element_Id /= Nil_String loop
-               Element   := Shared.String_Elements.Table (Element_Id);
-               File_Name := Canonical_Case_File_Name (Element.Value);
-
-               Source :=
-                 Source_Files_Htable.Get
-                   (Data.Tree.Source_Files_HT, File_Name);
-               while Source /= No_Source
-                 and then Source.Project /= Project
-               loop
-                  Source := Source.Next_With_File_Name;
-               end loop;
-
-               if Source = No_Source then
-                  Add_Source
-                    (Id               => Source,
-                     Data             => Data,
-                     Project          => Project,
-                     Source_Dir_Rank  => 0,
-                     Lang_Id          => Lang_Id,
-                     Kind             => Kind,
-                     File_Name        => File_Name,
-                     Display_File     => File_Name_Type (Element.Value),
-                     Naming_Exception => True,
-                     Location         => Element.Location);
-
-               else
-                  --  Check if the file name is already recorded for another
-                  --  language or another kind.
-
-                  if Source.Language /= Lang_Id then
-                     Error_Msg
-                       (Data.Flags,
-                        "the same file cannot be a source of two languages",
-                        Element.Location, Project);
-
-                  elsif Source.Kind /= Kind then
-                     Error_Msg
-                       (Data.Flags,
-                        "the same file cannot be a source and a template",
-                        Element.Location, Project);
-                  end if;
-
-                  --  If the file is already recorded for the same
-                  --  language and the same kind, it means that the file
-                  --  name appears several times in the *_Exceptions
-                  --  attribute; so there is nothing to do.
-               end if;
-
-               Element_Id := Element.Next;
-            end loop;
-         end if;
-      end Process_Exceptions_File_Based;
-
-      -----------------------------------
-      -- Process_Exceptions_Unit_Based --
-      -----------------------------------
-
-      procedure Process_Exceptions_Unit_Based
-        (Lang_Id : Language_Ptr;
-         Kind    : Source_Kind)
-      is
-         Lang       : constant Name_Id := Lang_Id.Name;
-         Exceptions : Array_Element_Id;
-         Element    : Array_Element;
-         Unit       : Name_Id;
-         Index      : Int;
-         File_Name  : File_Name_Type;
-         Source     : Source_Id;
-
-      begin
-         case Kind is
-            when Impl | Sep =>
-               Exceptions :=
-                 Value_Of
-                   (Name_Body,
-                    In_Arrays => Naming.Decl.Arrays,
-                    Shared    => Shared);
-
-               if Exceptions = No_Array_Element then
-                  Exceptions :=
-                    Value_Of
-                      (Name_Implementation,
-                       In_Arrays => Naming.Decl.Arrays,
-                       Shared    => Shared);
-               end if;
-
-            when Spec =>
-               Exceptions :=
-                 Value_Of
-                   (Name_Spec,
-                    In_Arrays => Naming.Decl.Arrays,
-                    Shared    => Shared);
-
-               if Exceptions = No_Array_Element then
-                  Exceptions :=
-                    Value_Of
-                      (Name_Spec,
-                       In_Arrays => Naming.Decl.Arrays,
-                       Shared    => Shared);
-               end if;
-         end case;
-
-         while Exceptions /= No_Array_Element loop
-            Element   := Shared.Array_Elements.Table (Exceptions);
-            File_Name := Canonical_Case_File_Name (Element.Value.Value);
-
-            Get_Name_String (Element.Index);
-            To_Lower (Name_Buffer (1 .. Name_Len));
-            Unit  := Name_Find;
-            Index := Element.Value.Index;
-
-            --  For Ada, check if it is a valid unit name
-
-            if Lang = Name_Ada then
-               Get_Name_String (Element.Index);
-               Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
-
-               if Unit = No_Name then
-                  Err_Vars.Error_Msg_Name_1 := Element.Index;
-                  Error_Msg
-                    (Data.Flags,
-                     "%% is not a valid unit name.",
-                     Element.Value.Location, Project);
-               end if;
-            end if;
-
-            if Unit /= No_Name then
-               Add_Source
-                 (Id               => Source,
-                  Data             => Data,
-                  Project          => Project,
-                  Source_Dir_Rank  => 0,
-                  Lang_Id          => Lang_Id,
-                  Kind             => Kind,
-                  File_Name        => File_Name,
-                  Display_File     => File_Name_Type (Element.Value.Value),
-                  Unit             => Unit,
-                  Index            => Index,
-                  Location         => Element.Value.Location,
-                  Naming_Exception => True);
-            end if;
-
-            Exceptions := Element.Next;
-         end loop;
-      end Process_Exceptions_Unit_Based;
-
-      ------------------
-      -- Check_Naming --
-      ------------------
-
-      procedure Check_Naming is
-         Dot_Replacement : File_Name_Type :=
-                             File_Name_Type
-                               (First_Name_Id + Character'Pos ('-'));
-         Separate_Suffix : File_Name_Type := No_File;
-         Casing          : Casing_Type    := All_Lower_Case;
-         Casing_Defined  : Boolean;
-         Lang_Id         : Language_Ptr;
-         Sep_Suffix_Loc  : Source_Ptr;
-         Suffix          : Variable_Value;
-         Lang            : Name_Id;
-
-      begin
-         Check_Common
-           (Dot_Replacement => Dot_Replacement,
-            Casing          => Casing,
-            Casing_Defined  => Casing_Defined,
-            Separate_Suffix => Separate_Suffix,
-            Sep_Suffix_Loc  => Sep_Suffix_Loc);
-
-         --  For all unit based languages, if any, set the specified value
-         --  of Dot_Replacement, Casing and/or Separate_Suffix. Do not
-         --  systematically overwrite, since the defaults come from the
-         --  configuration file.
-
-         if Dot_Replacement /= No_File
-           or else Casing_Defined
-           or else Separate_Suffix /= No_File
-         then
-            Lang_Id := Project.Languages;
-            while Lang_Id /= No_Language_Index loop
-               if Lang_Id.Config.Kind = Unit_Based then
-                  if Dot_Replacement /= No_File then
-                     Lang_Id.Config.Naming_Data.Dot_Replacement :=
-                         Dot_Replacement;
-                  end if;
-
-                  if Casing_Defined then
-                     Lang_Id.Config.Naming_Data.Casing := Casing;
-                  end if;
-               end if;
-
-               Lang_Id := Lang_Id.Next;
-            end loop;
-         end if;
-
-         --  Next, get the spec and body suffixes
-
-         Lang_Id := Project.Languages;
-         while Lang_Id /= No_Language_Index loop
-            Lang := Lang_Id.Name;
-
-            --  Spec_Suffix
-
-            Suffix := Value_Of
-              (Name                    => Lang,
-               Attribute_Or_Array_Name => Name_Spec_Suffix,
-               In_Package              => Naming_Id,
-               Shared                  => Shared);
-
-            if Suffix = Nil_Variable_Value then
-               Suffix := Value_Of
-                 (Name                    => Lang,
-                  Attribute_Or_Array_Name => Name_Specification_Suffix,
-                  In_Package              => Naming_Id,
-                  Shared                  => Shared);
-            end if;
-
-            if Suffix /= Nil_Variable_Value then
-               Lang_Id.Config.Naming_Data.Spec_Suffix :=
-                   File_Name_Type (Suffix.Value);
-
-               Check_Illegal_Suffix
-                 (Project,
-                  Lang_Id.Config.Naming_Data.Spec_Suffix,
-                  Lang_Id.Config.Naming_Data.Dot_Replacement,
-                  "Spec_Suffix", Suffix.Location, Data);
-
-               Write_Attr
-                 ("Spec_Suffix",
-                  Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
-            end if;
-
-            --  Body_Suffix
-
-            Suffix :=
-              Value_Of
-                (Name                    => Lang,
-                 Attribute_Or_Array_Name => Name_Body_Suffix,
-                 In_Package              => Naming_Id,
-                 Shared                  => Shared);
-
-            if Suffix = Nil_Variable_Value then
-               Suffix :=
-                 Value_Of
-                   (Name                    => Lang,
-                    Attribute_Or_Array_Name => Name_Implementation_Suffix,
-                    In_Package              => Naming_Id,
-                    Shared                  => Shared);
-            end if;
-
-            if Suffix /= Nil_Variable_Value then
-               Lang_Id.Config.Naming_Data.Body_Suffix :=
-                 File_Name_Type (Suffix.Value);
-
-               --  The default value of separate suffix should be the same as
-               --  the body suffix, so we need to compute that first.
-
-               if Separate_Suffix = No_File then
-                  Lang_Id.Config.Naming_Data.Separate_Suffix :=
-                    Lang_Id.Config.Naming_Data.Body_Suffix;
-                  Write_Attr
-                    ("Sep_Suffix",
-                     Get_Name_String
-                       (Lang_Id.Config.Naming_Data.Separate_Suffix));
-               else
-                  Lang_Id.Config.Naming_Data.Separate_Suffix :=
-                    Separate_Suffix;
-               end if;
-
-               Check_Illegal_Suffix
-                 (Project,
-                  Lang_Id.Config.Naming_Data.Body_Suffix,
-                  Lang_Id.Config.Naming_Data.Dot_Replacement,
-                  "Body_Suffix", Suffix.Location, Data);
-
-               Write_Attr
-                 ("Body_Suffix",
-                  Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
-
-            elsif Separate_Suffix /= No_File then
-               Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
-            end if;
-
-            --  Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
-            --  since that would cause a clear ambiguity. Note that we do allow
-            --  a Spec_Suffix to have the same termination as one of these,
-            --  which causes a potential ambiguity, but we resolve that by
-            --  matching the longest possible suffix.
-
-            if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
-              and then Lang_Id.Config.Naming_Data.Spec_Suffix =
-                       Lang_Id.Config.Naming_Data.Body_Suffix
-            then
-               Error_Msg
-                 (Data.Flags,
-                  "Body_Suffix ("""
-                  & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
-                  & """) cannot be the same as Spec_Suffix.",
-                  Ada_Body_Suffix_Loc, Project);
-            end if;
-
-            if Lang_Id.Config.Naming_Data.Body_Suffix /=
-               Lang_Id.Config.Naming_Data.Separate_Suffix
-              and then Lang_Id.Config.Naming_Data.Spec_Suffix =
-                       Lang_Id.Config.Naming_Data.Separate_Suffix
-            then
-               Error_Msg
-                 (Data.Flags,
-                  "Separate_Suffix ("""
-                  & Get_Name_String
-                    (Lang_Id.Config.Naming_Data.Separate_Suffix)
-                  & """) cannot be the same as Spec_Suffix.",
-                  Sep_Suffix_Loc, Project);
-            end if;
-
-            Lang_Id := Lang_Id.Next;
-         end loop;
-
-         --  Get the naming exceptions for all languages
-
-         for Kind in Spec_Or_Body loop
-            Lang_Id := Project.Languages;
-            while Lang_Id /= No_Language_Index loop
-               case Lang_Id.Config.Kind is
-                  when File_Based =>
-                     Process_Exceptions_File_Based (Lang_Id, Kind);
-
-                  when Unit_Based =>
-                     Process_Exceptions_Unit_Based (Lang_Id, Kind);
-               end case;
-
-               Lang_Id := Lang_Id.Next;
-            end loop;
-         end loop;
-      end Check_Naming;
-
-      ----------------------------
-      -- Initialize_Naming_Data --
-      ----------------------------
-
-      procedure Initialize_Naming_Data is
-         Specs : Array_Element_Id :=
-                   Util.Value_Of
-                     (Name_Spec_Suffix,
-                      Naming.Decl.Arrays,
-                      Shared);
-
-         Impls : Array_Element_Id :=
-                   Util.Value_Of
-                     (Name_Body_Suffix,
-                      Naming.Decl.Arrays,
-                      Shared);
-
-         Lang      : Language_Ptr;
-         Lang_Name : Name_Id;
-         Value     : Variable_Value;
-         Extended  : Project_Id;
-
-      begin
-         --  At this stage, the project already contains the default extensions
-         --  for the various languages. We now merge those suffixes read in the
-         --  user project, and they override the default.
-
-         while Specs /= No_Array_Element loop
-            Lang_Name := Shared.Array_Elements.Table (Specs).Index;
-            Lang :=
-              Get_Language_From_Name
-                (Project, Name => Get_Name_String (Lang_Name));
-
-            --  An extending project inherits its parent projects' languages
-            --  so if needed we should create entries for those languages
-
-            if Lang = null  then
-               Extended := Project.Extends;
-               while Extended /= null loop
-                  Lang := Get_Language_From_Name
-                    (Extended, Name => Get_Name_String (Lang_Name));
-                  exit when Lang /= null;
-
-                  Extended := Extended.Extends;
-               end loop;
-
-               if Lang /= null then
-                  Lang := new Language_Data'(Lang.all);
-                  Lang.First_Source := null;
-                  Lang.Next := Project.Languages;
-                  Project.Languages := Lang;
-               end if;
-            end if;
-
-            --  If language was not found in project or the projects it extends
-
-            if Lang = null then
-               Debug_Output
-                 ("ignoring spec naming data (lang. not in project): ",
-                  Lang_Name);
-
-            else
-               Value := Shared.Array_Elements.Table (Specs).Value;
-
-               if Value.Kind = Single then
-                  Lang.Config.Naming_Data.Spec_Suffix :=
-                    Canonical_Case_File_Name (Value.Value);
-               end if;
-            end if;
-
-            Specs := Shared.Array_Elements.Table (Specs).Next;
-         end loop;
-
-         while Impls /= No_Array_Element loop
-            Lang_Name := Shared.Array_Elements.Table (Impls).Index;
-            Lang :=
-              Get_Language_From_Name
-                (Project, Name => Get_Name_String (Lang_Name));
-
-            if Lang = null then
-               Debug_Output
-                 ("ignoring impl naming data (lang. not in project): ",
-                  Lang_Name);
-            else
-               Value := Shared.Array_Elements.Table (Impls).Value;
-
-               if Lang.Name = Name_Ada then
-                  Ada_Body_Suffix_Loc := Value.Location;
-               end if;
-
-               if Value.Kind = Single then
-                  Lang.Config.Naming_Data.Body_Suffix :=
-                    Canonical_Case_File_Name (Value.Value);
-               end if;
-            end if;
-
-            Impls := Shared.Array_Elements.Table (Impls).Next;
-         end loop;
-      end Initialize_Naming_Data;
-
-   --  Start of processing for Check_Naming_Schemes
-
-   begin
-      --  No Naming package or parsing a configuration file? nothing to do
-
-      if Naming_Id /= No_Package
-        and then Project.Qualifier /= Configuration
-      then
-         Naming := Shared.Packages.Table (Naming_Id);
-         Debug_Increase_Indent ("checking package Naming for ", Project.Name);
-         Initialize_Naming_Data;
-         Check_Naming;
-         Debug_Decrease_Indent ("done checking package naming");
-      end if;
-   end Check_Package_Naming;
-
    ------------------------------
    -- Check_Library_Attributes --
    ------------------------------
 
+   --  This procedure is awfully long (over 700 lines) should be broken up???
+
    procedure Check_Library_Attributes
      (Project : Project_Id;
       Data    : in out Tree_Processing_Data)
@@ -3803,8 +2967,7 @@ package body Prj.Nmsc is
             else
                Dir_Exists :=
                  Is_Directory
-                   (Get_Name_String
-                        (Project.Library_Dir.Display_Name));
+                   (Get_Name_String (Project.Library_Dir.Display_Name));
             end if;
 
             if not Dir_Exists then
@@ -3821,8 +2984,7 @@ package body Prj.Nmsc is
 
             elsif not Project.Externally_Built then
 
-               --  The library directory cannot be the same as the Object
-               --  directory.
+               --  Library directory cannot be the same as Object directory
 
                if Project.Library_Dir.Name = Project.Object_Directory.Name then
                   Error_Msg
@@ -4304,6 +3466,675 @@ package body Prj.Nmsc is
       end if;
    end Check_Library_Attributes;
 
+   --------------------------
+   -- Check_Package_Naming --
+   --------------------------
+
+   procedure Check_Package_Naming
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data)
+   is
+      Shared    : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
+      Naming_Id : constant Package_Id :=
+                    Util.Value_Of
+                      (Name_Naming, Project.Decl.Packages, Shared);
+      Naming    : Package_Element;
+
+      Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
+
+      procedure Check_Naming;
+      --  Check the validity of the Naming package (suffixes valid, ...)
+
+      procedure Check_Common
+        (Dot_Replacement : in out File_Name_Type;
+         Casing          : in out Casing_Type;
+         Casing_Defined  : out Boolean;
+         Separate_Suffix : in out File_Name_Type;
+         Sep_Suffix_Loc  : out Source_Ptr);
+      --  Check attributes common
+
+      procedure Process_Exceptions_File_Based
+        (Lang_Id : Language_Ptr;
+         Kind    : Source_Kind);
+      procedure Process_Exceptions_Unit_Based
+        (Lang_Id : Language_Ptr;
+         Kind    : Source_Kind);
+      --  Process the naming exceptions for the two types of languages
+
+      procedure Initialize_Naming_Data;
+      --  Initialize internal naming data for the various languages
+
+      ------------------
+      -- Check_Common --
+      ------------------
+
+      procedure Check_Common
+        (Dot_Replacement : in out File_Name_Type;
+         Casing          : in out Casing_Type;
+         Casing_Defined  : out Boolean;
+         Separate_Suffix : in out File_Name_Type;
+         Sep_Suffix_Loc  : out Source_Ptr)
+      is
+         Dot_Repl      : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Dot_Replacement,
+                              Naming.Decl.Attributes,
+                              Shared);
+         Casing_String : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Casing,
+                              Naming.Decl.Attributes,
+                              Shared);
+         Sep_Suffix    : constant Variable_Value :=
+                           Util.Value_Of
+                             (Name_Separate_Suffix,
+                              Naming.Decl.Attributes,
+                              Shared);
+         Dot_Repl_Loc  : Source_Ptr;
+
+      begin
+         Sep_Suffix_Loc := No_Location;
+
+         if not Dot_Repl.Default then
+            pragma Assert
+              (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
+
+            if Length_Of_Name (Dot_Repl.Value) = 0 then
+               Error_Msg
+                 (Data.Flags, "Dot_Replacement cannot be empty",
+                  Dot_Repl.Location, Project);
+            end if;
+
+            Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
+            Dot_Repl_Loc    := Dot_Repl.Location;
+
+            declare
+               Repl : constant String := Get_Name_String (Dot_Replacement);
+
+            begin
+               --  Dot_Replacement cannot
+               --   - be empty
+               --   - start or end with an alphanumeric
+               --   - be a single '_'
+               --   - start with an '_' followed by an alphanumeric
+               --   - contain a '.' except if it is "."
+
+               if Repl'Length = 0
+                 or else Is_Alphanumeric (Repl (Repl'First))
+                 or else Is_Alphanumeric (Repl (Repl'Last))
+                 or else (Repl (Repl'First) = '_'
+                           and then
+                             (Repl'Length = 1
+                               or else
+                                 Is_Alphanumeric (Repl (Repl'First + 1))))
+                 or else (Repl'Length > 1
+                           and then
+                             Index (Source => Repl, Pattern => ".") /= 0)
+               then
+                  Error_Msg
+                    (Data.Flags,
+                     '"' & Repl &
+                     """ is illegal for Dot_Replacement.",
+                     Dot_Repl_Loc, Project);
+               end if;
+            end;
+         end if;
+
+         if Dot_Replacement /= No_File then
+            Write_Attr
+              ("Dot_Replacement", Get_Name_String (Dot_Replacement));
+         end if;
+
+         Casing_Defined := False;
+
+         if not Casing_String.Default then
+            pragma Assert
+              (Casing_String.Kind = Single, "Casing is not a string");
+
+            declare
+               Casing_Image : constant String :=
+                                Get_Name_String (Casing_String.Value);
+
+            begin
+               if Casing_Image'Length = 0 then
+                  Error_Msg
+                    (Data.Flags,
+                     "Casing cannot be an empty string",
+                     Casing_String.Location, Project);
+               end if;
+
+               Casing := Value (Casing_Image);
+               Casing_Defined := True;
+
+            exception
+               when Constraint_Error =>
+                  Name_Len := Casing_Image'Length;
+                  Name_Buffer (1 .. Name_Len) := Casing_Image;
+                  Err_Vars.Error_Msg_Name_1 := Name_Find;
+                  Error_Msg
+                    (Data.Flags,
+                     "%% is not a correct Casing",
+                     Casing_String.Location, Project);
+            end;
+         end if;
+
+         Write_Attr ("Casing", Image (Casing));
+
+         if not Sep_Suffix.Default then
+            if Length_Of_Name (Sep_Suffix.Value) = 0 then
+               Error_Msg
+                 (Data.Flags,
+                  "Separate_Suffix cannot be empty",
+                  Sep_Suffix.Location, Project);
+
+            else
+               Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
+               Sep_Suffix_Loc  := Sep_Suffix.Location;
+
+               Check_Illegal_Suffix
+                 (Project, Separate_Suffix,
+                  Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
+                  Data);
+            end if;
+         end if;
+
+         if Separate_Suffix /= No_File then
+            Write_Attr
+              ("Separate_Suffix", Get_Name_String (Separate_Suffix));
+         end if;
+      end Check_Common;
+
+      -----------------------------------
+      -- Process_Exceptions_File_Based --
+      -----------------------------------
+
+      procedure Process_Exceptions_File_Based
+        (Lang_Id : Language_Ptr;
+         Kind    : Source_Kind)
+      is
+         Lang           : constant Name_Id := Lang_Id.Name;
+         Exceptions     : Array_Element_Id;
+         Exception_List : Variable_Value;
+         Element_Id     : String_List_Id;
+         Element        : String_Element;
+         File_Name      : File_Name_Type;
+         Source         : Source_Id;
+
+      begin
+         case Kind is
+            when Impl | Sep =>
+               Exceptions :=
+                 Value_Of
+                   (Name_Implementation_Exceptions,
+                    In_Arrays => Naming.Decl.Arrays,
+                    Shared    => Shared);
+
+            when Spec =>
+               Exceptions :=
+                 Value_Of
+                   (Name_Specification_Exceptions,
+                    In_Arrays => Naming.Decl.Arrays,
+                    Shared    => Shared);
+         end case;
+
+         Exception_List :=
+           Value_Of
+             (Index    => Lang,
+              In_Array => Exceptions,
+              Shared   => Shared);
+
+         if Exception_List /= Nil_Variable_Value then
+            Element_Id := Exception_List.Values;
+            while Element_Id /= Nil_String loop
+               Element   := Shared.String_Elements.Table (Element_Id);
+               File_Name := Canonical_Case_File_Name (Element.Value);
+
+               Source :=
+                 Source_Files_Htable.Get
+                   (Data.Tree.Source_Files_HT, File_Name);
+               while Source /= No_Source
+                 and then Source.Project /= Project
+               loop
+                  Source := Source.Next_With_File_Name;
+               end loop;
+
+               if Source = No_Source then
+                  Add_Source
+                    (Id               => Source,
+                     Data             => Data,
+                     Project          => Project,
+                     Source_Dir_Rank  => 0,
+                     Lang_Id          => Lang_Id,
+                     Kind             => Kind,
+                     File_Name        => File_Name,
+                     Display_File     => File_Name_Type (Element.Value),
+                     Naming_Exception => True,
+                     Location         => Element.Location);
+
+               else
+                  --  Check if the file name is already recorded for another
+                  --  language or another kind.
+
+                  if Source.Language /= Lang_Id then
+                     Error_Msg
+                       (Data.Flags,
+                        "the same file cannot be a source of two languages",
+                        Element.Location, Project);
+
+                  elsif Source.Kind /= Kind then
+                     Error_Msg
+                       (Data.Flags,
+                        "the same file cannot be a source and a template",
+                        Element.Location, Project);
+                  end if;
+
+                  --  If the file is already recorded for the same
+                  --  language and the same kind, it means that the file
+                  --  name appears several times in the *_Exceptions
+                  --  attribute; so there is nothing to do.
+               end if;
+
+               Element_Id := Element.Next;
+            end loop;
+         end if;
+      end Process_Exceptions_File_Based;
+
+      -----------------------------------
+      -- Process_Exceptions_Unit_Based --
+      -----------------------------------
+
+      procedure Process_Exceptions_Unit_Based
+        (Lang_Id : Language_Ptr;
+         Kind    : Source_Kind)
+      is
+         Exceptions : Array_Element_Id;
+         Element    : Array_Element;
+         Unit       : Name_Id;
+         Index      : Int;
+         File_Name  : File_Name_Type;
+         Source     : Source_Id;
+
+      begin
+         case Kind is
+            when Impl | Sep =>
+               Exceptions :=
+                 Value_Of
+                   (Name_Body,
+                    In_Arrays => Naming.Decl.Arrays,
+                    Shared    => Shared);
+
+               if Exceptions = No_Array_Element then
+                  Exceptions :=
+                    Value_Of
+                      (Name_Implementation,
+                       In_Arrays => Naming.Decl.Arrays,
+                       Shared    => Shared);
+               end if;
+
+            when Spec =>
+               Exceptions :=
+                 Value_Of
+                   (Name_Spec,
+                    In_Arrays => Naming.Decl.Arrays,
+                    Shared    => Shared);
+
+               if Exceptions = No_Array_Element then
+                  Exceptions :=
+                    Value_Of
+                      (Name_Spec,
+                       In_Arrays => Naming.Decl.Arrays,
+                       Shared    => Shared);
+               end if;
+         end case;
+
+         while Exceptions /= No_Array_Element loop
+            Element   := Shared.Array_Elements.Table (Exceptions);
+            File_Name := Canonical_Case_File_Name (Element.Value.Value);
+
+            Get_Name_String (Element.Index);
+            To_Lower (Name_Buffer (1 .. Name_Len));
+            Index := Element.Value.Index;
+
+            --  Check if it is a valid unit name
+
+            Get_Name_String (Element.Index);
+            Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
+
+            if Unit = No_Name then
+               Err_Vars.Error_Msg_Name_1 := Element.Index;
+               Error_Msg
+                 (Data.Flags,
+                  "%% is not a valid unit name.",
+                  Element.Value.Location, Project);
+            end if;
+
+            if Unit /= No_Name then
+               Add_Source
+                 (Id               => Source,
+                  Data             => Data,
+                  Project          => Project,
+                  Source_Dir_Rank  => 0,
+                  Lang_Id          => Lang_Id,
+                  Kind             => Kind,
+                  File_Name        => File_Name,
+                  Display_File     => File_Name_Type (Element.Value.Value),
+                  Unit             => Unit,
+                  Index            => Index,
+                  Location         => Element.Value.Location,
+                  Naming_Exception => True);
+            end if;
+
+            Exceptions := Element.Next;
+         end loop;
+      end Process_Exceptions_Unit_Based;
+
+      ------------------
+      -- Check_Naming --
+      ------------------
+
+      procedure Check_Naming is
+         Dot_Replacement : File_Name_Type :=
+                             File_Name_Type
+                               (First_Name_Id + Character'Pos ('-'));
+         Separate_Suffix : File_Name_Type := No_File;
+         Casing          : Casing_Type    := All_Lower_Case;
+         Casing_Defined  : Boolean;
+         Lang_Id         : Language_Ptr;
+         Sep_Suffix_Loc  : Source_Ptr;
+         Suffix          : Variable_Value;
+         Lang            : Name_Id;
+
+      begin
+         Check_Common
+           (Dot_Replacement => Dot_Replacement,
+            Casing          => Casing,
+            Casing_Defined  => Casing_Defined,
+            Separate_Suffix => Separate_Suffix,
+            Sep_Suffix_Loc  => Sep_Suffix_Loc);
+
+         --  For all unit based languages, if any, set the specified value
+         --  of Dot_Replacement, Casing and/or Separate_Suffix. Do not
+         --  systematically overwrite, since the defaults come from the
+         --  configuration file.
+
+         if Dot_Replacement /= No_File
+           or else Casing_Defined
+           or else Separate_Suffix /= No_File
+         then
+            Lang_Id := Project.Languages;
+            while Lang_Id /= No_Language_Index loop
+               if Lang_Id.Config.Kind = Unit_Based then
+                  if Dot_Replacement /= No_File then
+                     Lang_Id.Config.Naming_Data.Dot_Replacement :=
+                         Dot_Replacement;
+                  end if;
+
+                  if Casing_Defined then
+                     Lang_Id.Config.Naming_Data.Casing := Casing;
+                  end if;
+               end if;
+
+               Lang_Id := Lang_Id.Next;
+            end loop;
+         end if;
+
+         --  Next, get the spec and body suffixes
+
+         Lang_Id := Project.Languages;
+         while Lang_Id /= No_Language_Index loop
+            Lang := Lang_Id.Name;
+
+            --  Spec_Suffix
+
+            Suffix := Value_Of
+              (Name                    => Lang,
+               Attribute_Or_Array_Name => Name_Spec_Suffix,
+               In_Package              => Naming_Id,
+               Shared                  => Shared);
+
+            if Suffix = Nil_Variable_Value then
+               Suffix := Value_Of
+                 (Name                    => Lang,
+                  Attribute_Or_Array_Name => Name_Specification_Suffix,
+                  In_Package              => Naming_Id,
+                  Shared                  => Shared);
+            end if;
+
+            if Suffix /= Nil_Variable_Value then
+               Lang_Id.Config.Naming_Data.Spec_Suffix :=
+                   File_Name_Type (Suffix.Value);
+
+               Check_Illegal_Suffix
+                 (Project,
+                  Lang_Id.Config.Naming_Data.Spec_Suffix,
+                  Lang_Id.Config.Naming_Data.Dot_Replacement,
+                  "Spec_Suffix", Suffix.Location, Data);
+
+               Write_Attr
+                 ("Spec_Suffix",
+                  Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
+            end if;
+
+            --  Body_Suffix
+
+            Suffix :=
+              Value_Of
+                (Name                    => Lang,
+                 Attribute_Or_Array_Name => Name_Body_Suffix,
+                 In_Package              => Naming_Id,
+                 Shared                  => Shared);
+
+            if Suffix = Nil_Variable_Value then
+               Suffix :=
+                 Value_Of
+                   (Name                    => Lang,
+                    Attribute_Or_Array_Name => Name_Implementation_Suffix,
+                    In_Package              => Naming_Id,
+                    Shared                  => Shared);
+            end if;
+
+            if Suffix /= Nil_Variable_Value then
+               Lang_Id.Config.Naming_Data.Body_Suffix :=
+                 File_Name_Type (Suffix.Value);
+
+               --  The default value of separate suffix should be the same as
+               --  the body suffix, so we need to compute that first.
+
+               if Separate_Suffix = No_File then
+                  Lang_Id.Config.Naming_Data.Separate_Suffix :=
+                    Lang_Id.Config.Naming_Data.Body_Suffix;
+                  Write_Attr
+                    ("Sep_Suffix",
+                     Get_Name_String
+                       (Lang_Id.Config.Naming_Data.Separate_Suffix));
+               else
+                  Lang_Id.Config.Naming_Data.Separate_Suffix :=
+                    Separate_Suffix;
+               end if;
+
+               Check_Illegal_Suffix
+                 (Project,
+                  Lang_Id.Config.Naming_Data.Body_Suffix,
+                  Lang_Id.Config.Naming_Data.Dot_Replacement,
+                  "Body_Suffix", Suffix.Location, Data);
+
+               Write_Attr
+                 ("Body_Suffix",
+                  Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
+
+            elsif Separate_Suffix /= No_File then
+               Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
+            end if;
+
+            --  Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
+            --  since that would cause a clear ambiguity. Note that we do allow
+            --  a Spec_Suffix to have the same termination as one of these,
+            --  which causes a potential ambiguity, but we resolve that by
+            --  matching the longest possible suffix.
+
+            if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
+              and then Lang_Id.Config.Naming_Data.Spec_Suffix =
+                       Lang_Id.Config.Naming_Data.Body_Suffix
+            then
+               Error_Msg
+                 (Data.Flags,
+                  "Body_Suffix ("""
+                  & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
+                  & """) cannot be the same as Spec_Suffix.",
+                  Ada_Body_Suffix_Loc, Project);
+            end if;
+
+            if Lang_Id.Config.Naming_Data.Body_Suffix /=
+               Lang_Id.Config.Naming_Data.Separate_Suffix
+              and then Lang_Id.Config.Naming_Data.Spec_Suffix =
+                       Lang_Id.Config.Naming_Data.Separate_Suffix
+            then
+               Error_Msg
+                 (Data.Flags,
+                  "Separate_Suffix ("""
+                  & Get_Name_String
+                    (Lang_Id.Config.Naming_Data.Separate_Suffix)
+                  & """) cannot be the same as Spec_Suffix.",
+                  Sep_Suffix_Loc, Project);
+            end if;
+
+            Lang_Id := Lang_Id.Next;
+         end loop;
+
+         --  Get the naming exceptions for all languages
+
+         for Kind in Spec_Or_Body loop
+            Lang_Id := Project.Languages;
+            while Lang_Id /= No_Language_Index loop
+               case Lang_Id.Config.Kind is
+                  when File_Based =>
+                     Process_Exceptions_File_Based (Lang_Id, Kind);
+
+                  when Unit_Based =>
+                     Process_Exceptions_Unit_Based (Lang_Id, Kind);
+               end case;
+
+               Lang_Id := Lang_Id.Next;
+            end loop;
+         end loop;
+      end Check_Naming;
+
+      ----------------------------
+      -- Initialize_Naming_Data --
+      ----------------------------
+
+      procedure Initialize_Naming_Data is
+         Specs : Array_Element_Id :=
+                   Util.Value_Of
+                     (Name_Spec_Suffix,
+                      Naming.Decl.Arrays,
+                      Shared);
+
+         Impls : Array_Element_Id :=
+                   Util.Value_Of
+                     (Name_Body_Suffix,
+                      Naming.Decl.Arrays,
+                      Shared);
+
+         Lang      : Language_Ptr;
+         Lang_Name : Name_Id;
+         Value     : Variable_Value;
+         Extended  : Project_Id;
+
+      begin
+         --  At this stage, the project already contains the default extensions
+         --  for the various languages. We now merge those suffixes read in the
+         --  user project, and they override the default.
+
+         while Specs /= No_Array_Element loop
+            Lang_Name := Shared.Array_Elements.Table (Specs).Index;
+            Lang :=
+              Get_Language_From_Name
+                (Project, Name => Get_Name_String (Lang_Name));
+
+            --  An extending project inherits its parent projects' languages
+            --  so if needed we should create entries for those languages
+
+            if Lang = null  then
+               Extended := Project.Extends;
+               while Extended /= null loop
+                  Lang := Get_Language_From_Name
+                    (Extended, Name => Get_Name_String (Lang_Name));
+                  exit when Lang /= null;
+
+                  Extended := Extended.Extends;
+               end loop;
+
+               if Lang /= null then
+                  Lang := new Language_Data'(Lang.all);
+                  Lang.First_Source := null;
+                  Lang.Next := Project.Languages;
+                  Project.Languages := Lang;
+               end if;
+            end if;
+
+            --  If language was not found in project or the projects it extends
+
+            if Lang = null then
+               Debug_Output
+                 ("ignoring spec naming data (lang. not in project): ",
+                  Lang_Name);
+
+            else
+               Value := Shared.Array_Elements.Table (Specs).Value;
+
+               if Value.Kind = Single then
+                  Lang.Config.Naming_Data.Spec_Suffix :=
+                    Canonical_Case_File_Name (Value.Value);
+               end if;
+            end if;
+
+            Specs := Shared.Array_Elements.Table (Specs).Next;
+         end loop;
+
+         while Impls /= No_Array_Element loop
+            Lang_Name := Shared.Array_Elements.Table (Impls).Index;
+            Lang :=
+              Get_Language_From_Name
+                (Project, Name => Get_Name_String (Lang_Name));
+
+            if Lang = null then
+               Debug_Output
+                 ("ignoring impl naming data (lang. not in project): ",
+                  Lang_Name);
+            else
+               Value := Shared.Array_Elements.Table (Impls).Value;
+
+               if Lang.Name = Name_Ada then
+                  Ada_Body_Suffix_Loc := Value.Location;
+               end if;
+
+               if Value.Kind = Single then
+                  Lang.Config.Naming_Data.Body_Suffix :=
+                    Canonical_Case_File_Name (Value.Value);
+               end if;
+            end if;
+
+            Impls := Shared.Array_Elements.Table (Impls).Next;
+         end loop;
+      end Initialize_Naming_Data;
+
+   --  Start of processing for Check_Naming_Schemes
+
+   begin
+      --  No Naming package or parsing a configuration file? nothing to do
+
+      if Naming_Id /= No_Package
+        and then Project.Qualifier /= Configuration
+      then
+         Naming := Shared.Packages.Table (Naming_Id);
+         Debug_Increase_Indent ("checking package Naming for ", Project.Name);
+         Initialize_Naming_Data;
+         Check_Naming;
+         Debug_Decrease_Indent ("done checking package naming");
+      end if;
+   end Check_Package_Naming;
+
    ---------------------------------
    -- Check_Programming_Languages --
    ---------------------------------
@@ -4344,13 +4175,6 @@ package body Prj.Nmsc is
          Project.Languages := Lang;
          Lang.Name         := Name;
          Lang.Display_Name := Display_Name;
-
-         if Name = Name_Ada then
-            Lang.Config.Kind            := Unit_Based;
-            Lang.Config.Dependency_Kind := ALI_File;
-         else
-            Lang.Config.Kind := File_Based;
-         end if;
       end Add_Language;
 
    --  Start of processing for Check_Programming_Languages
@@ -4980,6 +4804,189 @@ package body Prj.Nmsc is
       end if;
    end Check_Stand_Alone_Library;
 
+   ---------------------
+   -- Check_Unit_Name --
+   ---------------------
+
+   procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is
+      The_Name        : String := Name;
+      Real_Name       : Name_Id;
+      Need_Letter     : Boolean := True;
+      Last_Underscore : Boolean := False;
+      OK              : Boolean := The_Name'Length > 0;
+      First           : Positive;
+
+      function Is_Reserved (Name : Name_Id) return Boolean;
+      function Is_Reserved (S    : String)  return Boolean;
+      --  Check that the given name is not an Ada 95 reserved word. The reason
+      --  for the Ada 95 here is that we do not want to exclude the case of an
+      --  Ada 95 unit called Interface (for example). In Ada 2005, such a unit
+      --  name would be rejected anyway by the compiler. That means there is no
+      --  requirement that the project file parser reject this.
+
+      -----------------
+      -- Is_Reserved --
+      -----------------
+
+      function Is_Reserved (S : String) return Boolean is
+      begin
+         Name_Len := 0;
+         Add_Str_To_Name_Buffer (S);
+         return Is_Reserved (Name_Find);
+      end Is_Reserved;
+
+      -----------------
+      -- Is_Reserved --
+      -----------------
+
+      function Is_Reserved (Name : Name_Id) return Boolean is
+      begin
+         if Get_Name_Table_Byte (Name) /= 0
+           and then Name /= Name_Project
+           and then Name /= Name_Extends
+           and then Name /= Name_External
+           and then Name not in Ada_2005_Reserved_Words
+         then
+            Unit := No_Name;
+            Debug_Output ("Ada reserved word: ", Name);
+            return True;
+
+         else
+            return False;
+         end if;
+      end Is_Reserved;
+
+   --  Start of processing for Check_Unit_Name
+
+   begin
+      To_Lower (The_Name);
+
+      Name_Len := The_Name'Length;
+      Name_Buffer (1 .. Name_Len) := The_Name;
+
+      --  Special cases of children of packages A, G, I and S on VMS
+
+      if OpenVMS_On_Target
+        and then Name_Len > 3
+        and then Name_Buffer (2 .. 3) = "__"
+        and then
+          ((Name_Buffer (1) = 'a') or else
+           (Name_Buffer (1) = 'g') or else
+           (Name_Buffer (1) = 'i') or else
+           (Name_Buffer (1) = 's'))
+      then
+         Name_Buffer (2) := '.';
+         Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
+         Name_Len := Name_Len - 1;
+      end if;
+
+      Real_Name := Name_Find;
+
+      if Is_Reserved (Real_Name) then
+         return;
+      end if;
+
+      First := The_Name'First;
+
+      for Index in The_Name'Range loop
+         if Need_Letter then
+
+            --  We need a letter (at the beginning, and following a dot),
+            --  but we don't have one.
+
+            if Is_Letter (The_Name (Index)) then
+               Need_Letter := False;
+
+            else
+               OK := False;
+
+               if Current_Verbosity = High then
+                  Debug_Indent;
+                  Write_Int  (Types.Int (Index));
+                  Write_Str  (": '");
+                  Write_Char (The_Name (Index));
+                  Write_Line ("' is not a letter.");
+               end if;
+
+               exit;
+            end if;
+
+         elsif Last_Underscore
+           and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
+         then
+            --  Two underscores are illegal, and a dot cannot follow
+            --  an underscore.
+
+            OK := False;
+
+            if Current_Verbosity = High then
+               Debug_Indent;
+               Write_Int  (Types.Int (Index));
+               Write_Str  (": '");
+               Write_Char (The_Name (Index));
+               Write_Line ("' is illegal here.");
+            end if;
+
+            exit;
+
+         elsif The_Name (Index) = '.' then
+
+            --  First, check if the name before the dot is not a reserved word
+
+            if Is_Reserved (The_Name (First .. Index - 1)) then
+               return;
+            end if;
+
+            First := Index + 1;
+
+            --  We need a letter after a dot
+
+            Need_Letter := True;
+
+         elsif The_Name (Index) = '_' then
+            Last_Underscore := True;
+
+         else
+            --  We need an letter or a digit
+
+            Last_Underscore := False;
+
+            if not Is_Alphanumeric (The_Name (Index)) then
+               OK := False;
+
+               if Current_Verbosity = High then
+                  Debug_Indent;
+                  Write_Int  (Types.Int (Index));
+                  Write_Str  (": '");
+                  Write_Char (The_Name (Index));
+                  Write_Line ("' is not alphanumeric.");
+               end if;
+
+               exit;
+            end if;
+         end if;
+      end loop;
+
+      --  Cannot end with an underscore or a dot
+
+      OK := OK and then not Need_Letter and then not Last_Underscore;
+
+      if OK then
+         if First /= Name'First and then
+           Is_Reserved (The_Name (First .. The_Name'Last))
+         then
+            return;
+         end if;
+
+         Unit := Real_Name;
+
+      else
+         --  Signal a problem with No_Name
+
+         Unit := No_Name;
+      end if;
+   end Check_Unit_Name;
+
    ----------------------------
    -- Compute_Directory_Last --
    ----------------------------
@@ -5690,7 +5697,7 @@ package body Prj.Nmsc is
       --  Name_Buffer contains the name of the unit in lower-cases. Check
       --  that this is a valid unit name
 
-      Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
+      Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
 
       --  If there is a naming exception for the same unit, the file is not
       --  a source for the unit.
@@ -6844,8 +6851,8 @@ package body Prj.Nmsc is
       --  several times, and to avoid cycles that may be introduced by symbolic
       --  links.
 
-      File_Pattern    : GNAT.Regexp.Regexp;
-      --  Pattern to use when matching file names.
+      File_Pattern : GNAT.Regexp.Regexp;
+      --  Pattern to use when matching file names
 
       Visited : Recursive_Dirs.Instance;
 
@@ -7692,6 +7699,7 @@ package body Prj.Nmsc is
          Src     : Source_Info;
          Id      : Source_Id;
          Lang_Id : Language_Ptr;
+
       begin
          Initialize (Iter, Project.Project.Name);
 
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 133fca5cfa4..796e601cada 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -24,9 +24,11 @@
 ------------------------------------------------------------------------------
 
 with Debug;
+with Opt;
 with Osint;    use Osint;
 with Output;   use Output;
 with Prj.Attr;
+with Prj.Com;
 with Prj.Err;  use Prj.Err;
 with Snames;   use Snames;
 with Uintp;    use Uintp;
@@ -70,6 +72,10 @@ package body Prj is
    procedure Free_List (Languages : in out Language_List);
    --  Free memory allocated for the list of languages or sources
 
+   procedure Reset_Units_In_Table (Table : in out Units_Htable.Instance);
+   --  Resets all Units to No_Unit_Index Unit.File_Names (Spec).Unit &
+   --  Unit.File_Names (Impl).Unit in the given table.
+
    procedure Free_Units (Table : in out Units_Htable.Instance);
    --  Free memory allocated for unit information in the project
 
@@ -113,6 +119,28 @@ package body Prj is
       Last := Last + S'Length;
    end Add_To_Buffer;
 
+   ---------------------------------
+   -- Current_Object_Path_File_Of --
+   ---------------------------------
+
+   function Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type
+   is
+   begin
+      return Shared.Private_Part.Current_Object_Path_File;
+   end Current_Object_Path_File_Of;
+
+   ---------------------------------
+   -- Current_Source_Path_File_Of --
+   ---------------------------------
+
+   function Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access)
+      return Path_Name_Type is
+   begin
+      return Shared.Private_Part.Current_Source_Path_File;
+   end Current_Source_Path_File_Of;
+
    ---------------------------
    -- Delete_Temporary_File --
    ---------------------------
@@ -671,6 +699,11 @@ package body Prj is
 
          Prj.Attr.Initialize;
 
+         --  Make sure that new reserved words after Ada 95 may be used as
+         --  identifiers.
+
+         Opt.Ada_Version := Opt.Ada_95;
+
          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
          Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
@@ -918,6 +951,28 @@ package body Prj is
       end loop;
    end Free_List;
 
+   --------------------------
+   -- Reset_Units_In_Table --
+   --------------------------
+
+   procedure Reset_Units_In_Table (Table : in out Units_Htable.Instance) is
+      Unit : Unit_Index;
+
+   begin
+      Unit := Units_Htable.Get_First (Table);
+      while Unit /= No_Unit_Index loop
+         if Unit.File_Names (Spec) /= null then
+            Unit.File_Names (Spec).Unit := No_Unit_Index;
+         end if;
+
+         if Unit.File_Names (Impl) /= null then
+            Unit.File_Names (Impl).Unit := No_Unit_Index;
+         end if;
+
+         Unit := Units_Htable.Get_Next (Table);
+      end loop;
+   end Reset_Units_In_Table;
+
    ----------------
    -- Free_Units --
    ----------------
@@ -931,13 +986,10 @@ package body Prj is
    begin
       Unit := Units_Htable.Get_First (Table);
       while Unit /= No_Unit_Index loop
-         if Unit.File_Names (Spec) /= null then
-            Unit.File_Names (Spec).Unit := No_Unit_Index;
-         end if;
 
-         if Unit.File_Names (Impl) /= null then
-            Unit.File_Names (Impl).Unit := No_Unit_Index;
-         end if;
+         --  We cannot reset Unit.File_Names (Impl or Spec).Unit here as
+         --  Source_Data buffer is freed by the following instruction
+         --  Free_List (Tree.Projects, Free_Project => True);
 
          Unchecked_Free (Unit);
          Unit := Units_Htable.Get_Next (Table);
@@ -980,6 +1032,7 @@ package body Prj is
          Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
          Source_Files_Htable.Reset (Tree.Source_Files_HT);
 
+         Reset_Units_In_Table (Tree.Units_HT);
          Free_List (Tree.Projects, Free_Project => True);
          Free_Units (Tree.Units_HT);
 
@@ -1025,10 +1078,51 @@ package body Prj is
 
       Tree.Replaced_Source_Number := 0;
 
+      Reset_Units_In_Table (Tree.Units_HT);
       Free_List (Tree.Projects, Free_Project => True);
       Free_Units (Tree.Units_HT);
    end Reset;
 
+   -------------------------------------
+   -- Set_Current_Object_Path_File_Of --
+   -------------------------------------
+
+   procedure Set_Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type)
+   is
+   begin
+      Shared.Private_Part.Current_Object_Path_File := To;
+   end Set_Current_Object_Path_File_Of;
+
+   -------------------------------------
+   -- Set_Current_Source_Path_File_Of --
+   -------------------------------------
+
+   procedure Set_Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type)
+   is
+   begin
+      Shared.Private_Part.Current_Source_Path_File := To;
+   end Set_Current_Source_Path_File_Of;
+
+   -----------------------
+   -- Set_Path_File_Var --
+   -----------------------
+
+   procedure Set_Path_File_Var (Name : String; Value : String) is
+      Host_Spec : String_Access := To_Host_File_Spec (Value);
+   begin
+      if Host_Spec = null then
+         Prj.Com.Fail
+           ("could not convert file name """ & Value & """ to host spec");
+      else
+         Setenv (Name, Host_Spec.all);
+         Free (Host_Spec);
+      end if;
+   end Set_Path_File_Var;
+
    -------------------
    -- Switches_Name --
    -------------------
@@ -1195,72 +1289,102 @@ package body Prj is
    -- Compute_All_Imported_Projects --
    -----------------------------------
 
-   procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref) is
-      Project : Project_Id;
+   procedure Compute_All_Imported_Projects
+     (Root_Project : Project_Id;
+      Tree         : Project_Tree_Ref)
+   is
+      procedure Analyze_Tree
+        (Local_Root : Project_Id;
+         Local_Tree : Project_Tree_Ref);
+      --  Process Project and all its aggregated project to analyze their own
+      --  imported projects.
+
+      ------------------
+      -- Analyze_Tree --
+      ------------------
+
+      procedure Analyze_Tree
+        (Local_Root : Project_Id;
+         Local_Tree : Project_Tree_Ref)
+      is
+         pragma Unreferenced (Local_Root);
+
+         Project : Project_Id;
+
+         procedure Recursive_Add
+           (Prj   : Project_Id;
+            Tree  : Project_Tree_Ref;
+            Dummy : in out Boolean);
+         --  Recursively add the projects imported by project Project, but not
+         --  those that are extended.
+
+         -------------------
+         -- Recursive_Add --
+         -------------------
+
+         procedure Recursive_Add
+           (Prj   : Project_Id;
+            Tree  : Project_Tree_Ref;
+            Dummy : in out Boolean)
+         is
+            pragma Unreferenced (Dummy, Tree);
+            List : Project_List;
+            Prj2 : Project_Id;
 
-      procedure Recursive_Add
-        (Prj   : Project_Id;
-         Tree  : Project_Tree_Ref;
-         Dummy : in out Boolean);
-      --  Recursively add the projects imported by project Project, but not
-      --  those that are extended.
+         begin
+            --  A project is not importing itself
 
-      -------------------
-      -- Recursive_Add --
-      -------------------
+            Prj2 := Ultimate_Extending_Project_Of (Prj);
 
-      procedure Recursive_Add
-        (Prj   : Project_Id;
-         Tree  : Project_Tree_Ref;
-         Dummy : in out Boolean)
-      is
-         pragma Unreferenced (Dummy, Tree);
-         List    : Project_List;
-         Prj2    : Project_Id;
+            if Project /= Prj2 then
 
-      begin
-         --  A project is not importing itself
+               --  Check that the project is not already in the list. We know
+               --  the one passed to Recursive_Add have never been visited
+               --  before, but the one passed it are the extended projects.
 
-         Prj2 := Ultimate_Extending_Project_Of (Prj);
+               List := Project.All_Imported_Projects;
+               while List /= null loop
+                  if List.Project = Prj2 then
+                     return;
+                  end if;
 
-         if Project /= Prj2 then
+                  List := List.Next;
+               end loop;
 
-            --  Check that the project is not already in the list. We know the
-            --  one passed to Recursive_Add have never been visited before, but
-            --  the one passed it are the extended projects.
+               --  Add it to the list
 
-            List := Project.All_Imported_Projects;
-            while List /= null loop
-               if List.Project = Prj2 then
-                  return;
-               end if;
+               Project.All_Imported_Projects :=
+                 new Project_List_Element'
+                   (Project => Prj2,
+                    Next    => Project.All_Imported_Projects);
+            end if;
+         end Recursive_Add;
 
-               List := List.Next;
-            end loop;
+         procedure For_All_Projects is
+           new For_Every_Project_Imported (Boolean, Recursive_Add);
 
-            --  Add it to the list
+         Dummy   : Boolean := False;
+         List    : Project_List;
 
-            Project.All_Imported_Projects :=
-              new Project_List_Element'
-                (Project => Prj2,
-                 Next    => Project.All_Imported_Projects);
-         end if;
-      end Recursive_Add;
+      begin
+         List := Local_Tree.Projects;
+         while List /= null loop
+            Project := List.Project;
+            Free_List
+              (Project.All_Imported_Projects, Free_Project => False);
+            For_All_Projects
+              (Project, Local_Tree, Dummy, Include_Aggregated => False);
+            List := List.Next;
+         end loop;
+      end Analyze_Tree;
 
-      procedure For_All_Projects is
-        new For_Every_Project_Imported (Boolean, Recursive_Add);
+      procedure For_Aggregates is
+        new For_Project_And_Aggregated (Analyze_Tree);
 
-      Dummy : Boolean := False;
-      List  : Project_List;
+   --  Start of processing for Compute_All_Imported_Projects
 
    begin
-      List := Tree.Projects;
-      while List /= null loop
-         Project := List.Project;
-         Free_List (Project.All_Imported_Projects, Free_Project => False);
-         For_All_Projects (Project, Tree, Dummy, Include_Aggregated => False);
-         List := List.Next;
-      end loop;
+      For_Aggregates (Root_Project, Tree);
    end Compute_All_Imported_Projects;
 
    -------------------
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 710275747ff..6cd46d323ac 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -410,8 +410,8 @@ package Prj is
 
    type Language_Config is record
       Kind : Language_Kind := File_Based;
-      --  Kind of language. All languages are file based, except Ada which is
-      --  unit based.
+      --  Kind of language. Most languages are file based. A few, such as Ada,
+      --  are unit based.
 
       Naming_Data : Lang_Naming_Data;
       --  The naming data for the languages (prefixes, etc.)
@@ -909,9 +909,11 @@ package Prj is
    --  If Only_If_Ada is True, then No_Name will be returned when the project
    --  doesn't Ada sources.
 
-   procedure Compute_All_Imported_Projects (Tree : Project_Tree_Ref);
+   procedure Compute_All_Imported_Projects
+     (Root_Project : Project_Id;
+      Tree         : Project_Tree_Ref);
    --  For all projects in the tree, compute the list of the projects imported
-   --  directly or indirectly by project Project. The result is stored in
+   --  directly or indirectly by project Root_Project. The result is stored in
    --  Project.All_Imported_Projects for each project
 
    function Ultimate_Extending_Project_Of
@@ -1595,6 +1597,27 @@ package Prj is
      (Source_File_Name : File_Name_Type) return File_Name_Type;
    --  Returns the switches file name corresponding to a source file name
 
+   procedure Set_Path_File_Var (Name : String; Value : String);
+   --  Call Setenv, after calling To_Host_File_Spec
+
+   function Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type;
+   --  Get the current include path file name
+
+   procedure Set_Current_Source_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type);
+   --  Record the current include path file name
+
+   function Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type;
+   --  Get the current object path file name
+
+   procedure Set_Current_Object_Path_File_Of
+     (Shared : Shared_Project_Tree_Data_Access;
+      To     : Path_Name_Type);
+   --  Record the current object path file name
+
    -----------
    -- Flags --
    -----------
diff --git a/gcc/ada/put_alfa.adb b/gcc/ada/put_alfa.adb
index 59be7c2824c..20a37d9330f 100644
--- a/gcc/ada/put_alfa.adb
+++ b/gcc/ada/put_alfa.adb
@@ -153,8 +153,11 @@ begin
                   Write_Info_Char (S.Scope_Name (N));
                end loop;
 
+               --  Default value of (0,0) is used for the special HEAP variable
+               --  so use another default value.
+
                Entity_Line := 0;
-               Entity_Col  := 0;
+               Entity_Col  := 1;
 
                --  Loop through cross reference entries for this scope
 
diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb
index 65dfbc80046..4706c0045b1 100644
--- a/gcc/ada/put_scos.adb
+++ b/gcc/ada/put_scos.adb
@@ -25,6 +25,7 @@
 
 with Par_SCO; use Par_SCO;
 with SCOs;    use SCOs;
+with Snames;  use Snames;
 
 procedure Put_SCOs is
    Ctr : Nat;
@@ -35,6 +36,9 @@ procedure Put_SCOs is
    procedure Output_Source_Location (Loc : Source_Location);
    --  Output source location in line:col format
 
+   procedure Output_String (S : String);
+   --  Output S
+
    ------------------
    -- Output_Range --
    ------------------
@@ -57,6 +61,17 @@ procedure Put_SCOs is
       Write_Info_Nat  (Nat (Loc.Col));
    end Output_Source_Location;
 
+   -------------------
+   -- Output_String --
+   -------------------
+
+   procedure Output_String (S : String) is
+   begin
+      for J in S'Range loop
+         Write_Info_Char (S (J));
+      end loop;
+   end Output_String;
+
 --  Start of processing for Put_SCOs
 
 begin
@@ -81,9 +96,7 @@ begin
             Write_Info_Nat (SUT.Dep_Num);
             Write_Info_Char (' ');
 
-            for N in SUT.File_Name'Range loop
-               Write_Info_Char (SUT.File_Name (N));
-            end loop;
+            Output_String (SUT.File_Name.all);
 
             Write_Info_Terminate;
          end if;
@@ -125,11 +138,30 @@ begin
 
                         Write_Info_Char (' ');
 
-                        if SCO_Table.Table (Start).C2 /= ' ' then
-                           Write_Info_Char (SCO_Table.Table (Start).C2);
-                        end if;
+                        declare
+                           Sent : SCO_Table_Entry
+                                    renames SCO_Table.Table (Start);
+                        begin
+                           if Sent.C2 /= ' ' then
+                              Write_Info_Char (Sent.C2);
+                              if Sent.C2 = 'P'
+                                   and then Sent.Pragma_Name /= Unknown_Pragma
+                              then
+                                 declare
+                                    Pnam : constant String :=
+                                             Sent.Pragma_Name'Img;
+                                 begin
+                                    --  Strip leading "PRAGMA_"
+
+                                    Output_String
+                                      (Pnam (Pnam'First + 7 .. Pnam'Last));
+                                    Write_Info_Char (':');
+                                 end;
+                              end if;
+                           end if;
 
-                        Output_Range (SCO_Table.Table (Start));
+                           Output_Range (Sent);
+                        end;
 
                         --  Increment entry counter (up to 6 entries per line,
                         --  continuation lines are marked Cs).
@@ -146,7 +178,9 @@ begin
                         pragma Assert (SCO_Table.Table (Start).C1 = 's');
                      end loop;
 
-                     Write_Info_Terminate;
+                     if Ctr > 0 then
+                        Write_Info_Terminate;
+                     end if;
 
                   --  Statement continuations should not occur since they
                   --  are supposed to have been handled in the loop above.
@@ -156,7 +190,7 @@ begin
 
                   --  Decision
 
-                  when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' =>
+                  when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
                      Start := Start + 1;
 
                      --  For disabled pragma, or nested decision therein, skip
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 3a887270b9d..6ea59ae1990 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *             Copyright (C) 1992-2010, Free Software Foundation, Inc.      *
+ *             Copyright (C) 1992-2011, 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- *
@@ -101,6 +101,7 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *);
 _Unwind_Reason_Code
 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
 
+extern void __gnat_setup_current_excep (_Unwind_Exception *);
 
 #ifdef IN_RTS   /* For eh personality routine */
 
@@ -108,6 +109,10 @@ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
 #include "unwind-dw2-fde.h"
 #include "unwind-pe.h"
 
+/* The known and handled exception classes.  */
+
+#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
+#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
 
 /* --------------------------------------------------------------
    -- The DB stuff below is there for debugging purposes only. --
@@ -125,10 +130,10 @@ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
 typedef struct
 {
   _Unwind_Action phase;
-  char * description;
+  const char * description;
 } phase_descriptor;
 
-static phase_descriptor phase_descriptors[]
+static const phase_descriptor phase_descriptors[]
   = {{ _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
      { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
      { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
@@ -506,8 +511,11 @@ typedef struct
 
 } region_descriptor;
 
-static void
-db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
+/* Extract and adjust the IP (instruction pointer) from an exception
+   context.  */
+
+static _Unwind_Ptr
+get_ip_from_context (_Unwind_Context *uw_context)
 {
   int ip_before_insn = 0;
 #ifdef HAVE_GETIPINFO
@@ -515,12 +523,26 @@ db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
 #else
   _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
 #endif
+  /* Subtract 1 if necessary because GetIPInfo yields a call return address
+     in this case, while we are interested in information for the call point.
+     This does not always yield the exact call instruction address but always
+     brings the IP back within the corresponding region.  */
   if (!ip_before_insn)
     ip--;
 
+  return ip;
+}
+
+static void
+db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
+{
+  _Unwind_Ptr ip;
+
   if (! (db_accepted_codes () & DB_REGIONS))
     return;
 
+  ip = get_ip_from_context (uw_context);
+
   db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
 
   if (region->lsda)
@@ -622,7 +644,7 @@ typedef enum
 } action_kind;
 
 /* filter value for cleanup actions.  */
-const int cleanup_filter = 0;
+static const int cleanup_filter = 0;
 
 typedef struct
 {
@@ -646,14 +668,7 @@ typedef struct
 static void
 db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
 {
-  int ip_before_insn = 0;
-#ifdef HAVE_GETIPINFO
-  _Unwind_Ptr ip = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
-#else
-  _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
-#endif
-  if (!ip_before_insn)
-    ip--;
+  _Unwind_Ptr ip = get_ip_from_context (uw_context);
 
   db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
 
@@ -701,16 +716,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
                           region_descriptor *region,
                           action_descriptor *action)
 {
-  int ip_before_insn = 0;
-#ifdef HAVE_GETIPINFO
-  _Unwind_Ptr call_site = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
-#else
-  _Unwind_Ptr call_site = _Unwind_GetIP (uw_context);
-#endif
-  /* Subtract 1 if necessary because GetIPInfo returns the actual call site
-     value + 1 in this case.  */
-  if (!ip_before_insn)
-    call_site--;
+  _Unwind_Ptr call_site = get_ip_from_context (uw_context);
 
   /* call_site is a direct index into the call-site table, with two special
      values : -1 for no-action and 0 for "terminate".  The latter should never
@@ -767,18 +773,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
                           action_descriptor *action)
 {
   const unsigned char *p = region->call_site_table;
-  int ip_before_insn = 0;
-#ifdef HAVE_GETIPINFO
-  _Unwind_Ptr ip = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
-#else
-  _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
-#endif
-  /* Subtract 1 if necessary because GetIPInfo yields a call return address
-     in this case, while we are interested in information for the call point.
-     This does not always yield the exact call instruction address but always
-     brings the IP back within the corresponding region.  */
-  if (!ip_before_insn)
-    ip--;
+  _Unwind_Ptr ip = get_ip_from_context (uw_context);
 
   /* Unless we are able to determine otherwise...  */
   action->kind = nothing;
@@ -842,7 +837,6 @@ get_call_site_action_for (_Unwind_Context *uw_context,
 #define Language_For          __gnat_language_for
 #define Import_Code_For       __gnat_import_code_for
 #define EID_For               __gnat_eid_for
-#define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
 
 extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
 extern char Language_For (_Unwind_Ptr eid);
@@ -850,44 +844,55 @@ extern char Language_For (_Unwind_Ptr eid);
 extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
 
 extern Exception_Id EID_For (_GNAT_Exception * e);
-extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
 
 static int
 is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
 {
-  /* Pointer to the GNAT exception data corresponding to the propagated
-     occurrence.  */
-  _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
-
-  /* Base matching rules: An exception data (id) matches itself, "when
-     all_others" matches anything and "when others" matches anything unless
-     explicitly stated otherwise in the propagated occurrence.  */
-
-  bool is_handled =
-    choice == E
-    || choice == GNAT_ALL_OTHERS
-    || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
-
-  /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
-     may have different exception data pointers that should match for the
-     same condition code, if both an export and an import have been
-     registered.  The import code for both the choice and the propagated
-     occurrence are expected to have been masked off regarding severity
-     bits already (at registration time for the former and from within the
-     low level exception vector for the latter).  */
+  if (propagated_exception->common.exception_class == GNAT_EXCEPTION_CLASS)
+    {
+      /* Pointer to the GNAT exception data corresponding to the propagated
+         occurrence.  */
+      _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
+
+      /* Base matching rules: An exception data (id) matches itself, "when
+         all_others" matches anything and "when others" matches anything
+         unless explicitly stated otherwise in the propagated occurrence.  */
+
+      bool is_handled =
+        choice == E
+        || choice == GNAT_ALL_OTHERS
+        || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
+
+      /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
+         may have different exception data pointers that should match for the
+         same condition code, if both an export and an import have been
+         registered.  The import code for both the choice and the propagated
+         occurrence are expected to have been masked off regarding severity
+         bits already (at registration time for the former and from within the
+         low level exception vector for the latter).  */
 #ifdef VMS
-  #define Non_Ada_Error system__aux_dec__non_ada_error
-  extern struct Exception_Data Non_Ada_Error;
-
-  is_handled |=
-    (Language_For (E) == 'V'
-     && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
-     && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
-	  && Import_Code_For (choice) == Import_Code_For (E))
-	 || choice == (_Unwind_Ptr)&Non_Ada_Error));
+#     define Non_Ada_Error system__aux_dec__non_ada_error
+      extern struct Exception_Data Non_Ada_Error;
+
+      is_handled |=
+        (Language_For (E) == 'V'
+         && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
+         && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
+              && Import_Code_For (choice) == Import_Code_For (E))
+             || choice == (_Unwind_Ptr)&Non_Ada_Error));
 #endif
 
-  return is_handled;
+      return is_handled;
+    }
+  else
+    {
+#     define Foreign_Exception system__exceptions__foreign_exception;
+      extern struct Exception_Data Foreign_Exception;
+
+      return choice == GNAT_ALL_OTHERS
+        || choice == GNAT_OTHERS
+        || choice == (_Unwind_Ptr)&Foreign_Exception;
+    }
 }
 
 /* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
@@ -1081,9 +1086,6 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
      Condition Handling Facility.  */
   int uw_version = (int) version_arg;
   _Unwind_Action uw_phases = (_Unwind_Action) phases_arg;
-
-  _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
-
   region_descriptor region;
   action_descriptor action;
 
@@ -1091,7 +1093,7 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
      possible variation on VMS for IA64.  */
   if (uw_version != 1)
     {
-      #if defined (VMS) && defined (__IA64)
+#if defined (VMS) && defined (__IA64)
 
       /* Assume we're called with sigargs/mechargs arguments if really
 	 unexpected bits are set in our first two formals.  Redirect to the
@@ -1105,7 +1107,7 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
       if ((unsigned int)uw_version & version_unexpected_bits_mask
 	  && (unsigned int)uw_phases & phases_unexpected_bits_mask)
 	return __gnat_handle_vms_condition (version_arg, phases_arg);
-      #endif
+#endif
 
       return _URC_FATAL_PHASE1_ERROR;
     }
@@ -1142,13 +1144,14 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
     {
       if (action.kind == cleanup)
 	{
-	  Adjust_N_Cleanups_For (gnat_exception, 1);
 	  return _URC_CONTINUE_UNWIND;
 	}
       else
 	{
 	  /* Trigger the appropriate notification routines before the second
-	     phase starts, which ensures the stack is still intact. */
+	     phase starts, which ensures the stack is still intact.
+             First, setup the Ada occurrence.  */
+          __gnat_setup_current_excep (uw_exception);
 	  __gnat_notify_handled_exception ();
 
 	  return _URC_HANDLER_FOUND;
@@ -1160,17 +1163,12 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
      occurrence (we are in a FORCED_UNWIND phase in this case). Install the
      context to get there.  */
 
-  /* If we are going to install a cleanup context, decrement the cleanup
-     count.  This is required in a FORCED_UNWINDing phase (for an unhandled
-     exception), as this is used from the forced unwinding handler in
-     Ada.Exceptions.Exception_Propagation to decide whether unwinding should
-     proceed further or Unhandled_Exception_Terminate should be called.  */
-  if (action.kind == cleanup)
-    Adjust_N_Cleanups_For (gnat_exception, -1);
-
   setup_to_install
     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
 
+  /* Write current exception, so that it can be retrieved from Ada.  */
+  __gnat_setup_current_excep (uw_exception);
+
   return _URC_INSTALL_CONTEXT;
 }
 
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index f022bceccc8..a9b0c068e3b 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -39,7 +39,7 @@ package Restrict is
    --  consistency, restrictions found in any with'ed units, parent specs
    --  etc., since we may as well check as much as we can at compile time.
    --  These variables should not be referenced directly by clients. Instead
-   --  use Check_Restrictions to record a violation of a restriction, and
+   --  use Check_Restriction to record a violation of a restriction, and
    --  Restriction_Active to test if a given restriction is active.
 
    Restrictions_Loc : array (All_Restrictions) of Source_Ptr :=
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 9742cb20b95..d4b07a97db1 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -293,9 +293,6 @@ package body Rtsfind is
          elsif U_Id in Ada_Dispatching_Child then
             Name_Buffer (16) := '.';
 
-         elsif U_Id in Ada_Finalization_Child then
-            Name_Buffer (17) := '.';
-
          elsif U_Id in Ada_Interrupts_Child then
             Name_Buffer (15) := '.';
 
@@ -324,6 +321,10 @@ package body Rtsfind is
       elsif U_Id in System_Child then
          Name_Buffer (7) := '.';
 
+         if U_Id in System_Storage_Pools_Child then
+            Name_Buffer (21) := '.';
+         end if;
+
          if U_Id in System_Strings_Child then
             Name_Buffer (15) := '.';
          end if;
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index d60de40b643..d262e86cae1 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -48,9 +48,6 @@ package Rtsfind is
    --    eventually, packages implementing delays will be found relative to
    --    the package that declares the time type.
 
-   --    Names of the form Ada_Finalization_xxx are second level children of
-   --    Ada.Finalization.
-
    --    Names of the form Ada_Interrupts_xxx are second level children of
    --    Ada.Interrupts. This is needed for Ada.Interrupts.Names which is used
    --    by pragma Interrupt_State.
@@ -80,6 +77,9 @@ package Rtsfind is
    --    name is System.xxx. For example, the name System_Str_Concat refers to
    --    package System.Str_Concat.
 
+   --    Names of the form System_Storage_Pools_xxx are second level children
+   --    of the package System.Storage_Pools.
+
    --    Names of the form System_Strings_xxx are second level children of the
    --    package System.Strings.
 
@@ -114,6 +114,10 @@ package Rtsfind is
       RTU_Null,
       --  Used as a null entry (will cause an error if referenced)
 
+      --  Package Ada
+
+      Ada,
+
       --  Children of Ada
 
       Ada_Calendar,
@@ -136,10 +140,6 @@ package Rtsfind is
 
       Ada_Dispatching_EDF,
 
-      --  Children of Ada.Finalization
-
-      Ada_Finalization_Heap_Management,
-
       --  Children of Ada.Interrupts
 
       Ada_Interrupts_Names,
@@ -226,7 +226,7 @@ package Rtsfind is
       System_DSA_Services,
       System_DSA_Types,
       System_Exception_Table,
-      System_Exceptions,
+      System_Exceptions_Debug,
       System_Exn_Int,
       System_Exn_LLF,
       System_Exn_LLI,
@@ -245,6 +245,7 @@ package Rtsfind is
       System_Fat_VAX_D_Float,
       System_Fat_VAX_F_Float,
       System_Fat_VAX_G_Float,
+      System_Finalization_Masters,
       System_Finalization_Root,
       System_Fore,
       System_Img_Bool,
@@ -370,6 +371,10 @@ package Rtsfind is
       System_WWd_Enum,
       System_WWd_Wchar,
 
+      --  Children of System.Storage_Pools
+
+      System_Storage_Pools_Subpools,
+
       --  Children of System.Strings
 
       System_Strings_Stream_Ops,
@@ -399,10 +404,6 @@ package Rtsfind is
      range Ada_Dispatching_EDF .. Ada_Dispatching_EDF;
    --  Range of values for children of Ada.Dispatching
 
-   subtype Ada_Finalization_Child is Ada_Child range
-     Ada_Finalization_Heap_Management .. Ada_Finalization_Heap_Management;
-   --  Range of values for children of Ada.Finalization
-
    subtype Ada_Interrupts_Child is Ada_Child range
      Ada_Interrupts_Names .. Ada_Interrupts_Names;
    --  Range of values for children of Ada.Interrupts
@@ -439,6 +440,9 @@ package Rtsfind is
      range System_Address_Image .. System_Tasking_Stages;
    --  Range of values for children or grandchildren of System
 
+   subtype System_Storage_Pools_Child is RTU_Id
+     range System_Storage_Pools_Subpools .. System_Storage_Pools_Subpools;
+
    subtype System_Strings_Child is RTU_Id
      range System_Strings_Stream_Ops .. System_Strings_Stream_Ops;
 
@@ -516,17 +520,7 @@ package Rtsfind is
      RE_Reraise_Occurrence_Always,       -- Ada.Exceptions
      RE_Reraise_Occurrence_No_Defer,     -- Ada.Exceptions
      RE_Save_Occurrence,                 -- Ada.Exceptions
-
-     RE_Add_Offset_To_Address,           -- Ada.Finalization.Heap_Management
-     RE_Allocate,                        -- Ada.Finalization.Heap_Management
-     RE_Attach,                          -- Ada.Finalization.Heap_Management
-     RE_Base_Pool,                       -- Ada.Finalization.Heap_Management
-     RE_Deallocate,                      -- Ada.Finalization.Heap_Management
-     RE_Detach,                          -- Ada.Finalization.Heap_Management
-     RE_Finalization_Collection,         -- Ada.Finalization.Heap_Management
-     RE_Finalization_Collection_Ptr,     -- Ada.Finalization.Heap_Management
-     RE_Set_Finalize_Address_Ptr,        -- Ada.Finalization.Heap_Management
-     RE_Set_Storage_Pool_Ptr,            -- Ada.Finalization.Heap_Management
+     RE_Triggered_By_Abort,              -- Ada.Exceptions
 
      RE_Interrupt_ID,                    -- Ada.Interrupts
      RE_Is_Reserved,                     -- Ada.Interrupts
@@ -760,7 +754,7 @@ package Rtsfind is
 
      RE_Register_Exception,              -- System.Exception_Table
 
-     RE_Local_Raise,                     -- System.Exceptions
+     RE_Local_Raise,                     -- System.Exceptions_Debug
 
      RE_Exn_Integer,                     -- System.Exn_Int
 
@@ -801,6 +795,15 @@ package Rtsfind is
      RE_Attr_VAX_G_Float,                -- System.Fat_VAX_G_Float
      RE_Fat_VAX_G,                       -- System.Fat_VAX_G_Float
 
+     RE_Add_Offset_To_Address,           -- System.Finalization_Masters
+     RE_Attach,                          -- System.Finalization_Masters
+     RE_Base_Pool,                       -- System.Finalization_Masters
+     RE_Detach,                          -- System.Finalization_Masters
+     RE_Finalization_Master,             -- System.Finalization_Masters
+     RE_Finalization_Master_Ptr,         -- System.Finalization_Masters
+     RE_Set_Base_Pool,                   -- System.Finalization_Masters
+     RE_Set_Finalize_Address,            -- System.Finalization_Masters
+
      RE_Root_Controlled,                 -- System.Finalization_Root
      RE_Root_Controlled_Ptr,             -- System.Finalization_Root
 
@@ -1323,9 +1326,15 @@ package Rtsfind is
      RE_Storage_Offset,                  -- System.Storage_Elements
      RE_To_Address,                      -- System.Storage_Elements
 
+     RE_Allocate_Any,                    -- System.Storage_Pools
+     RE_Deallocate_Any,                  -- System.Storage_Pools
      RE_Root_Storage_Pool,               -- System.Storage_Pools
-     RE_Allocate_Any,                    -- System.Storage_Pools,
-     RE_Deallocate_Any,                  -- System.Storage_Pools,
+
+     RE_Allocate_Any_Controlled,         -- System.Storage_Pools.Subpools
+     RE_Deallocate_Any_Controlled,       -- System.Storage_Pools.Subpools
+     RE_Root_Storage_Pool_With_Subpools, -- System.Storage_Pools.Subpools
+     RE_Root_Subpool,                    -- System.Storage_Pools.Subpools
+     RE_Subpool_Handle,                  -- System.Storage_Pools.Subpools
 
      RE_I_AD,                            -- System.Stream_Attributes
      RE_I_AS,                            -- System.Stream_Attributes
@@ -1699,17 +1708,7 @@ package Rtsfind is
      RE_Reraise_Occurrence_Always        => Ada_Exceptions,
      RE_Reraise_Occurrence_No_Defer      => Ada_Exceptions,
      RE_Save_Occurrence                  => Ada_Exceptions,
-
-     RE_Add_Offset_To_Address            => Ada_Finalization_Heap_Management,
-     RE_Allocate                         => Ada_Finalization_Heap_Management,
-     RE_Attach                           => Ada_Finalization_Heap_Management,
-     RE_Base_Pool                        => Ada_Finalization_Heap_Management,
-     RE_Deallocate                       => Ada_Finalization_Heap_Management,
-     RE_Detach                           => Ada_Finalization_Heap_Management,
-     RE_Finalization_Collection          => Ada_Finalization_Heap_Management,
-     RE_Finalization_Collection_Ptr      => Ada_Finalization_Heap_Management,
-     RE_Set_Finalize_Address_Ptr         => Ada_Finalization_Heap_Management,
-     RE_Set_Storage_Pool_Ptr             => Ada_Finalization_Heap_Management,
+     RE_Triggered_By_Abort               => Ada_Exceptions,
 
      RE_Interrupt_ID                     => Ada_Interrupts,
      RE_Is_Reserved                      => Ada_Interrupts,
@@ -1943,7 +1942,7 @@ package Rtsfind is
 
      RE_Register_Exception               => System_Exception_Table,
 
-     RE_Local_Raise                      => System_Exceptions,
+     RE_Local_Raise                      => System_Exceptions_Debug,
 
      RE_Exn_Integer                      => System_Exn_Int,
 
@@ -1984,6 +1983,15 @@ package Rtsfind is
      RE_Attr_VAX_G_Float                 => System_Fat_VAX_G_Float,
      RE_Fat_VAX_G                        => System_Fat_VAX_G_Float,
 
+     RE_Add_Offset_To_Address            => System_Finalization_Masters,
+     RE_Attach                           => System_Finalization_Masters,
+     RE_Base_Pool                        => System_Finalization_Masters,
+     RE_Detach                           => System_Finalization_Masters,
+     RE_Finalization_Master              => System_Finalization_Masters,
+     RE_Finalization_Master_Ptr          => System_Finalization_Masters,
+     RE_Set_Base_Pool                    => System_Finalization_Masters,
+     RE_Set_Finalize_Address             => System_Finalization_Masters,
+
      RE_Root_Controlled                  => System_Finalization_Root,
      RE_Root_Controlled_Ptr              => System_Finalization_Root,
 
@@ -2506,9 +2514,15 @@ package Rtsfind is
      RE_Storage_Offset                   => System_Storage_Elements,
      RE_To_Address                       => System_Storage_Elements,
 
-     RE_Root_Storage_Pool                => System_Storage_Pools,
      RE_Allocate_Any                     => System_Storage_Pools,
      RE_Deallocate_Any                   => System_Storage_Pools,
+     RE_Root_Storage_Pool                => System_Storage_Pools,
+
+     RE_Allocate_Any_Controlled          => System_Storage_Pools_Subpools,
+     RE_Deallocate_Any_Controlled        => System_Storage_Pools_Subpools,
+     RE_Root_Storage_Pool_With_Subpools  => System_Storage_Pools_Subpools,
+     RE_Root_Subpool                     => System_Storage_Pools_Subpools,
+     RE_Subpool_Handle                   => System_Storage_Pools_Subpools,
 
      RE_I_AD                             => System_Stream_Attributes,
      RE_I_AS                             => System_Stream_Attributes,
diff --git a/gcc/ada/s-assert.adb b/gcc/ada/s-assert.adb
index 030ec17192e..fbc0f8acbc7 100644
--- a/gcc/ada/s-assert.adb
+++ b/gcc/ada/s-assert.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2011, 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- --
@@ -32,7 +32,7 @@
 pragma Compiler_Unit;
 
 with Ada.Exceptions;
-with System.Exceptions;
+with System.Exceptions_Debug;
 
 package body System.Assertions is
 
@@ -42,7 +42,7 @@ package body System.Assertions is
 
    procedure Raise_Assert_Failure (Msg : String) is
    begin
-      System.Exceptions.Debug_Raise_Assert_Failure;
+      System.Exceptions_Debug.Debug_Raise_Assert_Failure;
       Ada.Exceptions.Raise_Exception (Assert_Failure'Identity, Msg);
    end Raise_Assert_Failure;
 
diff --git a/gcc/ada/s-atocou-x86.adb b/gcc/ada/s-atocou-x86.adb
index 1625ebaecbe..f7c0bcb3147 100644
--- a/gcc/ada/s-atocou-x86.adb
+++ b/gcc/ada/s-atocou-x86.adb
@@ -54,7 +54,7 @@ package body System.Atomic_Counters is
              & "sete %1",
          Outputs  =>
            (Unsigned_32'Asm_Output ("=m", Item.Value),
-            Boolean'Asm_Output ("=rm", Aux)),
+            Boolean'Asm_Output ("=qm", Aux)),
          Inputs   => Unsigned_32'Asm_Input ("m", Item.Value),
          Volatile => True);
 
diff --git a/gcc/ada/s-auxdec-vms-alpha.adb b/gcc/ada/s-auxdec-vms-alpha.adb
index 86c4629893f..4116e32b355 100644
--- a/gcc/ada/s-auxdec-vms-alpha.adb
+++ b/gcc/ada/s-auxdec-vms-alpha.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -218,26 +218,26 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "lda $16, %3"      & LF & HT &
+         "lda $16, %3"      & LF & HT &  --  Address of Bit
          "mb"               & LF & HT &
-         "sll $16, 3, $18 " & LF & HT &
-         "bis $31, 1, %1"   & LF & HT &
-         "and $18, 63, $19" & LF & HT &
-         "bic $18, 63, $18" & LF & HT &
-         "sra $18, 3, $18"  & LF & HT &
-         "bis $31, %4, $17" & LF & HT &
-         "sll %1, $19, $19" & LF & HT &
+         "sll $16, 3, $18 " & LF & HT &  --  Byte address to bit address
+         "bis $31, 1, %1"   & LF & HT &  --  Set temp to 1 for the sll
+         "and $18, 63, $19" & LF & HT &  --  Quadword bit offset
+         "bic $18, 63, $18" & LF & HT &  --  Quadword bit address
+         "sra $18, 3, $18"  & LF & HT &  --  Quadword address
+         "bis $31, %4, $17" & LF & HT &  --  Retry_Count -> $17
+         "sll %1, $19, $19" & LF &       --  $19 = 1 << bit_offset
          "1:"               & LF & HT &
-         "ldq_l %2, 0($18)" & LF & HT &
-         "and %2, $19, %1"  & LF & HT &
-         "bis %2, $19, %2"  & LF & HT &
-         "stq_c %2, 0($18)" & LF & HT &
-         "beq %2, 2f"       & LF & HT &
-         "cmovne %1, 1, %1" & LF & HT &
-         "br 3f"            & LF & HT &
+         "ldq_l %2, 0($18)" & LF & HT &  --  Load & lock
+         "and %2, $19, %1"  & LF & HT &  --  Previous value -> %1
+         "bis %2, $19, %2"  & LF & HT &  --  Set Bit
+         "stq_c %2, 0($18)" & LF & HT &  --  Store conditional
+         "beq %2, 2f"       & LF & HT &  --  Goto 2: if failed
+         "cmovne %1, 1, %1" & LF & HT &  --  Set Old_Bit
+         "br 3f"            & LF &
          "2:"               & LF & HT &
-         "subq $17, 1, $17" & LF & HT &
-         "bgt $17, 1b"      & LF & HT &
+         "subq $17, 1, $17" & LF & HT &  --  Retry_Count - 1
+         "bgt $17, 1b"      & LF &       --  Retry ?
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "trapb",
@@ -331,7 +331,7 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "mb"              & LF & HT &
+         "mb"              & LF &
          "1:"              & LF & HT &
          "ldl_l $1, %0"    & LF & HT &
          "addl $1, %2, $0" & LF & HT &
@@ -358,21 +358,21 @@ package body System.Aux_DEC is
       System.Machine_Code.Asm
         (
          "mb"               & LF & HT &
-         "bis $31, %5, $17" & LF & HT &
+         "bis $31, %5, $17" & LF &
          "1:"               & LF & HT &
          "ldl_l $1, %0"     & LF & HT &
          "addl $1, %4, $0"  & LF & HT &
          "stl_c $0, %3"     & LF & HT &
-         "beq $0, 2f"       & LF & HT &
+         "beq $0, 2f"       & LF &
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "stq $0, %2"       & LF & HT &
          "stl $1, %1"       & LF & HT &
-         "br 4f"            & LF & HT &
+         "br 4f"            & LF &
          "2:"               & LF & HT &
          "subq $17, 1, $17" & LF & HT &
          "bgt $17, 1b"      & LF & HT &
-         "br 3b"            & LF & HT &
+         "br 3b"            & LF &
          "4:",
          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
                       Integer'Asm_Output ("=m", Old_Value),
@@ -393,7 +393,7 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "mb"              & LF & HT &
+         "mb"              & LF &
          "1:"              & LF & HT &
          "ldq_l $1, %0"    & LF & HT &
          "addq $1, %2, $0" & LF & HT &
@@ -420,21 +420,21 @@ package body System.Aux_DEC is
       System.Machine_Code.Asm
         (
          "mb"               & LF & HT &
-         "bis $31, %5, $17" & LF & HT &
+         "bis $31, %5, $17" & LF &
          "1:"               & LF & HT &
          "ldq_l $1, %0"     & LF & HT &
          "addq $1, %4, $0"  & LF & HT &
          "stq_c $0, %3"     & LF & HT &
-         "beq $0, 2f"       & LF & HT &
+         "beq $0, 2f"       & LF &
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "stq $0, %2"       & LF & HT &
          "stq $1, %1"       & LF & HT &
-         "br 4f"            & LF & HT &
+         "br 4f"            & LF &
          "2:"               & LF & HT &
          "subq $17, 1, $17" & LF & HT &
          "bgt $17, 1b"      & LF & HT &
-         "br 3b"            & LF & HT &
+         "br 3b"            & LF &
          "4:",
          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
                       Long_Integer'Asm_Output ("=m", Old_Value),
@@ -459,7 +459,7 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "mb"             & LF & HT &
+         "mb"             & LF &
          "1:"             & LF & HT &
          "ldl_l $1, %0"   & LF & HT &
          "and $1, %2, $0" & LF & HT &
@@ -486,21 +486,21 @@ package body System.Aux_DEC is
       System.Machine_Code.Asm
         (
          "mb"               & LF & HT &
-         "bis $31, %5, $17" & LF & HT &
+         "bis $31, %5, $17" & LF &
          "1:"               & LF & HT &
          "ldl_l $1, %0"     & LF & HT &
          "and $1, %4, $0"   & LF & HT &
          "stl_c $0, %3"     & LF & HT &
-         "beq $0, 2f"       & LF & HT &
+         "beq $0, 2f"       & LF &
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "stq $0, %2"       & LF & HT &
          "stl $1, %1"       & LF & HT &
-         "br 4f"            & LF & HT &
+         "br 4f"            & LF &
          "2:"               & LF & HT &
          "subq $17, 1, $17" & LF & HT &
          "bgt $17, 1b"      & LF & HT &
-         "br 3b"            & LF & HT &
+         "br 3b"            & LF &
          "4:",
          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
                       Integer'Asm_Output ("=m", Old_Value),
@@ -521,7 +521,7 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "mb"             & LF & HT &
+         "mb"             & LF &
          "1:"             & LF & HT &
          "ldq_l $1, %0"   & LF & HT &
          "and $1, %2, $0" & LF & HT &
@@ -548,21 +548,21 @@ package body System.Aux_DEC is
       System.Machine_Code.Asm
         (
          "mb"               & LF & HT &
-         "bis $31, %5, $17" & LF & HT &
+         "bis $31, %5, $17" & LF &
          "1:"               & LF & HT &
          "ldq_l $1, %0"     & LF & HT &
          "and $1, %4, $0"   & LF & HT &
          "stq_c $0, %3"     & LF & HT &
-         "beq $0, 2f"       & LF & HT &
+         "beq $0, 2f"       & LF &
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "stq $0, %2"       & LF & HT &
          "stq $1, %1"       & LF & HT &
-         "br 4f"            & LF & HT &
+         "br 4f"            & LF &
          "2:"               & LF & HT &
          "subq $17, 1, $17" & LF & HT &
          "bgt $17, 1b"      & LF & HT &
-         "br 3b"            & LF & HT &
+         "br 3b"            & LF &
          "4:",
          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
                       Long_Integer'Asm_Output ("=m", Old_Value),
@@ -587,7 +587,7 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "mb"             & LF & HT &
+         "mb"             & LF &
          "1:"             & LF & HT &
          "ldl_l $1, %0"   & LF & HT &
          "bis $1, %2, $0" & LF & HT &
@@ -614,21 +614,21 @@ package body System.Aux_DEC is
       System.Machine_Code.Asm
         (
          "mb"               & LF & HT &
-         "bis $31, %5, $17" & LF & HT &
+         "bis $31, %5, $17" & LF &
          "1:"               & LF & HT &
          "ldl_l $1, %0"     & LF & HT &
          "bis $1, %4, $0"   & LF & HT &
          "stl_c $0, %3"     & LF & HT &
-         "beq $0, 2f"       & LF & HT &
+         "beq $0, 2f"       & LF &
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "stq $0, %2"       & LF & HT &
          "stl $1, %1"       & LF & HT &
-         "br 4f"            & LF & HT &
+         "br 4f"            & LF &
          "2:"               & LF & HT &
          "subq $17, 1, $17" & LF & HT &
          "bgt $17, 1b"      & LF & HT &
-         "br 3b"            & LF & HT &
+         "br 3b"            & LF &
          "4:",
          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
                       Integer'Asm_Output ("=m", Old_Value),
@@ -649,7 +649,7 @@ package body System.Aux_DEC is
    begin
       System.Machine_Code.Asm
         (
-         "mb"             & LF & HT &
+         "mb"             & LF &
          "1:"             & LF & HT &
          "ldq_l $1, %0"   & LF & HT &
          "bis $1, %2, $0" & LF & HT &
@@ -676,21 +676,21 @@ package body System.Aux_DEC is
       System.Machine_Code.Asm
         (
          "mb"               & LF & HT &
-         "bis $31, %5, $17" & LF & HT &
+         "bis $31, %5, $17" & LF &
          "1:"               & LF & HT &
          "ldq_l $1, %0"     & LF & HT &
          "bis $1, %4, $0"   & LF & HT &
          "stq_c $0, %3"     & LF & HT &
-         "beq $0, 2f"       & LF & HT &
+         "beq $0, 2f"       & LF &
          "3:"               & LF & HT &
          "mb"               & LF & HT &
          "stq $0, %2"       & LF & HT &
          "stq $1, %1"       & LF & HT &
-         "br 4f"            & LF & HT &
+         "br 4f"            & LF &
          "2:"               & LF & HT &
          "subq $17, 1, $17" & LF & HT &
          "bgt $17, 1b"      & LF & HT &
-         "br 3b"            & LF & HT &
+         "br 3b"            & LF &
          "4:",
          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
                       Long_Integer'Asm_Output ("=m", Old_Value),
diff --git a/gcc/ada/s-excdeb.adb b/gcc/ada/s-excdeb.adb
new file mode 100644
index 00000000000..5027bcaee57
--- /dev/null
+++ b/gcc/ada/s-excdeb.adb
@@ -0,0 +1,75 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--               S Y S T E M . E X C E P T I O N S _ D E B U G              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--         Copyright (C) 2006-2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Compiler_Unit;
+
+package body System.Exceptions_Debug is
+
+   ---------------------------
+   -- Debug_Raise_Exception --
+   ---------------------------
+
+   procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr) is
+      pragma Inspection_Point (E);
+   begin
+      null;
+   end Debug_Raise_Exception;
+
+   -------------------------------
+   -- Debug_unhandled_Exception --
+   -------------------------------
+
+   procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr) is
+      pragma Inspection_Point (E);
+   begin
+      null;
+   end Debug_Unhandled_Exception;
+
+   --------------------------------
+   -- Debug_Raise_Assert_Failure --
+   --------------------------------
+
+   procedure Debug_Raise_Assert_Failure is
+   begin
+      null;
+   end Debug_Raise_Assert_Failure;
+
+   -----------------
+   -- Local_Raise --
+   -----------------
+
+   procedure Local_Raise (Excep : System.Address) is
+      pragma Warnings (Off, Excep);
+   begin
+      return;
+   end Local_Raise;
+
+end System.Exceptions_Debug;
diff --git a/gcc/ada/s-excdeb.ads b/gcc/ada/s-excdeb.ads
new file mode 100644
index 00000000000..f0480918390
--- /dev/null
+++ b/gcc/ada/s-excdeb.ads
@@ -0,0 +1,77 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                S Y S T E M . E X C E P T I O N S _ D E B U G             --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2006-2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains internal routines used as debugger helpers.
+--  It should be compiled without optimization to let debuggers inspect
+--  parameter values reliably from breakpoints on the routines.
+
+pragma Compiler_Unit;
+
+with System.Standard_Library;
+
+package System.Exceptions_Debug is
+
+   pragma Preelaborate_05;
+   --  To let Ada.Exceptions "with" us and let us "with" Standard_Library
+
+   package SSL renames System.Standard_Library;
+   --  To let some of the hooks below have formal parameters typed in
+   --  accordance with what GDB expects.
+
+   procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr);
+   pragma Export
+     (Ada, Debug_Raise_Exception, "__gnat_debug_raise_exception");
+   --  Hook called at a "raise" point for an exception E, when it is
+   --  just about to be propagated.
+
+   procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr);
+   pragma Export
+     (Ada, Debug_Unhandled_Exception, "__gnat_unhandled_exception");
+   --  Hook called during the propagation process of an exception E, as soon
+   --  as it is known to be unhandled.
+
+   procedure Debug_Raise_Assert_Failure;
+   pragma Export
+     (Ada, Debug_Raise_Assert_Failure, "__gnat_debug_raise_assert_failure");
+   --  Hook called when an assertion failed. This is used by the debugger to
+   --  intercept assertion failures, and treat them specially.
+
+   procedure Local_Raise (Excep : System.Address);
+   pragma Export (Ada, Local_Raise);
+   --  This is a dummy routine, used only by the debugger for the purpose of
+   --  logging local raise statements that were transformed into a direct goto
+   --  to the handler code. The compiler in this case generates:
+   --
+   --    Local_Raise (exception_data'address);
+   --    goto Handler
+   --
+   --  The argument is the address of the exception data
+end System.Exceptions_Debug;
diff --git a/gcc/ada/s-except.adb b/gcc/ada/s-except.adb
index 3d04b4b1494..9e0b27cdd6d 100755
--- a/gcc/ada/s-except.adb
+++ b/gcc/ada/s-except.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2006-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2006-2011, 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- --
@@ -29,47 +29,17 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-pragma Compiler_Unit;
+--  This package does not require a body, since it is a package renaming. We
+--  provide a dummy file containing a No_Body pragma so that previous versions
+--  of the body (which did exist) will not interfere.
 
-package body System.Exceptions is
-
-   ---------------------------
-   -- Debug_Raise_Exception --
-   ---------------------------
-
-   procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr) is
-      pragma Inspection_Point (E);
-   begin
-      null;
-   end Debug_Raise_Exception;
-
-   -------------------------------
-   -- Debug_unhandled_Exception --
-   -------------------------------
-
-   procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr) is
-      pragma Inspection_Point (E);
-   begin
-      null;
-   end Debug_Unhandled_Exception;
+--  pragma No_Body;
 
-   --------------------------------
-   -- Debug_Raise_Assert_Failure --
-   --------------------------------
-
-   procedure Debug_Raise_Assert_Failure is
-   begin
-      null;
-   end Debug_Raise_Assert_Failure;
-
-   -----------------
-   -- Local_Raise --
-   -----------------
-
-   procedure Local_Raise (Excep : System.Address) is
-      pragma Warnings (Off, Excep);
-   begin
-      return;
-   end Local_Raise;
+--  The above pragma is commented out, since for now we can't use No_Body in
+--  a unit marked as a Compiler_Unit, since this requires GNAT 6.1, and we
+--  do not yet require this for bootstrapping. So instead we use a dummy Taft
+--  amendment type to require the body:
 
+package body System.Exceptions is
+   type Require_Body is new Integer;
 end System.Exceptions;
diff --git a/gcc/ada/s-except.ads b/gcc/ada/s-except.ads
index 10232978260..f0da1e520d3 100644
--- a/gcc/ada/s-except.ads
+++ b/gcc/ada/s-except.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2006-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2006-2011, 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- --
@@ -29,50 +29,37 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package contains internal routines used as debugger helpers.
---  It should be compiled without optimization to let debuggers inspect
---  parameter values reliably from breakpoints on the routines.
-
 pragma Compiler_Unit;
 
-with System.Standard_Library;
-
 package System.Exceptions is
 
    pragma Preelaborate_05;
    --  To let Ada.Exceptions "with" us and let us "with" Standard_Library
 
-   package SSL renames System.Standard_Library;
-   --  To let some of the hooks below have formal parameters typed in
-   --  accordance with what GDB expects.
-
-   procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr);
-   pragma Export
-     (Ada, Debug_Raise_Exception, "__gnat_debug_raise_exception");
-   --  Hook called at a "raise" point for an exception E, when it is
-   --  just about to be propagated.
-
-   procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr);
-   pragma Export
-     (Ada, Debug_Unhandled_Exception, "__gnat_unhandled_exception");
-   --  Hook called during the propagation process of an exception E, as soon
-   --  as it is known to be unhandled.
+   ZCX_By_Default : constant Boolean;
+   --  Visible copy to allow Ada.Exceptions to know the exception model.
 
-   procedure Debug_Raise_Assert_Failure;
-   pragma Export
-     (Ada, Debug_Raise_Assert_Failure, "__gnat_debug_raise_assert_failure");
-   --  Hook called when an assertion failed. This is used by the debugger to
-   --  intercept assertion failures, and treat them specially.
-
-   procedure Local_Raise (Excep : System.Address);
-   pragma Export (Ada, Local_Raise);
-   --  This is a dummy routine, used only by the debugger for the purpose of
-   --  logging local raise statements that were transformed into a direct goto
-   --  to the handler code. The compiler in this case generates:
+private
+   type Require_Body;
+   --  Dummy Taft-amendment type to make it legal (and required) to provide
+   --  a body for this package.
    --
-   --    Local_Raise (exception_data'address);
-   --    goto Handler
+   --  We do this because this unit used to have a body in earlier versions
+   --  of GNAT, and it causes various bootstrap path problems etc if we remove
+   --  a body, since we may pick up old unwanted bodies.
    --
-   --  The argument is the address of the exception data
+   --  Note: we use this standard Ada method of requiring a body rather
+   --  than the cleaner pragma No_Body because System.Exceptions is a compiler
+   --  unit, and older bootstrap compilers do not support pragma No_Body. This
+   --  type can be removed, and s-except.adb can be replaced by a source
+   --  containing just that pragma, when we decide to move to a 2008 compiler
+   --  as the minimal bootstrap compiler version. ???
+
+   ZCX_By_Default : constant Boolean := System.ZCX_By_Default;
+
+   Foreign_Exception : exception;
+   pragma Unreferenced (Foreign_Exception);
+   --  This hidden exception is used to represent non-Ada exception to
+   --  Ada handlers. It is in fact referenced by its linking name.
 
 end System.Exceptions;
diff --git a/gcc/ada/s-finmas.adb b/gcc/ada/s-finmas.adb
new file mode 100644
index 00000000000..a08bb08a494
--- /dev/null
+++ b/gcc/ada/s-finmas.adb
@@ -0,0 +1,492 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--           S Y S T E M . F I N A L I Z A T I O N _ M A S T E R S          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Exceptions; use Ada.Exceptions;
+
+with System.Address_Image;
+with System.HTable;           use System.HTable;
+with System.IO;               use System.IO;
+with System.Soft_Links;       use System.Soft_Links;
+with System.Storage_Elements; use System.Storage_Elements;
+
+package body System.Finalization_Masters is
+
+   --  Finalize_Address hash table types. In general, masters are homogeneous
+   --  collections of controlled objects. Rare cases such as allocations on a
+   --  subpool require heterogeneous masters. The following table provides a
+   --  relation between object address and its Finalize_Address routine.
+
+   type Header_Num is range 0 .. 127;
+
+   function Hash (Key : System.Address) return Header_Num;
+
+   --  Address --> Finalize_Address_Ptr
+
+   package Finalize_Address_Table is new Simple_HTable
+     (Header_Num => Header_Num,
+      Element    => Finalize_Address_Ptr,
+      No_Element => null,
+      Key        => System.Address,
+      Hash       => Hash,
+      Equal      => "=");
+
+   ---------------------------
+   -- Add_Offset_To_Address --
+   ---------------------------
+
+   function Add_Offset_To_Address
+     (Addr   : System.Address;
+      Offset : System.Storage_Elements.Storage_Offset) return System.Address
+   is
+   begin
+      return System.Storage_Elements."+" (Addr, Offset);
+   end Add_Offset_To_Address;
+
+   ------------
+   -- Attach --
+   ------------
+
+   procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr) is
+   begin
+      Lock_Task.all;
+
+      L.Next.Prev := N;
+      N.Next := L.Next;
+      L.Next := N;
+      N.Prev := L;
+
+      Unlock_Task.all;
+
+      --  Note: No need to unlock in case of an exception because the above
+      --  code can never raise one.
+   end Attach;
+
+   ---------------
+   -- Base_Pool --
+   ---------------
+
+   function Base_Pool
+     (Master : Finalization_Master) return Any_Storage_Pool_Ptr
+   is
+   begin
+      return Master.Base_Pool;
+   end Base_Pool;
+
+   -----------------------------
+   -- Delete_Finalize_Address --
+   -----------------------------
+
+   procedure Delete_Finalize_Address (Obj : System.Address) is
+   begin
+      Lock_Task.all;
+      Finalize_Address_Table.Remove (Obj);
+      Unlock_Task.all;
+   end Delete_Finalize_Address;
+
+   ------------
+   -- Detach --
+   ------------
+
+   procedure Detach (N : not null FM_Node_Ptr) is
+   begin
+      if N.Prev /= null and then N.Next /= null then
+         Lock_Task.all;
+
+         N.Prev.Next := N.Next;
+         N.Next.Prev := N.Prev;
+         N.Prev := null;
+         N.Next := null;
+
+         Unlock_Task.all;
+
+         --  Note: No need to unlock in case of an exception because the above
+         --  code can never raise one.
+      end if;
+   end Detach;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   overriding procedure Finalize (Master : in out Finalization_Master) is
+      Cleanup  : Finalize_Address_Ptr;
+      Curr_Ptr : FM_Node_Ptr;
+      Ex_Occur : Exception_Occurrence;
+      Obj_Addr : Address;
+      Raised   : Boolean := False;
+
+      function Is_Empty_List (L : not null FM_Node_Ptr) return Boolean;
+      --  Determine whether a list contains only one element, the dummy head
+
+      -------------------
+      -- Is_Empty_List --
+      -------------------
+
+      function Is_Empty_List (L : not null FM_Node_Ptr) return Boolean is
+      begin
+         return L.Next = L and then L.Prev = L;
+      end Is_Empty_List;
+
+   --  Start of processing for Finalize
+
+   begin
+      --  It is possible for multiple tasks to cause the finalization of the
+      --  same master. Let only one task finalize the objects.
+
+      if Master.Finalization_Started then
+         return;
+      end if;
+
+      --  Lock the master to prevent any allocations while the objects are
+      --  being finalized. The master remains locked because either the master
+      --  is explicitly deallocated or the associated access type is about to
+      --  go out of scope.
+
+      Master.Finalization_Started := True;
+
+      while not Is_Empty_List (Master.Objects'Unchecked_Access) loop
+         Curr_Ptr := Master.Objects.Next;
+
+         Detach (Curr_Ptr);
+
+         --  Skip the list header in order to offer proper object layout for
+         --  finalization.
+
+         Obj_Addr := Curr_Ptr.all'Address + Header_Offset;
+
+         --  Retrieve TSS primitive Finalize_Address depending on the master's
+         --  mode of operation.
+
+         if Master.Is_Homogeneous then
+            Cleanup := Master.Finalize_Address;
+         else
+            Cleanup := Finalize_Address (Obj_Addr);
+         end if;
+
+         --  If Finalize_Address is not available, then this is most likely an
+         --  error in the expansion of the designated type or the allocator.
+
+         pragma Assert (Cleanup /= null);
+
+         begin
+            Cleanup (Obj_Addr);
+
+         exception
+            when Fin_Occur : others =>
+               if not Raised then
+                  Raised := True;
+                  Save_Occurrence (Ex_Occur, Fin_Occur);
+               end if;
+         end;
+
+         --  When the master is a heterogeneous collection, destroy the object
+         --  - Finalize_Address pair since it is no longer needed.
+
+         if not Master.Is_Homogeneous then
+            Delete_Finalize_Address (Obj_Addr);
+         end if;
+      end loop;
+
+      --  If the finalization of a particular object failed or Finalize_Address
+      --  was not set, reraise the exception now.
+
+      if Raised then
+         Reraise_Occurrence (Ex_Occur);
+      end if;
+   end Finalize;
+
+   ----------------------
+   -- Finalize_Address --
+   ----------------------
+
+   function Finalize_Address
+     (Master : Finalization_Master) return Finalize_Address_Ptr
+   is
+   begin
+      return Master.Finalize_Address;
+   end Finalize_Address;
+
+   ----------------------
+   -- Finalize_Address --
+   ----------------------
+
+   function Finalize_Address
+     (Obj : System.Address) return Finalize_Address_Ptr
+   is
+      Result : Finalize_Address_Ptr;
+   begin
+      Lock_Task.all;
+      Result := Finalize_Address_Table.Get (Obj);
+      Unlock_Task.all;
+      return Result;
+   end Finalize_Address;
+
+   --------------------------
+   -- Finalization_Started --
+   --------------------------
+
+   function Finalization_Started
+     (Master : Finalization_Master) return Boolean
+   is
+   begin
+      return Master.Finalization_Started;
+   end Finalization_Started;
+
+   ----------
+   -- Hash --
+   ----------
+
+   function Hash (Key : System.Address) return Header_Num is
+   begin
+      return
+        Header_Num
+          (To_Integer (Key) mod Integer_Address (Header_Num'Range_Length));
+   end Hash;
+
+   -----------------
+   -- Header_Size --
+   -----------------
+
+   function Header_Size return System.Storage_Elements.Storage_Count is
+   begin
+      return FM_Node'Size / Storage_Unit;
+   end Header_Size;
+
+   -------------------
+   -- Header_Offset --
+   -------------------
+
+   function Header_Offset return System.Storage_Elements.Storage_Offset is
+   begin
+      return FM_Node'Size / Storage_Unit;
+   end Header_Offset;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   overriding procedure Initialize (Master : in out Finalization_Master) is
+   begin
+      --  The dummy head must point to itself in both directions
+
+      Master.Objects.Next := Master.Objects'Unchecked_Access;
+      Master.Objects.Prev := Master.Objects'Unchecked_Access;
+   end Initialize;
+
+   --------------------
+   -- Is_Homogeneous --
+   --------------------
+
+   function Is_Homogeneous (Master : Finalization_Master) return Boolean is
+   begin
+      return Master.Is_Homogeneous;
+   end Is_Homogeneous;
+
+   -------------
+   -- Objects --
+   -------------
+
+   function Objects (Master : Finalization_Master) return FM_Node_Ptr is
+   begin
+      return Master.Objects'Unrestricted_Access;
+   end Objects;
+
+   ------------------
+   -- Print_Master --
+   ------------------
+
+   procedure Print_Master (Master : Finalization_Master) is
+      Head      : constant FM_Node_Ptr := Master.Objects'Unrestricted_Access;
+      Head_Seen : Boolean := False;
+      N_Ptr     : FM_Node_Ptr;
+
+   begin
+      --  Output the basic contents of a master
+
+      --    Master   : 0x123456789
+      --    Is_Hmgen : TURE <or> FALSE
+      --    Base_Pool: null <or> 0x123456789
+      --    Fin_Addr : null <or> 0x123456789
+      --    Fin_Start: TRUE <or> FALSE
+
+      Put ("Master   : ");
+      Put_Line (Address_Image (Master'Address));
+
+      Put ("Is_Hmgen : ");
+      Put_Line (Master.Is_Homogeneous'Img);
+
+      Put ("Base_Pool: ");
+      if Master.Base_Pool = null then
+         Put_Line ("null");
+      else
+         Put_Line (Address_Image (Master.Base_Pool'Address));
+      end if;
+
+      Put ("Fin_Addr : ");
+      if Master.Finalize_Address = null then
+         Put_Line ("null");
+      else
+         Put_Line (Address_Image (Master.Finalize_Address'Address));
+      end if;
+
+      Put ("Fin_Start: ");
+      Put_Line (Master.Finalization_Started'Img);
+
+      --  Output all chained elements. The format is the following:
+
+      --    ^ <or> ? <or> null
+      --    |Header: 0x123456789 (dummy head)
+      --    |  Prev: 0x123456789
+      --    |  Next: 0x123456789
+      --    V
+
+      --  ^ - the current element points back to the correct element
+      --  ? - the current element points back to an erroneous element
+      --  n - the current element points back to null
+
+      --  Header - the address of the list header
+      --  Prev   - the address of the list header which the current element
+      --           points back to
+      --  Next   - the address of the list header which the current element
+      --           points to
+      --  (dummy head) - present if dummy head
+
+      N_Ptr := Head;
+      while N_Ptr /= null loop  --  Should never be null
+         Put_Line ("V");
+
+         --  We see the head initially; we want to exit when we see the head a
+         --  second time.
+
+         if N_Ptr = Head then
+            exit when Head_Seen;
+
+            Head_Seen := True;
+         end if;
+
+         --  The current element is null. This should never happen since the
+         --  list is circular.
+
+         if N_Ptr.Prev = null then
+            Put_Line ("null (ERROR)");
+
+         --  The current element points back to the correct element
+
+         elsif N_Ptr.Prev.Next = N_Ptr then
+            Put_Line ("^");
+
+         --  The current element points to an erroneous element
+
+         else
+            Put_Line ("? (ERROR)");
+         end if;
+
+         --  Output the header and fields
+
+         Put ("|Header: ");
+         Put (Address_Image (N_Ptr.all'Address));
+
+         --  Detect the dummy head
+
+         if N_Ptr = Head then
+            Put_Line (" (dummy head)");
+         else
+            Put_Line ("");
+         end if;
+
+         Put ("|  Prev: ");
+
+         if N_Ptr.Prev = null then
+            Put_Line ("null");
+         else
+            Put_Line (Address_Image (N_Ptr.Prev.all'Address));
+         end if;
+
+         Put ("|  Next: ");
+
+         if N_Ptr.Next = null then
+            Put_Line ("null");
+         else
+            Put_Line (Address_Image (N_Ptr.Next.all'Address));
+         end if;
+
+         N_Ptr := N_Ptr.Next;
+      end loop;
+   end Print_Master;
+
+   -------------------
+   -- Set_Base_Pool --
+   -------------------
+
+   procedure Set_Base_Pool
+     (Master   : in out Finalization_Master;
+      Pool_Ptr : Any_Storage_Pool_Ptr)
+   is
+   begin
+      Master.Base_Pool := Pool_Ptr;
+   end Set_Base_Pool;
+
+   --------------------------
+   -- Set_Finalize_Address --
+   --------------------------
+
+   procedure Set_Finalize_Address
+     (Master       : in out Finalization_Master;
+      Fin_Addr_Ptr : Finalize_Address_Ptr)
+   is
+   begin
+      Master.Finalize_Address := Fin_Addr_Ptr;
+   end Set_Finalize_Address;
+
+   --------------------------
+   -- Set_Finalize_Address --
+   --------------------------
+
+   procedure Set_Finalize_Address
+     (Obj          : System.Address;
+      Fin_Addr_Ptr : Finalize_Address_Ptr)
+   is
+   begin
+      Lock_Task.all;
+      Finalize_Address_Table.Set (Obj, Fin_Addr_Ptr);
+      Unlock_Task.all;
+   end Set_Finalize_Address;
+
+   --------------------------
+   -- Set_Is_Heterogeneous --
+   --------------------------
+
+   procedure Set_Is_Heterogeneous (Master : in out Finalization_Master) is
+   begin
+      Master.Is_Homogeneous := False;
+   end Set_Is_Heterogeneous;
+
+end System.Finalization_Masters;
diff --git a/gcc/ada/s-finmas.ads b/gcc/ada/s-finmas.ads
new file mode 100644
index 00000000000..0ffc78af2d0
--- /dev/null
+++ b/gcc/ada/s-finmas.ads
@@ -0,0 +1,193 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--           S Y S T E M . F I N A L I Z A T I O N _ M A S T E R S          --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Finalization;
+with System.Storage_Elements;
+with System.Storage_Pools;
+
+pragma Compiler_Unit;
+
+package System.Finalization_Masters is
+   pragma Preelaborate;
+
+   --  A reference to primitive Finalize_Address. The expander generates an
+   --  implementation of this procedure for each controlled and class-wide
+   --  type. Since controlled objects are simply viewed as addresses once
+   --  allocated through a master, Finalize_Address provides a backward
+   --  indirection from an address to a type-specific context.
+
+   type Finalize_Address_Ptr is access procedure (Obj : System.Address);
+
+   --  Heterogeneous collection type structure
+
+   type FM_Node is private;
+   type FM_Node_Ptr is access all FM_Node;
+   pragma No_Strict_Aliasing (FM_Node_Ptr);
+
+   --  A reference to any derivation from Root_Storage_Pool. Since this type
+   --  may not be used to allocate objects, its storage size is zero.
+
+   type Any_Storage_Pool_Ptr is
+     access System.Storage_Pools.Root_Storage_Pool'Class;
+   for Any_Storage_Pool_Ptr'Storage_Size use 0;
+
+   --  Finalization master type structure. A unique master is associated with
+   --  each access-to-controlled or access-to-class-wide type. Masters also act
+   --  as components of subpools. By default, a master contains objects of the
+   --  same designated type but it may also accomodate heterogeneous objects.
+
+   type Finalization_Master is
+     new Ada.Finalization.Limited_Controlled with private;
+
+   --  A reference to a finalization master. Since this type may not be used
+   --  to allocate objects, its storage size is zero.
+
+   type Finalization_Master_Ptr is access all Finalization_Master;
+   for Finalization_Master_Ptr'Storage_Size use 0;
+
+   procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
+   --  Prepend a node to a specific finalization master
+
+   procedure Delete_Finalize_Address (Obj : System.Address);
+   --  Destroy the relation pair object - Finalize_Address from the internal
+   --  hash table.
+
+   procedure Detach (N : not null FM_Node_Ptr);
+   --  Remove a node from an arbitrary finalization master
+
+   overriding procedure Finalize (Master : in out Finalization_Master);
+   --  Lock the master to prevent allocations during finalization. Iterate over
+   --  the list of allocated controlled objects, finalizing each one by calling
+   --  its specific Finalize_Address. In the end, deallocate the dummy head.
+
+   function Finalize_Address
+     (Master : Finalization_Master) return Finalize_Address_Ptr;
+   --  Return a reference to the TSS primitive Finalize_Address associated with
+   --  a master.
+
+   function Finalize_Address
+     (Obj : System.Address) return Finalize_Address_Ptr;
+   --  Retrieve the Finalize_Address primitive associated with a particular
+   --  object.
+
+   function Finalization_Started (Master : Finalization_Master) return Boolean;
+   --  Return the finalization status of a master
+
+   function Header_Offset return System.Storage_Elements.Storage_Offset;
+   --  Return the size of type FM_Node as Storage_Offset
+
+   function Header_Size return System.Storage_Elements.Storage_Count;
+   --  Return the size of type FM_Node as Storage_Count
+
+   function Is_Homogeneous (Master : Finalization_Master) return Boolean;
+   --  Return the behavior flag of a master
+
+   function Objects (Master : Finalization_Master) return FM_Node_Ptr;
+   --  Return the header of the doubly-linked list of controlled objects
+
+   procedure Print_Master (Master : Finalization_Master);
+   --  Debug routine, outputs the contents of a master
+
+   procedure Set_Finalize_Address
+     (Master       : in out Finalization_Master;
+      Fin_Addr_Ptr : Finalize_Address_Ptr);
+   --  Set the clean up routine of a finalization master. Note: this routine
+   --  must precede the one below since RTSfind needs to match this one.
+
+   procedure Set_Finalize_Address
+     (Obj          : System.Address;
+      Fin_Addr_Ptr : Finalize_Address_Ptr);
+   --  Add a relation pair object - Finalize_Address to the internal hash table
+
+   procedure Set_Is_Heterogeneous (Master : in out Finalization_Master);
+   --  Mark the master as being a heterogeneous collection of objects
+
+private
+   --  Heterogeneous collection type structure
+
+   type FM_Node is record
+      Prev : FM_Node_Ptr := null;
+      Next : FM_Node_Ptr := null;
+   end record;
+
+   --  Finalization master type structure. A unique master is associated with
+   --  each access-to-controlled or access-to-class-wide type. Masters also act
+   --  as components of subpools. By default, a master contains objects of the
+   --  same designated type but it may also accomodate heterogeneous objects.
+
+   type Finalization_Master is
+     new Ada.Finalization.Limited_Controlled with
+   record
+      Is_Homogeneous : Boolean := True;
+      --  A flag which controls the behavior of the master. A value of False
+      --  denotes a heterogeneous collection.
+
+      Base_Pool : Any_Storage_Pool_Ptr := null;
+      --  A reference to the pool which this finalization master services. This
+      --  field is used in conjunction with the build-in-place machinery.
+
+      Objects : aliased FM_Node;
+      --  A doubly linked list which contains the headers of all controlled
+      --  objects allocated in a [sub]pool.
+
+      Finalize_Address : Finalize_Address_Ptr := null;
+      --  A reference to the routine reponsible for object finalization. This
+      --  is used only when the master is in homogeneous mode.
+
+      Finalization_Started : Boolean := False;
+      pragma Atomic (Finalization_Started);
+      --  A flag used to detect allocations which occur during the finalization
+      --  of a master. The allocations must raise Program_Error. This scenario
+      --  may arise in a multitask environment. The flag is atomic because it
+      --  is accessed without Lock_Task / Unlock_Task.
+   end record;
+
+   --  Since RTSfind cannot contain names of the form RE_"+", the following
+   --  routine serves as a wrapper around System.Storage_Elements."+".
+
+   function Add_Offset_To_Address
+     (Addr   : System.Address;
+      Offset : System.Storage_Elements.Storage_Offset) return System.Address;
+
+   function Base_Pool
+     (Master : Finalization_Master) return Any_Storage_Pool_Ptr;
+   --  Return a reference to the underlying storage pool on which the master
+   --  operates.
+
+   overriding procedure Initialize (Master : in out Finalization_Master);
+   --  Initialize the dummy head of a finalization master
+
+   procedure Set_Base_Pool
+     (Master   : in out Finalization_Master;
+      Pool_Ptr : Any_Storage_Pool_Ptr);
+   --  Set the underlying pool of a finalization master
+
+end System.Finalization_Masters;
diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index 8f0d9e84dd0..cb07f40902e 100644
--- a/gcc/ada/s-gearop.adb
+++ b/gcc/ada/s-gearop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2006-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2006-2011, 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- --
@@ -43,6 +43,27 @@ package body System.Generic_Array_Operations is
       First : Integer) return Integer;
    pragma Inline_Always (Check_Unit_Last);
 
+   --------------
+   -- Diagonal --
+   --------------
+
+   function Diagonal (A : Matrix) return Vector is
+
+      N : constant Natural := Natural'Min (A'Length (1), A'Length (2));
+      R : Vector (A'First (1) .. A'First (1) + N - 1);
+
+   begin
+      for J in 0 .. N - 1 loop
+         R (R'First + J) := A (A'First (1) + J, A'First (2) + J);
+      end loop;
+
+      return R;
+   end Diagonal;
+
+   --------------------------
+   -- Square_Matrix_Length --
+   --------------------------
+
    function Square_Matrix_Length (A : Matrix) return Natural is
    begin
       if A'Length (1) /= A'Length (2) then
@@ -73,6 +94,213 @@ package body System.Generic_Array_Operations is
       return First + (Order - 1);
    end Check_Unit_Last;
 
+   ---------------------
+   -- Back_Substitute --
+   ---------------------
+
+   procedure Back_Substitute (M, N : in out Matrix) is
+      pragma Assert (M'First (1) = N'First (1) and then
+                     M'Last  (1) = N'Last (1));
+
+      Max_Col : Integer := M'Last (2);
+
+      procedure Sub_Row
+        (M      : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar);
+      --  Needs comments ???
+
+      procedure Sub_Row
+        (M      : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar)
+      is
+      begin
+         for J in M'Range (2) loop
+            M (Target, J) := M (Target, J) - Factor * M (Source, J);
+         end loop;
+      end Sub_Row;
+
+   --  Start of processing for Back_Substitute
+
+   begin
+      for Row in reverse M'Range (1) loop
+         Find_Non_Zero : for Col in M'First (2) .. Max_Col loop
+            if Is_Non_Zero (M (Row, Col)) then
+
+               --  Found first non-zero element, so subtract a multiple
+               --  of this row from all higher rows, to reduce all other
+               --  elements in this column to zero.
+
+               for J in M'First (1) .. Row - 1 loop
+                  Sub_Row (N, J, Row, (M (J, Col) / M (Row, Col)));
+                  Sub_Row (M, J, Row, (M (J, Col) / M (Row, Col)));
+               end loop;
+
+               Max_Col := Col - 1;
+               exit Find_Non_Zero;
+            end if;
+         end loop Find_Non_Zero;
+      end loop;
+   end Back_Substitute;
+
+   -----------------------
+   -- Forward_Eliminate --
+   -----------------------
+
+   procedure Forward_Eliminate
+     (M   : in out Matrix;
+      N   : in out Matrix;
+      Det : out Scalar)
+   is
+      pragma Assert (M'First (1) = N'First (1) and then
+                     M'Last  (1) = N'Last (1));
+
+      function "abs" (X : Scalar) return Scalar is
+        (if X < Zero then Zero - X else X);
+
+      procedure Sub_Row
+        (M : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar);
+      --  Needs commenting ???
+
+      procedure Divide_Row
+        (M, N  : in out Matrix;
+         Row   : Integer;
+         Scale : Scalar);
+      --  Needs commenting ???
+
+      procedure Switch_Row
+        (M, N  : in out Matrix;
+         Row_1 : Integer;
+         Row_2 : Integer);
+      --  Needs commenting ???
+
+      -------------
+      -- Sub_Row --
+      -------------
+
+      procedure Sub_Row
+        (M      : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar)
+         is
+      begin
+         for J in M'Range (2) loop
+            M (Target, J) := M (Target, J) - Factor * M (Source, J);
+         end loop;
+      end Sub_Row;
+
+      ----------------
+      -- Divide_Row --
+      ----------------
+
+      procedure Divide_Row
+        (M, N  : in out Matrix;
+         Row   : Integer;
+         Scale : Scalar)
+      is
+      begin
+         Det := Det * Scale;
+
+         for J in M'Range (2) loop
+            M (Row, J) := M (Row, J) / Scale;
+         end loop;
+
+         for J in N'Range (2) loop
+            N (Row - M'First (1) + N'First (1), J)
+               := N (Row - M'First (1) + N'First (1), J) / Scale;
+         end loop;
+      end Divide_Row;
+
+      ----------------
+      -- Switch_Row --
+      ----------------
+
+      procedure Switch_Row
+        (M, N  : in out Matrix;
+         Row_1 : Integer;
+         Row_2 : Integer)
+      is
+         procedure Swap (X, Y : in out Scalar);
+         --  Exchange the values of X and Y
+
+         procedure Swap (X, Y : in out Scalar) is
+            T : constant Scalar := X;
+         begin
+            X := Y;
+            Y := T;
+         end Swap;
+
+      --  Start of processing for Switch_Row
+
+      begin
+         if Row_1 /= Row_2 then
+            Det := Zero - Det;
+
+            for J in M'Range (2) loop
+               Swap (M (Row_1, J), M (Row_2, J));
+            end loop;
+
+            for J in N'Range (2) loop
+               Swap (N (Row_1 - M'First (1) + N'First (1), J),
+                     N (Row_2 - M'First (1) + N'First (1), J));
+            end loop;
+         end if;
+      end Switch_Row;
+
+      I : Integer := M'First (1);
+      --  Avoid use of I ???
+
+   --  Start of processing for Forward_Eliminate
+
+   begin
+      Det := One;
+
+      for J in M'Range (2) loop
+         declare
+            Max_I   : Integer := I;
+            Max_Abs : Scalar := Zero;
+
+         begin
+            --  Find best pivot in column J, starting in row I
+
+            for K in I .. M'Last (1) loop
+               declare
+                  New_Abs : constant Scalar := abs M (K, J);
+               begin
+                  if Max_Abs < New_Abs then
+                     Max_Abs := New_Abs;
+                     Max_I := K;
+                  end if;
+               end;
+            end loop;
+
+            if Zero < Max_Abs then
+               Switch_Row (M, N, I, Max_I);
+               Divide_Row (M, N, I, M (I, J));
+
+               for U in I + 1 .. M'Last (1) loop
+                  Sub_Row (N, U, I, M (U, J));
+                  Sub_Row (M, U, I, M (U, J));
+               end loop;
+
+               exit when I >= M'Last (1);
+
+               I := I + 1;
+
+            else
+               Det := Zero; --  Zero, but we don't have literals
+            end if;
+         end;
+      end loop;
+   end Forward_Eliminate;
+
    -------------------
    -- Inner_Product --
    -------------------
@@ -97,6 +325,15 @@ package body System.Generic_Array_Operations is
       return R;
    end Inner_Product;
 
+   -------------
+   -- L2_Norm --
+   -------------
+
+   function L2_Norm (X : Vector) return Scalar is
+   begin
+      return Sqrt (Inner_Product (X, X));
+   end L2_Norm;
+
    ----------------------------------
    -- Matrix_Elementwise_Operation --
    ----------------------------------
@@ -139,6 +376,7 @@ package body System.Generic_Array_Operations is
       return Result_Matrix
    is
       R : Result_Matrix (Left'Range (1), Left'Range (2));
+
    begin
       if Left'Length (1) /= Right'Length (1)
         or else Left'Length (2) /= Right'Length (2)
@@ -337,6 +575,7 @@ package body System.Generic_Array_Operations is
          for K in R'Range (2) loop
             declare
                S : Result_Scalar := Zero;
+
             begin
                for M in Left'Range (2) loop
                   S := S + Left (J, M)
@@ -370,6 +609,7 @@ package body System.Generic_Array_Operations is
       for J in Left'Range (1) loop
          declare
             S : Result_Scalar := Zero;
+
          begin
             for K in Left'Range (2) loop
                S := S + Left (J, K) * Right (K - Left'First (2) + Right'First);
@@ -402,6 +642,20 @@ package body System.Generic_Array_Operations is
       return R;
    end Outer_Product;
 
+   -----------------
+   -- Swap_Column --
+   -----------------
+
+   procedure Swap_Column (A : in out Matrix; Left, Right : Integer) is
+      Temp : Scalar;
+   begin
+      for J in A'Range (1) loop
+         Temp := A (J, Left);
+         A (J, Left) := A (J, Right);
+         A (J, Right) := Temp;
+      end loop;
+   end Swap_Column;
+
    ---------------
    -- Transpose --
    ---------------
diff --git a/gcc/ada/s-gearop.ads b/gcc/ada/s-gearop.ads
index dfbceb3d058..51e3b92c201 100644
--- a/gcc/ada/s-gearop.ads
+++ b/gcc/ada/s-gearop.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2006-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2006-2011, 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- --
@@ -32,6 +32,50 @@
 package System.Generic_Array_Operations is
 pragma Pure (Generic_Array_Operations);
 
+   ---------------------
+   -- Back_Substitute --
+   ---------------------
+
+   generic
+      type Scalar is private;
+      type Matrix is array (Integer range <>, Integer range <>) of Scalar;
+      with function "-" (Left, Right : Scalar) return Scalar is <>;
+      with function "*" (Left, Right : Scalar) return Scalar is <>;
+      with function "/" (Left, Right : Scalar) return Scalar is <>;
+      with function Is_Non_Zero (X : Scalar) return Boolean is <>;
+   procedure Back_Substitute (M, N : in out Matrix);
+
+   --------------
+   -- Diagonal --
+   --------------
+
+   generic
+      type Scalar is private;
+      type Vector is array (Integer range <>) of Scalar;
+      type Matrix is array (Integer range <>, Integer range <>) of Scalar;
+   function Diagonal (A : Matrix) return Vector;
+
+   -----------------------
+   -- Forward_Eliminate --
+   -----------------------
+
+   --  Use elementary row operations to put square matrix M in row echolon
+   --  form. Identical row operations are performed on matrix N, must have the
+   --  same number of rows as M.
+
+   generic
+      type Scalar is private;
+      type Matrix is array (Integer range <>, Integer range <>) of Scalar;
+      with function "-" (Left, Right : Scalar) return Scalar is <>;
+      with function "*" (Left, Right : Scalar) return Scalar is <>;
+      with function "/" (Left, Right : Scalar) return Scalar is <>;
+      with function "<" (Left, Right : Scalar) return Boolean is <>;
+      Zero, One : Scalar;
+   procedure Forward_Eliminate
+     (M   : in out Matrix;
+      N   : in out Matrix;
+      Det : out Scalar);
+
    --------------------------
    -- Square_Matrix_Length --
    --------------------------
@@ -242,6 +286,17 @@ pragma Pure (Generic_Array_Operations);
      (Left  : Left_Vector;
       Right : Right_Vector) return Result_Scalar;
 
+   -------------
+   -- L2_Norm --
+   -------------
+
+   generic
+      type Scalar is private;
+      type Vector is array (Integer range <>) of Scalar;
+      with function Inner_Product (Left, Right : Vector) return Scalar is <>;
+      with function Sqrt (X : Scalar) return Scalar is <>;
+   function L2_Norm (X : Vector) return Scalar;
+
    -------------------
    -- Outer_Product --
    -------------------
@@ -332,6 +387,15 @@ pragma Pure (Generic_Array_Operations);
      (Left  : Left_Matrix;
       Right : Right_Matrix) return Result_Matrix;
 
+   -----------------
+   -- Swap_Column --
+   -----------------
+
+   generic
+      type Scalar is private;
+      type Matrix is array (Integer range <>, Integer range <>) of Scalar;
+   procedure Swap_Column (A : in out Matrix; Left, Right : Integer);
+
    ---------------
    -- Transpose --
    ---------------
diff --git a/gcc/ada/s-interr-hwint.adb b/gcc/ada/s-interr-hwint.adb
index 038db362f23..1a43c952840 100644
--- a/gcc/ada/s-interr-hwint.adb
+++ b/gcc/ada/s-interr-hwint.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -1025,7 +1025,9 @@ package body System.Interrupts is
 
    exception
       when Standard'Abort_Signal =>
+
          --  Flush interrupt server semaphores, so they can terminate
+
          Finalize_Interrupt_Servers;
          raise;
    end Interrupt_Manager;
diff --git a/gcc/ada/s-parint.ads b/gcc/ada/s-parint.ads
index 3086d4210d8..a6257cc72b3 100644
--- a/gcc/ada/s-parint.ads
+++ b/gcc/ada/s-parint.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1995-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -38,7 +38,6 @@ with Interfaces;
 with System.RPC;
 
 package System.Partition_Interface is
-
    pragma Elaborate_Body;
 
    type DSA_Implementation_Name is (No_DSA, GARLIC_DSA, PolyORB_DSA);
@@ -46,12 +45,14 @@ package System.Partition_Interface is
    --  Identification of this DSA implementation variant
 
    PCS_Version : constant := 1;
-   --  Version of the PCS API (for Exp_Dist consistency check).
-   --  This version number is matched against Gnatvsn.PCS_Version_Number to
-   --  ensure that the versions of Exp_Dist and the PCS are consistent.
-
-   --  RCI receiving stubs contain a table of descriptors for
-   --  all user subprograms exported by the unit.
+   --  Version of the PCS API (for Exp_Dist consistency check)
+   --
+   --  This version number is matched against corresponding element of
+   --  Exp_Dist.PCS_Version_Number to ensure that the versions of Exp_Dist
+   --  and the PCS are consistent.
+
+   --  RCI receiving stubs contain a table of descriptors for all user
+   --  subprograms exported by the unit.
 
    type Subprogram_Id is new Natural;
    First_RCI_Subprogram_Id : constant := 2;
diff --git a/gcc/ada/s-pooglo.adb b/gcc/ada/s-pooglo.adb
index dc5596272c6..e4dcdb091c7 100644
--- a/gcc/ada/s-pooglo.adb
+++ b/gcc/ada/s-pooglo.adb
@@ -46,13 +46,19 @@ package body System.Pool_Global is
       Storage_Size : SSE.Storage_Count;
       Alignment    : SSE.Storage_Count)
    is
+      use SSE;
       pragma Warnings (Off, Pool);
-      pragma Warnings (Off, Alignment);
 
-      Allocated : System.Address;
+      Aligned_Size    : Storage_Count := Storage_Size;
+      Aligned_Address : System.Address;
+      Allocated       : System.Address;
 
    begin
-      Allocated := Memory.Alloc (Memory.size_t (Storage_Size));
+      if Alignment > Standard'System_Allocator_Alignment then
+         Aligned_Size := Aligned_Size + Alignment;
+      end if;
+
+      Allocated := Memory.Alloc (Memory.size_t (Aligned_Size));
 
       --  The call to Alloc returns an address whose alignment is compatible
       --  with the worst case alignment requirement for the machine; thus the
@@ -60,6 +66,33 @@ package body System.Pool_Global is
 
       if Allocated = Null_Address then
          raise Storage_Error;
+      end if;
+
+      --  Case where alignment requested is greater than the alignment that is
+      --  guaranteed to be provided by the system allocator.
+
+      if Alignment > Standard'System_Allocator_Alignment then
+
+         --  Realign the returned address
+
+         Aligned_Address := To_Address
+           (To_Integer (Allocated) + Integer_Address (Alignment)
+              - (To_Integer (Allocated) mod Integer_Address (Alignment)));
+
+         --  Save the block address
+
+         declare
+            Saved_Address : System.Address;
+            pragma Import (Ada, Saved_Address);
+            for Saved_Address'Address use
+               Aligned_Address
+               - Storage_Offset (System.Address'Size / Storage_Unit);
+         begin
+            Saved_Address := Allocated;
+         end;
+
+         Address := Aligned_Address;
+
       else
          Address := Allocated;
       end if;
@@ -75,12 +108,31 @@ package body System.Pool_Global is
       Storage_Size : SSE.Storage_Count;
       Alignment    : SSE.Storage_Count)
    is
+      use System.Storage_Elements;
       pragma Warnings (Off, Pool);
       pragma Warnings (Off, Storage_Size);
-      pragma Warnings (Off, Alignment);
 
    begin
-      Memory.Free (Address);
+      --  Case where the alignment of the block exceeds the guaranteed
+      --  alignment required by the system storage allocator, meaning that
+      --  this was specially wrapped at allocation time.
+
+      if Alignment > Standard'System_Allocator_Alignment then
+
+         --  Retrieve the block address
+
+         declare
+            Saved_Address : System.Address;
+            pragma Import (Ada, Saved_Address);
+            for Saved_Address'Address use
+              Address - Storage_Offset (System.Address'Size / Storage_Unit);
+         begin
+            Memory.Free (Saved_Address);
+         end;
+
+      else
+         Memory.Free (Address);
+      end if;
    end Deallocate;
 
    ------------------
diff --git a/gcc/ada/s-soflin.adb b/gcc/ada/s-soflin.adb
index 1c0584451d6..27f6e54a575 100644
--- a/gcc/ada/s-soflin.adb
+++ b/gcc/ada/s-soflin.adb
@@ -46,11 +46,6 @@ package body System.Soft_Links is
 
    package SST renames System.Secondary_Stack;
 
-   NT_Exc_Stack : array (0 .. 8192) of aliased Character;
-   for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
-   --  Allocate an exception stack for the main program to use.
-   --  This is currently only used under VMS.
-
    NT_TSD : TSD;
    --  Note: we rely on the default initialization of NT_TSD
 
@@ -173,24 +168,6 @@ package body System.Soft_Links is
       return NT_TSD.Current_Excep'Access;
    end Get_Current_Excep_NT;
 
-   ---------------------------
-   -- Get_Exc_Stack_Addr_NT --
-   ---------------------------
-
-   function Get_Exc_Stack_Addr_NT return Address is
-   begin
-      return NT_Exc_Stack (NT_Exc_Stack'Last)'Address;
-   end Get_Exc_Stack_Addr_NT;
-
-   -----------------------------
-   -- Get_Exc_Stack_Addr_Soft --
-   -----------------------------
-
-   function Get_Exc_Stack_Addr_Soft return Address is
-   begin
-      return Get_Exc_Stack_Addr.all;
-   end Get_Exc_Stack_Addr_Soft;
-
    ------------------------
    -- Get_GNAT_Exception --
    ------------------------
diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads
index b15f021dbca..f2d858bce8a 100644
--- a/gcc/ada/s-soflin.ads
+++ b/gcc/ada/s-soflin.ads
@@ -243,9 +243,6 @@ package System.Soft_Links is
    Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access;
    Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access;
 
-   function Get_Exc_Stack_Addr_NT return Address;
-   Get_Exc_Stack_Addr : Get_Address_Call := Get_Exc_Stack_Addr_NT'Access;
-
    function Get_Current_Excep_NT return EOA;
 
    Get_Current_Excep : Get_EOA_Call := Get_Current_Excep_NT'Access;
@@ -389,8 +386,6 @@ package System.Soft_Links is
    pragma Inline (Get_Sec_Stack_Addr_Soft);
    pragma Inline (Set_Sec_Stack_Addr_Soft);
 
-   function Get_Exc_Stack_Addr_Soft return Address;
-
    --  The following is a dummy record designed to mimic Communication_Block as
    --  defined in s-tpobop.ads:
 
diff --git a/gcc/ada/s-spsufi.adb b/gcc/ada/s-spsufi.adb
new file mode 100644
index 00000000000..86b18aad7df
--- /dev/null
+++ b/gcc/ada/s-spsufi.adb
@@ -0,0 +1,62 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--        S Y S T E M . S T O R A G E _ P O O L S . S U B P O O L S .       --
+--                          F I N A L I Z A T I O N                         --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body System.Storage_Pools.Subpools.Finalization is
+
+   -----------------------------
+   -- Finalize_And_Deallocate --
+   -----------------------------
+
+   procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle) is
+   begin
+      --  Do nothing if the subpool was never created or never used. The latter
+      --  case may arise with an array of subpool implementations.
+
+      if Subpool = null
+        or else Subpool.Owner = null
+        or else Subpool.Node = null
+      then
+         return;
+      end if;
+
+      --  Clean up all controlled objects allocated through the subpool
+
+      Finalize_Subpool (Subpool);
+
+      --  Dispatch to the user-defined implementation of Deallocate_Subpool
+
+      Deallocate_Subpool (Pool_Of_Subpool (Subpool).all, Subpool);
+
+      Subpool := null;
+   end Finalize_And_Deallocate;
+
+end System.Storage_Pools.Subpools.Finalization;
diff --git a/gcc/ada/s-spsufi.ads b/gcc/ada/s-spsufi.ads
new file mode 100644
index 00000000000..66aac4b07a9
--- /dev/null
+++ b/gcc/ada/s-spsufi.ads
@@ -0,0 +1,44 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--        S Y S T E M . S T O R A G E _ P O O L S . S U B P O O L S .       --
+--                          F I N A L I Z A T I O N                         --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Compiler_Unit;
+
+package System.Storage_Pools.Subpools.Finalization is
+
+   procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle);
+   --  This routine performs the following actions:
+   --    1) Finalize all objects chained on the subpool's master
+   --    2) Remove the the subpool from the owner's list of subpools
+   --    3) Deallocate the doubly linked list node associated with the subpool
+   --    4) Call Deallocate_Subpool
+
+end System.Storage_Pools.Subpools.Finalization;
diff --git a/gcc/ada/s-stopoo.adb b/gcc/ada/s-stopoo.adb
index c6674603366..3ac5beb176c 100644
--- a/gcc/ada/s-stopoo.adb
+++ b/gcc/ada/s-stopoo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2009 Free Software Foundation, Inc.            --
+--          Copyright (C) 2009-2011, 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- --
@@ -37,13 +37,12 @@ package body System.Storage_Pools is
 
    procedure Allocate_Any
     (Pool                     : in out Root_Storage_Pool'Class;
-     Storage_Address          : out Address;
+     Storage_Address          : out System.Address;
      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
      Alignment                : System.Storage_Elements.Storage_Count)
    is
    begin
-      Allocate
-        (Pool, Storage_Address, Size_In_Storage_Elements, Alignment);
+      Allocate (Pool, Storage_Address, Size_In_Storage_Elements, Alignment);
    end Allocate_Any;
 
    --------------------
@@ -52,12 +51,12 @@ package body System.Storage_Pools is
 
    procedure Deallocate_Any
     (Pool                     : in out Root_Storage_Pool'Class;
-     Storage_Address          : Address;
+     Storage_Address          : System.Address;
      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
      Alignment                : System.Storage_Elements.Storage_Count)
    is
    begin
-      Deallocate
-        (Pool, Storage_Address, Size_In_Storage_Elements, Alignment);
+      Deallocate (Pool, Storage_Address, Size_In_Storage_Elements, Alignment);
    end Deallocate_Any;
+
 end System.Storage_Pools;
diff --git a/gcc/ada/s-stopoo.ads b/gcc/ada/s-stopoo.ads
index c2d43f7c54c..1c4d12754a0 100644
--- a/gcc/ada/s-stopoo.ads
+++ b/gcc/ada/s-stopoo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -44,14 +44,14 @@ package System.Storage_Pools is
 
    procedure Allocate
      (Pool                     : in out Root_Storage_Pool;
-      Storage_Address          : out Address;
+      Storage_Address          : out System.Address;
       Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
       Alignment                : System.Storage_Elements.Storage_Count)
    is abstract;
 
    procedure Deallocate
      (Pool                     : in out Root_Storage_Pool;
-      Storage_Address          : Address;
+      Storage_Address          : System.Address;
       Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
       Alignment                : System.Storage_Elements.Storage_Count)
    is abstract;
@@ -62,6 +62,13 @@ package System.Storage_Pools is
    is abstract;
 
 private
+   type Root_Storage_Pool is abstract
+     new Ada.Finalization.Limited_Controlled with null record;
+
+   --  ??? Are these two still needed? It might be possible to use Subpools.
+   --  Allocate_Any_Controlled / Deallocate_Any_Controlled for non-controlled
+   --  objects.
+
    --  The following two procedures support the use of class-wide pool
    --  objects in storage pools. When a local type is given a class-wide
    --  storage pool, allocation and deallocation for the type must dispatch
@@ -71,16 +78,14 @@ private
 
    procedure Allocate_Any
     (Pool                     : in out Root_Storage_Pool'Class;
-     Storage_Address          : out Address;
+     Storage_Address          : out System.Address;
      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
      Alignment                : System.Storage_Elements.Storage_Count);
 
    procedure Deallocate_Any
     (Pool                     : in out Root_Storage_Pool'Class;
-     Storage_Address          : Address;
+     Storage_Address          : System.Address;
      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
      Alignment                : System.Storage_Elements.Storage_Count);
 
-   type Root_Storage_Pool is abstract
-     new Ada.Finalization.Limited_Controlled with null record;
 end System.Storage_Pools;
diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb
new file mode 100644
index 00000000000..2b4e7fc4044
--- /dev/null
+++ b/gcc/ada/s-stposu.adb
@@ -0,0 +1,774 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--        S Y S T E M . S T O R A G E _ P O O L S . S U B P O O L S         --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Exceptions;              use Ada.Exceptions;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with System.Address_Image;
+with System.Finalization_Masters; use System.Finalization_Masters;
+with System.IO;                   use System.IO;
+with System.Soft_Links;           use System.Soft_Links;
+with System.Storage_Elements;     use System.Storage_Elements;
+
+package body System.Storage_Pools.Subpools is
+
+   Finalize_Address_Table_In_Use : Boolean := False;
+   --  This flag should be set only when a successfull allocation on a subpool
+   --  has been performed and the associated Finalize_Address has been added to
+   --  the hash table in System.Finalization_Masters.
+
+   function Address_To_FM_Node_Ptr is
+     new Ada.Unchecked_Conversion (Address, FM_Node_Ptr);
+
+   procedure Attach (N : not null SP_Node_Ptr; L : not null SP_Node_Ptr);
+   --  Attach a subpool node to a pool
+
+   procedure Free is new Ada.Unchecked_Deallocation (SP_Node, SP_Node_Ptr);
+
+   procedure Detach (N : not null SP_Node_Ptr);
+   --  Unhook a subpool node from an arbitrary subpool list
+
+   function Nearest_Multiple_Rounded_Up
+     (Size      : Storage_Count;
+      Alignment : Storage_Count) return Storage_Count;
+   --  Given arbitrary values of storage size and alignment, calculate the
+   --  nearest multiple of the alignment rounded up where size can fit.
+
+   --------------
+   -- Allocate --
+   --------------
+
+   overriding procedure Allocate
+     (Pool                     : in out Root_Storage_Pool_With_Subpools;
+      Storage_Address          : out System.Address;
+      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+      Alignment                : System.Storage_Elements.Storage_Count)
+   is
+   begin
+      --  Dispatch to the user-defined implementations of Allocate_From_Subpool
+      --  and Default_Subpool_For_Pool.
+
+      Allocate_From_Subpool
+        (Root_Storage_Pool_With_Subpools'Class (Pool),
+         Storage_Address,
+         Size_In_Storage_Elements,
+         Alignment,
+         Default_Subpool_For_Pool
+           (Root_Storage_Pool_With_Subpools'Class (Pool)));
+   end Allocate;
+
+   -----------------------------
+   -- Allocate_Any_Controlled --
+   -----------------------------
+
+   procedure Allocate_Any_Controlled
+     (Pool            : in out Root_Storage_Pool'Class;
+      Context_Subpool : Subpool_Handle;
+      Context_Master  : Finalization_Masters.Finalization_Master_Ptr;
+      Fin_Address     : Finalization_Masters.Finalize_Address_Ptr;
+      Addr            : out System.Address;
+      Storage_Size    : System.Storage_Elements.Storage_Count;
+      Alignment       : System.Storage_Elements.Storage_Count;
+      Is_Controlled   : Boolean;
+      On_Subpool      : Boolean)
+   is
+      Is_Subpool_Allocation : constant Boolean :=
+                                Pool in Root_Storage_Pool_With_Subpools'Class;
+
+      Master  : Finalization_Master_Ptr := null;
+      N_Addr  : Address;
+      N_Ptr   : FM_Node_Ptr;
+      N_Size  : Storage_Count;
+      Subpool : Subpool_Handle := null;
+
+      Header_And_Padding : Storage_Offset;
+      --  This offset includes the size of a FM_Node plus any additional
+      --  padding due to a larger alignment.
+
+   begin
+      --  Step 1: Pool-related runtime checks
+
+      --  Allocation on a pool_with_subpools. In this scenario there is a
+      --  master for each subpool. The master of the access type is ignored.
+
+      if Is_Subpool_Allocation then
+
+         --  Case of an allocation without a Subpool_Handle. Dispatch to the
+         --  implementation of Default_Subpool_For_Pool.
+
+         if Context_Subpool = null then
+            Subpool :=
+              Default_Subpool_For_Pool
+                (Root_Storage_Pool_With_Subpools'Class (Pool));
+
+         --  Allocation with a Subpool_Handle
+
+         else
+            Subpool := Context_Subpool;
+         end if;
+
+         --  Ensure proper ownership and chaining of the subpool
+
+         if Subpool.Owner /=
+              Root_Storage_Pool_With_Subpools'Class (Pool)'Unchecked_Access
+           or else Subpool.Node = null
+           or else Subpool.Node.Prev = null
+           or else Subpool.Node.Next = null
+         then
+            raise Program_Error with "incorrect owner of subpool";
+         end if;
+
+         Master := Subpool.Master'Unchecked_Access;
+
+      --  Allocation on a simple pool. In this scenario there is a master for
+      --  each access-to-controlled type. No context subpool should be present.
+
+      else
+         --  If the master is missing, then the expansion of the access type
+         --  failed to create one. This is a serious error.
+
+         if Context_Master = null then
+            raise Program_Error with "missing master in pool allocation";
+         end if;
+
+         --  If a subpool is present, then this is the result of erroneous
+         --  allocator expansion. This is not a serious error, but it should
+         --  still be detected.
+
+         if Context_Subpool /= null then
+            raise Program_Error with "subpool not required in pool allocation";
+         end if;
+
+         --  If the allocation is intended to be on a subpool, but the access
+         --  type's pool does not support subpools, then this is the result of
+         --  erroneous end-user code.
+
+         if On_Subpool then
+            raise Program_Error
+              with "pool of access type does not support subpools";
+         end if;
+
+         Master := Context_Master;
+      end if;
+
+      --  Step 2: Master, Finalize_Address-related runtime checks and size
+      --  calculations.
+
+      --  Allocation of a descendant from [Limited_]Controlled, a class-wide
+      --  object or a record with controlled components.
+
+      if Is_Controlled then
+
+         --  Do not allow the allocation of controlled objects while the
+         --  associated master is being finalized.
+
+         if Finalization_Started (Master.all) then
+            raise Program_Error with "allocation after finalization started";
+         end if;
+
+         --  Check whether primitive Finalize_Address is available. If it is
+         --  not, then either the expansion of the designated type failed or
+         --  the expansion of the allocator failed. This is a serious error.
+
+         if Fin_Address = null then
+            raise Program_Error
+              with "primitive Finalize_Address not available";
+         end if;
+
+         --  The size must acount for the hidden header preceding the object.
+         --  Account for possible padding space before the header due to a
+         --  larger alignment.
+
+         Header_And_Padding :=
+           Nearest_Multiple_Rounded_Up
+             (Size      => Header_Size,
+              Alignment => Alignment);
+
+         N_Size := Storage_Size + Header_And_Padding;
+
+      --  Non-controlled allocation
+
+      else
+         N_Size := Storage_Size;
+      end if;
+
+      --  Step 3: Allocation of object
+
+      --  For descendants of Root_Storage_Pool_With_Subpools, dispatch to the
+      --  implementation of Allocate_From_Subpool.
+
+      if Is_Subpool_Allocation then
+         Allocate_From_Subpool
+           (Root_Storage_Pool_With_Subpools'Class (Pool),
+            N_Addr, N_Size, Alignment, Subpool);
+
+      --  For descendants of Root_Storage_Pool, dispatch to the implementation
+      --  of Allocate.
+
+      else
+         Allocate (Pool, N_Addr, N_Size, Alignment);
+      end if;
+
+      --  Step 4: Attachment
+
+      if Is_Controlled then
+
+         --  Map the allocated memory into a FM_Node record. This converts the
+         --  top of the allocated bits into a list header. If there is padding
+         --  due to larger alignment, the header is placed right next to the
+         --  object:
+
+         --     N_Addr  N_Ptr
+         --     |       |
+         --     V       V
+         --     +-------+---------------+----------------------+
+         --     |Padding|    Header     |        Object        |
+         --     +-------+---------------+----------------------+
+         --     ^       ^               ^
+         --     |       +- Header_Size -+
+         --     |                       |
+         --     +- Header_And_Padding --+
+
+         N_Ptr := Address_To_FM_Node_Ptr
+                    (N_Addr + Header_And_Padding - Header_Offset);
+
+         --  Prepend the allocated object to the finalization master
+
+         Attach (N_Ptr, Objects (Master.all));
+
+         --  Move the address from the hidden list header to the start of the
+         --  object. This operation effectively hides the list header.
+
+         Addr := N_Addr + Header_And_Padding;
+
+         --  Subpool allocations use heterogeneous masters to manage various
+         --  controlled objects. Associate a Finalize_Address with the object.
+         --  This relation pair is deleted when the object is deallocated or
+         --  when the associated master is finalized.
+
+         if Is_Subpool_Allocation then
+            pragma Assert (not Master.Is_Homogeneous);
+
+            Set_Finalize_Address (Addr, Fin_Address);
+            Finalize_Address_Table_In_Use := True;
+
+         --  Normal allocations chain objects on homogeneous collections
+
+         else
+            pragma Assert (Master.Is_Homogeneous);
+
+            if Finalize_Address (Master.all) = null then
+               Set_Finalize_Address (Master.all, Fin_Address);
+            end if;
+         end if;
+
+      --  Non-controlled allocation
+
+      else
+         Addr := N_Addr;
+      end if;
+   end Allocate_Any_Controlled;
+
+   ------------
+   -- Attach --
+   ------------
+
+   procedure Attach (N : not null SP_Node_Ptr; L : not null SP_Node_Ptr) is
+   begin
+      --  Ensure that the node has not been attached already
+
+      pragma Assert (N.Prev = null and then N.Next = null);
+
+      Lock_Task.all;
+
+      L.Next.Prev := N;
+      N.Next := L.Next;
+      L.Next := N;
+      N.Prev := L;
+
+      Unlock_Task.all;
+
+      --  Note: No need to unlock in case of an exception because the above
+      --  code can never raise one.
+   end Attach;
+
+   -------------------------------
+   -- Deallocate_Any_Controlled --
+   -------------------------------
+
+   procedure Deallocate_Any_Controlled
+     (Pool          : in out Root_Storage_Pool'Class;
+      Addr          : System.Address;
+      Storage_Size  : System.Storage_Elements.Storage_Count;
+      Alignment     : System.Storage_Elements.Storage_Count;
+      Is_Controlled : Boolean)
+   is
+      N_Addr : Address;
+      N_Ptr  : FM_Node_Ptr;
+      N_Size : Storage_Count;
+
+      Header_And_Padding : Storage_Offset;
+      --  This offset includes the size of a FM_Node plus any additional
+      --  padding due to a larger alignment.
+
+   begin
+      --  Step 1: Detachment
+
+      if Is_Controlled then
+
+         --  Destroy the relation pair object - Finalize_Address since it is no
+         --  longer needed.
+
+         if Finalize_Address_Table_In_Use then
+            Delete_Finalize_Address (Addr);
+         end if;
+
+         --  Account for possible padding space before the header due to a
+         --  larger alignment.
+
+         Header_And_Padding :=
+           Nearest_Multiple_Rounded_Up
+             (Size      => Header_Size,
+              Alignment => Alignment);
+
+         --    N_Addr  N_Ptr           Addr (from input)
+         --    |       |               |
+         --    V       V               V
+         --    +-------+---------------+----------------------+
+         --    |Padding|    Header     |        Object        |
+         --    +-------+---------------+----------------------+
+         --    ^       ^               ^
+         --    |       +- Header_Size -+
+         --    |                       |
+         --    +- Header_And_Padding --+
+
+         --  Convert the bits preceding the object into a list header
+
+         N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Offset);
+
+         --  Detach the object from the related finalization master. This
+         --  action does not need to know the prior context used during
+         --  allocation.
+
+         Detach (N_Ptr);
+
+         --  Move the address from the object to the beginning of the list
+         --  header.
+
+         N_Addr := Addr - Header_And_Padding;
+
+         --  The size of the deallocated object must include the size of the
+         --  hidden list header.
+
+         N_Size := Storage_Size + Header_And_Padding;
+
+      else
+         N_Addr := Addr;
+         N_Size := Storage_Size;
+      end if;
+
+      --  Step 2: Deallocation
+
+      --  Dispatch to the proper implementation of Deallocate. This action
+      --  covers both Root_Storage_Pool and Root_Storage_Pool_With_Subpools
+      --  implementations.
+
+      Deallocate (Pool, N_Addr, N_Size, Alignment);
+   end Deallocate_Any_Controlled;
+
+   ------------
+   -- Detach --
+   ------------
+
+   procedure Detach (N : not null SP_Node_Ptr) is
+   begin
+      --  Ensure that the node is attached to some list
+
+      pragma Assert (N.Next /= null and then N.Prev /= null);
+
+      Lock_Task.all;
+
+      N.Prev.Next := N.Next;
+      N.Next.Prev := N.Prev;
+      N.Prev := null;
+      N.Next := null;
+
+      Unlock_Task.all;
+
+      --  Note: No need to unlock in case of an exception because the above
+      --  code can never raise one.
+   end Detach;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   overriding procedure Finalize (Controller : in out Pool_Controller) is
+   begin
+      Finalize_Pool (Controller.Enclosing_Pool.all);
+   end Finalize;
+
+   -------------------
+   -- Finalize_Pool --
+   -------------------
+
+   procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools) is
+      Curr_Ptr : SP_Node_Ptr;
+      Ex_Occur : Exception_Occurrence;
+      Raised   : Boolean := False;
+
+      function Is_Empty_List (L : not null SP_Node_Ptr) return Boolean;
+      --  Determine whether a list contains only one element, the dummy head
+
+      -------------------
+      -- Is_Empty_List --
+      -------------------
+
+      function Is_Empty_List (L : not null SP_Node_Ptr) return Boolean is
+      begin
+         return L.Next = L and then L.Prev = L;
+      end Is_Empty_List;
+
+   --  Start of processing for Finalize_Pool
+
+   begin
+      --  It is possible for multiple tasks to cause the finalization of a
+      --  common pool. Allow only one task to finalize the contents.
+
+      if Pool.Finalization_Started then
+         return;
+      end if;
+
+      --  Lock the pool to prevent the creation of additional subpools while
+      --  the available ones are finalized. The pool remains locked because
+      --  either it is about to be deallocated or the associated access type
+      --  is about to go out of scope.
+
+      Pool.Finalization_Started := True;
+
+      while not Is_Empty_List (Pool.Subpools'Unchecked_Access) loop
+         Curr_Ptr := Pool.Subpools.Next;
+
+         --  Perform the following actions:
+
+         --    1) Finalize all objects chained on the subpool's master
+         --    2) Remove the the subpool from the owner's list of subpools
+         --    3) Deallocate the doubly linked list node associated with the
+         --       subpool.
+
+         begin
+            Finalize_Subpool (Curr_Ptr.Subpool);
+
+         exception
+            when Fin_Occur : others =>
+               if not Raised then
+                  Raised := True;
+                  Save_Occurrence (Ex_Occur, Fin_Occur);
+               end if;
+         end;
+      end loop;
+
+      --  If the finalization of a particular master failed, reraise the
+      --  exception now.
+
+      if Raised then
+         Reraise_Occurrence (Ex_Occur);
+      end if;
+   end Finalize_Pool;
+
+   ----------------------
+   -- Finalize_Subpool --
+   ----------------------
+
+   procedure Finalize_Subpool (Subpool : not null Subpool_Handle) is
+   begin
+      --  Do nothing if the subpool was never used
+
+      if Subpool.Owner = null
+        or else Subpool.Node = null
+      then
+         return;
+      end if;
+
+      --  Clean up all controlled objects chained on the subpool's master
+
+      Finalize (Subpool.Master);
+
+      --  Remove the subpool from its owner's list of subpools
+
+      Detach (Subpool.Node);
+
+      --  Destroy the associated doubly linked list node which was created in
+      --  Set_Pool_Of_Subpool.
+
+      Free (Subpool.Node);
+   end Finalize_Subpool;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   overriding procedure Initialize (Controller : in out Pool_Controller) is
+   begin
+      Initialize_Pool (Controller.Enclosing_Pool.all);
+   end Initialize;
+
+   ---------------------
+   -- Initialize_Pool --
+   ---------------------
+
+   procedure Initialize_Pool (Pool : in out Root_Storage_Pool_With_Subpools) is
+   begin
+      --  The dummy head must point to itself in both directions
+
+      Pool.Subpools.Next := Pool.Subpools'Unchecked_Access;
+      Pool.Subpools.Prev := Pool.Subpools'Unchecked_Access;
+   end Initialize_Pool;
+
+   ---------------------------------
+   -- Nearest_Multiple_Rounded_Up --
+   ---------------------------------
+
+   function Nearest_Multiple_Rounded_Up
+     (Size      : Storage_Count;
+      Alignment : Storage_Count) return Storage_Count
+   is
+   begin
+      if Size mod Alignment = 0 then
+         return Size;
+
+      --  Add enough padding to reach the nearest multiple of the alignment
+      --  rounding up.
+
+      else
+         return ((Size + Alignment - 1) / Alignment) * Alignment;
+      end if;
+   end Nearest_Multiple_Rounded_Up;
+
+   ---------------------
+   -- Pool_Of_Subpool --
+   ---------------------
+
+   function Pool_Of_Subpool (Subpool : not null Subpool_Handle)
+     return access Root_Storage_Pool_With_Subpools'Class is
+   begin
+      return Subpool.Owner;
+   end Pool_Of_Subpool;
+
+   ----------------
+   -- Print_Pool --
+   ----------------
+
+   procedure Print_Pool (Pool : Root_Storage_Pool_With_Subpools) is
+      Head      : constant SP_Node_Ptr := Pool.Subpools'Unrestricted_Access;
+      Head_Seen : Boolean := False;
+      SP_Ptr    : SP_Node_Ptr;
+
+   begin
+      --  Output the contents of the pool
+
+      --    Pool      : 0x123456789
+      --    Subpools  : 0x123456789
+      --    Fin_Start : TRUE <or> FALSE
+      --    Controller: OK <or> NOK
+
+      Put ("Pool      : ");
+      Put_Line (Address_Image (Pool'Address));
+
+      Put ("Subpools  : ");
+      Put_Line (Address_Image (Pool.Subpools'Address));
+
+      Put ("Fin_Start : ");
+      Put_Line (Pool.Finalization_Started'Img);
+
+      Put ("Controlled: ");
+      if Pool.Controller.Enclosing_Pool = Pool'Unrestricted_Access then
+         Put_Line ("OK");
+      else
+         Put_Line ("NOK (ERROR)");
+      end if;
+
+      SP_Ptr := Head;
+      while SP_Ptr /= null loop  --  Should never be null
+         Put_Line ("V");
+
+         --  We see the head initially; we want to exit when we see the head a
+         --  second time.
+
+         if SP_Ptr = Head then
+            exit when Head_Seen;
+
+            Head_Seen := True;
+         end if;
+
+         --  The current element is null. This should never happend since the
+         --  list is circular.
+
+         if SP_Ptr.Prev = null then
+            Put_Line ("null (ERROR)");
+
+         --  The current element points back to the correct element
+
+         elsif SP_Ptr.Prev.Next = SP_Ptr then
+            Put_Line ("^");
+
+         --  The current element points to an erroneous element
+
+         else
+            Put_Line ("? (ERROR)");
+         end if;
+
+         --  Output the contents of the node
+
+         Put ("|Header: ");
+         Put (Address_Image (SP_Ptr.all'Address));
+         if SP_Ptr = Head then
+            Put_Line (" (dummy head)");
+         else
+            Put_Line ("");
+         end if;
+
+         Put ("|  Prev: ");
+
+         if SP_Ptr.Prev = null then
+            Put_Line ("null");
+         else
+            Put_Line (Address_Image (SP_Ptr.Prev.all'Address));
+         end if;
+
+         Put ("|  Next: ");
+
+         if SP_Ptr.Next = null then
+            Put_Line ("null");
+         else
+            Put_Line (Address_Image (SP_Ptr.Next.all'Address));
+         end if;
+
+         Put ("|  Subp: ");
+
+         if SP_Ptr.Subpool = null then
+            Put_Line ("null");
+         else
+            Put_Line (Address_Image (SP_Ptr.Subpool.all'Address));
+         end if;
+
+         SP_Ptr := SP_Ptr.Next;
+      end loop;
+   end Print_Pool;
+
+   -------------------
+   -- Print_Subpool --
+   -------------------
+
+   procedure Print_Subpool (Subpool : Subpool_Handle) is
+   begin
+      if Subpool = null then
+         Put_Line ("null");
+         return;
+      end if;
+
+      --  Output the contents of a subpool
+
+      --    Owner : 0x123456789
+      --    Master: 0x123456789
+      --    Node  : 0x123456789
+
+      Put ("Owner : ");
+      if Subpool.Owner = null then
+         Put_Line ("null");
+      else
+         Put_Line (Address_Image (Subpool.Owner'Address));
+      end if;
+
+      Put ("Master: ");
+      Put_Line (Address_Image (Subpool.Master'Address));
+
+      Put ("Node  : ");
+      if Subpool.Node = null then
+         Put ("null");
+
+         if Subpool.Owner = null then
+            Put_Line (" OK");
+         else
+            Put_Line (" (ERROR)");
+         end if;
+      else
+         Put_Line (Address_Image (Subpool.Node'Address));
+      end if;
+
+      Print_Master (Subpool.Master);
+   end Print_Subpool;
+
+   -------------------------
+   -- Set_Pool_Of_Subpool --
+   -------------------------
+
+   procedure Set_Pool_Of_Subpool
+     (Subpool : not null Subpool_Handle;
+      Pool    : in out Root_Storage_Pool_With_Subpools'Class)
+   is
+      N_Ptr : SP_Node_Ptr;
+
+   begin
+      --  If the subpool is already owned, raise Program_Error. This is a
+      --  direct violation of the RM rules.
+
+      if Subpool.Owner /= null then
+         raise Program_Error with "subpool already belongs to a pool";
+      end if;
+
+      --  Prevent the creation of a new subpool while the owner is being
+      --  finalized. This is a serious error.
+
+      if Pool.Finalization_Started then
+         raise Program_Error
+           with "subpool creation after finalization started";
+      end if;
+
+      Subpool.Owner := Pool'Unchecked_Access;
+
+      --  Create a subpool node and decorate it. Since this node is not
+      --  allocated on the owner's pool, it must be explicitly destroyed by
+      --  Finalize_And_Detach.
+
+      N_Ptr := new SP_Node;
+      N_Ptr.Subpool := Subpool;
+      Subpool.Node := N_Ptr;
+
+      Attach (N_Ptr, Pool.Subpools'Unchecked_Access);
+
+      --  Mark the subpool's master as being a heterogeneous collection of
+      --  controlled objects.
+
+      Set_Is_Heterogeneous (Subpool.Master);
+   end Set_Pool_Of_Subpool;
+
+end System.Storage_Pools.Subpools;
diff --git a/gcc/ada/s-stposu.ads b/gcc/ada/s-stposu.ads
new file mode 100644
index 00000000000..0c5bd218515
--- /dev/null
+++ b/gcc/ada/s-stposu.ads
@@ -0,0 +1,344 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--        S Y S T E M . S T O R A G E _ P O O L S . S U B P O O L S         --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2011, Free Software Foundation, Inc.            --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Finalization;
+with System.Finalization_Masters;
+with System.Storage_Elements;
+
+package System.Storage_Pools.Subpools is
+   pragma Preelaborate;
+
+   type Root_Storage_Pool_With_Subpools is abstract
+     new Root_Storage_Pool with private;
+   --  The base for all implementations of Storage_Pool_With_Subpools. This
+   --  type is Limited_Controlled by derivation. To use subpools, an access
+   --  type must be associated with an implementation descending from type
+   --  Root_Storage_Pool_With_Subpools.
+
+   type Root_Subpool is abstract tagged limited private;
+   --  The base for all implementations of Subpool. Objects of this type are
+   --  managed by the pool_with_subpools.
+
+   type Subpool_Handle is access all Root_Subpool'Class;
+   for Subpool_Handle'Storage_Size use 0;
+   --  Since subpools are limited types by definition, a handle is instead used
+   --  to manage subpool abstractions.
+
+   overriding procedure Allocate
+     (Pool                     : in out Root_Storage_Pool_With_Subpools;
+      Storage_Address          : out System.Address;
+      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+      Alignment                : System.Storage_Elements.Storage_Count);
+   --  Allocate an object described by Size_In_Storage_Elements and Alignment
+   --  on the default subpool of Pool. Controlled types allocated through this
+   --  routine will NOT be handled properly.
+
+   procedure Allocate_From_Subpool
+     (Pool                     : in out Root_Storage_Pool_With_Subpools;
+      Storage_Address          : out System.Address;
+      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+      Alignment                : System.Storage_Elements.Storage_Count;
+      Subpool                  : not null Subpool_Handle)
+   is abstract;
+
+   --  ??? This precondition causes errors in simple tests, disabled for now
+
+--     with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
+   --  This routine requires implementation. Allocate an object described by
+   --  Size_In_Storage_Elements and Alignment on a subpool.
+
+   function Create_Subpool
+     (Pool         : in out Root_Storage_Pool_With_Subpools;
+      Storage_Size : Storage_Elements.Storage_Count :=
+                     Storage_Elements.Storage_Count'Last)
+   return not null Subpool_Handle
+   is abstract;
+   --  This routine requires implementation. Create a subpool within the given
+   --  pool_with_subpools.
+
+   overriding procedure Deallocate
+     (Pool                     : in out Root_Storage_Pool_With_Subpools;
+      Storage_Address          : System.Address;
+      Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+      Alignment                : System.Storage_Elements.Storage_Count)
+   is null;
+
+   procedure Deallocate_Subpool
+     (Pool    : in out Root_Storage_Pool_With_Subpools;
+      Subpool : in out Subpool_Handle)
+   is abstract;
+
+   --  ??? This precondition causes errors in simple tests, disabled for now
+
+--     with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
+   --  This routine requires implementation. Reclaim the storage a particular
+   --  subpool occupies in a pool_with_subpools. This routine is called by
+   --  Ada.Unchecked_Deallocate_Subpool.
+
+   function Default_Subpool_For_Pool
+     (Pool : Root_Storage_Pool_With_Subpools)
+   return not null Subpool_Handle
+   is abstract;
+   --  This routine requires implementation. Returns a common subpool used for
+   --  allocations without Subpool_Handle_name in the allocator.
+
+   function Pool_Of_Subpool
+     (Subpool : not null Subpool_Handle)
+   return access Root_Storage_Pool_With_Subpools'Class;
+   --  Return the owner of the subpool
+
+   procedure Set_Pool_Of_Subpool
+     (Subpool : not null Subpool_Handle;
+      Pool    : in out Root_Storage_Pool_With_Subpools'Class);
+   --  Set the owner of the subpool. This is intended to be called from
+   --  Create_Subpool or similar subpool constructors. Raises Program_Error
+   --  if the subpool already belongs to a pool.
+
+private
+   --  Model
+   --             Pool_With_Subpools     SP_Node    SP_Node    SP_Node
+   --       +-->+--------------------+   +-----+    +-----+    +-----+
+   --       |   |      Subpools -------->|  ------->|  ------->|  ------->
+   --       |   +--------------------+   +-----+    +-----+    +-----+
+   --       |   |Finalization_Started|<------  |<-------  |<-------  |<---
+   --       |   +--------------------+   +-----+    +-----+    +-----+
+   --       +--- Controller.Encl_Pool|   | nul |    |  +  |    |  +  |
+   --       |   +--------------------+   +-----+    +--|--+    +--:--+
+   --       |   :                    :    Dummy        |  ^       :
+   --       |   :                    :                 |  |       :
+   --       |                            Root_Subpool  V  |
+   --       |                            +-------------+  |
+   --       +-------------------------------- Owner    |  |
+   --               FM_Node   FM_Node    +-------------+  |
+   --               +-----+   +-----+<-- Master.Objects|  |
+   --            <------  |<------  |    +-------------+  |
+   --               +-----+   +-----+    |    Node -------+
+   --               |  ------>|  ----->  +-------------+
+   --               +-----+   +-----+    :             :
+   --               |ctrl |    Dummy     :             :
+   --               | obj |
+   --               +-----+
+   --
+   --  SP_Nodes are created on the heap. FM_Nodes and associated objects are
+   --  created on the pool_with_subpools.
+
+   type Any_Storage_Pool_With_Subpools_Ptr
+     is access all Root_Storage_Pool_With_Subpools'Class;
+   for Any_Storage_Pool_With_Subpools_Ptr'Storage_Size use 0;
+
+   --  A pool controller is a special controlled object which ensures the
+   --  proper initialization and finalization of the enclosing pool.
+
+   type Pool_Controller (Enclosing_Pool : Any_Storage_Pool_With_Subpools_Ptr)
+     is new Ada.Finalization.Limited_Controlled with null record;
+
+   --  Subpool list types. Each pool_with_subpools contains a list of subpools.
+   --  This is an indirect doubly linked list since subpools are not supposed
+   --  to be allocatable by language design.
+
+   type SP_Node;
+   type SP_Node_Ptr is access all SP_Node;
+
+   type SP_Node is record
+      Prev    : SP_Node_Ptr := null;
+      Next    : SP_Node_Ptr := null;
+      Subpool : Subpool_Handle := null;
+   end record;
+
+   --  Root_Storage_Pool_With_Subpools internal structure. The type uses a
+   --  special controller to perform initialization and finalization actions
+   --  on itself. This is necessary because the end user of this package may
+   --  decide to override Initialize and Finalize, thus disabling the desired
+   --  behavior.
+
+   --          Pool_With_Subpools     SP_Node    SP_Node    SP_Node
+   --    +-->+--------------------+   +-----+    +-----+    +-----+
+   --    |   |      Subpools -------->|  ------->|  ------->|  ------->
+   --    |   +--------------------+   +-----+    +-----+    +-----+
+   --    |   |Finalization_Started|   :     :    :     :    :     :
+   --    |   +--------------------+
+   --    +--- Controller.Encl_Pool|
+   --        +--------------------+
+   --        :       End-user     :
+   --        :      components    :
+
+   type Root_Storage_Pool_With_Subpools is abstract
+     new Root_Storage_Pool with
+   record
+      Subpools : aliased SP_Node;
+      --  A doubly linked list of subpools
+
+      Finalization_Started : Boolean := False;
+      pragma Atomic (Finalization_Started);
+      --  A flag which prevents the creation of new subpools while the master
+      --  pool is being finalized. The flag needs to be atomic because it is
+      --  accessed without Lock_Task / Unlock_Task.
+
+      Controller : Pool_Controller
+                     (Root_Storage_Pool_With_Subpools'Unchecked_Access);
+      --  A component which ensures that the enclosing pool is initialized and
+      --  finalized at the appropriate places.
+   end record;
+
+   --  A subpool is an abstraction layer which sits on top of a pool. It
+   --  contains links to all controlled objects allocated on a particular
+   --  subpool.
+
+   --        Pool_With_Subpools   SP_Node    SP_Node    SP_Node
+   --    +-->+----------------+   +-----+    +-----+    +-----+
+   --    |   |    Subpools ------>|  ------->|  ------->|  ------->
+   --    |   +----------------+   +-----+    +-----+    +-----+
+   --    |   :                :<------  |<-------  |<-------  |
+   --    |   :                :   +-----+    +-----+    +-----+
+   --    |                        |null |    |  +  |    |  +  |
+   --    |                        +-----+    +--|--+    +--:--+
+   --    |                                      |  ^       :
+   --    |                        Root_Subpool  V  |
+   --    |                        +-------------+  |
+   --    +---------------------------- Owner    |  |
+   --                             +-------------+  |
+   --                      .......... Master    |  |
+   --                             +-------------+  |
+   --                             |    Node -------+
+   --                             +-------------+
+   --                             :   End-user  :
+   --                             :  components :
+
+   type Root_Subpool is abstract tagged limited record
+      Owner : Any_Storage_Pool_With_Subpools_Ptr := null;
+      --  A reference to the master pool_with_subpools
+
+      Master : aliased System.Finalization_Masters.Finalization_Master;
+      --  A heterogeneous collection of controlled objects
+
+      Node : SP_Node_Ptr := null;
+      --  A link to the doubly linked list node which contains the subpool.
+      --  This back pointer is used in subpool deallocation.
+   end record;
+
+   --  ??? Once Storage_Pools.Allocate_Any is removed, this should be renamed
+   --  to Allocate_Any.
+
+   procedure Allocate_Any_Controlled
+     (Pool            : in out Root_Storage_Pool'Class;
+      Context_Subpool : Subpool_Handle;
+      Context_Master  : Finalization_Masters.Finalization_Master_Ptr;
+      Fin_Address     : Finalization_Masters.Finalize_Address_Ptr;
+      Addr            : out System.Address;
+      Storage_Size    : System.Storage_Elements.Storage_Count;
+      Alignment       : System.Storage_Elements.Storage_Count;
+      Is_Controlled   : Boolean;
+      On_Subpool      : Boolean);
+   --  Compiler interface. This version of Allocate handles all possible cases,
+   --  either on a pool or a pool_with_subpools, regardless of the controlled
+   --  status of the allocated object. Parameter usage:
+   --
+   --    * Pool - The pool associated with the access type. Pool can be any
+   --    derivation from Root_Storage_Pool, including a pool_with_subpools.
+   --
+   --    * Context_Subpool - The subpool handle name of an allocator. If no
+   --    subpool handle is present at the point of allocation, the actual
+   --    would be null.
+   --
+   --    * Context_Master - The finalization master associated with the access
+   --    type. If the access type's designated type is not controlled, the
+   --    actual would be null.
+   --
+   --    * Fin_Address - TSS routine Finalize_Address of the designated type.
+   --    If the designated type is not controlled, the actual would be null.
+   --
+   --    * Addr - The address of the allocated object.
+   --
+   --    * Storage_Size - The size of the allocated object.
+   --
+   --    * Alignment - The alignment of the allocated object.
+   --
+   --    * Is_Controlled - A flag which determines whether the allocated object
+   --    is controlled. When set to True, the machinery generates additional
+   --    data.
+   --
+   --    * On_Subpool - A flag which determines whether the a subpool handle
+   --    name is present at the point of allocation. This is used for error
+   --    diagnostics.
+
+   procedure Deallocate_Any_Controlled
+     (Pool          : in out Root_Storage_Pool'Class;
+      Addr          : System.Address;
+      Storage_Size  : System.Storage_Elements.Storage_Count;
+      Alignment     : System.Storage_Elements.Storage_Count;
+      Is_Controlled : Boolean);
+   --  Compiler interface. This version of Deallocate handles all possible
+   --  cases, either from a pool or a pool_with_subpools, regardless of the
+   --  controlled status of the deallocated object. Parameter usage:
+   --
+   --    * Pool - The pool associated with the access type. Pool can be any
+   --    derivation from Root_Storage_Pool, including a pool_with_subpools.
+   --
+   --    * Addr - The address of the allocated object.
+   --
+   --    * Storage_Size - The size of the allocated object.
+   --
+   --    * Alignment - The alignment of the allocated object.
+   --
+   --    * Is_Controlled - A flag which determines whether the allocated object
+   --    is controlled. When set to True, the machinery generates additional
+   --    data.
+
+   overriding procedure Finalize (Controller : in out Pool_Controller);
+   --  Buffer routine, calls Finalize_Pool
+
+   procedure Finalize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
+   --  Iterate over all subpools of Pool, detach them one by one and finalize
+   --  their masters. This action first detaches a controlled object from a
+   --  particular master, then invokes its Finalize_Address primitive.
+
+   procedure Finalize_Subpool (Subpool : not null Subpool_Handle);
+   --  Finalize all controlled objects chained on Subpool's master. Remove the
+   --  subpool from its owner's list. Deallocate the associated doubly linked
+   --  list node.
+
+   overriding procedure Initialize (Controller : in out Pool_Controller);
+   --  Buffer routine, calls Initialize_Pool
+
+   procedure Initialize_Pool (Pool : in out Root_Storage_Pool_With_Subpools);
+   --  Setup the doubly linked list of subpools
+
+   procedure Print_Pool (Pool : Root_Storage_Pool_With_Subpools);
+   --  Debug routine, output the contents of a pool_with_subpools
+
+   procedure Print_Subpool (Subpool : Subpool_Handle);
+   --  Debug routine, output the contents of a subpool
+
+end System.Storage_Pools.Subpools;
diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index 3e0b9ab7cd3..9d8ac90b59c 100644
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -164,7 +164,7 @@ package body System.Task_Primitives.Operations is
       --  cases (e.g. shutdown of the Server_Task in System.Interrupts) we
       --  need to send the Abort signal to a task.
 
-      if ZCX_By_Default and then GCC_ZCX_Support then
+      if ZCX_By_Default then
          return;
       end if;
 
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 8d46cbd98c1..f46736fbf5f 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -178,7 +178,7 @@ package body System.Task_Primitives.Operations is
       --  cases (e.g. shutdown of the Server_Task in System.Interrupts) we
       --  need to send the Abort signal to a task.
 
-      if ZCX_By_Default and then GCC_ZCX_Support then
+      if ZCX_By_Default then
          return;
       end if;
 
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 705e8a51434..2372d3d9b29 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -203,7 +203,7 @@ package body System.Task_Primitives.Operations is
       --  cases (e.g. shutdown of the Server_Task in System.Interrupts) we
       --  need to send the Abort signal to a task.
 
-      if ZCX_By_Default and then GCC_ZCX_Support then
+      if ZCX_By_Default then
          return;
       end if;
 
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index a48622d0345..042a9312326 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -265,7 +265,7 @@ package body System.Task_Primitives.Operations is
       --  cases (e.g. shutdown of the Server_Task in System.Interrupts) we
       --  need to send the Abort signal to a task.
 
-      if ZCX_By_Default and then GCC_ZCX_Support then
+      if ZCX_By_Default then
          return;
       end if;
 
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index cd6daca128f..6c2c527fe11 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -167,7 +167,7 @@ package body System.Task_Primitives.Operations is
       --  cases (e.g. shutdown of the Server_Task in System.Interrupts) we
       --  need to send the Abort signal to a task.
 
-      if ZCX_By_Default and then GCC_ZCX_Support then
+      if ZCX_By_Default then
          return;
       end if;
 
diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index bd19c474eaa..1759c5084c7 100644
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -136,9 +136,6 @@ package body System.Task_Primitives.Operations is
      new Ada.Unchecked_Conversion
        (Task_Id, System.Task_Primitives.Task_Address);
 
-   function Get_Exc_Stack_Addr return Address;
-   --  Replace System.Soft_Links.Get_Exc_Stack_Addr_NT
-
    procedure Timer_Sleep_AST (ID : Address);
    pragma Convention (C, Timer_Sleep_AST);
    --  Signal the condition variable when AST fires
@@ -755,7 +752,6 @@ package body System.Task_Primitives.Operations is
 
       if Result = 0 then
          Succeeded := True;
-         Self_ID.Common.LL.Exc_Stack_Ptr := new Exc_Stack_T;
 
       else
          if not Single_Lock then
@@ -770,15 +766,6 @@ package body System.Task_Primitives.Operations is
       pragma Assert (Result = 0);
    end Initialize_TCB;
 
-   ------------------------
-   -- Get_Exc_Stack_Addr --
-   ------------------------
-
-   function Get_Exc_Stack_Addr return Address is
-   begin
-      return Self.Common.LL.Exc_Stack_Ptr (Exc_Stack_T'Last)'Address;
-   end Get_Exc_Stack_Addr;
-
    -----------------
    -- Create_Task --
    -----------------
@@ -859,9 +846,6 @@ package body System.Task_Primitives.Operations is
       procedure Free is new
         Ada.Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
 
-      procedure Free is new Ada.Unchecked_Deallocation
-       (Exc_Stack_T, Exc_Stack_Ptr_T);
-
    begin
       if not Single_Lock then
          Result := pthread_mutex_destroy (T.Common.LL.L'Access);
@@ -875,7 +859,6 @@ package body System.Task_Primitives.Operations is
          Known_Tasks (T.Known_Tasks_Index) := null;
       end if;
 
-      Free (T.Common.LL.Exc_Stack_Ptr);
       Free (Tmp);
 
       if Is_Self then
@@ -1247,8 +1230,6 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
-      SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access;
-
       --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index e1f3986e2a5..0214efb63cc 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -188,7 +188,7 @@ package body System.Task_Primitives.Operations is
       --  It is not safe to raise an exception when using ZCX and the GCC
       --  exception handling mechanism.
 
-      if ZCX_By_Default and then GCC_ZCX_Support then
+      if ZCX_By_Default then
          return;
       end if;
 
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 074c86b6a4a..40772c94d09 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -566,7 +566,7 @@ package System.Tasking is
       --  Protection: Set by Activator before Self is activated, and only read
       --  and modified by Self after that.
 
-      Wait_Count : Integer;
+      Wait_Count : Natural;
       --  This count is used by a task that is waiting for other tasks. At all
       --  other times, the value should be zero. It is used differently in
       --  several different states. Since a task cannot be in more than one of
@@ -942,13 +942,13 @@ package System.Tasking is
       --  not write this field until the master is complete, the
       --  synchronization should be adequate to prevent races.
 
-      Alive_Count : Integer := 0;
+      Alive_Count : Natural := 0;
       --  Number of tasks directly dependent on this task (including itself)
       --  that are still "alive", i.e. not terminated.
       --
       --  Protection: Self.L
 
-      Awake_Count : Integer := 0;
+      Awake_Count : Natural := 0;
       --  Number of tasks directly dependent on this task (including itself)
       --  still "awake", i.e., are not terminated and not waiting on a
       --  terminate alternative.
diff --git a/gcc/ada/s-taspri-vms.ads b/gcc/ada/s-taspri-vms.ads
index 3d20080e65e..891dee28c9d 100644
--- a/gcc/ada/s-taspri-vms.ads
+++ b/gcc/ada/s-taspri-vms.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1991-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1991-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -78,10 +78,6 @@ package System.Task_Primitives is
 
 private
 
-   type Exc_Stack_T is array (0 .. 8192) of aliased Character;
-   for Exc_Stack_T'Alignment use Standard'Maximum_Alignment;
-   type Exc_Stack_Ptr_T is access all Exc_Stack_T;
-
    type Lock is record
       L         : aliased System.OS_Interface.pthread_mutex_t;
       Prio      : Interfaces.C.int;
@@ -121,9 +117,6 @@ private
       L : aliased RTS_Lock;
       --  Protection for all components is lock L
 
-      Exc_Stack_Ptr : Exc_Stack_Ptr_T;
-      --  ??? This needs comments
-
       AST_Pending : Boolean;
       --  Used to detect delay and sleep timeouts
 
diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb
index 8c604c90a79..0958a8dbf32 100644
--- a/gcc/ada/s-tasren.adb
+++ b/gcc/ada/s-tasren.adb
@@ -97,16 +97,15 @@ package body System.Tasking.Rendezvous is
    procedure Local_Undefer_Abort (Self_Id : Task_Id) renames
      System.Tasking.Initialization.Undefer_Abort_Nestable;
 
-   --  Florist defers abort around critical sections that
-   --  make entry calls to the Interrupt_Manager task, which
-   --  violates the general rule about top-level runtime system
-   --  calls from abort-deferred regions.  It is not that this is
-   --  unsafe, but when it occurs in "normal" programs it usually
-   --  means either the user is trying to do a potentially blocking
-   --  operation from within a protected object, or there is a
-   --  runtime system/compiler error that has failed to undefer
-   --  an earlier abort deferral. Thus, for debugging it may be
-   --  wise to modify the above renamings to the non-nestable forms.
+   --  Florist defers abort around critical sections that make entry calls
+   --  to the Interrupt_Manager task, which violates the general rule about
+   --  top-level runtime system calls from abort-deferred regions. It is not
+   --  that this is unsafe, but when it occurs in "normal" programs it usually
+   --  means either the user is trying to do a potentially blocking operation
+   --  from within a protected object, or there is a runtime system/compiler
+   --  error that has failed to undefer an earlier abort deferral. Thus, for
+   --  debugging it may be wise to modify the above renamings to the
+   --  non-nestable forms.
 
    procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
    pragma Inline (Boost_Priority);
@@ -126,18 +125,17 @@ package body System.Tasking.Rendezvous is
      (Entry_Call : Entry_Call_Link;
       Acceptor   : Task_Id);
    pragma Inline (Setup_For_Rendezvous_With_Body);
-   --  Call this only with abort deferred and holding lock of Acceptor.
-   --  When a rendezvous selected (ready for rendezvous) we need to save
-   --  previous caller and adjust the priority. Also we need to make
-   --  this call not Abortable (Cancellable) since the rendezvous has
-   --  already been started.
+   --  Call this only with abort deferred and holding lock of Acceptor. When
+   --  a rendezvous selected (ready for rendezvous) we need to save previous
+   --  caller and adjust the priority. Also we need to make this call not
+   --  Abortable (Cancellable) since the rendezvous has already been started.
 
    procedure Wait_For_Call (Self_Id : Task_Id);
    pragma Inline (Wait_For_Call);
-   --  Call this only with abort deferred and holding lock of Self_Id.
-   --  An accepting task goes into Sleep by calling this routine
-   --  waiting for a call from the caller or waiting for an abort.
-   --  Make sure Self_Id is locked before calling this routine.
+   --  Call this only with abort deferred and holding lock of Self_Id. An
+   --  accepting task goes into Sleep by calling this routine waiting for a
+   --  call from the caller or waiting for an abort. Make sure Self_Id is
+   --  locked before calling this routine.
 
    -----------------
    -- Accept_Call --
@@ -148,7 +146,7 @@ package body System.Tasking.Rendezvous is
       Uninterpreted_Data : out System.Address)
    is
       Self_Id      : constant Task_Id := STPO.Self;
-      Caller       : Task_Id := null;
+      Caller       : Task_Id          := null;
       Open_Accepts : aliased Accept_List (1 .. 1);
       Entry_Call   : Entry_Call_Link;
 
@@ -217,8 +215,8 @@ package body System.Tasking.Rendezvous is
          end if;
       end if;
 
-      --  Self_Id.Common.Call should already be updated by the Caller
-      --  On return, we will start the rendezvous.
+      --  Self_Id.Common.Call should already be updated by the Caller. On
+      --  return, we will start the rendezvous.
 
       STPO.Unlock (Self_Id);
 
@@ -239,7 +237,7 @@ package body System.Tasking.Rendezvous is
 
    procedure Accept_Trivial (E : Task_Entry_Index) is
       Self_Id      : constant Task_Id := STPO.Self;
-      Caller       : Task_Id := null;
+      Caller       : Task_Id          := null;
       Open_Accepts : aliased Accept_List (1 .. 1);
       Entry_Call   : Entry_Call_Link;
 
@@ -274,6 +272,7 @@ package body System.Tasking.Rendezvous is
       Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
 
       if Entry_Call = null then
+
          --  Need to wait for entry call
 
          Open_Accepts (1).Null_Body := True;
@@ -296,7 +295,9 @@ package body System.Tasking.Rendezvous is
 
          STPO.Unlock (Self_Id);
 
-      else  --  found caller already waiting
+      --  Found caller already waiting
+
+      else
          pragma Assert (Entry_Call.State < Done);
 
          STPO.Unlock (Self_Id);
@@ -310,8 +311,8 @@ package body System.Tasking.Rendezvous is
       if Parameters.Runtime_Traces then
          Send_Trace_Info (M_Accept_Complete);
 
-         --  Fake one, since there is (???) no way
-         --  to know that the rendezvous is over
+         --  Fake one, since there is (???) no way to know that the rendezvous
+         --  is over.
 
          Send_Trace_Info (M_RDV_Complete);
       end if;
@@ -328,15 +329,13 @@ package body System.Tasking.Rendezvous is
    --------------------
 
    procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id) is
-      Caller        : constant Task_Id := Call.Self;
+      Caller        : constant Task_Id             := Call.Self;
       Caller_Prio   : constant System.Any_Priority := Get_Priority (Caller);
       Acceptor_Prio : constant System.Any_Priority := Get_Priority (Acceptor);
-
    begin
       if Caller_Prio > Acceptor_Prio then
          Call.Acceptor_Prev_Priority := Acceptor_Prio;
          Set_Priority (Acceptor, Caller_Prio);
-
       else
          Call.Acceptor_Prev_Priority := Priority_Not_Boosted;
       end if;
@@ -530,33 +529,39 @@ package body System.Tasking.Rendezvous is
       use type STPE.Protection_Entries_Access;
 
    begin
-      --  Consider phasing out Complete_Rendezvous in favor
-      --  of direct call to this with Ada.Exceptions.Null_ID.
-      --  See code expansion examples for Accept_Call and Selective_Wait.
-      --  Also consider putting an explicit re-raise after this call, in
-      --  the generated code. That way we could eliminate the
-      --  code here that reraises the exception.
+      --  Consider phasing out Complete_Rendezvous in favor of direct call to
+      --  this with Ada.Exceptions.Null_ID. See code expansion examples for
+      --  Accept_Call and Selective_Wait. Also consider putting an explicit
+      --  re-raise after this call, in the generated code. That way we could
+      --  eliminate the code here that reraises the exception.
 
-      --  The deferral level is critical here,
-      --  since we want to raise an exception or allow abort to take
-      --  place, if there is an exception or abort pending.
+      --  The deferral level is critical here, since we want to raise an
+      --  exception or allow abort to take place, if there is an exception or
+      --  abort pending.
 
       pragma Debug
        (Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R'));
 
       if Ex = Ada.Exceptions.Null_Id then
-         --  The call came from normal end-of-rendezvous,
-         --  so abort is not yet deferred.
+
+         --  The call came from normal end-of-rendezvous, so abort is not yet
+         --  deferred.
 
          if Parameters.Runtime_Traces then
             Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
          end if;
 
          Initialization.Defer_Abort_Nestable (Self_Id);
+
+      elsif ZCX_By_Default then
+
+         --  With ZCX, aborts are not automatically deferred in handlers
+
+         Initialization.Defer_Abort_Nestable (Self_Id);
       end if;
 
-      --  We need to clean up any accepts which Self may have
-      --  been serving when it was aborted.
+      --  We need to clean up any accepts which Self may have been serving when
+      --  it was aborted.
 
       if Ex = Standard'Abort_Signal'Identity then
          if Single_Lock then
@@ -574,8 +579,8 @@ package body System.Tasking.Rendezvous is
             Caller := Entry_Call.Self;
 
             --  Take write lock. This follows the lock precedence rule that
-            --  Caller may be locked while holding lock of Acceptor.
-            --  Complete the call abnormally, with exception.
+            --  Caller may be locked while holding lock of Acceptor. Complete
+            --  the call abnormally, with exception.
 
             STPO.Write_Lock (Caller);
             Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
@@ -591,13 +596,15 @@ package body System.Tasking.Rendezvous is
          Caller := Entry_Call.Self;
 
          if Entry_Call.Needs_Requeue then
-            --  We dare not lock Self_Id at the same time as Caller,
-            --  for fear of deadlock.
+
+            --  We dare not lock Self_Id at the same time as Caller, for fear
+            --  of deadlock.
 
             Entry_Call.Needs_Requeue := False;
             Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
 
             if Entry_Call.Called_Task /= null then
+
                --  Requeue to another task entry
 
                if Single_Lock then
@@ -693,6 +700,7 @@ package body System.Tasking.Rendezvous is
       --  ??? Do we need to give precedence to Program_Error that might be
       --  raised due to failure of finalization, over Tasking_Error from
       --  failure of requeue?
+
    end Exceptional_Complete_Rendezvous;
 
    -------------------------------------
@@ -727,7 +735,6 @@ package body System.Tasking.Rendezvous is
    is
       Self_Id    : constant Task_Id := STPO.Self;
       Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call;
-
    begin
       Initialization.Defer_Abort (Self_Id);
       Entry_Call.Needs_Requeue := True;
@@ -821,6 +828,7 @@ package body System.Tasking.Rendezvous is
 
       case Treatment is
          when Accept_Alternative_Selected =>
+
             --  Ready to rendezvous
 
             Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
@@ -902,6 +910,7 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Self_Id);
 
          when Terminate_Selected =>
+
             --  Terminate alternative is open
 
             Self_Id.Open_Accepts := Open_Accepts;
@@ -920,13 +929,12 @@ package body System.Tasking.Rendezvous is
             pragma Assert (Self_Id.Open_Accepts = null);
 
             if Self_Id.Terminate_Alternative then
-               --  An entry call should have reset this to False,
-               --  so we must be aborted.
-               --  We cannot be in an async. select, since that
-               --  is not legal, so the abort must be of the entire
-               --  task.  Therefore, we do not need to cancel the
-               --  terminate alternative.  The cleanup will be done
-               --  in Complete_Master.
+
+               --  An entry call should have reset this to False, so we must be
+               --  aborted. We cannot be in an async. select, since that is not
+               --  legal, so the abort must be of the entire task. Therefore,
+               --  we do not need to cancel the terminate alternative. The
+               --  cleanup will be done in Complete_Master.
 
                pragma Assert (Self_Id.Pending_ATC_Level = 0);
                pragma Assert (Self_Id.Awake_Count = 0);
@@ -967,6 +975,7 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Self_Id);
 
          when No_Alternative_Open =>
+
             --  In this case, Index will be No_Rendezvous on return, which
             --  should cause a Program_Error if it is not a Delay_Mode.
 
@@ -1003,10 +1012,13 @@ package body System.Tasking.Rendezvous is
          Unlock_RTS;
       end if;
 
-      --  Caller has been chosen.
+      --  Caller has been chosen
+
       --  Self_Id.Common.Call should already be updated by the Caller.
+
       --  Self_Id.Chosen_Index should either be updated by the Caller
       --  or by Test_Selective_Wait.
+
       --  On return, we sill start rendezvous unless the accept body is
       --  null. In the latter case, we will have already completed the RV.
 
@@ -1082,10 +1094,10 @@ package body System.Tasking.Rendezvous is
    begin
       --  Find out whether Entry_Call can be accepted immediately
 
-      --  If the Acceptor is not callable, return False.
-      --  If the rendezvous can start, initiate it.
-      --  If the accept-body is trivial, also complete the rendezvous.
-      --  If the acceptor is not ready, enqueue the call.
+      --    If the Acceptor is not callable, return False.
+      --    If the rendezvous can start, initiate it.
+      --    If the accept-body is trivial, also complete the rendezvous.
+      --    If the acceptor is not ready, enqueue the call.
 
       --  This should have a special case for Accept_Call and Accept_Trivial,
       --  so that we don't have the loop setup overhead, below.
@@ -1359,12 +1371,12 @@ package body System.Tasking.Rendezvous is
             raise Tasking_Error;
          end if;
 
-         --  The following is special for async. entry calls.
-         --  If the call was not queued abortably, we need to wait until
-         --  it is before proceeding with the abortable part.
+         --  The following is special for async. entry calls. If the call was
+         --  not queued abortably, we need to wait until it is before
+         --  proceeding with the abortable part.
 
-         --  Wait_Until_Abortable can be called unconditionally here,
-         --  but it is expensive.
+         --  Wait_Until_Abortable can be called unconditionally here, but it is
+         --  expensive.
 
          if Entry_Call.State < Was_Abortable then
             Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
@@ -1485,15 +1497,16 @@ package body System.Tasking.Rendezvous is
 
       case Treatment is
          when Accept_Alternative_Selected =>
-            --  Ready to rendezvous
-            --  In this case the accept body is not Null_Body. Defer abort
-            --  until it gets into the accept body.
+
+            --  Ready to rendezvous. In this case the accept body is not
+            --  Null_Body. Defer abort until it gets into the accept body.
 
             Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
             Initialization.Defer_Abort (Self_Id);
             STPO.Unlock (Self_Id);
 
          when Accept_Alternative_Completed =>
+
             --  Rendezvous is over
 
             if Parameters.Runtime_Traces then
@@ -1594,14 +1607,16 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Self_Id);
 
          when No_Alternative_Open =>
+
             --  In this case, Index will be No_Rendezvous on return. We sleep
             --  for the time we need to.
+
             --  Wait for a signal or timeout. A wakeup can be made
             --  for several reasons:
-            --  1) Delay is expired
-            --  2) Pending_Action needs to be checked
-            --     (Abort, Priority change)
-            --  3) Spurious wakeup
+            --    1) Delay is expired
+            --    2) Pending_Action needs to be checked
+            --       (Abort, Priority change)
+            --    3) Spurious wakeup
 
             Self_Id.Open_Accepts := null;
             Self_Id.Common.State := Acceptor_Delay_Sleep;
@@ -1614,7 +1629,9 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Self_Id);
 
          when others =>
+
             --  Should never get here
+
             pragma Assert (False);
             null;
       end case;
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 8795ce7727d..61f0c16c63e 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -1324,7 +1324,16 @@ package body System.Tasking.Stages is
       --  Execute the task termination handler if we found it
 
       if TH /= null then
-         TH.all (Cause, Self_ID, EO);
+         begin
+            TH.all (Cause, Self_ID, EO);
+
+         exception
+
+            --  RM-C.7.3 requires all exceptions raised here to be ignored
+
+            when others =>
+               null;
+         end;
       end if;
 
       if System.Stack_Usage.Is_Enabled then
diff --git a/gcc/ada/s-tasuti.adb b/gcc/ada/s-tasuti.adb
index 8e818be9ce9..a6b362ee2aa 100644
--- a/gcc/ada/s-tasuti.adb
+++ b/gcc/ada/s-tasuti.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -504,12 +504,14 @@ package body System.Tasking.Utilities is
            (Debug.Trace
             (Self_ID, "Make_Passive: Phase 1, parent waiting", 'M'));
 
-         --  If parent is in Master_Completion_Sleep, it
-         --  cannot be on a terminate alternative, hence
-         --  it cannot have Awake_Count of zero.
+         --  If parent is in Master_Completion_Sleep, it cannot be on a
+         --  terminate alternative, hence it cannot have Wait_Count of
+         --  zero. ???Except that the race condition in Make_Independent can
+         --  cause Wait_Count to be zero, so we need to check for that.
 
-         pragma Assert (P.Common.Wait_Count > 0);
-         P.Common.Wait_Count := P.Common.Wait_Count - 1;
+         if P.Common.Wait_Count > 0 then
+            P.Common.Wait_Count := P.Common.Wait_Count - 1;
+         end if;
 
          if P.Common.Wait_Count = 0 then
             Wakeup (P, Master_Completion_Sleep);
diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb
index 0890181544d..8aeabc2efbb 100644
--- a/gcc/ada/s-tpobop.adb
+++ b/gcc/ada/s-tpobop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1998-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 1998-2011, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -258,7 +258,11 @@ package body System.Tasking.Protected_Objects.Operations is
             --  enabled for its remaining life.
 
             Self_Id := STPO.Self;
-            Initialization.Undefer_Abort_Nestable (Self_Id);
+
+            if not ZCX_By_Default then
+               Initialization.Undefer_Abort_Nestable (Self_Id);
+            end if;
+
             Transfer_Occurrence
               (Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access,
                Self_Id.Common.Compiler_Data.Current_Excep);
@@ -270,6 +274,9 @@ package body System.Tasking.Protected_Objects.Operations is
       end if;
 
       if Runtime_Traces then
+
+         --  ??? Entry_Call can be null
+
          Send_Trace_Info (PO_Done, Entry_Call.Self);
       end if;
    end Exceptional_Complete_Entry_Body;
diff --git a/gcc/ada/s-vaflop-vms-alpha.adb b/gcc/ada/s-vaflop-vms-alpha.adb
index 2c1e6842ff0..ba607f62d39 100644
--- a/gcc/ada/s-vaflop-vms-alpha.adb
+++ b/gcc/ada/s-vaflop-vms-alpha.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2011, Free Software Foundation, Inc.         --
 --                       (Version for Alpha OpenVMS)                        --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
@@ -67,12 +67,9 @@ package body System.Vax_Float_Operations is
       A, B : T;
       C    : G;
    begin
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X),
-           Volatile => True);
-      Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X));
+      Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
       return C;
    end D_To_G;
 
@@ -84,10 +81,8 @@ package body System.Vax_Float_Operations is
       A : T;
       B : G;
    begin
-      Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A),
-           Volatile => True);
+      Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
       return B;
    end F_To_G;
 
@@ -103,8 +98,7 @@ package body System.Vax_Float_Operations is
       --  Because converting to a wider FP format is a no-op, we say
       --  A is 64-bit even though we are loading 32 bits into it.
 
-      Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X),
-           Volatile => True);
+      Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
 
       B := S (Cvt_G_T (A));
       return B;
@@ -118,12 +112,9 @@ package body System.Vax_Float_Operations is
       A, B : T;
       C    : D;
    begin
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X),
-           Volatile => True);
-      Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
+      Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
+      Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B));
       return C;
    end G_To_D;
 
@@ -136,12 +127,9 @@ package body System.Vax_Float_Operations is
       B : S;
       C : F;
    begin
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X),
-           Volatile => True);
-      Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
+      Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
       return C;
    end G_To_F;
 
@@ -153,10 +141,8 @@ package body System.Vax_Float_Operations is
       A : T;
       B : Q;
    begin
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X),
-           Volatile => True);
-      Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
+      Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A));
       return B;
    end G_To_Q;
 
@@ -167,8 +153,7 @@ package body System.Vax_Float_Operations is
    function G_To_T (X : G) return T is
       A, B : T;
    begin
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
       B := Cvt_G_T (A);
       return B;
    end G_To_T;
@@ -190,10 +175,8 @@ package body System.Vax_Float_Operations is
       A : S;
       B : F;
    begin
-      Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A),
-           Volatile => True);
+      Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
       return B;
    end Q_To_F;
 
@@ -205,10 +188,8 @@ package body System.Vax_Float_Operations is
       A : T;
       B : G;
    begin
-      Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A),
-           Volatile => True);
+      Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
       return B;
    end Q_To_G;
 
@@ -221,8 +202,7 @@ package body System.Vax_Float_Operations is
       B : F;
    begin
       A := Cvt_T_F (T (X));
-      Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A),
-           Volatile => True);
+      Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
       return B;
    end S_To_F;
 
@@ -244,8 +224,7 @@ package body System.Vax_Float_Operations is
       B : G;
    begin
       A := Cvt_T_G (X);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A),
-           Volatile => True);
+      Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
       return B;
    end T_To_G;
 
@@ -257,12 +236,9 @@ package body System.Vax_Float_Operations is
       A, B : S;
       C    : F;
    begin
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X),
-           Volatile => True);
-      Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
+      Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
       return C;
    end Abs_F;
 
@@ -275,10 +251,8 @@ package body System.Vax_Float_Operations is
       C    : G;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
-      Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
       return C;
    end Abs_G;
 
@@ -291,13 +265,10 @@ package body System.Vax_Float_Operations is
       R1        : F;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("addf %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
       return R1;
    end Add_F;
 
@@ -310,13 +281,10 @@ package body System.Vax_Float_Operations is
       R1        : G;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("addg %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
       return R1;
    end Add_G;
 
@@ -392,13 +360,10 @@ package body System.Vax_Float_Operations is
       R1        : F;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("divf %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
       return R1;
    end Div_F;
 
@@ -411,13 +376,10 @@ package body System.Vax_Float_Operations is
       R1        : G;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("divg %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
       return R1;
    end Div_G;
 
@@ -429,11 +391,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : S;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
       return R /= 0.0;
    end Eq_F;
 
@@ -445,11 +405,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : T;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
       return R /= 0.0;
    end Eq_G;
 
@@ -461,11 +419,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : S;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("cmpgle %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
       return R /= 0.0;
    end Le_F;
 
@@ -477,11 +433,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : T;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("cmpgle %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
       return R /= 0.0;
    end Le_G;
 
@@ -493,11 +447,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : S;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("cmpglt %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
       return R /= 0.0;
    end Lt_F;
 
@@ -509,11 +461,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : T;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("cmpglt %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
       return R /= 0.0;
    end Lt_G;
 
@@ -526,13 +476,10 @@ package body System.Vax_Float_Operations is
       R1        : F;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("mulf %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
       return R1;
    end Mul_F;
 
@@ -545,13 +492,10 @@ package body System.Vax_Float_Operations is
       R1        : G;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("mulg %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
       return R1;
    end Mul_G;
 
@@ -563,11 +507,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : S;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
       return R = 0.0;
    end Ne_F;
 
@@ -579,11 +521,9 @@ package body System.Vax_Float_Operations is
       X1, Y1, R : T;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
       return R = 0.0;
    end Ne_G;
 
@@ -596,10 +536,8 @@ package body System.Vax_Float_Operations is
       C    : F;
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
-      Asm ("cpysn %1,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("subf $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
       return C;
    end Neg_F;
 
@@ -612,10 +550,8 @@ package body System.Vax_Float_Operations is
       C    : G;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
-      Asm ("cpysn %1,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B),
-           Volatile => True);
+      Asm ("subg $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
       return C;
    end Neg_G;
 
@@ -652,13 +588,11 @@ package body System.Vax_Float_Operations is
 
    function Return_D (X : D) return D is
       R : D;
-
    begin
       --  The return value is already in $f0 so we need to trick the compiler
       --  into thinking that we're moving X to $f0.
-
       Asm ("cvtdg $f0,$f0", Inputs => D'Asm_Input ("g", X), Clobber => "$f0",
-           Volatile => True);
+        Volatile => True);
       Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True);
       return R;
    end Return_D;
@@ -669,13 +603,11 @@ package body System.Vax_Float_Operations is
 
    function Return_F (X : F) return F is
       R : F;
-
    begin
       --  The return value is already in $f0 so we need to trick the compiler
       --  into thinking that we're moving X to $f0.
-
       Asm ("stf $f0,%0", F'Asm_Output ("=m", R), F'Asm_Input ("g", X),
-           Clobber => "$f0", Volatile => True);
+        Clobber => "$f0", Volatile => True);
       return R;
    end Return_F;
 
@@ -685,13 +617,11 @@ package body System.Vax_Float_Operations is
 
    function Return_G (X : G) return G is
       R : G;
-
    begin
       --  The return value is already in $f0 so we need to trick the compiler
       --  into thinking that we're moving X to $f0.
-
       Asm ("stg $f0,%0", G'Asm_Output ("=m", R), G'Asm_Input ("g", X),
-           Clobber => "$f0", Volatile => True);
+        Clobber => "$f0", Volatile => True);
       return R;
    end Return_G;
 
@@ -705,13 +635,10 @@ package body System.Vax_Float_Operations is
 
    begin
       Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
-      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
       Asm ("subf %1,%2,%0", S'Asm_Output ("=f", R),
-           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
-           Volatile => True);
+           (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
+      Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
       return R1;
    end Sub_F;
 
@@ -724,13 +651,10 @@ package body System.Vax_Float_Operations is
       R1        : G;
    begin
       Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
-      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y),
-           Volatile => True);
+      Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
       Asm ("subg %1,%2,%0", T'Asm_Output ("=f", R),
-           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)),
-           Volatile => True);
-      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
-           Volatile => True);
+           (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
+      Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
       return R1;
    end Sub_G;
 
diff --git a/gcc/ada/scans.adb b/gcc/ada/scans.adb
index 7f6b808a565..0c51891f369 100644
--- a/gcc/ada/scans.adb
+++ b/gcc/ada/scans.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -118,13 +118,6 @@ package body Scans is
       Set_Reserved (Name_Reverse,   Tok_Reverse);
       Set_Reserved (Name_Select,    Tok_Select);
       Set_Reserved (Name_Separate,  Tok_Separate);
-
-      --  We choose to make Some into a non-reserved word, so it is handled
-      --  like a regular identifier in most contexts. Uncomment the following
-      --  line if a pedantic Ada2012 mode is required.
-
-      --  Set_Reserved (Name_Some,      Tok_Some);
-
       Set_Reserved (Name_Subtype,   Tok_Subtype);
       Set_Reserved (Name_Tagged,    Tok_Tagged);
       Set_Reserved (Name_Task,      Tok_Task);
@@ -140,9 +133,13 @@ package body Scans is
 
       --  Ada 2005 reserved words
 
-      Set_Reserved (Name_Interface,     Tok_Interface);
-      Set_Reserved (Name_Overriding,    Tok_Overriding);
-      Set_Reserved (Name_Synchronized,  Tok_Synchronized);
+      Set_Reserved (Name_Interface,    Tok_Interface);
+      Set_Reserved (Name_Overriding,   Tok_Overriding);
+      Set_Reserved (Name_Synchronized, Tok_Synchronized);
+
+      --  Ada 2012 reserved words
+
+      Set_Reserved (Name_Some, Tok_Some);
 
    end Initialize_Ada_Keywords;
 
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index 137f616ccc2..ca2a5bb904e 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -47,7 +47,7 @@ package Scans is
 
    --  Note: Namet.Is_Keyword_Name depends on the fact that the first entry in
    --  this type declaration is *not* for a reserved word. For details on why
-   --  there is this requirement, see Scans.Initialize_Ada_Keywords.
+   --  there is this requirement, see Initialize_Ada_Keywords below.
 
    type Token_Type is (
 
@@ -341,7 +341,9 @@ package Scans is
    --  Flag array used to test for reserved word
 
    procedure Initialize_Ada_Keywords;
-   --  Set up Token_Type values in Names table entries for Ada reserved words
+   --  Set up Token_Type values in Names table entries for Ada reserved
+   --  words. This ignores Ada_Version; Ada_Version is taken into account in
+   --  Snames.Is_Keyword_Name.
 
    --------------------------
    -- Scan State Variables --
diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb
index 2862a0afa08..ed6b1a87beb 100644
--- a/gcc/ada/scn.adb
+++ b/gcc/ada/scn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -472,18 +472,9 @@ package body Scn is
       Token_Name := Name_Find;
 
       if not Used_As_Identifier (Token) or else Force_Msg then
-
-         --  If "some" is made into a reserved work in Ada2012, the following
-         --  check will make it into a regular identifier in earlier versions
-         --  of the language.
-
-         if Token = Tok_Some and then Ada_Version < Ada_2012 then
-            null;
-         else
-            Error_Msg_Name_1 := Token_Name;
-            Error_Msg_SC ("reserved word* cannot be used as identifier!");
-            Used_As_Identifier (Token) := True;
-         end if;
+         Error_Msg_Name_1 := Token_Name;
+         Error_Msg_SC ("reserved word* cannot be used as identifier!");
+         Used_As_Identifier (Token) := True;
       end if;
 
       Token := Tok_Identifier;
diff --git a/gcc/ada/scos.adb b/gcc/ada/scos.adb
index a45f3d88467..b7df692de3a 100644
--- a/gcc/ada/scos.adb
+++ b/gcc/ada/scos.adb
@@ -25,22 +25,6 @@
 
 package body SCOs is
 
-   -------------
-   -- Add_SCO --
-   -------------
-
-   procedure Add_SCO
-     (From        : Source_Location := No_Source_Location;
-      To          : Source_Location := No_Source_Location;
-      C1          : Character       := ' ';
-      C2          : Character       := ' ';
-      Last        : Boolean         := False;
-      Pragma_Sloc : Source_Ptr      := No_Location)
-   is
-   begin
-      SCO_Table.Append ((From, To, C1, C2, Last, Pragma_Sloc));
-   end Add_SCO;
-
    ----------------
    -- Initialize --
    ----------------
diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads
index 61a675856b9..7c0bb820d54 100644
--- a/gcc/ada/scos.ads
+++ b/gcc/ada/scos.ads
@@ -28,7 +28,11 @@
 --  the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
 --  is used in the ALI file.
 
-with Types; use Types;
+with Snames; use Snames;
+--  Note: used for Pragma_Id only, no other feature from Snames should be used,
+--  as a simplified version is maintained in Xcov.
+
+with Types;  use Types;
 
 with GNAT.Table;
 
@@ -143,19 +147,18 @@ package SCOs is
    --    where each sloc-range corresponds to a single statement, and * is
    --    one of:
 
-   --      t  type declaration
-   --      s  subtype declaration
-   --      o  object declaration
-   --      r  renaming declaration
-   --      i  generic instantiation
-   --      C  CASE statement (from CASE through end of expression)
-   --      E  EXIT statement
-   --      F  FOR loop statement (from FOR through end of iteration scheme)
-   --      I  IF statement (from IF through end of condition)
-   --      p  disabled PRAGMA
-   --      P  PRAGMA
-   --      R  extended RETURN statement
-   --      W  WHILE loop statement (from WHILE through end of condition)
+   --      t        type declaration
+   --      s        subtype declaration
+   --      o        object declaration
+   --      r        renaming declaration
+   --      i        generic instantiation
+   --      C        CASE statement (from CASE through end of expression)
+   --      E        EXIT statement
+   --      F        FOR loop (from FOR through end of iteration scheme)
+   --      I        IF statement (from IF through end of condition)
+   --      P[name:] PRAGMA with the indicated name
+   --      R        extended RETURN statement
+   --      W        WHILE loop statement (from WHILE through end of condition)
 
    --      Note: for I and W, condition above is in the RM syntax sense (this
    --      condition is a decision in SCO terminology).
@@ -227,15 +230,15 @@ package SCOs is
 
    --    Here * is one of the following characters:
 
-   --      I  decision in IF statement or conditional expression
    --      E  decision in EXIT WHEN statement
    --      G  decision in entry guard
+   --      I  decision in IF statement or conditional expression
    --      P  decision in pragma Assert/Check/Pre_Condition/Post_Condition
    --      W  decision in WHILE iteration scheme
    --      X  decision appearing in some other expression context
 
-   --    For I, E, G, P, W, sloc is the source location of the IF, EXIT,
-   --    ENTRY, PRAGMA or WHILE token, respectively
+   --    For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF,
+   --    PRAGMA or WHILE token, respectively
 
    --    For X, sloc is omitted
 
@@ -353,16 +356,19 @@ package SCOs is
    No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
 
    type SCO_Table_Entry is record
-      From : Source_Location;
-      To   : Source_Location;
-      C1   : Character;
-      C2   : Character;
-      Last : Boolean;
+      From : Source_Location := No_Source_Location;
+      To   : Source_Location := No_Source_Location;
+      C1   : Character       := ' ';
+      C2   : Character       := ' ';
+      Last : Boolean         := False;
 
       Pragma_Sloc : Source_Ptr := No_Location;
       --  For the statement SCO for a pragma, or for any expression SCO nested
       --  in a pragma Debug/Assert/PPC, location of PRAGMA token (used for
       --  control of SCO output, value not recorded in ALI file).
+
+      Pragma_Name : Pragma_Id := Unknown_Pragma;
+      --  For the statement SCO for a pragma, gives the pragma name
    end record;
 
    package SCO_Table is new GNAT.Table (
@@ -388,10 +394,16 @@ package SCOs is
    --    statements on a single CS line (possibly followed by Cs continuation
    --    lines).
 
-   --    Decision (IF/EXIT/WHILE)
-   --      C1   = 'I'/'E'/'W' (for IF/EXIT/WHILE)
+   --    Note: for a pragma that may be disabled (Debug, Assert, PPC, Check),
+   --    the entry is initially created with C2 = 'p', to mark it as disabled.
+   --    Later on during semantic analysis, if the pragma is enabled,
+   --    Set_SCO_Pragma_Enabled changes C2 to 'P' to cause the entry to be
+   --    emitted in Put_SCOs.
+
+   --    Decision (EXIT/entry guard/IF/WHILE)
+   --      C1   = 'E'/'G'/'I'/'W' (for EXIT/entry Guard/IF/WHILE)
    --      C2   = ' '
-   --      From = IF/EXIT/WHILE token
+   --      From = EXIT/ENTRY/IF/WHILE token
    --      To   = No_Source_Location
    --      Last = unused
 
@@ -402,14 +414,12 @@ package SCOs is
    --      To   = No_Source_Location
    --      Last = unused
 
-   --      Note: when the parse tree is first scanned, we unconditionally build
-   --      a pragma decision entry for any decision in a pragma (here as always
-   --      in SCO contexts, the only pragmas with decisions are Assert, Check,
-   --      dyadic Debug, Precondition and Postcondition).
-   --
-   --      During analysis, if the pragma is enabled, Set_SCO_Pragma_Enabled
-   --      marks the statement SCO table entry as enaabled (C1 changed from 'p'
-   --      to 'P') to cause the entry to be emitted in Put_SCOs.
+   --    Note: when the parse tree is first scanned, we unconditionally build a
+   --    pragma decision entry for any decision in a pragma (here as always in
+   --    SCO contexts, the only pragmas with decisions are Assert, Check,
+   --    dyadic Debug, Precondition and Postcondition). These entries will
+   --    be omitted in output if the pragma is disabled (see comments for
+   --    statement entries).
 
    --    Decision (Expression)
    --      C1   = 'X'
@@ -483,13 +493,4 @@ package SCOs is
    procedure Initialize;
    --  Reset tables for a new compilation
 
-   procedure Add_SCO
-     (From        : Source_Location := No_Source_Location;
-      To          : Source_Location := No_Source_Location;
-      C1          : Character       := ' ';
-      C2          : Character       := ' ';
-      Last        : Boolean         := False;
-      Pragma_Sloc : Source_Ptr      := No_Location);
-   --  Adds one entry to SCO table with given field values
-
 end SCOs;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 59626e86aa1..be0c907f71a 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -674,6 +674,7 @@ package body Sem is
            N_Formal_Modular_Type_Definition         |
            N_Formal_Ordinary_Fixed_Point_Definition |
            N_Formal_Private_Type_Definition         |
+           N_Formal_Incomplete_Type_Definition      |
            N_Formal_Signed_Integer_Type_Definition  |
            N_Function_Specification                 |
            N_Generic_Association                    |
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index a226c4810e7..ec108be4e47 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1309,6 +1309,10 @@ package body Sem_Aggr is
       --  for discrete choices such as "L .. H => Expr" or the OTHERS choice).
       --  In this event we do not resolve Expr unless expansion is disabled.
       --  To know why, see the DELAYED COMPONENT RESOLUTION note above.
+      --
+      --  NOTE: In the case of "... => <>", we pass the in the
+      --  N_Component_Association node as Expr, since there is no Expression in
+      --  that case, and we need a Sloc for the error message.
 
       ---------
       -- Add --
@@ -1635,6 +1639,13 @@ package body Sem_Aggr is
                end if;
             end if;
 
+            --  If it's "... => <>", nothing to resolve
+
+            if Nkind (Expr) = N_Component_Association then
+               pragma Assert (Box_Present (Expr));
+               return Success;
+            end if;
+
             --  Ada 2005 (AI-231): Propagate the type to the nested aggregate.
             --  Required to check the null-exclusion attribute (if present).
             --  This value may be overridden later on.
@@ -1644,19 +1655,29 @@ package body Sem_Aggr is
             Resolution_OK := Resolve_Array_Aggregate
               (Expr, Nxt_Ind, Nxt_Ind_Constr, Component_Typ, Others_Allowed);
 
-         --  Do not resolve the expressions of discrete or others choices
-         --  unless the expression covers a single component, or the expander
-         --  is inactive.
+         else
+
+            --  If it's "... => <>", nothing to resolve
 
-         elsif Single_Elmt
-           or else not Expander_Active
-           or else In_Spec_Expression
-         then
-            Analyze_And_Resolve (Expr, Component_Typ);
-            Check_Expr_OK_In_Limited_Aggregate (Expr);
-            Check_Non_Static_Context (Expr);
-            Aggregate_Constraint_Checks (Expr, Component_Typ);
-            Check_Unset_Reference (Expr);
+            if Nkind (Expr) = N_Component_Association then
+               pragma Assert (Box_Present (Expr));
+               return Success;
+            end if;
+
+            --  Do not resolve the expressions of discrete or others choices
+            --  unless the expression covers a single component, or the
+            --  expander is inactive.
+
+            if Single_Elmt
+              or else not Expander_Active
+              or else In_Spec_Expression
+            then
+               Analyze_And_Resolve (Expr, Component_Typ);
+               Check_Expr_OK_In_Limited_Aggregate (Expr);
+               Check_Non_Static_Context (Expr);
+               Aggregate_Constraint_Checks (Expr, Component_Typ);
+               Check_Unset_Reference (Expr);
+            end if;
          end if;
 
          if Raises_Constraint_Error (Expr)
@@ -1988,9 +2009,15 @@ package body Sem_Aggr is
 
                   --  Ada 2005 (AI-287): In case of default initialization of a
                   --  component the expander will generate calls to the
-                  --  corresponding initialization subprogram.
+                  --  corresponding initialization subprogram. We need to call
+                  --  Resolve_Aggr_Expr to check the rules about
+                  --  dimensionality.
 
-                  null;
+                  if not Resolve_Aggr_Expr (Assoc,
+                                            Single_Elmt => Single_Choice)
+                  then
+                     return Failure;
+                  end if;
 
                elsif not Resolve_Aggr_Expr (Expression (Assoc),
                                             Single_Elmt => Single_Choice)
@@ -2321,9 +2348,13 @@ package body Sem_Aggr is
 
                --  Ada 2005 (AI-287): In case of default initialization of a
                --  component the expander will generate calls to the
-               --  corresponding initialization subprogram.
+               --  corresponding initialization subprogram. We need to call
+               --  Resolve_Aggr_Expr to check the rules about
+               --  dimensionality.
 
-               null;
+               if not Resolve_Aggr_Expr (Assoc, Single_Elmt => False) then
+                  return Failure;
+               end if;
 
             elsif not Resolve_Aggr_Expr (Expression (Assoc),
                                          Single_Elmt => False)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 5195e4f3a88..3adbac5cdb0 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1945,6 +1945,8 @@ package body Sem_Attr is
            and then
          Aname /= Name_Elab_Spec
            and then
+         Aname /= Name_Elab_Subp_Body
+           and then
          Aname /= Name_UET_Address
            and then
          Aname /= Name_Enabled
@@ -3012,9 +3014,12 @@ package body Sem_Attr is
       -- Elab_Body --
       ---------------
 
-      --  Also handles processing for Elab_Spec
+      --  Also handles processing for Elab_Spec and Elab_Subp_Body
+
+      when Attribute_Elab_Body      |
+           Attribute_Elab_Spec      |
+           Attribute_Elab_Subp_Body =>
 
-      when Attribute_Elab_Body | Attribute_Elab_Spec =>
          Check_E0;
          Check_Unit_Name (P);
          Set_Etype (N, Standard_Void_Type);
@@ -4558,6 +4563,13 @@ package body Sem_Attr is
             end if;
          end if;
 
+      --------------------------------
+      -- System_Allocator_Alignment --
+      --------------------------------
+
+      when Attribute_System_Allocator_Alignment =>
+         Standard_Attribute (Ttypes.System_Allocator_Alignment);
+
       ---------
       -- Tag --
       ---------
@@ -7693,60 +7705,62 @@ package body Sem_Attr is
       --  Note that in some cases, the values have already been folded as
       --  a result of the processing in Analyze_Attribute.
 
-      when Attribute_Abort_Signal             |
-           Attribute_Access                   |
-           Attribute_Address                  |
-           Attribute_Address_Size             |
-           Attribute_Asm_Input                |
-           Attribute_Asm_Output               |
-           Attribute_Base                     |
-           Attribute_Bit_Order                |
-           Attribute_Bit_Position             |
-           Attribute_Callable                 |
-           Attribute_Caller                   |
-           Attribute_Class                    |
-           Attribute_Code_Address             |
-           Attribute_Compiler_Version         |
-           Attribute_Count                    |
-           Attribute_Default_Bit_Order        |
-           Attribute_Elaborated               |
-           Attribute_Elab_Body                |
-           Attribute_Elab_Spec                |
-           Attribute_Enabled                  |
-           Attribute_External_Tag             |
-           Attribute_Fast_Math                |
-           Attribute_First_Bit                |
-           Attribute_Input                    |
-           Attribute_Last_Bit                 |
-           Attribute_Maximum_Alignment        |
-           Attribute_Old                      |
-           Attribute_Output                   |
-           Attribute_Partition_ID             |
-           Attribute_Pool_Address             |
-           Attribute_Position                 |
-           Attribute_Priority                 |
-           Attribute_Read                     |
-           Attribute_Result                   |
-           Attribute_Storage_Pool             |
-           Attribute_Storage_Size             |
-           Attribute_Storage_Unit             |
-           Attribute_Stub_Type                |
-           Attribute_Tag                      |
-           Attribute_Target_Name              |
-           Attribute_Terminated               |
-           Attribute_To_Address               |
-           Attribute_Type_Key                 |
-           Attribute_UET_Address              |
-           Attribute_Unchecked_Access         |
-           Attribute_Universal_Literal_String |
-           Attribute_Unrestricted_Access      |
-           Attribute_Valid                    |
-           Attribute_Value                    |
-           Attribute_Wchar_T_Size             |
-           Attribute_Wide_Value               |
-           Attribute_Wide_Wide_Value          |
-           Attribute_Word_Size                |
-           Attribute_Write                    =>
+      when Attribute_Abort_Signal               |
+           Attribute_Access                     |
+           Attribute_Address                    |
+           Attribute_Address_Size               |
+           Attribute_Asm_Input                  |
+           Attribute_Asm_Output                 |
+           Attribute_Base                       |
+           Attribute_Bit_Order                  |
+           Attribute_Bit_Position               |
+           Attribute_Callable                   |
+           Attribute_Caller                     |
+           Attribute_Class                      |
+           Attribute_Code_Address               |
+           Attribute_Compiler_Version           |
+           Attribute_Count                      |
+           Attribute_Default_Bit_Order          |
+           Attribute_Elaborated                 |
+           Attribute_Elab_Body                  |
+           Attribute_Elab_Spec                  |
+           Attribute_Elab_Subp_Body             |
+           Attribute_Enabled                    |
+           Attribute_External_Tag               |
+           Attribute_Fast_Math                  |
+           Attribute_First_Bit                  |
+           Attribute_Input                      |
+           Attribute_Last_Bit                   |
+           Attribute_Maximum_Alignment          |
+           Attribute_Old                        |
+           Attribute_Output                     |
+           Attribute_Partition_ID               |
+           Attribute_Pool_Address               |
+           Attribute_Position                   |
+           Attribute_Priority                   |
+           Attribute_Read                       |
+           Attribute_Result                     |
+           Attribute_Storage_Pool               |
+           Attribute_Storage_Size               |
+           Attribute_Storage_Unit               |
+           Attribute_Stub_Type                  |
+           Attribute_System_Allocator_Alignment |
+           Attribute_Tag                        |
+           Attribute_Target_Name                |
+           Attribute_Terminated                 |
+           Attribute_To_Address                 |
+           Attribute_Type_Key                   |
+           Attribute_UET_Address                |
+           Attribute_Unchecked_Access           |
+           Attribute_Universal_Literal_String   |
+           Attribute_Unrestricted_Access        |
+           Attribute_Valid                      |
+           Attribute_Value                      |
+           Attribute_Wchar_T_Size               |
+           Attribute_Wide_Value                 |
+           Attribute_Wide_Wide_Value            |
+           Attribute_Word_Size                  |
+           Attribute_Write                      =>
 
          raise Program_Error;
       end case;
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index 6db8949be33..0e8561ae729 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -172,6 +172,17 @@ package Sem_Attr is
       --  Ada code, e.g. if it is necessary to do selective reelaboration to
       --  fix some error.
 
+      --------------------
+      -- Elab_Subp_Body --
+      --------------------
+
+      Attribute_Elab_Subp_Body => True,
+      --  This attribute can only be applied to a library level subprogram
+      --  name and is only relevant in CodePeer mode. It returns the entity
+      --  for the corresponding elaboration procedure for elaborating the body
+      --  of the referenced subprogram unit. This is used in the main generated
+      --  elaboration procedure by the binder in CodePeer mode only.
+
       ---------------
       -- Elab_Spec --
       ---------------
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 7b0a1fb8224..58aaee1d573 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -1391,6 +1391,10 @@ package body Sem_Cat is
       if Ekind (Subp) = E_Function then
          Rtyp := Etype (Subp);
 
+         --  AI05-0101 (Binding Interpretation): The result type of a remote
+         --  function must either support external streaming or be a
+         --  controlling access result type.
+
          if Has_Controlling_Result (Subp) then
             null;
 
@@ -1406,19 +1410,16 @@ package body Sem_Cat is
                  ("limited return type must have Read and Write attributes",
                      Parent (Subp));
                Explain_Limited_Type (Rtyp, Parent (Subp));
+            end if;
 
-            --  Check that the return type supports external streaming.
-            --  Note that the language of the standard (E.2.2(14)) does not
-            --  explicitly mention that case, but it really does not make
-            --  sense to return a value containing a local access type.
+         --  Check that the return type supports external streaming
 
-            elsif No_External_Streaming (Rtyp)
-                    and then not Error_Posted (Rtyp)
-            then
-               Illegal_Remote_Subp ("return type containing non-remote access "
-                 & "must have Read and Write attributes",
-                 Parent (Subp));
-            end if;
+         elsif No_External_Streaming (Rtyp)
+                 and then not Error_Posted (Rtyp)
+         then
+            Illegal_Remote_Subp ("return type containing non-remote access "
+              & "must have Read and Write attributes",
+              Parent (Subp));
          end if;
       end if;
 
@@ -1674,13 +1675,8 @@ package body Sem_Cat is
          then
             return True;
 
-         --  A limited interface is not currently a legal ancestor for the
-         --  designated type of an RACW type, because a type that implements
-         --  such an interface need not be limited. However, the ARG seems to
-         --  incline towards allowing an access to classwide limited interface
-         --  type as a remote access type, as resolved in AI05-060. But note
-         --  that the expansion circuitry for RACWs that designate classwide
-         --  interfaces is not complete yet.
+         --  AI05-0060 (Binding Interpretation): A limited interface is a legal
+         --  ancestor for the designated type of an RACW type.
 
          elsif Is_Limited_Record (E) and then Is_Limited_Interface (E) then
             return True;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 59ec7a4b051..ce7c9b360e0 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2585,6 +2585,13 @@ package body Sem_Ch10 is
             if Par_Name /= Standard_Standard then
                Par_Name := Scope (Par_Name);
             end if;
+
+            --  Abandon processing in case of previous errors
+
+            if No (Par_Name) then
+               pragma Assert (Serious_Errors_Detected /= 0);
+               return;
+            end if;
          end loop;
 
          if Present (Entity (Pref))
@@ -5034,6 +5041,14 @@ package body Sem_Ch10 is
               ("instantiation depends on itself", Name (With_Clause));
 
          elsif not Is_Visible_Child_Unit (Uname) then
+
+            --  Abandon processing in case of previous errors
+
+            if No (Scope (Uname)) then
+               pragma Assert (Serious_Errors_Detected /= 0);
+               return;
+            end if;
+
             Set_Is_Visible_Child_Unit (Uname);
 
             --  If the child unit appears in the context of its parent, it is
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 4965938c011..fbc9aa906fe 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -342,7 +342,11 @@ package body Sem_Ch12 is
       Def : Node_Id);
    --  Creates a new private type, which does not require completion
 
+   procedure Analyze_Formal_Incomplete_Type (T : Entity_Id; Def : Node_Id);
+   --  Ada 2012: Creates a new incomplete type whose actual does not freeze
+
    procedure Analyze_Generic_Formal_Part (N : Node_Id);
+   --  Analyze generic formal part
 
    procedure Analyze_Generic_Access_Type (T : Entity_Id; Def : Node_Id);
    --  Create a new access type with the given designated type
@@ -1300,16 +1304,20 @@ package body Sem_Ch12 is
                        Assoc);
 
                      --  An instantiation is a freeze point for the actuals,
-                     --  unless this is a rewritten formal package.
+                     --  unless this is a rewritten formal package, or the
+                     --  formal is an Ada 2012 formal incomplete type.
 
-                     if Nkind (I_Node) /= N_Formal_Package_Declaration then
+                     if Nkind (I_Node) /= N_Formal_Package_Declaration
+                       and then
+                         Ekind (Defining_Identifier (Analyzed_Formal)) /=
+                           E_Incomplete_Type
+                     then
                         Append_Elmt (Entity (Match), Actual_Types);
                      end if;
                   end if;
 
-                  --  A remote access-to-class-wide type must not be an
-                  --  actual parameter for a generic formal of an access
-                  --  type (E.2.2 (17)).
+                  --  A remote access-to-class-wide type is not a legal actual
+                  --  for a generic formal of an access type (E.2.2(17)).
 
                   if Nkind (Analyzed_Formal) = N_Formal_Type_Declaration
                     and then
@@ -2361,6 +2369,26 @@ package body Sem_Ch12 is
       Set_RM_Size   (T, RM_Size (Standard_Integer));
    end Analyze_Formal_Private_Type;
 
+   ------------------------------------
+   -- Analyze_Formal_Incomplete_Type --
+   ------------------------------------
+
+   procedure Analyze_Formal_Incomplete_Type
+     (T   : Entity_Id;
+      Def : Node_Id)
+   is
+   begin
+      Enter_Name (T);
+      Set_Ekind (T, E_Incomplete_Type);
+      Set_Etype (T, T);
+
+      if Tagged_Present (Def) then
+         Set_Is_Tagged_Type (T);
+         Make_Class_Wide_Type (T);
+         Set_Direct_Primitive_Operations (T, New_Elmt_List);
+      end if;
+   end Analyze_Formal_Incomplete_Type;
+
    ----------------------------------------
    -- Analyze_Formal_Signed_Integer_Type --
    ----------------------------------------
@@ -2545,7 +2573,11 @@ package body Sem_Ch12 is
             end;
 
             if Subp /= Any_Id then
+
+               --  Subprogram found, generate reference to it
+
                Set_Entity (Def, Subp);
+               Generate_Reference (Subp, Def);
 
                if Subp = Nam then
                   Error_Msg_N ("premature usage of formal subprogram", Def);
@@ -2594,6 +2626,9 @@ package body Sem_Ch12 is
          when N_Formal_Derived_Type_Definition         =>
             Analyze_Formal_Derived_Type (N, T, Def);
 
+         when N_Formal_Incomplete_Type_Definition         =>
+            Analyze_Formal_Incomplete_Type (T, Def);
+
          when N_Formal_Discrete_Type_Definition        =>
             Analyze_Formal_Discrete_Type (T, Def);
 
@@ -3497,15 +3532,13 @@ package body Sem_Ch12 is
                            Enclosing_Master := Scope (Enclosing_Master);
                         end if;
 
-                     elsif Ekind (Enclosing_Master) = E_Generic_Package then
-                        Enclosing_Master := Scope (Enclosing_Master);
-
-                     elsif Is_Generic_Subprogram (Enclosing_Master)
+                     elsif Is_Generic_Unit (Enclosing_Master)
                        or else Ekind (Enclosing_Master) = E_Void
                      then
                         --  Cleanup actions will eventually be performed on the
-                        --  enclosing instance, if any. Enclosing scope is void
-                        --  in the formal part of a generic subprogram.
+                        --  enclosing subprogram or package instance, if any.
+                        --  Enclosing scope is void in the formal part of a
+                        --  generic subprogram.
 
                         exit Scope_Loop;
 
@@ -9447,9 +9480,13 @@ package body Sem_Ch12 is
       procedure Validate_Access_Type_Instance;
       procedure Validate_Derived_Type_Instance;
       procedure Validate_Derived_Interface_Type_Instance;
+      procedure Validate_Discriminated_Formal_Type;
       procedure Validate_Interface_Type_Instance;
       procedure Validate_Private_Type_Instance;
-      --  These procedures perform validation tests for the named case
+      procedure Validate_Incomplete_Type_Instance;
+      --  These procedures perform validation tests for the named case.
+      --  Validate_Discriminated_Formal_Type is shared by formal private
+      --  types and Ada 2012 formal incomplete types.
 
       function Subtypes_Match (Gen_T, Act_T : Entity_Id) return Boolean;
       --  Check that base types are the same and that the subtypes match
@@ -10272,73 +10309,17 @@ package body Sem_Ch12 is
          end if;
       end Validate_Derived_Type_Instance;
 
-      --------------------------------------
-      -- Validate_Interface_Type_Instance --
-      --------------------------------------
-
-      procedure Validate_Interface_Type_Instance is
-      begin
-         if not Is_Interface (Act_T) then
-            Error_Msg_NE
-              ("actual for formal interface type must be an interface",
-                Actual, Gen_T);
-
-         elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T)
-           or else
-             Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
-           or else
-             Is_Protected_Interface (A_Gen_T) /=
-               Is_Protected_Interface (Act_T)
-           or else
-             Is_Synchronized_Interface (A_Gen_T) /=
-               Is_Synchronized_Interface (Act_T)
-         then
-            Error_Msg_NE
-              ("actual for interface& does not match (RM 12.5.5(4))",
-               Actual, Gen_T);
-         end if;
-      end Validate_Interface_Type_Instance;
-
-      ------------------------------------
-      -- Validate_Private_Type_Instance --
-      ------------------------------------
+      ----------------------------------------
+      -- Validate_Discriminated_Formal_Type --
+      ----------------------------------------
 
-      procedure Validate_Private_Type_Instance is
+      procedure Validate_Discriminated_Formal_Type is
          Formal_Discr : Entity_Id;
          Actual_Discr : Entity_Id;
          Formal_Subt  : Entity_Id;
 
       begin
-         if Is_Limited_Type (Act_T)
-           and then not Is_Limited_Type (A_Gen_T)
-         then
-            Error_Msg_NE
-              ("actual for non-limited & cannot be a limited type", Actual,
-               Gen_T);
-            Explain_Limited_Type (Act_T, Actual);
-            Abandon_Instantiation (Actual);
-
-         elsif Known_To_Have_Preelab_Init (A_Gen_T)
-           and then not Has_Preelaborable_Initialization (Act_T)
-         then
-            Error_Msg_NE
-              ("actual for & must have preelaborable initialization", Actual,
-               Gen_T);
-
-         elsif Is_Indefinite_Subtype (Act_T)
-            and then not Is_Indefinite_Subtype (A_Gen_T)
-            and then Ada_Version >= Ada_95
-         then
-            Error_Msg_NE
-              ("actual for & must be a definite subtype", Actual, Gen_T);
-
-         elsif not Is_Tagged_Type (Act_T)
-           and then Is_Tagged_Type (A_Gen_T)
-         then
-            Error_Msg_NE
-              ("actual for & must be a tagged type", Actual, Gen_T);
-
-         elsif Has_Discriminants (A_Gen_T) then
+         if Has_Discriminants (A_Gen_T) then
             if not Has_Discriminants (Act_T) then
                Error_Msg_NE
                  ("actual for & must have discriminants", Actual, Gen_T);
@@ -10403,9 +10384,89 @@ package body Sem_Ch12 is
                   Abandon_Instantiation (Actual);
                end if;
             end if;
+         end if;
+      end Validate_Discriminated_Formal_Type;
 
+      ---------------------------------------
+      -- Validate_Incomplete_Type_Instance --
+      ---------------------------------------
+
+      procedure Validate_Incomplete_Type_Instance is
+      begin
+         if not Is_Tagged_Type (Act_T)
+           and then Is_Tagged_Type (A_Gen_T)
+         then
+            Error_Msg_NE
+              ("actual for & must be a tagged type", Actual, Gen_T);
+         end if;
+
+         Validate_Discriminated_Formal_Type;
+      end Validate_Incomplete_Type_Instance;
+
+      --------------------------------------
+      -- Validate_Interface_Type_Instance --
+      --------------------------------------
+
+      procedure Validate_Interface_Type_Instance is
+      begin
+         if not Is_Interface (Act_T) then
+            Error_Msg_NE
+              ("actual for formal interface type must be an interface",
+                Actual, Gen_T);
+
+         elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T)
+           or else
+             Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
+           or else
+             Is_Protected_Interface (A_Gen_T) /=
+               Is_Protected_Interface (Act_T)
+           or else
+             Is_Synchronized_Interface (A_Gen_T) /=
+               Is_Synchronized_Interface (Act_T)
+         then
+            Error_Msg_NE
+              ("actual for interface& does not match (RM 12.5.5(4))",
+               Actual, Gen_T);
+         end if;
+      end Validate_Interface_Type_Instance;
+
+      ------------------------------------
+      -- Validate_Private_Type_Instance --
+      ------------------------------------
+
+      procedure Validate_Private_Type_Instance is
+      begin
+         if Is_Limited_Type (Act_T)
+           and then not Is_Limited_Type (A_Gen_T)
+         then
+            Error_Msg_NE
+              ("actual for non-limited & cannot be a limited type", Actual,
+               Gen_T);
+            Explain_Limited_Type (Act_T, Actual);
+            Abandon_Instantiation (Actual);
+
+         elsif Known_To_Have_Preelab_Init (A_Gen_T)
+           and then not Has_Preelaborable_Initialization (Act_T)
+         then
+            Error_Msg_NE
+              ("actual for & must have preelaborable initialization", Actual,
+               Gen_T);
+
+         elsif Is_Indefinite_Subtype (Act_T)
+            and then not Is_Indefinite_Subtype (A_Gen_T)
+            and then Ada_Version >= Ada_95
+         then
+            Error_Msg_NE
+              ("actual for & must be a definite subtype", Actual, Gen_T);
+
+         elsif not Is_Tagged_Type (Act_T)
+           and then Is_Tagged_Type (A_Gen_T)
+         then
+            Error_Msg_NE
+              ("actual for & must be a tagged type", Actual, Gen_T);
          end if;
 
+         Validate_Discriminated_Formal_Type;
          Ancestor := Gen_T;
       end Validate_Private_Type_Instance;
 
@@ -10463,7 +10524,13 @@ package body Sem_Ch12 is
                       and then
                          Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
          then
-            if Is_Class_Wide_Type (Act_T)
+            --  If the formal is an incomplete type, the actual can be
+            --  incomplete as well.
+
+            if Ekind (A_Gen_T) = E_Incomplete_Type then
+               null;
+
+            elsif Is_Class_Wide_Type (Act_T)
               or else No (Full_View (Act_T))
             then
                Error_Msg_N ("premature use of incomplete type", Actual);
@@ -10486,7 +10553,14 @@ package body Sem_Ch12 is
            and then not Is_Derived_Type (Act_T)
            and then No (Full_View (Root_Type (Act_T)))
          then
-            Error_Msg_N ("premature use of private type", Actual);
+            --  If the formal is an incomplete type, the actual can be
+            --  private or incomplete as well.
+
+            if Ekind (A_Gen_T) = E_Incomplete_Type then
+               null;
+            else
+               Error_Msg_N ("premature use of private type", Actual);
+            end if;
 
          elsif Has_Private_Component (Act_T) then
             Error_Msg_N
@@ -10528,6 +10602,9 @@ package body Sem_Ch12 is
             when N_Formal_Private_Type_Definition =>
                Validate_Private_Type_Instance;
 
+            when N_Formal_Incomplete_Type_Definition =>
+               Validate_Incomplete_Type_Instance;
+
             when N_Formal_Derived_Type_Definition =>
                Validate_Derived_Type_Instance;
 
@@ -10642,7 +10719,10 @@ package body Sem_Ch12 is
             Set_Generic_Parent_Type (Decl_Node, Ancestor);
          end if;
 
-      elsif Nkind (Def) = N_Formal_Private_Type_Definition then
+      elsif Nkind_In (Def,
+        N_Formal_Private_Type_Definition,
+        N_Formal_Incomplete_Type_Definition)
+      then
          Set_Generic_Parent_Type (Decl_Node, A_Gen_T);
       end if;
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f2075d0cae9..a926280b2a0 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -73,11 +73,11 @@ package body Sem_Ch13 is
    -- Local Subprograms --
    -----------------------
 
-   procedure Alignment_Check_For_Esize_Change (Typ : Entity_Id);
-   --  This routine is called after setting the Esize of type entity Typ.
-   --  The purpose is to deal with the situation where an alignment has been
-   --  inherited from a derived type that is no longer appropriate for the
-   --  new Esize value. In this case, we reset the Alignment to unknown.
+   procedure Alignment_Check_For_Size_Change (Typ : Entity_Id; Size : Uint);
+   --  This routine is called after setting one of the sizes of type entity
+   --  Typ to Size. The purpose is to deal with the situation of a derived
+   --  type whose inherited alignment is no longer appropriate for the new
+   --  size value. In this case, we reset the Alignment to unknown.
 
    procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
    --  If Typ has predicates (indicated by Has_Predicates being set for Typ,
@@ -235,8 +235,8 @@ package body Sem_Ch13 is
       --  Processing depends on version of Ada
 
       --  For Ada 95, we just renumber bits within a storage unit. We do the
-      --  same for Ada 83 mode, since we recognize pragma Bit_Order in Ada 83,
-      --  and are free to add this extension.
+      --  same for Ada 83 mode, since we recognize the Bit_Order attribute in
+      --  Ada 83, and are free to add this extension.
 
       if Ada_Version < Ada_2005 then
          Comp := First_Component_Or_Discriminant (R);
@@ -661,11 +661,11 @@ package body Sem_Ch13 is
       end if;
    end Adjust_Record_For_Reverse_Bit_Order;
 
-   --------------------------------------
-   -- Alignment_Check_For_Esize_Change --
-   --------------------------------------
+   -------------------------------------
+   -- Alignment_Check_For_Size_Change --
+   -------------------------------------
 
-   procedure Alignment_Check_For_Esize_Change (Typ : Entity_Id) is
+   procedure Alignment_Check_For_Size_Change (Typ : Entity_Id; Size : Uint) is
    begin
       --  If the alignment is known, and not set by a rep clause, and is
       --  inconsistent with the size being set, then reset it to unknown,
@@ -674,11 +674,11 @@ package body Sem_Ch13 is
 
       if Known_Alignment (Typ)
         and then not Has_Alignment_Clause (Typ)
-        and then Esize (Typ) mod (Alignment (Typ) * SSU) /= 0
+        and then Size mod (Alignment (Typ) * SSU) /= 0
       then
          Init_Alignment (Typ);
       end if;
-   end Alignment_Check_For_Esize_Change;
+   end Alignment_Check_For_Size_Change;
 
    -----------------------------------
    -- Analyze_Aspect_Specifications --
@@ -710,7 +710,7 @@ package body Sem_Ch13 is
       --  or attribute definition node in either case to activate special
       --  processing (e.g. not traversing the list of homonyms for inline).
 
-      Delay_Required : Boolean;
+      Delay_Required : Boolean := False;
       --  Set True if delay is required
 
    begin
@@ -904,7 +904,7 @@ package body Sem_Ch13 is
 
                   --  Never need to delay for boolean aspects
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Library unit aspects. These are boolean aspects, but we
                --  have to do special things with the insertion, since the
@@ -944,7 +944,7 @@ package body Sem_Ch13 is
 
                   --  If not package declaration, no delay is required
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Aspects related to container iterators. These aspects denote
                --  subprograms, and thus must be delayed.
@@ -1026,6 +1026,7 @@ package body Sem_Ch13 is
                     Aspect_Output         |
                     Aspect_Read           |
                     Aspect_Size           |
+                    Aspect_Small          |
                     Aspect_Storage_Pool   |
                     Aspect_Storage_Size   |
                     Aspect_Stream_Size    |
@@ -1045,7 +1046,8 @@ package body Sem_Ch13 is
                   --  to take care of it right away.
 
                   if Nkind_In (Expr, N_Integer_Literal, N_String_Literal) then
-                     Delay_Required := False;
+                     pragma Assert (not Delay_Required);
+                     null;
                   else
                      Delay_Required := True;
                      Set_Is_Delayed_Aspect (Aspect);
@@ -1072,7 +1074,7 @@ package body Sem_Ch13 is
                   --  We don't have to play the delay game here, since the only
                   --  values are check names which don't get analyzed anyway.
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Aspects corresponding to pragmas with two arguments, where
                --  the second argument is a local name referring to the entity,
@@ -1094,7 +1096,7 @@ package body Sem_Ch13 is
                   --  We don't have to play the delay game here, since the only
                   --  values are ON/OFF which don't get analyzed anyway.
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Default_Value and Default_Component_Value aspects. These
                --  are specially handled because they have no corresponding
@@ -1135,6 +1137,40 @@ package body Sem_Ch13 is
                   Set_Is_Delayed_Aspect (Aspect);
                   Set_Has_Default_Aspect (Base_Type (Entity (Ent)));
 
+               when Aspect_Attach_Handler =>
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Name_Attach_Handler),
+                      Pragma_Argument_Associations =>
+                        New_List (Ent, Relocate_Node (Expr)));
+
+                  Set_From_Aspect_Specification (Aitem, True);
+
+                  pragma Assert (not Delay_Required);
+
+               when Aspect_Priority | Aspect_Interrupt_Priority => declare
+                  Pname : Name_Id;
+
+               begin
+                  if A_Id = Aspect_Priority then
+                     Pname := Name_Priority;
+                  else
+                     Pname := Name_Interrupt_Priority;
+                  end if;
+
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Pname),
+                      Pragma_Argument_Associations =>
+                        New_List (Relocate_Node (Expr)));
+
+                  Set_From_Aspect_Specification (Aitem, True);
+
+                  pragma Assert (not Delay_Required);
+               end;
+
                --  Aspects Pre/Post generate Precondition/Postcondition pragmas
                --  with a first argument that is the expression, and a second
                --  argument that is an informative message if the test fails.
@@ -1334,6 +1370,12 @@ package body Sem_Ch13 is
                begin
                   Args := New_List;
 
+                  if Nkind (Parent (N)) = N_Compilation_Unit then
+                     Error_Msg_N
+                       ("incorrect placement of aspect `Test_Case`", E);
+                     goto Continue;
+                  end if;
+
                   if Nkind (Expr) /= N_Aggregate then
                      Error_Msg_NE
                        ("wrong syntax for aspect `Test_Case` for &", Id, E);
@@ -1433,18 +1475,65 @@ package body Sem_Ch13 is
                --  Here if not compilation unit case
 
                else
-                  --  For Pre/Post cases, insert immediately after the entity
-                  --  declaration, since that is the required pragma placement.
+                  case A_Id is
 
-                  if A_Id in Pre_Post_Aspects then
-                     Insert_After (N, Aitem);
+                     --  For Pre/Post cases, insert immediately after the
+                     --  entity declaration, since that is the required pragma
+                     --  placement.
 
-                  --  For all other cases, insert in sequence
+                     when Pre_Post_Aspects =>
+                        Insert_After (N, Aitem);
 
-                  else
-                     Insert_After (Ins_Node, Aitem);
-                     Ins_Node := Aitem;
-                  end if;
+                     --  For Priority aspects, insert into the task or
+                     --  protected definition, which we need to create if it's
+                     --  not there.
+
+                     when Aspect_Priority | Aspect_Interrupt_Priority =>
+                        declare
+                           T : Node_Id; -- the type declaration
+                           L : List_Id; -- list of decls of task/protected
+
+                        begin
+                           if Nkind (N) = N_Object_Declaration then
+                              T := Parent (Etype (Defining_Identifier (N)));
+
+                           else
+                              T := N;
+                           end if;
+
+                           if Nkind (T) = N_Protected_Type_Declaration then
+                              pragma Assert
+                                (Present (Protected_Definition (T)));
+
+                              L := Visible_Declarations
+                                     (Protected_Definition (T));
+
+                           elsif Nkind (T) = N_Task_Type_Declaration then
+                              if No (Task_Definition (T)) then
+                                 Set_Task_Definition
+                                   (T,
+                                    Make_Task_Definition
+                                      (Sloc (T),
+                                       Visible_Declarations => New_List,
+                                       End_Label => Empty));
+                              end if;
+
+                              L := Visible_Declarations
+                                     (Task_Definition (T));
+
+                           else
+                              raise Program_Error;
+                           end if;
+
+                           Prepend (Aitem, To => L);
+                        end;
+
+                     --  For all other cases, insert in sequence
+
+                     when others =>
+                        Insert_After (Ins_Node, Aitem);
+                        Ins_Node := Aitem;
+                  end case;
                end if;
             end if;
          end;
@@ -1539,6 +1628,13 @@ package body Sem_Ch13 is
       --  attribute has the proper type structure. If the name is overloaded,
       --  check that all interpretations are legal.
 
+      procedure Check_Iterator_Functions;
+      --  Check that there is a single function in Default_Iterator attribute
+      --  has the proper type structure.
+
+      function Check_Primitive_Function (Subp : Entity_Id) return Boolean;
+      --  Common legality check for the previous two
+
       -----------------------------------
       -- Analyze_Stream_TSS_Definition --
       -----------------------------------
@@ -1681,7 +1777,6 @@ package body Sem_Ch13 is
       ------------------------------
 
       procedure Check_Indexing_Functions is
-         Ctrl : Entity_Id;
 
          procedure Check_One_Function (Subp : Entity_Id);
          --  Check one possible interpretation
@@ -1692,34 +1787,10 @@ package body Sem_Ch13 is
 
          procedure Check_One_Function (Subp : Entity_Id) is
          begin
-            if Ekind (Subp) /= E_Function then
-               Error_Msg_N ("indexing requires a function", Subp);
-            end if;
-
-            if No (First_Formal (Subp)) then
-               Error_Msg_N
-                 ("function for indexing must have parameters", Subp);
-            else
-               Ctrl := Etype (First_Formal (Subp));
-            end if;
-
-            if Ctrl = Ent
-              or else Ctrl = Class_Wide_Type (Ent)
-              or else
-                (Ekind (Ctrl) = E_Anonymous_Access_Type
-                  and then
-                    (Designated_Type (Ctrl) = Ent
-                      or else Designated_Type (Ctrl) = Class_Wide_Type (Ent)))
-            then
-               null;
-
-            else
-               Error_Msg_N ("indexing function must apply to type&", Subp);
-            end if;
-
-            if No (Next_Formal (First_Formal (Subp))) then
-               Error_Msg_N
-                 ("function for indexing must have two parameters", Subp);
+            if not Check_Primitive_Function (Subp) then
+               Error_Msg_NE
+                 ("aspect Indexing requires a function that applies to type&",
+                   Subp, Ent);
             end if;
 
             if not Has_Implicit_Dereference (Etype (Subp)) then
@@ -1731,6 +1802,10 @@ package body Sem_Ch13 is
       --  Start of processing for Check_Indexing_Functions
 
       begin
+         if In_Instance then
+            return;
+         end if;
+
          Analyze (Expr);
 
          if not Is_Overloaded (Expr) then
@@ -1759,6 +1834,133 @@ package body Sem_Ch13 is
          end if;
       end Check_Indexing_Functions;
 
+      ------------------------------
+      -- Check_Iterator_Functions --
+      ------------------------------
+
+      procedure Check_Iterator_Functions is
+         Default : Entity_Id;
+
+         function Valid_Default_Iterator (Subp : Entity_Id) return Boolean;
+         --  Check one possible interpretation for validity
+
+         ----------------------------
+         -- Valid_Default_Iterator --
+         ----------------------------
+
+         function Valid_Default_Iterator (Subp : Entity_Id) return Boolean is
+            Formal : Entity_Id;
+
+         begin
+            if not Check_Primitive_Function (Subp) then
+               return False;
+            else
+               Formal := First_Formal (Subp);
+            end if;
+
+            --  False if any subsequent formal has no default expression
+
+            Formal := Next_Formal (Formal);
+            while Present (Formal) loop
+               if No (Expression (Parent (Formal))) then
+                  return False;
+               end if;
+
+               Next_Formal (Formal);
+            end loop;
+
+            --  True if all subsequent formals have default expressions
+
+            return True;
+         end Valid_Default_Iterator;
+
+      --  Start of processing for Check_Iterator_Functions
+
+      begin
+         Analyze (Expr);
+
+         if not Is_Entity_Name (Expr) then
+            Error_Msg_N ("aspect Iterator must be a function name", Expr);
+         end if;
+
+         if not Is_Overloaded (Expr) then
+            if not Check_Primitive_Function (Entity (Expr)) then
+               Error_Msg_NE
+                 ("aspect Indexing requires a function that applies to type&",
+                   Entity (Expr), Ent);
+            end if;
+
+            if not Valid_Default_Iterator (Entity (Expr)) then
+               Error_Msg_N ("improper function for default iterator", Expr);
+            end if;
+
+         else
+            Default := Empty;
+            declare
+               I : Interp_Index;
+               It : Interp;
+
+            begin
+               Get_First_Interp (Expr, I, It);
+               while Present (It.Nam) loop
+                  if not Check_Primitive_Function (It.Nam)
+                    or else not Valid_Default_Iterator (It.Nam)
+                  then
+                     Remove_Interp (I);
+
+                  elsif Present (Default) then
+                     Error_Msg_N ("default iterator must be unique", Expr);
+
+                  else
+                     Default := It.Nam;
+                  end if;
+
+                  Get_Next_Interp (I, It);
+               end loop;
+            end;
+
+            if Present (Default) then
+               Set_Entity (Expr, Default);
+               Set_Is_Overloaded (Expr, False);
+            end if;
+         end if;
+      end Check_Iterator_Functions;
+
+      -------------------------------
+      -- Check_Primitive_Function  --
+      -------------------------------
+
+      function Check_Primitive_Function (Subp : Entity_Id) return Boolean is
+         Ctrl : Entity_Id;
+
+      begin
+         if Ekind (Subp) /= E_Function then
+            return False;
+         end if;
+
+         if No (First_Formal (Subp)) then
+            return False;
+         else
+            Ctrl := Etype (First_Formal (Subp));
+         end if;
+
+         if Ctrl = Ent
+           or else Ctrl = Class_Wide_Type (Ent)
+           or else
+             (Ekind (Ctrl) = E_Anonymous_Access_Type
+               and then
+                 (Designated_Type (Ctrl) = Ent
+                   or else Designated_Type (Ctrl) = Class_Wide_Type (Ent)))
+         then
+            null;
+
+         else
+            return False;
+         end if;
+
+         return True;
+      end Check_Primitive_Function;
+
       ----------------------
       -- Duplicate_Clause --
       ----------------------
@@ -1807,9 +2009,10 @@ package body Sem_Ch13 is
       end if;
 
       --  Process Ignore_Rep_Clauses option (we also ignore rep clauses in
-      --  CodePeer mode, since they are not relevant in that context).
+      --  CodePeer mode or ALFA mode, since they are not relevant in these
+      --  contexts).
 
-      if Ignore_Rep_Clauses or CodePeer_Mode then
+      if Ignore_Rep_Clauses or CodePeer_Mode or ALFA_Mode then
          case Id is
 
             --  The following should be ignored. They do not affect legality
@@ -1829,8 +2032,8 @@ package body Sem_Ch13 is
                Rewrite (N, Make_Null_Statement (Sloc (N)));
                return;
 
-            --  We do not want too ignore 'Small in CodePeer_Mode, since it
-            --  has an impact on the exact computations performed.
+            --  We do not want too ignore 'Small in CodePeer_Mode or ALFA_Mode,
+            --  since it has an impact on the exact computations performed.
 
             --  Perhaps 'Small should also not be ignored by
             --  Ignore_Rep_Clauses ???
@@ -2385,6 +2588,39 @@ package body Sem_Ch13 is
          when Attribute_Constant_Indexing =>
             Check_Indexing_Functions;
 
+         ----------------------
+         -- Default_Iterator --
+         ----------------------
+
+         when Attribute_Default_Iterator =>  Default_Iterator : declare
+            Func : Entity_Id;
+
+         begin
+            if not Is_Tagged_Type (U_Ent) then
+               Error_Msg_N
+                 ("aspect Default_Iterator applies to  tagged type", Nam);
+            end if;
+
+            Check_Iterator_Functions;
+
+            Analyze (Expr);
+
+            if not Is_Entity_Name (Expr)
+              or else Ekind (Entity (Expr)) /= E_Function
+            then
+               Error_Msg_N ("aspect Iterator must be a function", Expr);
+            else
+               Func := Entity (Expr);
+            end if;
+
+            if No (First_Formal (Func))
+              or else Etype (First_Formal (Func)) /= U_Ent
+            then
+               Error_Msg_NE
+                 ("Default Iterator must be a primitive of&", Func, U_Ent);
+            end if;
+         end Default_Iterator;
+
          ------------------
          -- External_Tag --
          ------------------
@@ -2431,9 +2667,10 @@ package body Sem_Ch13 is
 
          when Attribute_Implicit_Dereference =>
 
-            --  Legality checks already performed above
+            --  Legality checks already performed at the point of
+            --  the type declaration, aspect is not delayed.
 
-            null;   --  TBD???
+            null;
 
          -----------
          -- Input --
@@ -2443,6 +2680,19 @@ package body Sem_Ch13 is
             Analyze_Stream_TSS_Definition (TSS_Stream_Input);
             Set_Has_Specified_Stream_Input (Ent);
 
+         ----------------------
+         -- Iterator_Element --
+         ----------------------
+
+         when Attribute_Iterator_Element =>
+            Analyze (Expr);
+
+            if not Is_Entity_Name (Expr)
+              or else not Is_Type (Entity (Expr))
+            then
+               Error_Msg_N ("aspect Iterator_Element must be a type", Expr);
+            end if;
+
          -------------------
          -- Machine_Radix --
          -------------------
@@ -2510,7 +2760,7 @@ package body Sem_Ch13 is
 
                Set_Esize (U_Ent, Size);
                Set_Has_Object_Size_Clause (U_Ent);
-               Alignment_Check_For_Esize_Change (U_Ent);
+               Alignment_Check_For_Size_Change (U_Ent, Size);
             end if;
          end Object_Size;
 
@@ -2603,6 +2853,9 @@ package body Sem_Ch13 is
                   --  (object size) unset, the back end will set it from the
                   --  size and alignment in an appropriate manner.
 
+                  --  In both cases, we check whether the alignment must be
+                  --  reset in the wake of the size change.
+
                   if Is_Elementary_Type (U_Ent) then
                      if Size <= System_Storage_Unit then
                         Init_Esize (U_Ent, System_Storage_Unit);
@@ -2614,7 +2867,9 @@ package body Sem_Ch13 is
                         Set_Esize  (U_Ent, (Size + 63) / 64 * 64);
                      end if;
 
-                     Alignment_Check_For_Esize_Change (U_Ent);
+                     Alignment_Check_For_Size_Change (U_Ent, Esize (U_Ent));
+                  else
+                     Alignment_Check_For_Size_Change (U_Ent, Size);
                   end if;
 
                --  For objects, set Esize only
@@ -3541,6 +3796,7 @@ package body Sem_Ch13 is
                if Nkind (Ritem) = N_Aspect_Specification
                  and then Entity (Ritem) = E
                  and then Is_Delayed_Aspect (Ritem)
+                 and then Scope (E) = Current_Scope
                then
                   Check_Aspect_At_Freeze_Point (Ritem);
                end if;
@@ -5477,7 +5733,7 @@ package body Sem_Ch13 is
       Ident : constant Node_Id   := Identifier (ASN);
 
       Freeze_Expr : constant Node_Id := Expression (ASN);
-      --  Preanalyzed expression from call to Check_Aspect_At_Freeze_Point
+      --  Expression from call to Check_Aspect_At_Freeze_Point
 
       End_Decl_Expr : constant Node_Id := Entity (Ident);
       --  Expression to be analyzed at end of declarations
@@ -5507,11 +5763,25 @@ package body Sem_Ch13 is
          Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
 
       elsif A_Id = Aspect_Variable_Indexing or else
-            A_Id = Aspect_Constant_Indexing
+            A_Id = Aspect_Constant_Indexing or else
+            A_Id = Aspect_Default_Iterator  or else
+            A_Id = Aspect_Iterator_Element
       then
+         --  Make type unfrozen before analysis, to prevent spurious errors
+         --  about late attributes.
+
+         Set_Is_Frozen (Ent, False);
          Analyze (End_Decl_Expr);
          Analyze (Aspect_Rep_Item (ASN));
-         Err := Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
+         Set_Is_Frozen (Ent, True);
+
+         --  If the end of declarations comes before any other freeze
+         --  point, the Freeze_Expr is not analyzed: no check needed.
+
+         Err :=
+           Analyzed (Freeze_Expr)
+             and then not In_Instance
+             and then Entity (End_Decl_Expr) /= Entity (Freeze_Expr);
 
       --  All other cases
 
@@ -5583,6 +5853,9 @@ package body Sem_Ch13 is
          when Aspect_Test_Case =>
             raise Program_Error;
 
+         when Aspect_Attach_Handler =>
+            T := RTE (RE_Interrupt_ID);
+
          --  Default_Value is resolved with the type entity in question
 
          when Aspect_Default_Value =>
@@ -5604,6 +5877,12 @@ package body Sem_Ch13 is
          when Aspect_External_Tag =>
             T := Standard_String;
 
+         when Aspect_Priority | Aspect_Interrupt_Priority =>
+            T := Standard_Integer;
+
+         when Aspect_Small =>
+            T := Universal_Real;
+
          when Aspect_Storage_Pool =>
             T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ea54583e718..d21e8a1a8d5 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1353,7 +1353,7 @@ package body Sem_Ch3 is
       Set_Has_Task (T, False);
       Set_Has_Controlled_Component (T, False);
 
-      --  Initialize Associated_Collection explicitly to Empty, to avoid
+      --  Initialize field Finalization_Master explicitly to Empty, to avoid
       --  problems where an incomplete view of this entity has been previously
       --  established by a limited with and an overlaid version of this field
       --  (Stored_Constraint) was initialized for the incomplete view.
@@ -1361,10 +1361,10 @@ package body Sem_Ch3 is
       --  This reset is performed in most cases except where the access type
       --  has been created for the purposes of allocating or deallocating a
       --  build-in-place object. Such access types have explicitly set pools
-      --  and collections.
+      --  and finalization masters.
 
       if No (Associated_Storage_Pool (T)) then
-         Set_Associated_Collection (T, Empty);
+         Set_Finalization_Master (T, Empty);
       end if;
 
       --  Ada 2005 (AI-231): Propagate the null-excluding and access-constant
@@ -4758,6 +4758,8 @@ package body Sem_Ch3 is
       if Present (Component_Typ) then
          Element_Type := Process_Subtype (Component_Typ, P, Related_Id, 'C');
 
+         Set_Etype (Component_Typ, Element_Type);
+
          if not Nkind_In (Component_Typ, N_Identifier, N_Expanded_Name) then
             Check_SPARK_Restriction ("subtype mark required", Component_Typ);
          end if;
@@ -14930,6 +14932,12 @@ package body Sem_Ch3 is
             Set_Has_Private_Declaration (Prev);
             Set_Has_Private_Declaration (Id);
 
+            --  Preserve aspect and iterator flags that may have been set on
+            --  the partial view.
+
+            Set_Has_Delayed_Aspects (Prev, Has_Delayed_Aspects (Id));
+            Set_Has_Implicit_Dereference (Prev, Has_Implicit_Dereference (Id));
+
             --  If no error, propagate freeze_node from private to full view.
             --  It may have been generated for an early operational item.
 
@@ -17164,9 +17172,8 @@ package body Sem_Ch3 is
             --  worst, and therefore defaults are not allowed if the parent is
             --  a generic formal private type (see ACATS B370001).
 
-            if Is_Access_Type (Discr_Type) then
+            if Is_Access_Type (Discr_Type) and then Default_Present then
                if Ekind (Discr_Type) /= E_Anonymous_Access_Type
-                 or else not Default_Present
                  or else Is_Limited_Record (Current_Scope)
                  or else Is_Concurrent_Type (Current_Scope)
                  or else Is_Concurrent_Record_Type (Current_Scope)
@@ -19698,14 +19705,14 @@ package body Sem_Ch3 is
       if ALFA_Mode then
 
          --  If the range of the type is already symmetric with a possible
-         --  extra negative value, just make the type its own base type.
+         --  extra negative value, leave it this way.
 
          if UI_Le (Lo_Val, Hi_Val)
            and then (UI_Eq (Lo_Val, UI_Negate (Hi_Val))
                       or else
                         UI_Eq (Lo_Val, UI_Sub (UI_Negate (Hi_Val), Uint_1)))
          then
-            Set_Etype (T, T);
+            null;
 
          else
             declare
@@ -19757,7 +19764,8 @@ package body Sem_Ch3 is
                      High_Bound => Ubound));
 
                Analyze (Decl);
-               Set_Etype (Implicit_Base, Implicit_Base);
+               Set_Etype (Implicit_Base, Base_Type (Implicit_Base));
+               Set_Etype (T, Base_Type (Implicit_Base));
                Insert_Before (Parent (Def), Decl);
             end;
          end if;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 21c7a89b938..62218c46e17 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -30,6 +30,7 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Util; use Exp_Util;
+with Expander; use Expander;
 with Fname;    use Fname;
 with Itypes;   use Itypes;
 with Lib;      use Lib;
@@ -443,7 +444,32 @@ package body Sem_Ch4 is
          end loop;
       end if;
 
-      --  Analyze the allocator
+      --  Ada 2012 (AI05-0111-3): Analyze the subpool_specification, if
+      --  any. The expected type for the name is any type. A non-overloading
+      --  rule then requires it to be of a type descended from
+      --  System.Storage_Pools.Subpools.Subpool_Handle.
+
+      --  This isn't exactly what the AI says, but it seems to be the right
+      --  rule. The AI should be fixed.???
+
+      declare
+         Subpool : constant Node_Id := Subpool_Handle_Name (N);
+
+      begin
+         if Present (Subpool) then
+            Analyze (Subpool);
+
+            if Is_Overloaded (Subpool) then
+               Error_Msg_N ("ambiguous subpool handle", Subpool);
+            end if;
+
+            --  Check that Etype (Subpool) is descended from Subpool_Handle
+
+            Resolve (Subpool);
+         end if;
+      end;
+
+      --  Analyze the qualified expression or subtype indication
 
       if Nkind (E) = N_Qualified_Expression then
          Acc_Type := Create_Itype (E_Allocator_Type, N);
@@ -451,7 +477,7 @@ package body Sem_Ch4 is
          Find_Type (Subtype_Mark (E));
 
          --  Analyze the qualified expression, and apply the name resolution
-         --  rule given in  4.7 (3).
+         --  rule given in  4.7(3).
 
          Analyze (E);
          Type_Id := Etype (E);
@@ -677,6 +703,16 @@ package body Sem_Ch4 is
          Check_Restriction (No_Task_Allocators, N);
       end if;
 
+      --  AI05-0013-1: No_Nested_Finalization forbids allocators if the access
+      --  type is nested, and the designated type needs finalization. The rule
+      --  is conservative in that class-wide types need finalization.
+
+      if Needs_Finalization (Designated_Type (Acc_Type))
+        and then not Is_Library_Level_Entity (Acc_Type)
+      then
+         Check_Restriction (No_Nested_Finalization, N);
+      end if;
+
       --  Check that an allocator of a nested access type doesn't create a
       --  protected object when restriction No_Local_Protected_Objects applies.
       --  We don't have an equivalent to Has_Task for protected types, so only
@@ -1725,6 +1761,13 @@ package body Sem_Ch4 is
    begin
       Check_SPARK_Restriction ("explicit dereference is not allowed", N);
 
+      --  In formal verification mode, keep track of all reads and writes
+      --  through explicit dereferences.
+
+      if ALFA_Mode then
+         ALFA.Generate_Dereference (N);
+      end if;
+
       Analyze (P);
       Set_Etype (N, Any_Type);
 
@@ -2200,6 +2243,10 @@ package body Sem_Ch4 is
                      Check_Implicit_Dereference (N, CT);
                   end;
                end if;
+
+            elsif Try_Container_Indexing (N, P, First (Exprs)) then
+               return;
+
             end if;
 
             Get_Next_Interp (I, It);
@@ -3305,6 +3352,10 @@ package body Sem_Ch4 is
       Iterator : Node_Id;
 
    begin
+      --  Analyze construct with expansion disabled, because it will be
+      --  rewritten as a loop during expansion.
+
+      Expander_Mode_Save_And_Set (False);
       Check_SPARK_Restriction ("quantified expression is not allowed", N);
 
       Set_Etype  (Ent,  Standard_Void_Type);
@@ -3326,9 +3377,9 @@ package body Sem_Ch4 is
       Set_Parent (Iterator, N);
       Analyze_Iteration_Scheme (Iterator);
 
-      --  The loop specification may have been converted into an
-      --  iterator specification during its analysis. Update the
-      --  quantified node accordingly.
+      --  The loop specification may have been converted into an iterator
+      --  specification during its analysis. Update the quantified node
+      --  accordingly.
 
       if Present (Iterator_Specification (Iterator)) then
          Set_Iterator_Specification
@@ -3338,8 +3389,8 @@ package body Sem_Ch4 is
 
       Analyze (Condition (N));
       End_Scope;
-
       Set_Etype (N, Standard_Boolean);
+      Expander_Mode_Restore;
    end Analyze_Quantified_Expression;
 
    -------------------
@@ -6331,7 +6382,18 @@ package body Sem_Ch4 is
       --  diagnosed in caller.
 
       if No (Func_Name) then
-         return False;
+
+         --  The prefix itself may be an indexing of a container
+         --  rewrite as such and re-analyze.
+
+         if Has_Implicit_Dereference (Etype (Prefix)) then
+            Build_Explicit_Dereference
+              (Prefix, First_Discriminant (Etype (Prefix)));
+            return Try_Container_Indexing (N, Prefix, Expr);
+
+         else
+            return False;
+         end if;
       end if;
 
       if Is_Var
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 2e4adcde4a9..7de014fefe9 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
@@ -2005,8 +2006,21 @@ package body Sem_Ch5 is
                   Set_Parent (D_Copy, Parent (DS));
                   Pre_Analyze_Range (D_Copy);
 
+                  --  Ada2012: If the domain of iteration is a function call,
+                  --  it is the new iterator form.
+
+                  --  We have also implemented the shorter form : for X in S
+                  --  for Alfa use. In this case, 'Old and 'Result must be
+                  --  treated as entity names over which iterators are legal.
+
                   if Nkind (D_Copy) = N_Function_Call
                     or else
+                      (ALFA_Mode
+                        and then (Nkind (D_Copy) = N_Attribute_Reference
+                        and then
+                          (Attribute_Name (D_Copy) = Name_Result
+                            or else Attribute_Name (D_Copy) = Name_Old)))
+                    or else
                       (Is_Entity_Name (D_Copy)
                         and then not Is_Type (Entity (D_Copy)))
                   then
@@ -2027,6 +2041,14 @@ package body Sem_Ch5 is
                         Set_Iterator_Specification (N, I_Spec);
                         Set_Loop_Parameter_Specification (N, Empty);
                         Analyze_Iterator_Specification (I_Spec);
+
+                        --  In a generic context, analyze the original domain
+                        --  of iteration, for name capture.
+
+                        if not Expander_Active then
+                           Analyze (DS);
+                        end if;
+
                         return;
                      end;
 
@@ -2207,7 +2229,7 @@ package body Sem_Ch5 is
       Loc       : constant Source_Ptr := Sloc (N);
       Def_Id    : constant Node_Id    := Defining_Identifier (N);
       Subt      : constant Node_Id    := Subtype_Indication (N);
-      Container : constant Node_Id    := Name (N);
+      Iter_Name : constant Node_Id    := Name (N);
 
       Ent : Entity_Id;
       Typ : Entity_Id;
@@ -2220,45 +2242,81 @@ package body Sem_Ch5 is
          Analyze (Subt);
       end if;
 
-      --  If it is an expression, the container is pre-analyzed in the caller.
+      --  If it is an expression, the name is pre-analyzed in the caller.
       --  If it it of a controlled type we need a block for the finalization
       --  actions. As for loop bounds that need finalization, we create a
       --  declaration and an assignment to trigger these actions.
 
-      if Present (Etype (Container))
-        and then Is_Controlled (Etype (Container))
-        and then not Is_Entity_Name (Container)
+      if Present (Etype (Iter_Name))
+        and then Is_Controlled (Etype (Iter_Name))
+        and then not Is_Entity_Name (Iter_Name)
       then
          declare
-            Id : constant Entity_Id := Make_Temporary (Loc, 'R', Container);
+            Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name);
 
             Decl   : Node_Id;
-            Assign : Node_Id;
 
          begin
-            Typ := Etype (Container);
+            Typ := Etype (Iter_Name);
 
             Decl :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Id,
-                Object_Definition   => New_Occurrence_Of (Typ, Loc));
+                Object_Definition   => New_Occurrence_Of (Typ, Loc),
+                Expression          => Relocate_Node (Iter_Name));
 
-            Assign :=
-              Make_Assignment_Statement (Loc,
-                Name        => New_Occurrence_Of (Id, Loc),
-                Expression  => Relocate_Node (Container));
-
-            Insert_Actions (Parent (N), New_List (Decl, Assign));
+            Insert_Actions (Parent (Parent (N)), New_List (Decl));
+            Rewrite (Name (N), New_Occurrence_Of (Id, Loc));
+            Set_Etype (Id, Typ);
+            Set_Etype (Name (N), Typ);
          end;
 
+      --  Container is an entity or an array with uncontrolled components, or
+      --  else it is a container iterator given by a function call, typically
+      --  called Iterate in the case of predefined containers, even though
+      --  Iterate is not a reserved name. What matter is that the return type
+      --  of the function is an iterator type.
+
       else
+         Analyze (Iter_Name);
+
+         if Nkind (Iter_Name) = N_Function_Call then
+            declare
+               C  : constant Node_Id := Name (Iter_Name);
+               I  : Interp_Index;
+               It : Interp;
+
+            begin
+               if not Is_Overloaded (Iter_Name) then
+                  Resolve (Iter_Name, Etype (C));
+
+               else
+                  Get_First_Interp (C, I, It);
+                  while It.Typ /= Empty loop
+                     if Reverse_Present (N) then
+                        if Is_Reversible_Iterator (It.Typ) then
+                           Resolve (Iter_Name, It.Typ);
+                           exit;
+                        end if;
 
-         --  Container is an entity or an array with uncontrolled components
+                     elsif Is_Iterator (It.Typ) then
+                        Resolve (Iter_Name, It.Typ);
+                        exit;
+                     end if;
 
-         Analyze_And_Resolve (Container);
+                     Get_Next_Interp (I, It);
+                  end loop;
+               end if;
+            end;
+
+         --  Domain of iteration is not overloaded
+
+         else
+            Resolve (Iter_Name, Etype (Iter_Name));
+         end if;
       end if;
 
-      Typ := Etype (Container);
+      Typ := Etype (Iter_Name);
 
       if Is_Array_Type (Typ) then
          if Of_Present (N) then
@@ -2269,6 +2327,11 @@ package body Sem_Ch5 is
             Set_Etype (Def_Id, Etype (First_Index (Typ)));
          end if;
 
+         --  Check for type error in iterator
+
+      elsif Typ = Any_Type then
+         return;
+
       --  Iteration over a container
 
       else
@@ -2276,26 +2339,21 @@ package body Sem_Ch5 is
 
          if Of_Present (N) then
 
-            --  Find the Element_Type in the package instance that defines the
-            --  container type.
-
-            Ent := First_Entity (Scope (Base_Type (Typ)));
-            while Present (Ent) loop
-               if Chars (Ent) = Name_Element_Type then
-                  Set_Etype (Def_Id, Ent);
-                  exit;
-               end if;
+            --  The type of the loop variable is the Iterator_Element aspect of
+            --  the container type.
 
-               Next_Entity (Ent);
-            end loop;
+            Set_Etype (Def_Id,
+              Entity (Find_Aspect (Typ, Aspect_Iterator_Element)));
 
          else
-            --  Find the Cursor type in similar fashion
+            --  The result type of Iterate function is the classwide type of
+            --  the interface parent. We need the specific Cursor type defined
+            --  in the container package.
 
-            Ent := First_Entity (Scope (Base_Type (Typ)));
+            Ent := First_Entity (Scope (Typ));
             while Present (Ent) loop
                if Chars (Ent) = Name_Cursor then
-                  Set_Etype (Def_Id, Ent);
+                  Set_Etype (Def_Id, Etype (Ent));
                   exit;
                end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5f7b1a79ea3..4c196669ccf 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1156,11 +1156,12 @@ package body Sem_Ch6 is
          end loop;
       end if;
 
-      --  Special processing for Elab_Spec and Elab_Body calls
+      --  Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls
 
       if Nkind (P) = N_Attribute_Reference
         and then (Attribute_Name (P) = Name_Elab_Spec
-                   or else Attribute_Name (P) = Name_Elab_Body)
+                   or else Attribute_Name (P) = Name_Elab_Body
+                   or else Attribute_Name (P) = Name_Elab_Subp_Body)
       then
          if Present (Actuals) then
             Error_Msg_N
@@ -2339,14 +2340,15 @@ package body Sem_Ch6 is
          --  In general, the spec will be frozen when we start analyzing the
          --  body. However, for internally generated operations, such as
          --  wrapper functions for inherited operations with controlling
-         --  results, the spec may not have been frozen by the time we
-         --  expand the freeze actions that include the bodies. In particular,
-         --  extra formals for accessibility or for return-in-place may need
-         --  to be generated. Freeze nodes, if any, are inserted before the
-         --  current body.
+         --  results, the spec may not have been frozen by the time we expand
+         --  the freeze actions that include the bodies. In particular, extra
+         --  formals for accessibility or for return-in-place may need to be
+         --  generated. Freeze nodes, if any, are inserted before the current
+         --  body. These freeze actions are also needed in ASIS mode to enable
+         --  the proper back-annotations.
 
          if not Is_Frozen (Spec_Id)
-           and then Expander_Active
+           and then (Expander_Active or ASIS_Mode)
          then
             --  Force the generation of its freezing node to ensure proper
             --  management of access types in the backend.
@@ -4714,7 +4716,7 @@ package body Sem_Ch6 is
                --  Grouping (use of comma in param lists) must be the same
                --  This is where we catch a misconformance like:
 
-               --    A,B : Integer
+               --    A, B : Integer
                --    A : Integer; B : Integer
 
                --  which are represented identically in the tree except
@@ -5667,6 +5669,12 @@ package body Sem_Ch6 is
          then
             return True;
 
+         elsif From_With_Type (T1)
+           and then From_With_Type (T2)
+           and then Available_View (T1) = Available_View (T2)
+         then
+            return True;
+
          else
             return False;
          end if;
@@ -6079,14 +6087,13 @@ package body Sem_Ch6 is
             end if;
 
             --  In the case of functions whose result type needs finalization,
-            --  add an extra formal of type Ada.Finalization.Heap_Management.
-            --  Finalization_Collection_Ptr.
+            --  add an extra formal which represents the finalization master.
 
-            if Needs_BIP_Collection (E) then
+            if Needs_BIP_Finalization_Master (E) then
                Discard :=
                  Add_Extra_Formal
-                   (E, RTE (RE_Finalization_Collection_Ptr),
-                    E, BIP_Formal_Suffix (BIP_Collection));
+                   (E, RTE (RE_Finalization_Master_Ptr),
+                    E, BIP_Formal_Suffix (BIP_Finalization_Master));
             end if;
 
             --  If the result type contains tasks, we have two extra formals:
@@ -6361,7 +6368,19 @@ package body Sem_Ch6 is
                   end if;
                end if;
 
-               if not Has_Completion (E) then
+               --  Ada 2012 (AI05-0165): For internally generated bodies of
+               --  null procedures locate the internally generated spec. We
+               --  enforce mode conformance since a tagged type may inherit
+               --  from interfaces several null primitives which differ only
+               --  in the mode of the formals.
+
+               if not (Comes_From_Source (E))
+                 and then Is_Null_Procedure (E)
+                 and then not Mode_Conformant (Designator, E)
+               then
+                  null;
+
+               elsif not Has_Completion (E) then
                   if Nkind (N) /= N_Subprogram_Body_Stub then
                      Set_Corresponding_Spec (N, E);
                   end if;
@@ -7036,6 +7055,35 @@ package body Sem_Ch6 is
       Iface : constant Entity_Id := Find_Dispatching_Type (Iface_Prim);
       Typ   : constant Entity_Id := Find_Dispatching_Type (Prim);
 
+      function Controlling_Formal (Prim : Entity_Id) return Entity_Id;
+      --  Return the controlling formal of Prim
+
+      ------------------------
+      -- Controlling_Formal --
+      ------------------------
+
+      function Controlling_Formal (Prim : Entity_Id) return Entity_Id is
+         E : Entity_Id := First_Entity (Prim);
+
+      begin
+         while Present (E) loop
+            if Is_Formal (E) and then Is_Controlling_Formal (E) then
+               return E;
+            end if;
+
+            Next_Entity (E);
+         end loop;
+
+         return Empty;
+      end Controlling_Formal;
+
+      --  Local variables
+
+      Iface_Ctrl_F : constant Entity_Id := Controlling_Formal (Iface_Prim);
+      Prim_Ctrl_F  : constant Entity_Id := Controlling_Formal (Prim);
+
+   --  Start of processing for Is_Interface_Conformant
+
    begin
       pragma Assert (Is_Subprogram (Iface_Prim)
         and then Is_Subprogram (Prim)
@@ -7059,8 +7107,17 @@ package body Sem_Ch6 is
       then
          return False;
 
-      --  Case of a procedure, or a function that does not have a controlling
-      --  result (I or access I).
+      --  The mode of the controlling formals must match
+
+      elsif Present (Iface_Ctrl_F)
+         and then Present (Prim_Ctrl_F)
+         and then Ekind (Iface_Ctrl_F) /= Ekind (Prim_Ctrl_F)
+      then
+         return False;
+
+      --  Case of a procedure, or a function whose result type matches the
+      --  result type of the interface primitive, or a function that has no
+      --  controlling result (I or access I).
 
       elsif Ekind (Iface_Prim) = E_Procedure
         or else Etype (Prim) = Etype (Iface_Prim)
@@ -8253,6 +8310,18 @@ package body Sem_Ch6 is
             if Scope (E) /= Current_Scope then
                null;
 
+            --  Ada 2012 (AI05-0165): For internally generated bodies of
+            --  null procedures locate the internally generated spec. We
+            --  enforce mode conformance since a tagged type may inherit
+            --  from interfaces several null primitives which differ only
+            --  in the mode of the formals.
+
+            elsif not Comes_From_Source (S)
+              and then Is_Null_Procedure (S)
+              and then not Mode_Conformant (E, S)
+            then
+               null;
+
             --  Check if we have type conformance
 
             elsif Type_Conformant (E, S) then
@@ -9557,7 +9626,6 @@ package body Sem_Ch6 is
                     Statements => Plist)));
 
             Set_Ekind (Post_Proc, E_Procedure);
-            Set_Is_Postcondition_Proc (Post_Proc);
 
             --  If this is a procedure, set the Postcondition_Proc attribute on
             --  the proper defining entity for the subprogram.
@@ -9681,12 +9749,13 @@ package body Sem_Ch6 is
          if AS_Needed then
             if Nkind (N) = N_Accept_Statement then
 
-               --  If expansion is active, The formal is replaced by a local
+               --  If expansion is active, the formal is replaced by a local
                --  variable that renames the corresponding entry of the
                --  parameter block, and it is this local variable that may
-               --  require an actual subtype.
+               --  require an actual subtype. In ALFA mode, expansion of accept
+               --  statements is skipped.
 
-               if Expander_Active then
+               if Expander_Active and not ALFA_Mode then
                   Decl := Build_Actual_Subtype (T, Renamed_Object (Formal));
                else
                   Decl := Build_Actual_Subtype (T, Formal);
@@ -9726,6 +9795,7 @@ package body Sem_Ch6 is
 
             if Nkind (N) = N_Accept_Statement
               and then Expander_Active
+              and then not ALFA_Mode
             then
                Set_Actual_Subtype (Renamed_Object (Formal),
                  Defining_Identifier (Decl));
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 62f4abd0f0a..e1453d0c1e8 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1196,8 +1196,11 @@ package body Sem_Ch7 is
 
          --  Check on incomplete types
 
+         --  AI05-0213: A formal incomplete type has no completion
+
          if Ekind (E) = E_Incomplete_Type
            and then No (Full_View (E))
+           and then not Is_Generic_Type (E)
          then
             Error_Msg_N ("no declaration in visible part for incomplete}", E);
          end if;
@@ -2585,7 +2588,9 @@ package body Sem_Ch7 is
                and then Unit_Requires_Body (E))
 
            or else
-             (Ekind (E) = E_Incomplete_Type and then No (Full_View (E)))
+             (Ekind (E) = E_Incomplete_Type
+               and then No (Full_View (E))
+               and then not Is_Generic_Type (E))
 
            or else
             ((Ekind (E) = E_Task_Type or else
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index cf623bef718..77f948f4f6a 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -682,9 +682,10 @@ package body Sem_Ch8 is
    -----------------------------
 
    procedure Analyze_Object_Renaming (N : Node_Id) is
-      Id  : constant Entity_Id := Defining_Identifier (N);
+      Loc : constant Source_Ptr := Sloc (N);
+      Id  : constant Entity_Id  := Defining_Identifier (N);
       Dec : Node_Id;
-      Nam : constant Node_Id   := Name (N);
+      Nam : constant Node_Id    := Name (N);
       T   : Entity_Id;
       T2  : Entity_Id;
 
@@ -704,7 +705,6 @@ package body Sem_Ch8 is
       ------------------------------
 
       procedure Check_Constrained_Object is
-         Loc  : constant Source_Ptr := Sloc (N);
          Subt : Entity_Id;
 
       begin
@@ -721,6 +721,12 @@ package body Sem_Ch8 is
             then
                null;
 
+            --  A renaming of an unchecked union does not have an
+            --  actual subtype.
+
+            elsif Is_Unchecked_Union (Etype (Nam)) then
+               null;
+
             else
                Subt := Make_Temporary (Loc, 'T');
                Remove_Side_Effects (Nam);
@@ -805,6 +811,29 @@ package body Sem_Ch8 is
 
          Resolve (Nam, T);
 
+         --  If the renamed object is a function call of a limited type,
+         --  the expansion of the renaming is complicated by the presence
+         --  of various temporaries and subtypes that capture constraints
+         --  of the renamed object. Rewrite node as an object declaration,
+         --  whose expansion is simpler. Given that the object is limited
+         --  there is no copy involved and no performance hit.
+
+         if Nkind (Nam) = N_Function_Call
+           and then Is_Immutably_Limited_Type (Etype (Nam))
+           and then not Is_Constrained (Etype (Nam))
+           and then Comes_From_Source (N)
+         then
+            Set_Etype (Id, T);
+            Set_Ekind (Id, E_Constant);
+            Rewrite (N,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Id,
+                Constant_Present    => True,
+                Object_Definition   => New_Occurrence_Of (Etype (Nam), Loc),
+                Expression          => Relocate_Node (Nam)));
+            return;
+         end if;
+
          --  Check that a class-wide object is not being renamed as an object
          --  of a specific type. The test for access types is needed to exclude
          --  cases where the renamed object is a dynamically tagged access
@@ -828,9 +857,9 @@ package body Sem_Ch8 is
 
          --  Ada 2005 AI05-105: if the declaration has an anonymous access
          --  type, the renamed object must also have an anonymous type, and
-         --  this is a name resolution rule. This was implicit in the last
-         --  part of the first sentence in 8.5.1.(3/2), and is made explicit
-         --  by this recent AI.
+         --  this is a name resolution rule. This was implicit in the last part
+         --  of the first sentence in 8.5.1(3/2), and is made explicit by this
+         --  recent AI.
 
          if not Is_Overloaded (Nam) then
             if Ekind (Etype (Nam)) /= Ekind (T) then
@@ -971,7 +1000,7 @@ package body Sem_Ch8 is
 
       T2 := Etype (Nam);
 
-      --  (Ada 2005: AI-326): Handle wrong use of incomplete type
+      --  Ada 2005 (AI-326): Handle wrong use of incomplete type
 
       if Nkind (Nam) = N_Explicit_Dereference
         and then Ekind (Etype (T2)) = E_Incomplete_Type
@@ -1605,11 +1634,6 @@ package body Sem_Ch8 is
    procedure Analyze_Subprogram_Renaming (N : Node_Id) is
       Formal_Spec : constant Node_Id := Corresponding_Formal_Spec (N);
       Is_Actual   : constant Boolean := Present (Formal_Spec);
-
-      CW_Actual : Boolean := False;
-      --  True if the renaming is for a defaulted formal subprogram when the
-      --  actual for a related formal type is class-wide. For AI05-0071.
-
       Inst_Node   : Node_Id                   := Empty;
       Nam         : constant Node_Id          := Name (N);
       New_S       : Entity_Id;
@@ -1662,6 +1686,11 @@ package body Sem_Ch8 is
       --  This rule only applies if there is no explicit visible class-wide
       --  operation at the point of the instantiation.
 
+      function Has_Class_Wide_Actual return Boolean;
+      --  Ada 2012 (AI05-071, AI05-0131): True if N is the renaming for a
+      --  defaulted formal subprogram when the actual for the controlling
+      --  formal type is class-wide.
+
       -----------------------------
       -- Check_Class_Wide_Actual --
       -----------------------------
@@ -1700,7 +1729,7 @@ package body Sem_Ch8 is
                Next (F);
             end loop;
 
-            if Ekind (Prim_Op) = E_Function then
+            if Ekind_In (Prim_Op, E_Function, E_Operator) then
                return Make_Simple_Return_Statement (Loc,
                   Expression =>
                     Make_Function_Call (Loc,
@@ -1751,6 +1780,7 @@ package body Sem_Ch8 is
          F := First_Formal (Formal_Spec);
          while Present (F) loop
             if Has_Unknown_Discriminants (Etype (F))
+              and then not Is_Class_Wide_Type (Etype (F))
               and then Is_Class_Wide_Type (Get_Instance_Of (Etype (F)))
             then
                Formal_Type := Etype (F);
@@ -1762,7 +1792,6 @@ package body Sem_Ch8 is
          end loop;
 
          if Present (Formal_Type) then
-            CW_Actual := True;
 
             --  Create declaration and body for class-wide operation
 
@@ -1811,7 +1840,7 @@ package body Sem_Ch8 is
             Result := Defining_Entity (New_Decl);
          end if;
 
-         --  Return the class-wide operation if one was created.
+         --  Return the class-wide operation if one was created
 
          return Result;
       end Check_Class_Wide_Actual;
@@ -1864,6 +1893,41 @@ package body Sem_Ch8 is
          end if;
       end Check_Null_Exclusion;
 
+      ---------------------------
+      -- Has_Class_Wide_Actual --
+      ---------------------------
+
+      function Has_Class_Wide_Actual return Boolean is
+         F_Nam  : Entity_Id;
+         F_Spec : Entity_Id;
+
+      begin
+         if Is_Actual
+           and then Nkind (Nam) in N_Has_Entity
+           and then Present (Entity (Nam))
+           and then Is_Dispatching_Operation (Entity (Nam))
+         then
+            F_Nam  := First_Entity (Entity (Nam));
+            F_Spec := First_Formal (Formal_Spec);
+            while Present (F_Nam)
+              and then Present (F_Spec)
+            loop
+               if Is_Controlling_Formal (F_Nam)
+                 and then Has_Unknown_Discriminants (Etype (F_Spec))
+                 and then not Is_Class_Wide_Type (Etype (F_Spec))
+                 and then Is_Class_Wide_Type (Get_Instance_Of (Etype (F_Spec)))
+               then
+                  return True;
+               end if;
+
+               Next_Entity (F_Nam);
+               Next_Formal (F_Spec);
+            end loop;
+         end if;
+
+         return False;
+      end Has_Class_Wide_Actual;
+
       -------------------------
       -- Original_Subprogram --
       -------------------------
@@ -1909,6 +1973,11 @@ package body Sem_Ch8 is
          end if;
       end Original_Subprogram;
 
+      CW_Actual : constant Boolean := Has_Class_Wide_Actual;
+      --  Ada 2012 (AI05-071, AI05-0131): True if the renaming is for a
+      --  defaulted formal subprogram when the actual for a related formal
+      --  type is class-wide.
+
    --  Start of processing for Analyze_Subprogram_Renaming
 
    begin
@@ -2029,7 +2098,14 @@ package body Sem_Ch8 is
       if Is_Actual then
          Inst_Node := Unit_Declaration_Node (Formal_Spec);
 
-         if Is_Entity_Name (Nam)
+         --  Check whether the renaming is for a defaulted actual subprogram
+         --  with a class-wide actual.
+
+         if CW_Actual then
+            New_S := Analyze_Subprogram_Specification (Spec);
+            Old_S := Check_Class_Wide_Actual;
+
+         elsif Is_Entity_Name (Nam)
            and then Present (Entity (Nam))
            and then not Comes_From_Source (Nam)
            and then not Is_Overloaded (Nam)
@@ -2330,9 +2406,7 @@ package body Sem_Ch8 is
          --  of a generic, its entity is set to the first available homonym.
          --  We must first disambiguate the name, then set the proper entity.
 
-         if Is_Actual
-           and then Is_Overloaded (Nam)
-         then
+         if Is_Actual and then Is_Overloaded (Nam) then
             Set_Entity (Nam, Old_S);
          end if;
       end if;
@@ -2392,23 +2466,13 @@ package body Sem_Ch8 is
          end if;
       end if;
 
-      --  If no renamed entity was found, check whether the renaming is for
-      --  a defaulted actual subprogram with a class-wide actual.
-
-      if Old_S = Any_Id
-        and then Is_Actual
-        and then From_Default (N)
-      then
-         Old_S := Check_Class_Wide_Actual;
-      end if;
-
       if Old_S /= Any_Id then
-         if Is_Actual
-           and then From_Default (N)
-         then
+         if Is_Actual and then From_Default (N) then
+
             --  This is an implicit reference to the default actual
 
             Generate_Reference (Old_S, Nam, Typ => 'i', Force => True);
+
          else
             Generate_Reference (Old_S, Nam);
          end if;
@@ -2461,7 +2525,7 @@ package body Sem_Ch8 is
 
             --  If this a defaulted subprogram for a class-wide actual there is
             --  no check for mode conformance,  given that the signatures don't
-            --  match (the source mentions T but the actual mentions T'class).
+            --  match (the source mentions T but the actual mentions T'Class).
 
             if CW_Actual then
                null;
@@ -4820,7 +4884,9 @@ package body Sem_Ch8 is
             Set_Entity_Or_Discriminal (N, E);
 
             if Ada_Version >= Ada_2012
-              and then Nkind (Parent (N)) in N_Subexpr
+              and then
+                (Nkind (Parent (N)) in N_Subexpr
+                  or else Nkind (Parent (N)) = N_Object_Declaration)
             then
                Check_Implicit_Dereference (N, Etype (E));
             end if;
@@ -5118,7 +5184,7 @@ package body Sem_Ch8 is
                            Next_Entity (Id);
                         end loop;
 
-                        --  If not found,  standard error message.
+                        --  If not found, standard error message
 
                         Error_Msg_NE ("& not declared in&", N, Selector);
 
@@ -5510,13 +5576,29 @@ package body Sem_Ch8 is
 
                      if Present (Inst) then
                         if Within (It.Nam, Inst) then
-                           return (It.Nam);
+                           if Within (Old_S, Inst) then
+
+                              --  Choose the innermost subprogram, which would
+                              --  have hidden the outer one in the generic.
+
+                              if Scope_Depth (It.Nam) <
+                                Scope_Depth (Old_S)
+                              then
+                                 return Old_S;
+                              else
+                                 return It.Nam;
+                              end if;
+                           end if;
+
                         elsif Within (Old_S, Inst) then
                            return (Old_S);
+
                         else
                            return Report_Overload;
                         end if;
 
+                     --  If not within an instance, ambiguity is real
+
                      else
                         return Report_Overload;
                      end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 419f6cf962e..c16a671e0d3 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -500,24 +500,13 @@ package body Sem_Prag is
 
       procedure Check_Test_Case;
       --  Called to process a test-case pragma. The treatment is similar to the
-      --  one for pre- and postcondition in Check_Precondition_Postcondition.
-      --  There are three cases:
-      --
-      --    The pragma appears after a subprogram spec
-      --
-      --      The first step is to analyze the pragma, but this is skipped if
-      --      the subprogram spec appears within a package specification
-      --      (because this is the case where we delay analysis till the end of
-      --      the spec). Then (whether or not it was analyzed), the pragma is
-      --      chained to the subprogram in question (using Spec_TC_List and
-      --      Next_Pragma).
-      --
-      --    The pragma appears at the start of subprogram body declarations
-      --
-      --      In this case an immediate return to the caller is made, and the
-      --      pragma is NOT analyzed.
-      --
-      --    In all other cases, an error message for bad placement is given
+      --  one for pre- and postcondition in Check_Precondition_Postcondition,
+      --  except the placement rules for the test-case pragma are stricter.
+      --  This pragma may only occur after a subprogram spec declared directly
+      --  in a package spec unit. In this case, the pragma is chained to the
+      --  subprogram in question (using Spec_TC_List and Next_Pragma) and
+      --  analysis of the pragma is delayed till the end of the spec. In
+      --  all other cases, an error message for bad placement is given.
 
       procedure Check_Valid_Configuration_Pragma;
       --  Legality checks for placement of a configuration pragma
@@ -1884,6 +1873,15 @@ package body Sem_Prag is
          --  See if it is in the pragmas after a library level subprogram
 
          elsif Nkind (Parent (N)) = N_Compilation_Unit_Aux then
+
+            --  In formal verification mode, analyze pragma expression for
+            --  correctness, as it is not expanded later.
+
+            if ALFA_Mode then
+               Analyze_PPC_In_Decl_Part
+                 (N, Defining_Entity (Unit (Parent (Parent (N)))));
+            end if;
+
             Chain_PPC (Unit (Parent (Parent (N))));
             return;
          end if;
@@ -1963,9 +1961,9 @@ package body Sem_Prag is
          PO : Node_Id;
 
          procedure Chain_TC (PO : Node_Id);
-         --  If PO is an entry or a [generic] subprogram declaration node, then
-         --  the test-case applies to this subprogram and the processing for
-         --  the pragma is completed. Otherwise the pragma is misplaced.
+         --  If PO is a [generic] subprogram declaration node, then the
+         --  test-case applies to this subprogram and the processing for the
+         --  pragma is completed. Otherwise the pragma is misplaced.
 
          --------------
          -- Chain_TC --
@@ -1984,20 +1982,22 @@ package body Sem_Prag is
                     ("pragma% cannot be applied to abstract subprogram");
                end if;
 
+            elsif Nkind (PO) = N_Entry_Declaration then
+               if From_Aspect_Specification (N) then
+                  Error_Pragma ("aspect% cannot be applied to entry");
+               else
+                  Error_Pragma ("pragma% cannot be applied to entry");
+               end if;
+
             elsif not Nkind_In (PO, N_Subprogram_Declaration,
-                                    N_Generic_Subprogram_Declaration,
-                                    N_Entry_Declaration)
+                                    N_Generic_Subprogram_Declaration)
             then
                Pragma_Misplaced;
             end if;
 
-            --  Here if we have [generic] subprogram or entry declaration
+            --  Here if we have [generic] subprogram declaration
 
-            if Nkind (PO) = N_Entry_Declaration then
-               S := Defining_Entity (PO);
-            else
-               S := Defining_Unit_Name (Specification (PO));
-            end if;
+            S := Defining_Unit_Name (Specification (PO));
 
             --  Note: we do not analyze the pragma at this point. Instead we
             --  delay this analysis until the end of the declarative part in
@@ -2045,6 +2045,16 @@ package body Sem_Prag is
             Pragma_Misplaced;
          end if;
 
+         --  Test cases should only appear in package spec unit
+
+         if Get_Source_Unit (N) = No_Unit
+           or else not Nkind_In (Sinfo.Unit (Cunit (Get_Source_Unit (N))),
+                                 N_Package_Declaration,
+                                 N_Generic_Package_Declaration)
+         then
+            Pragma_Misplaced;
+         end if;
+
          --  Search prior declarations
 
          P := N;
@@ -2073,7 +2083,18 @@ package body Sem_Prag is
             elsif not Comes_From_Source (PO) then
                null;
 
-            --  Only remaining possibility is subprogram declaration
+            --  Only remaining possibility is subprogram declaration. First
+            --  check that it is declared directly in a package declaration.
+            --  This may be either the package declaration for the current unit
+            --  being defined or a local package declaration.
+
+            elsif not Present (Parent (Parent (PO)))
+              or else not Present (Parent (Parent (Parent (PO))))
+              or else not Nkind_In (Parent (Parent (PO)),
+                                    N_Package_Declaration,
+                                    N_Generic_Package_Declaration)
+            then
+               Pragma_Misplaced;
 
             else
                Chain_TC (PO);
@@ -2081,14 +2102,6 @@ package body Sem_Prag is
             end if;
          end loop;
 
-         --  If we fall through loop, pragma is at start of list, so see if it
-         --  is in the pragmas after a library level subprogram.
-
-         if Nkind (Parent (N)) = N_Compilation_Unit_Aux then
-            Chain_TC (Unit (Parent (Parent (N))));
-            return;
-         end if;
-
          --  If we fall through, pragma was misplaced
 
          Pragma_Misplaced;
@@ -4681,9 +4694,12 @@ package body Sem_Prag is
 
                   --  Inline is a program unit pragma (RM 10.1.5) and cannot
                   --  appear in a formal part to apply to a formal subprogram.
+                  --  Do not apply check within an instance or a formal package
+                  --  the test will have been applied to the original generic.
 
                   elsif Nkind (Decl) in N_Formal_Subprogram_Declaration
                     and then List_Containing (Decl) = List_Containing (N)
+                    and then not In_Instance
                   then
                      Error_Msg_N
                        ("Inline cannot apply to a formal subprogram", N);
@@ -13292,12 +13308,12 @@ package body Sem_Prag is
          --                  [, Requires =>  Boolean_EXPRESSION]
          --                  [, Ensures  =>  Boolean_EXPRESSION]);
 
-         --  MODE_TYPE ::= Normal | Robustness
+         --  MODE_TYPE ::= Nominal | Robustness
 
          when Pragma_Test_Case => Test_Case : declare
          begin
             GNAT_Pragma;
-            Check_At_Least_N_Arguments (3);
+            Check_At_Least_N_Arguments (2);
             Check_At_Most_N_Arguments (4);
             Check_Arg_Order
                  ((Name_Name, Name_Mode, Name_Requires, Name_Ensures));
@@ -13305,12 +13321,13 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Name);
             Check_Arg_Is_Static_Expression (Arg1, Standard_String);
             Check_Optional_Identifier (Arg2, Name_Mode);
-            Check_Arg_Is_One_Of (Arg2, Name_Normal, Name_Robustness);
+            Check_Arg_Is_One_Of (Arg2, Name_Nominal, Name_Robustness);
 
             if Arg_Count = 4 then
                Check_Identifier (Arg3, Name_Requires);
                Check_Identifier (Arg4, Name_Ensures);
-            else
+
+            elsif Arg_Count = 3 then
                Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures);
             end if;
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 4de5c3d6a68..3670221e0bb 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -1685,6 +1685,7 @@ package body Sem_Res is
       Tsk : Node_Id := Empty;
 
       function Process_Discr (Nod : Node_Id) return Traverse_Result;
+      --  Comment needed???
 
       -------------------
       -- Process_Discr --
@@ -1753,15 +1754,6 @@ package body Sem_Res is
       It1       : Interp;
       Seen      : Entity_Id := Empty; -- prevent junk warning
 
-      procedure Build_Explicit_Dereference
-        (Expr : Node_Id;
-         Disc : Entity_Id);
-      --  AI05-139: Names with implicit dereference. If the expression N is a
-      --  reference type and the context imposes the corresponding designated
-      --  type, convert N into N.Disc.all. Such expressions are always over-
-      --  loaded with both interpretations, and the dereference interpretation
-      --  carries the name of the reference discriminant.
-
       function Comes_From_Predefined_Lib_Unit (Nod : Node_Id) return Boolean;
       --  Determine whether a node comes from a predefined library unit or
       --  Standard.
@@ -1777,30 +1769,6 @@ package body Sem_Res is
       procedure Resolution_Failed;
       --  Called when attempt at resolving current expression fails
 
-      --------------------------------
-      -- Build_Explicit_Dereference --
-      --------------------------------
-
-      procedure Build_Explicit_Dereference
-        (Expr : Node_Id;
-         Disc : Entity_Id)
-      is
-         Loc : constant Source_Ptr := Sloc (Expr);
-
-      begin
-         Set_Is_Overloaded (Expr, False);
-         Rewrite (Expr,
-           Make_Explicit_Dereference (Loc,
-             Prefix =>
-               Make_Selected_Component (Loc,
-                 Prefix => Relocate_Node (Expr),
-                 Selector_Name =>
-               New_Occurrence_Of (Disc, Loc))));
-
-         Set_Etype (Prefix (Expr), Etype (Disc));
-         Set_Etype (Expr, Typ);
-      end Build_Explicit_Dereference;
-
       ------------------------------------
       -- Comes_From_Predefined_Lib_Unit --
       -------------------------------------
@@ -1819,18 +1787,14 @@ package body Sem_Res is
 
       procedure Patch_Up_Value (N : Node_Id; Typ : Entity_Id) is
       begin
-         if Nkind (N) = N_Integer_Literal
-           and then Is_Real_Type (Typ)
-         then
+         if Nkind (N) = N_Integer_Literal and then Is_Real_Type (Typ) then
             Rewrite (N,
               Make_Real_Literal (Sloc (N),
                 Realval => UR_From_Uint (Intval (N))));
             Set_Etype (N, Universal_Real);
             Set_Is_Static_Expression (N);
 
-         elsif Nkind (N) = N_Real_Literal
-           and then Is_Integer_Type (Typ)
-         then
+         elsif Nkind (N) = N_Real_Literal and then Is_Integer_Type (Typ) then
             Rewrite (N,
               Make_Integer_Literal (Sloc (N),
                 Intval => UR_To_Uint (Realval (N))));
@@ -1838,7 +1802,7 @@ package body Sem_Res is
             Set_Is_Static_Expression (N);
 
          elsif Nkind (N) = N_String_Literal
-           and then Is_Character_Type (Typ)
+                 and then Is_Character_Type (Typ)
          then
             Set_Character_Literal_Name (Char_Code (Character'Pos ('A')));
             Rewrite (N,
@@ -1849,15 +1813,13 @@ package body Sem_Res is
             Set_Etype (N, Any_Character);
             Set_Is_Static_Expression (N);
 
-         elsif Nkind (N) /= N_String_Literal
-           and then Is_String_Type (Typ)
-         then
+         elsif Nkind (N) /= N_String_Literal and then Is_String_Type (Typ) then
             Rewrite (N,
               Make_String_Literal (Sloc (N),
                 Strval => End_String));
 
          elsif Nkind (N) = N_Range then
-            Patch_Up_Value (Low_Bound (N), Typ);
+            Patch_Up_Value (Low_Bound (N),  Typ);
             Patch_Up_Value (High_Bound (N), Typ);
          end if;
       end Patch_Up_Value;
@@ -1878,7 +1840,7 @@ package body Sem_Res is
          then
             Error_Msg_NE ("ambiguous call to&", Arg, Name (Arg));
 
-            --  Could use comments on what is going on here ???
+            --  Could use comments on what is going on here???
 
             Get_First_Interp (Name (Arg), I, It);
             while Present (It.Nam) loop
@@ -1926,8 +1888,8 @@ package body Sem_Res is
          return;
       end if;
 
-      --  Access attribute on remote subprogram cannot be used for
-      --  a non-remote access-to-subprogram type.
+      --  Access attribute on remote subprogram cannot be used for a non-remote
+      --  access-to-subprogram type.
 
       if Nkind (N) = N_Attribute_Reference
         and then (Attribute_Name (N) = Name_Access              or else
@@ -3987,14 +3949,17 @@ package body Sem_Res is
                     ("& is not a dispatching operation of &!", A, Nam);
                end if;
 
+            --  Apply the checks described in 3.10.2(27): if the context is a
+            --  specific access-to-object, the actual cannot be class-wide.
+            --  Use base type to exclude access_to_subprogram cases.
+
             elsif Is_Access_Type (A_Typ)
               and then Is_Access_Type (F_Typ)
-              and then Ekind (F_Typ) /= E_Access_Subprogram_Type
-              and then Ekind (F_Typ) /= E_Anonymous_Access_Subprogram_Type
+              and then not Is_Access_Subprogram_Type (Base_Type (F_Typ))
               and then (Is_Class_Wide_Type (Designated_Type (A_Typ))
                          or else (Nkind (A) = N_Attribute_Reference
                                    and then
-                                     Is_Class_Wide_Type (Etype (Prefix (A)))))
+                                  Is_Class_Wide_Type (Etype (Prefix (A)))))
               and then not Is_Class_Wide_Type (Designated_Type (F_Typ))
               and then not Is_Controlling_Formal (F)
 
@@ -4008,9 +3973,7 @@ package body Sem_Res is
                Error_Msg_N
                  ("access to class-wide argument not allowed here!", A);
 
-               if Is_Subprogram (Nam)
-                 and then Comes_From_Source (Nam)
-               then
+               if Is_Subprogram (Nam) and then Comes_From_Source (Nam) then
                   Error_Msg_Node_2 := Designated_Type (F_Typ);
                   Error_Msg_NE
                     ("& is not a dispatching operation of &!", A, Nam);
@@ -4057,7 +4020,8 @@ package body Sem_Res is
    -----------------------
 
    procedure Resolve_Allocator (N : Node_Id; Typ : Entity_Id) is
-      E        : constant Node_Id := Expression (N);
+      Desig_T  : constant Entity_Id := Designated_Type (Typ);
+      E        : constant Node_Id   := Expression (N);
       Subtyp   : Entity_Id;
       Discrim  : Entity_Id;
       Constr   : Node_Id;
@@ -4159,7 +4123,7 @@ package body Sem_Res is
 
       if Nkind (E) = N_Qualified_Expression then
          if Is_Class_Wide_Type (Etype (E))
-           and then not Is_Class_Wide_Type (Designated_Type (Typ))
+           and then not Is_Class_Wide_Type (Desig_T)
            and then not In_Dispatching_Context
          then
             Error_Msg_N
@@ -4303,7 +4267,7 @@ package body Sem_Res is
       --  Expand_Allocator_Expression).
 
       if Ada_Version >= Ada_2005
-        and then Is_Class_Wide_Type (Designated_Type (Typ))
+        and then Is_Class_Wide_Type (Desig_T)
       then
          declare
             Exp_Typ : Entity_Id;
@@ -4365,7 +4329,7 @@ package body Sem_Res is
       --  type when restriction No_Task_Hierarchy applies.
 
       if not Is_Library_Level_Entity (Base_Type (Typ))
-        and then Has_Task (Base_Type (Designated_Type (Typ)))
+        and then Has_Task (Base_Type (Desig_T))
       then
          Check_Restriction (No_Task_Hierarchy, N);
       end if;
@@ -4382,6 +4346,26 @@ package body Sem_Res is
            and then Nkind (Associated_Node_For_Itype (Typ)) =
                       N_Discriminant_Specification
          then
+            declare
+               Discr : constant Entity_Id :=
+                         Defining_Identifier (Associated_Node_For_Itype (Typ));
+
+            begin
+               --  Ada 2012 AI05-0052: If the designated type of the allocator
+               --  is limited, then the allocator shall not be used to define
+               --  the value of an access discriminant unless the discriminated
+               --  type is immutably limited.
+
+               if Ada_Version >= Ada_2012
+                 and then Is_Limited_Type (Desig_T)
+                 and then not Is_Immutably_Limited_Type (Scope (Discr))
+               then
+                  Error_Msg_N
+                    ("only immutably limited types can have anonymous "
+                     & "access discriminants designating a limited type", N);
+               end if;
+            end;
+
             --  Avoid marking an allocator as a dynamic coextension if it is
             --  within a static construct.
 
@@ -4397,20 +4381,34 @@ package body Sem_Res is
          end if;
       end if;
 
-      --  Report a simple error:  if the designated object is a local task,
-      --  its body has not been seen yet, and its activation will fail
-      --  an elaboration check.
+      --  Report a simple error: if the designated object is a local task,
+      --  its body has not been seen yet, and its activation will fail an
+      --  elaboration check.
 
-      if Is_Task_Type (Designated_Type (Typ))
-        and then Scope (Base_Type (Designated_Type (Typ))) = Current_Scope
+      if Is_Task_Type (Desig_T)
+        and then Scope (Base_Type (Desig_T)) = Current_Scope
         and then Is_Compilation_Unit (Current_Scope)
         and then Ekind (Current_Scope) = E_Package
         and then not In_Package_Body (Current_Scope)
       then
-         Error_Msg_N
-           ("cannot activate task before body seen?", N);
+         Error_Msg_N ("cannot activate task before body seen?", N);
          Error_Msg_N ("\Program_Error will be raised at run time?", N);
       end if;
+
+      --  Ada 2012 (AI05-0111-3): Issue a warning whenever allocating a task
+      --  or a type containing tasks on a subpool since the deallocation of
+      --  the subpool may lead to undefined task behavior. Perform the check
+      --  only when the allocator has not been converted into a Program_Error
+      --  due to a previous error.
+
+      if Ada_Version >= Ada_2012
+        and then Nkind (N) = N_Allocator
+        and then Present (Subpool_Handle_Name (N))
+        and then Has_Task (Desig_T)
+      then
+         Error_Msg_N ("?allocation of task on subpool may lead to " &
+                      "undefined behavior", N);
+      end if;
    end Resolve_Allocator;
 
    ---------------------------
@@ -4656,13 +4654,16 @@ package body Sem_Res is
       --  universal real, since in this case we don't do a conversion to a
       --  specific fixed-point type (instead the expander handles the case).
 
+      --  Set the type of the node to its universal interpretation because
+      --  legality checks on an exponentiation operand need the context.
+
       elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real)
         and then Present (Universal_Interpretation (L))
         and then Present (Universal_Interpretation (R))
       then
+         Set_Etype (N, B_Typ);
          Resolve (L, Universal_Interpretation (L));
          Resolve (R, Universal_Interpretation (R));
-         Set_Etype (N, B_Typ);
 
       elsif (B_Typ = Universal_Real
               or else Etype (N) = Universal_Fixed
@@ -7817,6 +7818,14 @@ package body Sem_Res is
       if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
          Error_Msg_N ("exponentiation not available for fixed point", N);
          return;
+
+      elsif Nkind (Parent (N)) in N_Op
+        and then Is_Fixed_Point_Type (Etype (Parent (N)))
+        and then Etype (N) = Universal_Real
+        and then Comes_From_Source (N)
+      then
+         Error_Msg_N ("exponentiation not available for fixed point", N);
+         return;
       end if;
 
       if Comes_From_Source (N)
@@ -8052,14 +8061,24 @@ package body Sem_Res is
 
    procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
    begin
-      --  The loop structure is already resolved during its analysis, only the
-      --  resolution of the condition needs to be done. Expansion is disabled
-      --  so that checks and other generated code are inserted in the tree
-      --  after expression has been rewritten as a loop.
+      --  Normal mode (not ALFA)
 
-      Expander_Mode_Save_And_Set (False);
-      Resolve (Condition (N), Typ);
-      Expander_Mode_Restore;
+      if not ALFA_Mode then
+
+         --  The loop structure is already resolved during its analysis, only
+         --  the resolution of the condition needs to be done. Expansion is
+         --  disabled so that checks and other generated code are inserted in
+         --  the tree after expression has been rewritten as a loop.
+
+         Expander_Mode_Save_And_Set (False);
+         Resolve (Condition (N), Typ);
+         Expander_Mode_Restore;
+
+      --  In ALFA_Mode, no magic needed, we just resolve the underlying nodes
+
+      else
+         Resolve (Condition (N), Typ);
+      end if;
    end Resolve_Quantified_Expression;
 
    -------------------
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index d11767b4859..70a94234d3e 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -570,6 +570,44 @@ package body Sem_Type is
       H            : Entity_Id;
       First_Interp : Interp_Index;
 
+      function Within_Instance (E : Entity_Id) return Boolean;
+      --  Within an instance there can be spurious ambiguities between a local
+      --  entity and one declared outside of the instance. This can only happen
+      --  for subprograms, because otherwise the local entity hides the outer
+      --  one. For an overloadable entity, this predicate determines whether it
+      --  is a candidate within the instance, or must be ignored.
+
+      ---------------------
+      -- Within_Instance --
+      ---------------------
+
+      function Within_Instance (E : Entity_Id) return Boolean is
+         Inst : Entity_Id;
+         Scop : Entity_Id;
+
+      begin
+         if not In_Instance then
+            return False;
+         end if;
+
+         Inst := Current_Scope;
+         while Present (Inst) and then not Is_Generic_Instance (Inst) loop
+            Inst := Scope (Inst);
+         end loop;
+
+         Scop := Scope (E);
+         while Present (Scop) and then Scop /= Standard_Standard loop
+            if Scop = Inst then
+               return True;
+            end if;
+            Scop := Scope (Scop);
+         end loop;
+
+         return False;
+      end Within_Instance;
+
+   --  Start of processing for Collect_Interps
+
    begin
       New_Interps (N);
 
@@ -621,11 +659,14 @@ package body Sem_Type is
 
                      --  A homograph in the same scope can occur within an
                      --  instantiation, the resulting ambiguity has to be
-                     --  resolved later.
-
-                     if Scope (H) = Scope (Ent)
-                        and then In_Instance
-                        and then not Is_Inherited_Operation (H)
+                     --  resolved later. The homographs may both be local
+                     --  functions or actuals, or may be declared at different
+                     --  levels within the instance. The renaming of an actual
+                     --  within the instance must not be included.
+
+                     if Within_Instance (H)
+                       and then H /= Renamed_Entity (Ent)
+                       and then not Is_Inherited_Operation (H)
                      then
                         All_Interp.Table (All_Interp.Last) :=
                           (H, Etype (H), Empty);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index f97dbb4adb1..6a5e5f1a1fd 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -981,6 +981,27 @@ package body Sem_Util is
       Set_Has_Fully_Qualified_Name (Elab_Ent);
    end Build_Elaboration_Entity;
 
+   --------------------------------
+   -- Build_Explicit_Dereference --
+   --------------------------------
+
+   procedure Build_Explicit_Dereference
+     (Expr : Node_Id;
+      Disc : Entity_Id)
+   is
+      Loc : constant Source_Ptr := Sloc (Expr);
+   begin
+      Set_Is_Overloaded (Expr, False);
+      Rewrite (Expr,
+        Make_Explicit_Dereference (Loc,
+          Prefix =>
+            Make_Selected_Component (Loc,
+              Prefix        => Relocate_Node (Expr),
+              Selector_Name => New_Occurrence_Of (Disc, Loc))));
+      Set_Etype (Prefix (Expr), Etype (Disc));
+      Set_Etype (Expr, Designated_Type (Etype (Disc)));
+   end Build_Explicit_Dereference;
+
    -----------------------------------
    -- Cannot_Raise_Constraint_Error --
    -----------------------------------
@@ -1360,7 +1381,7 @@ package body Sem_Util is
          return;
       end if;
 
-      --  Ada 2012 AI04-0144-2: Dangerous order dependence. Actuals in nested
+      --  Ada 2012 AI05-0144-2: Dangerous order dependence. Actuals in nested
       --  calls within a construct have been collected. If one of them is
       --  writable and overlaps with another one, evaluation of the enclosing
       --  construct is nondeterministic. This is illegal in Ada 2012, but is
@@ -4168,6 +4189,15 @@ package body Sem_Util is
       end if;
    end Get_Actual_Subtype_If_Available;
 
+   ------------------------
+   -- Get_Body_From_Stub --
+   ------------------------
+
+   function Get_Body_From_Stub (N : Node_Id) return Node_Id is
+   begin
+      return Proper_Body (Unit (Library_Unit (N)));
+   end Get_Body_From_Stub;
+
    -------------------------------
    -- Get_Default_External_Name --
    -------------------------------
@@ -4271,11 +4301,15 @@ package body Sem_Util is
       if List_Length (Args) = 4 then
          Res := Pick (Args, 4);
 
-      else
+      elsif List_Length (Args) = 3 then
          Res := Pick (Args, 3);
+
          if Chars (Res) /= Name_Ensures then
             Res := Empty;
          end if;
+
+      else
+         Res := Empty;
       end if;
 
       return Res;
@@ -4430,8 +4464,14 @@ package body Sem_Util is
       Res  : Node_Id;
 
    begin
-      Res := Pick (Args, 3);
-      if Chars (Res) /= Name_Requires then
+      if List_Length (Args) >= 3 then
+         Res := Pick (Args, 3);
+
+         if Chars (Res) /= Name_Requires then
+            Res := Empty;
+         end if;
+
+      else
          Res := Empty;
       end if;
 
@@ -7125,6 +7165,51 @@ package body Sem_Util is
       end if;
    end Is_Fully_Initialized_Variant;
 
+   -----------------
+   -- Is_Iterator --
+   -----------------
+
+   function Is_Iterator (Typ : Entity_Id) return Boolean is
+      Ifaces_List : Elist_Id;
+      Iface_Elmt  : Elmt_Id;
+      Iface       : Entity_Id;
+
+   begin
+      if Is_Class_Wide_Type (Typ)
+        and then
+          (Chars (Etype (Typ)) = Name_Forward_Iterator
+             or else
+           Chars (Etype (Typ)) = Name_Reversible_Iterator)
+        and then
+          Is_Predefined_File_Name
+            (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
+      then
+         return True;
+
+      elsif not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
+         return False;
+
+      else
+         Collect_Interfaces (Typ, Ifaces_List);
+
+         Iface_Elmt := First_Elmt (Ifaces_List);
+         while Present (Iface_Elmt) loop
+            Iface := Node (Iface_Elmt);
+            if Chars (Iface) = Name_Forward_Iterator
+              and then
+                Is_Predefined_File_Name
+                  (Unit_File_Name (Get_Source_Unit (Iface)))
+            then
+               return True;
+            end if;
+
+            Next_Elmt (Iface_Elmt);
+         end loop;
+
+         return False;
+      end if;
+   end Is_Iterator;
+
    ------------
    -- Is_LHS --
    ------------
@@ -7351,7 +7436,20 @@ package body Sem_Util is
       --  but we still want to allow the conversion if it converts a variable).
 
       elsif Original_Node (AV) /= AV then
-         return Is_OK_Variable_For_Out_Formal (Original_Node (AV));
+
+         --  In Ada2012, the explicit dereference may be a rewritten call to a
+         --  Reference function.
+
+         if Ada_Version >= Ada_2012
+           and then Nkind (Original_Node (AV)) = N_Function_Call
+           and then
+             Has_Implicit_Dereference (Etype (Name (Original_Node (AV))))
+         then
+            return True;
+
+         else
+            return Is_OK_Variable_For_Out_Formal (Original_Node (AV));
+         end if;
 
       --  All other non-variables are rejected
 
@@ -7584,9 +7682,9 @@ package body Sem_Util is
 
    begin
       --  Verify that prefix is analyzed and has the proper form. Note that
-      --  the attributes Elab_Spec, Elab_Body, and UET_Address, which also
-      --  produce the address of an entity, do not analyze their prefix
-      --  because they denote entities that are not necessarily visible.
+      --  the attributes Elab_Spec, Elab_Body, Elab_Subp_Body and UET_Address,
+      --  which also produce the address of an entity, do not analyze their
+      --  prefix because they denote entities that are not necessarily visible.
       --  Neither of them can apply to a protected type.
 
       return Ada_Version >= Ada_2005
@@ -7755,6 +7853,50 @@ package body Sem_Util is
       return False;
    end Is_Renamed_Entry;
 
+   ----------------------------
+   -- Is_Reversible_Iterator --
+   ----------------------------
+
+   function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean is
+      Ifaces_List : Elist_Id;
+      Iface_Elmt  : Elmt_Id;
+      Iface       : Entity_Id;
+
+   begin
+      if Is_Class_Wide_Type (Typ)
+        and then  Chars (Etype (Typ)) = Name_Reversible_Iterator
+        and then
+          Is_Predefined_File_Name
+            (Unit_File_Name (Get_Source_Unit (Etype (Typ))))
+      then
+         return True;
+
+      elsif not Is_Tagged_Type (Typ)
+        or else not Is_Derived_Type (Typ)
+      then
+         return False;
+
+      else
+         Collect_Interfaces (Typ, Ifaces_List);
+
+         Iface_Elmt := First_Elmt (Ifaces_List);
+         while Present (Iface_Elmt) loop
+            Iface := Node (Iface_Elmt);
+            if Chars (Iface) = Name_Reversible_Iterator
+              and then
+                Is_Predefined_File_Name
+                  (Unit_File_Name (Get_Source_Unit (Iface)))
+            then
+               return True;
+            end if;
+
+            Next_Elmt (Iface_Elmt);
+         end loop;
+      end if;
+
+      return False;
+   end Is_Reversible_Iterator;
+
    ----------------------
    -- Is_Selector_Name --
    ----------------------
@@ -7939,6 +8081,22 @@ package body Sem_Util is
           or else Nkind (N) = N_Procedure_Call_Statement;
    end Is_Statement;
 
+   --------------------------------------------------
+   -- Is_Subprogram_Stub_Without_Prior_Declaration --
+   --------------------------------------------------
+
+   function Is_Subprogram_Stub_Without_Prior_Declaration
+     (N : Node_Id) return Boolean
+   is
+   begin
+      --  A subprogram stub without prior declaration serves as declaration for
+      --  the actual subprogram body. As such, it has an attached defining
+      --  entity of E_[Generic_]Function or E_[Generic_]Procedure.
+
+      return Nkind (N) = N_Subprogram_Body_Stub
+        and then Ekind (Defining_Entity (N)) /= E_Subprogram_Body;
+   end Is_Subprogram_Stub_Without_Prior_Declaration;
+
    ---------------------------------
    -- Is_Synchronized_Tagged_Type --
    ---------------------------------
@@ -8349,6 +8507,19 @@ package body Sem_Util is
       end if;
    end Is_Volatile_Object;
 
+   ---------------------------
+   -- Itype_Has_Declaration --
+   ---------------------------
+
+   function Itype_Has_Declaration (Id : Entity_Id) return Boolean is
+   begin
+      pragma Assert (Is_Itype (Id));
+      return Present (Parent (Id))
+        and then Nkind_In (Parent (Id), N_Full_Type_Declaration,
+                                        N_Subtype_Declaration)
+        and then Defining_Entity (Parent (Id)) = Id;
+   end Itype_Has_Declaration;
+
    -------------------------
    -- Kill_Current_Values --
    -------------------------
@@ -10335,6 +10506,13 @@ package body Sem_Util is
                P : constant Node_Id := Prefix (Exp);
 
             begin
+               --  In formal verification mode, keep track of all reads and
+               --  writes through explicit dereferences.
+
+               if ALFA_Mode then
+                  ALFA.Generate_Dereference (N, 'm');
+               end if;
+
                if Nkind (P) = N_Selected_Component
                  and then Present (
                    Entry_Formal (Entity (Selector_Name (P))))
@@ -10525,8 +10703,14 @@ package body Sem_Util is
    --  Start of processing for Object_Access_Level
 
    begin
-      if Is_Entity_Name (Obj) then
-         E := Entity (Obj);
+      if Nkind (Obj) = N_Defining_Identifier
+        or else Is_Entity_Name (Obj)
+      then
+         if Nkind (Obj) = N_Defining_Identifier then
+            E := Obj;
+         else
+            E := Entity (Obj);
+         end if;
 
          if Is_Prival (E) then
             E := Prival_Link (E);
@@ -11677,10 +11861,10 @@ package body Sem_Util is
    -- Set_Current_Entity --
    ------------------------
 
-   --  The given entity is to be set as the currently visible definition
-   --  of its associated name (i.e. the Node_Id associated with its name).
-   --  All we have to do is to get the name from the identifier, and
-   --  then set the associated Node_Id to point to the given entity.
+   --  The given entity is to be set as the currently visible definition of its
+   --  associated name (i.e. the Node_Id associated with its name). All we have
+   --  to do is to get the name from the identifier, and then set the
+   --  associated Node_Id to point to the given entity.
 
    procedure Set_Current_Entity (E : Entity_Id) is
    begin
@@ -12336,21 +12520,56 @@ package body Sem_Util is
 
    function Unique_Defining_Entity (N : Node_Id) return Entity_Id is
    begin
-      case Nkind (N) is
-         when N_Package_Body =>
-            return Corresponding_Spec (N);
+      return Unique_Entity (Defining_Entity (N));
+   end Unique_Defining_Entity;
+
+   -------------------
+   -- Unique_Entity --
+   -------------------
+
+   function Unique_Entity (E : Entity_Id) return Entity_Id is
+      U : Entity_Id := E;
+      P : Node_Id;
+
+   begin
+      case Ekind (E) is
+         when Type_Kind =>
+            if Present (Full_View (E)) then
+               U := Full_View (E);
+            end if;
+
+         when E_Package_Body =>
+            P := Parent (E);
+
+            if Nkind (P) = N_Defining_Program_Unit_Name then
+               P := Parent (P);
+            end if;
+
+            U := Corresponding_Spec (P);
 
-         when N_Subprogram_Body =>
-            if Acts_As_Spec (N) then
-               return Defining_Entity (N);
+         when E_Subprogram_Body =>
+            P := Parent (E);
+
+            if Nkind (P) = N_Defining_Program_Unit_Name then
+               P := Parent (P);
+            end if;
+
+            P := Parent (P);
+
+            if Nkind (P) = N_Subprogram_Body_Stub then
+               if Present (Library_Unit (P)) then
+                  U := Get_Body_From_Stub (P);
+               end if;
             else
-               return Corresponding_Spec (N);
+               U := Corresponding_Spec (P);
             end if;
 
          when others =>
-            return Defining_Entity (N);
+            null;
       end case;
-   end Unique_Defining_Entity;
+
+      return U;
+   end Unique_Entity;
 
    -----------------
    -- Unique_Name --
@@ -12378,11 +12597,15 @@ package body Sem_Util is
          end if;
       end Get_Scoped_Name;
 
+   --  Start of processing for Unique_Name
+
    begin
       if E = Standard_Standard then
          return Get_Name_String (Name_Standard);
 
-      elsif Scope (E) = Standard_Standard then
+      elsif Scope (E) = Standard_Standard
+        and then not (Ekind (E) = E_Package or else Is_Subprogram (E))
+      then
          return Get_Name_String (Name_Standard) & "__" &
            Get_Name_String (Chars (E));
 
@@ -12428,7 +12651,13 @@ package body Sem_Util is
         and then Nkind (N) not in N_Generic_Renaming_Declaration
       loop
          N := Parent (N);
-         pragma Assert (Present (N));
+
+         --  We don't use Assert here, because that causes an infinite loop
+         --  when assertions are turned off. Better to crash.
+
+         if No (N) then
+            raise Program_Error;
+         end if;
       end loop;
 
       return N;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index ef2d3554671..b3844d89608 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -141,6 +141,15 @@ package Sem_Util is
    --  the compilation unit, and install it in the Elaboration_Entity field
    --  of Spec_Id, the entity for the compilation unit.
 
+      procedure Build_Explicit_Dereference
+        (Expr : Node_Id;
+         Disc : Entity_Id);
+      --  AI05-139: Names with implicit dereference. If the expression N is a
+      --  reference type and the context imposes the corresponding designated
+      --  type, convert N into N.Disc.all. Such expressions are always over-
+      --  loaded with both interpretations, and the dereference interpretation
+      --  carries the name of the reference discriminant.
+
    function Cannot_Raise_Constraint_Error (Expr : Node_Id) return Boolean;
    --  Returns True if the expression cannot possibly raise Constraint_Error.
    --  The response is conservative in the sense that a result of False does
@@ -479,6 +488,9 @@ package Sem_Util is
    --  Actual_Subtype field of the corresponding entity is set, then it is
    --  returned. Otherwise the Etype of the node is returned.
 
+   function Get_Body_From_Stub (N : Node_Id) return Node_Id;
+   --  Return the body node for a stub (subprogram or package)
+
    function Get_Default_External_Name (E : Node_Or_Entity_Id) return Node_Id;
    --  This is used to construct the string literal node representing a
    --  default external name, i.e. one that is constructed from the name of an
@@ -507,11 +519,11 @@ package Sem_Util is
      (T   : Entity_Id;
       Pos : Uint;
       Loc : Source_Ptr) return Node_Id;
-   --  This function obtains the E_Enumeration_Literal entity for the specified
-   --  value from the enumeration type or subtype T and returns an identifier
-   --  node referencing this value. The second argument is the Pos value, which
-   --  is assumed to be in range. The third argument supplies a source location
-   --  for constructed nodes returned by this function.
+   --  This function returns an identifier denoting the E_Enumeration_Literal
+   --  entity for the specified value from the enumeration type or subtype T.
+   --  The second argument is the Pos value, which is assumed to be in range.
+   --  The third argument supplies a source location for constructed nodes
+   --  returned by this function.
 
    procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id);
    --  Retrieve the fully expanded name of the library unit declared by
@@ -792,10 +804,15 @@ package Sem_Util is
    --  by a derived type declaration.
 
    function Is_Inherited_Operation_For_Type
-     (E : Entity_Id; Typ : Entity_Id) return Boolean;
+     (E   : Entity_Id;
+      Typ : Entity_Id) return Boolean;
    --  E is a subprogram. Return True is E is an implicit operation inherited
    --  by the derived type declaration for type Typ.
 
+   function Is_Iterator (Typ : Entity_Id) return Boolean;
+   --  AI05-0139-2: Check whether Typ is derived from the predefined interface
+   --  Ada.Iterator_Interfaces.Forward_Iterator.
+
    function Is_LHS (N : Node_Id) return Boolean;
    --  Returns True iff N is used as Name in an assignment statement
 
@@ -863,6 +880,10 @@ package Sem_Util is
    function Is_Renamed_Entry (Proc_Nam : Entity_Id) return Boolean;
    --  Return True if Proc_Nam is a procedure renaming of an entry
 
+   function Is_Reversible_Iterator (Typ : Entity_Id) return Boolean;
+   --  AI05-0139-2: Check whether Typ is derived from the predefined interface
+   --  Ada.Iterator_Interfaces.Reversible_Iterator.
+
    function Is_Selector_Name (N : Node_Id) return Boolean;
    --  Given an N_Identifier node N, determines if it is a Selector_Name.
    --  As described in Sinfo, Selector_Names are special because they
@@ -884,6 +905,11 @@ package Sem_Util is
    --  the N_Statement_Other_Than_Procedure_Call subtype from Sinfo).
    --  Note that a label is *not* a statement, and will return False.
 
+   function Is_Subprogram_Stub_Without_Prior_Declaration
+     (N : Node_Id) return Boolean;
+   --  Return True if N is a subprogram stub with no prior subprogram
+   --  declaration.
+
    function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean;
    --  Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2))
 
@@ -943,6 +969,11 @@ package Sem_Util is
    --  for something actually declared as volatile, not for an object that gets
    --  treated as volatile (see Einfo.Treat_As_Volatile).
 
+   function Itype_Has_Declaration (Id : Entity_Id) return Boolean;
+   --  Applies to Itypes. True if the Itype is attached to a declaration for
+   --  the type through its Parent field, which may or not be present in the
+   --  tree.
+
    procedure Kill_Current_Values (Last_Assignment_Only : Boolean := False);
    --  This procedure is called to clear all constant indications from all
    --  entities in the current scope and in any parent scopes if the current
@@ -1297,7 +1328,7 @@ package Sem_Util is
    procedure Set_Current_Entity (E : Entity_Id);
    pragma Inline (Set_Current_Entity);
    --  Establish the entity E as the currently visible definition of its
-   --  associated name (i.e. the Node_Id associated with its name)
+   --  associated name (i.e. the Node_Id associated with its name).
 
    procedure Set_Debug_Info_Needed (T : Entity_Id);
    --  Sets the Debug_Info_Needed flag on entity T , and also on any entities
@@ -1395,8 +1426,16 @@ package Sem_Util is
    --  specified we check only for the given stream operation.
 
    function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
-   --  Return the entity which represents declaration N, so that matching
-   --  declaration and body have the same entity.
+   --  Return the entity which represents declaration N, so that different
+   --  views of the same entity have the same unique defining entity:
+   --  * package spec and body;
+   --  * subprogram declaration, subprogram stub and subprogram body;
+   --  * private view and full view of a type.
+   --  In other cases, return the defining entity for N.
+
+   function Unique_Entity (E : Entity_Id) return Entity_Id;
+   --  Return the unique entity for entity E, which would be returned by
+   --  Unique_Defining_Entity if applied to the enclosing declaration of E.
 
    function Unique_Name (E : Entity_Id) return String;
    --  Return a unique name for entity E, which could be used to identify E
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index fe5f38b125f..d58a14d7bca 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -211,18 +211,6 @@ package body Sem_Warn is
            ("?code statement with no outputs should usually be Volatile!", N);
          return;
       end if;
-
-      --  Check multiple code statements in a row
-
-      if Is_List_Member (N)
-        and then Present (Prev (N))
-        and then Nkind (Prev (N)) = N_Code_Statement
-      then
-         Error_Msg_F
-           ("?code statements in sequence should usually be Volatile!", N);
-         Error_Msg_F
-           ("\?(suggest using template with multiple instructions)!", N);
-      end if;
    end Check_Code_Statement;
 
    ---------------------------------
@@ -1760,14 +1748,15 @@ package body Sem_Warn is
                      SE : constant Entity_Id := Scope (E);
 
                      function Within_Postcondition return Boolean;
-                     --  Returns True iff N is within a Precondition
+                     --  Returns True iff N is within a Postcondition or
+                     --  Ensures component in a Test_Case.
 
                      --------------------------
                      -- Within_Postcondition --
                      --------------------------
 
                      function Within_Postcondition return Boolean is
-                        Nod : Node_Id;
+                        Nod, P : Node_Id;
 
                      begin
                         Nod := Parent (N);
@@ -1776,6 +1765,17 @@ package body Sem_Warn is
                              and then Pragma_Name (Nod) = Name_Postcondition
                            then
                               return True;
+
+                           elsif Present (Parent (Nod)) then
+                              P := Parent (Nod);
+
+                              if Nkind (P) = N_Pragma
+                                and then Pragma_Name (P) = Name_Test_Case
+                                and then
+                                  Nod = Get_Ensures_From_Test_Case_Pragma (P)
+                              then
+                                 return True;
+                              end if;
                            end if;
 
                            Nod := Parent (Nod);
@@ -1905,8 +1905,8 @@ package body Sem_Warn is
                      end if;
 
                      --  One more check, don't bother if we are within a
-                     --  postcondition pragma, since the expression occurs
-                     --  in a place unrelated to the actual test.
+                     --  postcondition, since the expression occurs in a
+                     --  place unrelated to the actual test.
 
                      if not Within_Postcondition then
 
@@ -3352,12 +3352,12 @@ package body Sem_Warn is
                         if Is_Elementary_Type (Etype (Act1))
                           and then Ekind (Form2) = E_In_Parameter
                         then
-                           null;  --  no real aliasing.
+                           null;  --  No real aliasing
 
                         elsif Is_Elementary_Type (Etype (Act2))
                           and then Ekind (Form2) = E_In_Parameter
                         then
-                           null;  --  ditto
+                           null;  --  Ditto
 
                         --  If the call was written in prefix notation, and
                         --  thus its prefix before rewriting was a selected
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 73b848946f2..d1f00676284 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2930,6 +2930,7 @@ package body Sinfo is
       (N : Node_Id) return Boolean is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Incomplete_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Incomplete_Type_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
@@ -3103,15 +3104,6 @@ package body Sinfo is
       return Node1 (N);
    end Withed_Body;
 
-   function Zero_Cost_Handling
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Exception_Handler
-        or else NT (N).Nkind = N_Handled_Sequence_Of_Statements);
-      return Flag5 (N);
-   end Zero_Cost_Handling;
-
    --------------------------
    -- Field Set Procedures --
    --------------------------
@@ -5980,6 +5972,7 @@ package body Sinfo is
       (N : Node_Id; Val : Boolean := True) is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Incomplete_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Incomplete_Type_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
@@ -6153,15 +6146,6 @@ package body Sinfo is
       Set_Node1 (N, Val);
    end Set_Withed_Body;
 
-   procedure Set_Zero_Cost_Handling
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Exception_Handler
-        or else NT (N).Nkind = N_Handled_Sequence_Of_Statements);
-      Set_Flag5 (N, Val);
-   end Set_Zero_Cost_Handling;
-
    -------------------------
    -- Iterator Procedures --
    -------------------------
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index eca688af230..87b018694ea 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -943,11 +943,11 @@ package Sinfo is
    --    there is no requirement that these match, and there are obscure cases
    --    of generated code where they do not match.
 
-   --    Note: Aspect specifications, introduced in Ada2012, require additional
-   --    links between identifiers and various attributes. These attributes
-   --    can be of arbitrary types, and the entity field of identifiers that
-   --    denote aspects must be used to store arbitrary expressions for later
-   --    semantic checks. See section on Aspect specifications for details.
+   --    Note: Ada 2012 aspect specifications require additional links between
+   --    identifiers and various attributes. These attributes can be of
+   --    arbitrary types, and the entity field of identifiers that denote
+   --    aspects must be used to store arbitrary expressions for later semantic
+   --    checks. See section on aspect specifications for details.
 
    --  Entity_Or_Associated_Node (Node4-Sem)
    --    A synonym for both Entity and Associated_Node. Used by convention in
@@ -1806,14 +1806,6 @@ package Sinfo is
    --    library unit of the with_clause and as a result loads its body.
    --    Used for a more precise unit traversal for CodePeer.
 
-   --  Zero_Cost_Handling (Flag5-Sem)
-   --    This flag is set in all handled sequence of statement and exception
-   --    handler nodes if exceptions are to be handled using the zero-cost
-   --    mechanism (see Ada.Exceptions and System.Exceptions in files
-   --    a-except.ads/adb and s-except.ads for full details). What gigi needs
-   --    to do for such a handler is simply to put the code in the handler
-   --    somewhere. The front end has generated all necessary labels.
-
    --------------------------------------------------
    -- Note on Use of End_Label and End_Span Fields --
    --------------------------------------------------
@@ -5957,7 +5949,6 @@ package Sinfo is
       --  Exception_Handlers (List5) (set to No_List if none present)
       --  At_End_Proc (Node1) (set to Empty if no clean up procedure)
       --  First_Real_Statement (Node2-Sem)
-      --  Zero_Cost_Handling (Flag5-Sem)
 
       --  Note: the parent always contains a Declarations field which contains
       --  declarations associated with the handled sequence of statements. This
@@ -5983,7 +5974,6 @@ package Sinfo is
       --  Exception_Choices (List4)
       --  Statements (List3)
       --  Exception_Label (Node5-Sem) (set to Empty of not present)
-      --  Zero_Cost_Handling (Flag5-Sem)
       --  Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present)
       --  Local_Raise_Not_OK (Flag7-Sem)
       --  Has_Local_Raise (Flag8-Sem)
@@ -6219,6 +6209,7 @@ package Sinfo is
       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
       --      is FORMAL_TYPE_DEFINITION
       --        [ASPECT_SPECIFICATIONS];
+      --  | type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [is tagged]
 
       --  N_Formal_Type_Declaration
       --  Sloc points to TYPE
@@ -6244,6 +6235,12 @@ package Sinfo is
       --  | FORMAL_ARRAY_TYPE_DEFINITION
       --  | FORMAL_ACCESS_TYPE_DEFINITION
       --  | FORMAL_INTERFACE_TYPE_DEFINITION
+      --  | FORMAL_INCOMPLETE_TYPE_DEFINITION
+
+      --  The Ada 2012 syntax introduces two new non-terminals:
+      --  Formal_{Complete,Incomplete}_Type_Declaration just to introduce
+      --  the latter category. Here we introduce an incomplete type definition
+      --  in order to preserve as much as possible the existing structure.
 
       ---------------------------------------------
       -- 12.5.1  Formal Private Type Definition --
@@ -6278,6 +6275,16 @@ package Sinfo is
       --  Synchronized_Present (Flag7)
       --  Interface_List (List2) (set to No_List if none)
 
+      -----------------------------------------------
+      -- 12.5.1  Formal Incomplete Type Definition --
+      -----------------------------------------------
+
+      --  FORMAL_INCOMPLETE_TYPE_DEFINITION ::= [tagged]
+
+      --  N_Formal_Incomplete_Type_Definition
+      --  Sloc points to identifier of parent
+      --  Tagged_Present (Flag15)
+
       ---------------------------------------------
       -- 12.5.2  Formal Discrete Type Definition --
       ---------------------------------------------
@@ -7815,6 +7822,7 @@ package Sinfo is
       N_Formal_Ordinary_Fixed_Point_Definition,
       N_Formal_Package_Declaration,
       N_Formal_Private_Type_Definition,
+      N_Formal_Incomplete_Type_Definition,
       N_Formal_Signed_Integer_Type_Definition,
       N_Freeze_Entity,
       N_Generic_Association,
@@ -9001,9 +9009,6 @@ package Sinfo is
    function Withed_Body
      (N : Node_Id) return Node_Id;    -- Node1
 
-   function Zero_Cost_Handling
-     (N : Node_Id) return Boolean;    -- Flag5
-
    --  End functions (note used by xsinfo utility program to end processing)
 
    ----------------------------
@@ -9973,9 +9978,6 @@ package Sinfo is
    procedure Set_Withed_Body
      (N : Node_Id; Val : Node_Id);            -- Node1
 
-   procedure Set_Zero_Cost_Handling
-     (N : Node_Id; Val : Boolean := True);    -- Flag5
-
    -------------------------
    -- Iterator Procedures --
    -------------------------
@@ -11336,6 +11338,13 @@ package Sinfo is
         4 => False,   --  unused
         5 => False),  --  unused
 
+     N_Formal_Incomplete_Type_Definition =>
+       (1 => False,   --  unused
+        2 => False,   --  unused
+        3 => False,   --  unused
+        4 => False,   --  unused
+        5 => False),  --  unused
+
      N_Formal_Derived_Type_Definition =>
        (1 => False,   --  unused
         2 => True,    --  Interface_List (List2)
@@ -12037,7 +12046,6 @@ package Sinfo is
    pragma Inline (Used_Operations);
    pragma Inline (Was_Originally_Stub);
    pragma Inline (Withed_Body);
-   pragma Inline (Zero_Cost_Handling);
 
    pragma Inline (Set_ABE_Is_Certain);
    pragma Inline (Set_Abort_Present);
@@ -12357,7 +12365,6 @@ package Sinfo is
    pragma Inline (Set_Used_Operations);
    pragma Inline (Set_Was_Originally_Stub);
    pragma Inline (Set_Withed_Body);
-   pragma Inline (Set_Zero_Cost_Handling);
 
    --------------
    -- Synonyms --
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index defe9495ee9..e6753b583de 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -306,7 +306,11 @@ package body Snames is
 
    function Is_Attribute_Name (N : Name_Id) return Boolean is
    begin
-      return N in First_Attribute_Name .. Last_Attribute_Name;
+      --  Don't consider Name_Elab_Subp_Body to be a valid attribute name
+      --  unless we are working in CodePeer mode.
+
+      return N in First_Attribute_Name .. Last_Attribute_Name
+        and then (CodePeer_Mode or else N /= Name_Elab_Subp_Body);
    end Is_Attribute_Name;
 
    ----------------------------------
@@ -373,9 +377,11 @@ package body Snames is
    begin
       return Get_Name_Table_Byte (N) /= 0
         and then (Ada_Version >= Ada_95
-                  or else N not in Ada_95_Reserved_Words)
+                   or else N not in Ada_95_Reserved_Words)
         and then (Ada_Version >= Ada_2005
-                  or else N not in Ada_2005_Reserved_Words);
+                   or else N not in Ada_2005_Reserved_Words)
+        and then (Ada_Version >= Ada_2012
+                   or else N not in Ada_2012_Reserved_Words);
    end Is_Keyword_Name;
 
    ----------------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 252dbda4181..3c54e8a05fb 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -631,8 +631,8 @@ package Snames is
    Name_Entry_Count                    : constant Name_Id := N + $;
    Name_External_Name                  : constant Name_Id := N + $;
    Name_First_Optional_Parameter       : constant Name_Id := N + $;
+   Name_Force                          : constant Name_Id := N + $;
    Name_Form                           : constant Name_Id := N + $;
-   Name_Formal_Proof                   : constant Name_Id := N + $;
    Name_G_Float                        : constant Name_Id := N + $;
    Name_Gcc                            : constant Name_Id := N + $;
    Name_Gnat                           : constant Name_Id := N + $;
@@ -661,7 +661,7 @@ package Snames is
    Name_No_Requeue_Statements          : constant Name_Id := N + $;
    Name_No_Task_Attributes             : constant Name_Id := N + $;
    Name_No_Task_Attributes_Package     : constant Name_Id := N + $;
-   Name_Normal                         : constant Name_Id := N + $;
+   Name_Nominal                        : constant Name_Id := N + $;
    Name_On                             : constant Name_Id := N + $;
    Name_Policy                         : constant Name_Id := N + $;
    Name_Parameter_Types                : constant Name_Id := N + $;
@@ -814,6 +814,7 @@ package Snames is
    Name_Storage_Size                   : constant Name_Id := N + $;
    Name_Storage_Unit                   : constant Name_Id := N + $; -- GNAT
    Name_Stream_Size                    : constant Name_Id := N + $; -- Ada 05
+   Name_System_Allocator_Alignment     : constant Name_Id := N + $; -- GNAT
    Name_Tag                            : constant Name_Id := N + $;
    Name_Target_Name                    : constant Name_Id := N + $; -- GNAT
    Name_Terminated                     : constant Name_Id := N + $;
@@ -879,9 +880,13 @@ package Snames is
 
    --  Remaining attributes are ones that return entities
 
+   --  Note that Elab_Subp_Body is not considered to be a valid attribute
+   --  name unless we are operating in CodePeer mode.
+
    First_Entity_Attribute_Name         : constant Name_Id := N + $;
    Name_Elab_Body                      : constant Name_Id := N + $; -- GNAT
    Name_Elab_Spec                      : constant Name_Id := N + $; -- GNAT
+   Name_Elab_Subp_Body                 : constant Name_Id := N + $; -- GNAT
    Name_Storage_Pool                   : constant Name_Id := N + $;
 
    --  These attributes are the ones that return types
@@ -948,12 +953,8 @@ package Snames is
    Name_All_Checks                     : constant Name_Id := N + $;
    Last_Check_Name                     : constant Name_Id := N + $;
 
-   --  Names corresponding to reserved keywords, excluding those already
-   --  declared in the attribute list (Access, Delta, Digits, Mod, Range).
-
-   --  Note: Name_Some is here even though for now we do not treat it as being
-   --  reserved. We treat it instead as an unreserved keyword. This may change
-   --  in the future, but in any case it belongs in the following list.
+   --  Ada 83 reserved words, excluding those already declared in the attribute
+   --  list (Access, Delta, Digits, Mod, Range).
 
    Name_Abort                            : constant Name_Id := N + $;
    Name_Abs                              : constant Name_Id := N + $;
@@ -1003,7 +1004,6 @@ package Snames is
    Name_Reverse                          : constant Name_Id := N + $;
    Name_Select                           : constant Name_Id := N + $;
    Name_Separate                         : constant Name_Id := N + $;
-   Name_Some                             : constant Name_Id := N + $;
    Name_Subtype                          : constant Name_Id := N + $;
    Name_Task                             : constant Name_Id := N + $;
    Name_Terminate                        : constant Name_Id := N + $;
@@ -1048,7 +1048,7 @@ package Snames is
 
    Name_Free                             : constant Name_Id := N + $;
 
-   --  Reserved words used only in Ada 95
+   --  Ada 95 reserved words
 
    First_95_Reserved_Word                : constant Name_Id := N + $;
    Name_Abstract                         : constant Name_Id := N + $;
@@ -1093,6 +1093,7 @@ package Snames is
    Name_Default_Language                 : constant Name_Id := N + $;
    Name_Default_Switches                 : constant Name_Id := N + $;
    Name_Dependency_Driver                : constant Name_Id := N + $;
+   Name_Dependency_Kind                  : constant Name_Id := N + $;
    Name_Dependency_Switches              : constant Name_Id := N + $;
    Name_Driver                           : constant Name_Id := N + $;
    Name_Excluded_Source_Dirs             : constant Name_Id := N + $;
@@ -1121,6 +1122,7 @@ package Snames is
    Name_Include_Path_File                : constant Name_Id := N + $;
    Name_Inherit_Source_Path              : constant Name_Id := N + $;
    Name_Languages                        : constant Name_Id := N + $;
+   Name_Language_Kind                    : constant Name_Id := N + $;
    Name_Leading_Library_Options          : constant Name_Id := N + $;
    Name_Leading_Required_Switches        : constant Name_Id := N + $;
    Name_Leading_Switches                 : constant Name_Id := N + $;
@@ -1217,10 +1219,13 @@ package Snames is
    Name_Cursor                           : constant Name_Id := N + $;
    Name_Element                          : constant Name_Id := N + $;
    Name_Element_Type                     : constant Name_Id := N + $;
+   Name_Has_Element                      : constant Name_Id := N + $;
    Name_No_Element                       : constant Name_Id := N + $;
+   Name_Forward_Iterator                 : constant Name_Id := N + $;
+   Name_Reversible_Iterator              : constant Name_Id := N + $;
    Name_Previous                         : constant Name_Id := N + $;
 
-   --  Ada 05 reserved words
+   --  Ada 2005 reserved words
 
    First_2005_Reserved_Word              : constant Name_Id := N + $;
    Name_Interface                        : constant Name_Id := N + $;
@@ -1231,6 +1236,15 @@ package Snames is
    subtype Ada_2005_Reserved_Words is
      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
 
+   --  Ada 2012 reserved words
+
+   First_2012_Reserved_Word              : constant Name_Id := N + $;
+   Name_Some                             : constant Name_Id := N + $;
+   Last_2012_Reserved_Word               : constant Name_Id := N + $;
+
+   subtype Ada_2012_Reserved_Words is
+     Name_Id range First_2012_Reserved_Word .. Last_2012_Reserved_Word;
+
    --  Mark last defined name for consistency check in Snames body
 
    Last_Predefined_Name                  : constant Name_Id := N + $;
@@ -1351,6 +1365,7 @@ package Snames is
       Attribute_Storage_Size,
       Attribute_Storage_Unit,
       Attribute_Stream_Size,
+      Attribute_System_Allocator_Alignment,
       Attribute_Tag,
       Attribute_Target_Name,
       Attribute_Terminated,
@@ -1412,6 +1427,7 @@ package Snames is
 
       Attribute_Elab_Body,
       Attribute_Elab_Spec,
+      Attribute_Elab_Subp_Body,
       Attribute_Storage_Pool,
 
       --  Type attributes
@@ -1708,7 +1724,10 @@ package Snames is
    --  Called to initialize the preset names in the names table
 
    function Is_Attribute_Name (N : Name_Id) return Boolean;
-   --  Test to see if the name N is the name of a recognized attribute
+   --  Test to see if the name N is the name of a recognized attribute. Note
+   --  that Name_Elab_Subp_Body returns False if not operating in CodePeer
+   --  mode. This is the mechanism for considering this pragma illegal in
+   --  normal GNAT programs.
 
    function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
    --  Test to see if the name N is the name of a recognized entity attribute,
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 5c6f3297a88..3c45d789390 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -1801,6 +1801,11 @@ package body Sprint is
 
             Write_Str_With_Col_Check_Sloc ("private");
 
+         when N_Formal_Incomplete_Type_Definition =>
+            if Tagged_Present (Node) then
+               Write_Str_With_Col_Check ("is tagged ");
+            end if;
+
          when N_Formal_Signed_Integer_Type_Definition =>
             Write_Str_With_Col_Check_Sloc ("range <>");
 
@@ -1814,7 +1819,12 @@ package body Sprint is
                Write_Str_With_Col_Check ("(<>)");
             end if;
 
-            Write_Str_With_Col_Check (" is ");
+            if Nkind (Formal_Type_Definition (Node)) /=
+                N_Formal_Incomplete_Type_Definition
+            then
+               Write_Str_With_Col_Check (" is ");
+            end if;
+
             Sprint_Node (Formal_Type_Definition (Node));
             Write_Char (';');
 
@@ -2699,7 +2709,12 @@ package body Sprint is
                Write_Str (" some ");
             end if;
 
-            Sprint_Node (Loop_Parameter_Specification (Node));
+            if Present (Iterator_Specification (Node)) then
+               Sprint_Node (Iterator_Specification (Node));
+            else
+               Sprint_Node (Loop_Parameter_Specification (Node));
+            end if;
+
             Write_Str (" => ");
             Sprint_Node (Condition (Node));
 
diff --git a/gcc/ada/system-aix.ads b/gcc/ada/system-aix.ads
index a24b1f08902..3f91af51ecc 100644
--- a/gcc/ada/system-aix.ads
+++ b/gcc/ada/system-aix.ads
@@ -141,7 +141,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -150,6 +149,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-aix64.ads b/gcc/ada/system-aix64.ads
index 8b2a4e91e47..4ad3756042b 100644
--- a/gcc/ada/system-aix64.ads
+++ b/gcc/ada/system-aix64.ads
@@ -141,7 +141,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -150,6 +149,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-darwin-ppc.ads b/gcc/ada/system-darwin-ppc.ads
index 0c9c32d5db5..79894e5c360 100644
--- a/gcc/ada/system-darwin-ppc.ads
+++ b/gcc/ada/system-darwin-ppc.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (Darwin/PPC Version)                            --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -157,7 +157,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -166,6 +165,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-darwin-x86.ads b/gcc/ada/system-darwin-x86.ads
index a4d5fbf25e0..efd93f63c20 100644
--- a/gcc/ada/system-darwin-x86.ads
+++ b/gcc/ada/system-darwin-x86.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (Darwin/x86 Version)                            --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -157,7 +157,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -166,6 +165,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-darwin-x86_64.ads b/gcc/ada/system-darwin-x86_64.ads
index 4211f347c8e..27f1241616d 100644
--- a/gcc/ada/system-darwin-x86_64.ads
+++ b/gcc/ada/system-darwin-x86_64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                         (Darwin/x86_64 Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -157,7 +157,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -166,6 +165,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-freebsd-x86.ads b/gcc/ada/system-freebsd-x86.ads
index ffec2c11d72..cb03d56d434 100644
--- a/gcc/ada/system-freebsd-x86.ads
+++ b/gcc/ada/system-freebsd-x86.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (FreeBSD/x86 Version)                           --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-freebsd-x86_64.ads b/gcc/ada/system-freebsd-x86_64.ads
index b699ef1a968..8f523a20ff8 100644
--- a/gcc/ada/system-freebsd-x86_64.ads
+++ b/gcc/ada/system-freebsd-x86_64.ads
@@ -5,9 +5,9 @@
 --                               S Y S T E M                                --
 --                                                                          --
 --                                 S p e c                                  --
---                        (FreeBSD/x86_64 Version)                          --
+--                         (FreeBSD/x86_64 Version)                         --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -116,7 +116,7 @@ private
    --  of the individual switch values.
 
    Backend_Divide_Checks     : constant Boolean := False;
-   Backend_Overflow_Checks   : constant Boolean := False;
+   Backend_Overflow_Checks   : constant Boolean := True;
    Command_Line_Args         : constant Boolean := True;
    Configurable_Run_Time     : constant Boolean := False;
    Denorm                    : constant Boolean := True;
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-hpux-ia64.ads b/gcc/ada/system-hpux-ia64.ads
index 5c03a2490c9..c9cf952e806 100644
--- a/gcc/ada/system-hpux-ia64.ads
+++ b/gcc/ada/system-hpux-ia64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (HP-UX/ia64 Version)                           --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-hpux.ads b/gcc/ada/system-hpux.ads
index ec6cd1c2c72..f32ea6f4948 100644
--- a/gcc/ada/system-hpux.ads
+++ b/gcc/ada/system-hpux.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                             (HP-UX Version)                              --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,7 +139,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    --------------------------
    -- Underlying Priorities --
diff --git a/gcc/ada/system-irix-n32.ads b/gcc/ada/system-irix-n32.ads
index b26894b52da..3dd0810d257 100644
--- a/gcc/ada/system-irix-n32.ads
+++ b/gcc/ada/system-irix-n32.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (SGI Irix, n32 ABI)                            --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -143,7 +143,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -152,7 +151,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    --  Note: Denorm is False because denormals are not supported on the
    --  R10000, and we want the code to be valid for this processor.
diff --git a/gcc/ada/system-irix-o32.ads b/gcc/ada/system-irix-o32.ads
index 22bbbaac43b..91d0afd9a07 100644
--- a/gcc/ada/system-irix-o32.ads
+++ b/gcc/ada/system-irix-o32.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (SGI Irix, o32 ABI)                            --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,7 +139,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    --  Note: Denorm is False because denormals are not supported on the
    --  R10000, and we want the code to be valid for this processor.
diff --git a/gcc/ada/system-linux-alpha.ads b/gcc/ada/system-linux-alpha.ads
index 721247553ce..154c01bf6c5 100644
--- a/gcc/ada/system-linux-alpha.ads
+++ b/gcc/ada/system-linux-alpha.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                        (GNU-Linux/alpha Version)                         --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -129,7 +129,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -138,6 +137,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-hppa.ads b/gcc/ada/system-linux-hppa.ads
index 97900432a67..3b4bb270036 100644
--- a/gcc/ada/system-linux-hppa.ads
+++ b/gcc/ada/system-linux-hppa.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                        (GNU/Linux-HPPA Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-ia64.ads b/gcc/ada/system-linux-ia64.ads
index cb0746f1270..11be8491d27 100644
--- a/gcc/ada/system-linux-ia64.ads
+++ b/gcc/ada/system-linux-ia64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                        (GNU-Linux/ia64 Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -139,7 +139,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -148,6 +147,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-ppc.ads b/gcc/ada/system-linux-ppc.ads
index 6433e06104f..cbd814341ed 100644
--- a/gcc/ada/system-linux-ppc.ads
+++ b/gcc/ada/system-linux-ppc.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                         (GNU-Linux/PPC Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -139,7 +139,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -148,6 +147,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-s390.ads b/gcc/ada/system-linux-s390.ads
index 3ca842b2523..19ad00025ad 100644
--- a/gcc/ada/system-linux-s390.ads
+++ b/gcc/ada/system-linux-s390.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (GNU-Linux/s390 Version)                        --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -129,7 +129,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -138,6 +137,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-s390x.ads b/gcc/ada/system-linux-s390x.ads
index 5631b539f34..6ed5749aafd 100644
--- a/gcc/ada/system-linux-s390x.ads
+++ b/gcc/ada/system-linux-s390x.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (GNU-Linux/s390x Version)                       --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -129,7 +129,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -138,6 +137,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-sh4.ads b/gcc/ada/system-linux-sh4.ads
index 3113677104b..344b7ef541e 100644
--- a/gcc/ada/system-linux-sh4.ads
+++ b/gcc/ada/system-linux-sh4.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                         (GNU-Linux/sh4 Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -139,7 +139,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -148,6 +147,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-sparc.ads b/gcc/ada/system-linux-sparc.ads
index 69ac9f25b10..1f4f2207d45 100644
--- a/gcc/ada/system-linux-sparc.ads
+++ b/gcc/ada/system-linux-sparc.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (GNU/Linux-SPARC Version)                       --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -129,7 +129,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -138,6 +137,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-x86.ads b/gcc/ada/system-linux-x86.ads
index f17f2ef7476..c0bd494d020 100644
--- a/gcc/ada/system-linux-x86.ads
+++ b/gcc/ada/system-linux-x86.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                         (GNU-Linux/x86 Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -139,7 +139,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -148,6 +147,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-linux-x86_64.ads b/gcc/ada/system-linux-x86_64.ads
index 94ef86f4f5f..1fd23fc4a12 100644
--- a/gcc/ada/system-linux-x86_64.ads
+++ b/gcc/ada/system-linux-x86_64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                       (GNU-Linux/x86-64 Version)                         --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -139,7 +139,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -148,6 +147,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-lynxos-ppc.ads b/gcc/ada/system-lynxos-ppc.ads
index 76df7e70c9a..8d718c83fe8 100644
--- a/gcc/ada/system-lynxos-ppc.ads
+++ b/gcc/ada/system-lynxos-ppc.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (LynxOS PPC Version)                           --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -145,7 +145,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -154,6 +153,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-lynxos-x86.ads b/gcc/ada/system-lynxos-x86.ads
index ad14bfe3ff8..18a4a3606b0 100644
--- a/gcc/ada/system-lynxos-x86.ads
+++ b/gcc/ada/system-lynxos-x86.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (LynxOS x86 Version)                           --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -145,7 +145,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -154,6 +153,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-mingw-x86_64.ads b/gcc/ada/system-mingw-x86_64.ads
index 587fd21163d..9464259f68f 100644
--- a/gcc/ada/system-mingw-x86_64.ads
+++ b/gcc/ada/system-mingw-x86_64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                            (Windows Version)                             --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,7 +139,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    ---------------------------
    -- Underlying Priorities --
diff --git a/gcc/ada/system-mingw.ads b/gcc/ada/system-mingw.ads
index b9ab72407a2..9753650e918 100644
--- a/gcc/ada/system-mingw.ads
+++ b/gcc/ada/system-mingw.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                            (Windows Version)                             --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,7 +139,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    ---------------------------
    -- Underlying Priorities --
diff --git a/gcc/ada/system-solaris-sparc.ads b/gcc/ada/system-solaris-sparc.ads
index bc00976c5f9..1afb18b1f47 100644
--- a/gcc/ada/system-solaris-sparc.ads
+++ b/gcc/ada/system-solaris-sparc.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (SUN Solaris Version)                           --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-solaris-sparcv9.ads b/gcc/ada/system-solaris-sparcv9.ads
index 96686f52605..4929c75a1db 100644
--- a/gcc/ada/system-solaris-sparcv9.ads
+++ b/gcc/ada/system-solaris-sparcv9.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                        (Solaris Sparcv9 Version)                         --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-solaris-x86.ads b/gcc/ada/system-solaris-x86.ads
index 57aeb8d8bf8..cd722e349fb 100644
--- a/gcc/ada/system-solaris-x86.ads
+++ b/gcc/ada/system-solaris-x86.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                          (x86 Solaris Version)                           --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-solaris-x86_64.ads b/gcc/ada/system-solaris-x86_64.ads
index f146264ae8a..4f336780791 100644
--- a/gcc/ada/system-solaris-x86_64.ads
+++ b/gcc/ada/system-solaris-x86_64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                        (x86-64 Solaris Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -116,7 +116,7 @@ private
    --  of the individual switch values.
 
    Backend_Divide_Checks     : constant Boolean := False;
-   Backend_Overflow_Checks   : constant Boolean := False;
+   Backend_Overflow_Checks   : constant Boolean := True;
    Command_Line_Args         : constant Boolean := True;
    Configurable_Run_Time     : constant Boolean := False;
    Denorm                    : constant Boolean := True;
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,6 +139,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-tru64.ads b/gcc/ada/system-tru64.ads
index e56ae595526..43facc7465f 100644
--- a/gcc/ada/system-tru64.ads
+++ b/gcc/ada/system-tru64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                           (DEC Unix Version)                             --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -131,7 +131,6 @@ private
    Stack_Check_Default       : constant Boolean := True;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -140,7 +139,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    --  Note: Denorm is False because denormals are only handled properly
    --  if the -mieee switch is set, and we do not require this usage.
diff --git a/gcc/ada/system-vms-ia64.ads b/gcc/ada/system-vms-ia64.ads
index f5d806ddf77..010de3d13de 100644
--- a/gcc/ada/system-vms-ia64.ads
+++ b/gcc/ada/system-vms-ia64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --            (OpenVMS 64bit Itanium GCC_ZCX DEC Threads Version)           --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -149,7 +149,6 @@ private
    Stack_Check_Default       : constant Boolean := True;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -158,7 +157,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    --------------------------
    -- Underlying Priorities --
diff --git a/gcc/ada/system-vms_64.ads b/gcc/ada/system-vms_64.ads
index 2934699420a..11f2853ad2d 100644
--- a/gcc/ada/system-vms_64.ads
+++ b/gcc/ada/system-vms_64.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                (OpenVMS 64bit GCC_ZCX DEC Threads Version)               --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -149,7 +149,6 @@ private
    Stack_Check_Default       : constant Boolean := True;
    Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -158,7 +157,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := True;
-   GCC_ZCX_Support           : constant Boolean := True;
 
    --------------------------
    -- Underlying Priorities --
diff --git a/gcc/ada/system-vxworks-arm.ads b/gcc/ada/system-vxworks-arm.ads
index 7990959199d..484d40d95c7 100644
--- a/gcc/ada/system-vxworks-arm.ads
+++ b/gcc/ada/system-vxworks-arm.ads
@@ -144,7 +144,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := True;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -153,6 +152,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-vxworks-m68k.ads b/gcc/ada/system-vxworks-m68k.ads
index 2e3cb20e009..429ca5d5a57 100644
--- a/gcc/ada/system-vxworks-m68k.ads
+++ b/gcc/ada/system-vxworks-m68k.ads
@@ -144,7 +144,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := True;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -153,6 +152,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-vxworks-mips.ads b/gcc/ada/system-vxworks-mips.ads
index 2741068361d..3dbb835704d 100644
--- a/gcc/ada/system-vxworks-mips.ads
+++ b/gcc/ada/system-vxworks-mips.ads
@@ -144,7 +144,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := True;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -153,6 +152,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-vxworks-ppc.ads b/gcc/ada/system-vxworks-ppc.ads
index c5c55145661..220d1f82914 100644
--- a/gcc/ada/system-vxworks-ppc.ads
+++ b/gcc/ada/system-vxworks-ppc.ads
@@ -144,7 +144,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := True;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -153,6 +152,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := True;
 
 end System;
diff --git a/gcc/ada/system-vxworks-sparcv9.ads b/gcc/ada/system-vxworks-sparcv9.ads
index c7207118fde..856161f1006 100644
--- a/gcc/ada/system-vxworks-sparcv9.ads
+++ b/gcc/ada/system-vxworks-sparcv9.ads
@@ -146,7 +146,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := True;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -155,6 +154,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system-vxworks-x86.ads b/gcc/ada/system-vxworks-x86.ads
index 7780b4dd816..14388d87207 100644
--- a/gcc/ada/system-vxworks-x86.ads
+++ b/gcc/ada/system-vxworks-x86.ads
@@ -144,7 +144,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := True;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -153,6 +152,5 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := True;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/system.ads b/gcc/ada/system.ads
index 90b32878709..d38a53337ae 100644
--- a/gcc/ada/system.ads
+++ b/gcc/ada/system.ads
@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                            (Compiler Version)                            --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -123,11 +123,11 @@ private
    -- System Implementation Parameters --
    --------------------------------------
 
-   --  These parameters provide information about the target that is used
-   --  by the compiler. They are in the private part of System, where they
-   --  can be accessed using the special circuitry in the Targparm unit
-   --  whose source should be consulted for more detailed descriptions
-   --  of the individual switch values.
+   --  These parameters provide information about the target that is used by
+   --  the compiler. They are in the private part of System, where they can be
+   --  accessed using the special circuitry in the Targparm unit whose source
+   --  should be consulted for more detailed descriptions of the individual
+   --  switch values.
 
    --  This version of system.ads is used only for building the compiler.
    --  We really ought to use the proper target system (i.e. the one that
@@ -154,7 +154,6 @@ private
    Stack_Check_Default       : constant Boolean := False;
    Stack_Check_Probes        : constant Boolean := False;
    Stack_Check_Limits        : constant Boolean := False;
-   Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
    Support_Composite_Assign  : constant Boolean := True;
    Support_Composite_Compare : constant Boolean := True;
@@ -163,7 +162,6 @@ private
    Suppress_Standard_Library : constant Boolean := False;
    Use_Ada_Main_Program_Name : constant Boolean := False;
    ZCX_By_Default            : constant Boolean := False;
-   GCC_ZCX_Support           : constant Boolean := False;
 
    --  Obsolete entries, to be removed eventually (bootstrap issues!)
 
@@ -171,5 +169,7 @@ private
    High_Integrity_Mode       : constant Boolean := False;
    Long_Shifts_Inlined       : constant Boolean := True;
    Functions_Return_By_DSP   : constant Boolean := False;
+   Support_64_Bit_Divides    : constant Boolean := True;
+   GCC_ZCX_Support           : constant Boolean := False;
 
 end System;
diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb
index b8cc154c88c..7868446e862 100644
--- a/gcc/ada/targparm.adb
+++ b/gcc/ada/targparm.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2011, 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- --
@@ -55,7 +55,6 @@ package body Targparm is
       MRN,  --   Machine_Rounds
       PAS,  --   Preallocated_Stacks
       RTX,  --   RTX_RTSS_Kernel_Module
-      S64,  --   Support_64_Bit_Divides
       SAG,  --   Support_Aggregates
       SCA,  --   Support_Composite_Assign
       SCC,  --   Support_Composite_Compare
@@ -67,8 +66,7 @@ package body Targparm is
       SSL,  --   Suppress_Standard_Library
       UAM,  --   Use_Ada_Main_Program_Name
       VMS,  --   OpenVMS
-      ZCD,  --   ZCX_By_Default
-      ZCG); --   GCC_ZCX_Support
+      ZCD); --   ZCX_By_Default
 
    Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
    --  Flag is set True if corresponding parameter is scanned
@@ -92,7 +90,6 @@ package body Targparm is
    MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
    PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
    RTX_Str : aliased constant Source_Buffer := "RTX_RTSS_Kernel_Module";
-   S64_Str : aliased constant Source_Buffer := "Support_64_Bit_Divides";
    SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
    SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
    SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
@@ -105,7 +102,6 @@ package body Targparm is
    UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
    VMS_Str : aliased constant Source_Buffer := "OpenVMS";
    ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
-   ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";
 
    --  The following defines a set of pointers to the above strings,
    --  indexed by the tag values.
@@ -129,7 +125,6 @@ package body Targparm is
       MRN_Str'Access,
       PAS_Str'Access,
       RTX_Str'Access,
-      S64_Str'Access,
       SAG_Str'Access,
       SCA_Str'Access,
       SCC_Str'Access,
@@ -141,8 +136,7 @@ package body Targparm is
       SSL_Str'Access,
       UAM_Str'Access,
       VMS_Str'Access,
-      ZCD_Str'Access,
-      ZCG_Str'Access);
+      ZCD_Str'Access);
 
    -----------------------
    -- Local Subprograms --
@@ -579,7 +573,6 @@ package body Targparm is
                      when MRN => Machine_Rounds_On_Target            := Result;
                      when PAS => Preallocated_Stacks_On_Target       := Result;
                      when RTX => RTX_RTSS_Kernel_Module_On_Target    := Result;
-                     when S64 => Support_64_Bit_Divides_On_Target    := Result;
                      when SAG => Support_Aggregates_On_Target        := Result;
                      when SCA => Support_Composite_Assign_On_Target  := Result;
                      when SCC => Support_Composite_Compare_On_Target := Result;
@@ -592,7 +585,6 @@ package body Targparm is
                      when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
                      when VMS => OpenVMS_On_Target                   := Result;
                      when ZCD => ZCX_By_Default_On_Target            := Result;
-                     when ZCG => GCC_ZCX_Support_On_Target           := Result;
 
                      goto Line_Loop_Continue;
                   end case;
diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads
index fa6e25ede9f..971769b9957 100644
--- a/gcc/ada/targparm.ads
+++ b/gcc/ada/targparm.ads
@@ -308,9 +308,6 @@ package Targparm is
    --  front-end setjmp/longjmp approach, and this is the default. If
    --  this variable is True, then GCC ZCX is used.
 
-   GCC_ZCX_Support_On_Target  : Boolean := False;
-   --  Indicates that the target supports GCC Exceptions
-
    ------------------------------------
    -- Run-Time Library Configuration --
    ------------------------------------
@@ -391,14 +388,6 @@ package Targparm is
    --  used at the source level, and the corresponding flag is false, then an
    --  error message will be issued saying the feature is not supported.
 
-   Support_64_Bit_Divides_On_Target : Boolean := True;
-   --  If True, the back end supports 64-bit divide operations. If False, then
-   --  the source program may not contain 64-bit divide operations. This is
-   --  specifically useful in the zero foot-print case, where the issue is
-   --  whether there is a hardware divide instruction for 64-bits so that
-   --  no run-time support is required. It should always be set True if the
-   --  necessary run-time support is present.
-
    Support_Aggregates_On_Target : Boolean := True;
    --  In the general case, the use of aggregates may generate calls
    --  to run-time routines in the C library, including memset, memcpy,
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index be4ca8aceab..a9a7757fc63 100644
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -717,6 +717,7 @@ package body Tbuild is
      (Def_Id : Entity_Id;
       Loc    : Source_Ptr) return Node_Id
    is
+      pragma Assert (Nkind (Def_Id) in N_Entity);
       Occurrence : Node_Id;
    begin
       Occurrence := New_Node (N_Identifier, Loc);
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index fb31f38b0db..c9411e13e38 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -263,11 +263,40 @@ package body Treepr is
    -- pn --
    --------
 
-   procedure pn (N : Node_Id) is
+   procedure pn (N : Union_Id) is
    begin
-      Print_Tree_Node (N);
+      case N is
+         when List_Low_Bound .. List_High_Bound - 1 =>
+            pl (Int (N));
+         when Node_Range =>
+            Print_Tree_Node (Node_Id (N));
+         when Elist_Range =>
+            Print_Tree_Elist (Elist_Id (N));
+         when Elmt_Range =>
+            raise Program_Error;
+         when Names_Range =>
+            Namet.wn (Name_Id (N));
+         when Strings_Range =>
+            Write_String_Table_Entry (String_Id (N));
+         when Uint_Range =>
+            Uintp.pid (From_Union (N));
+         when Ureal_Range =>
+            Urealp.pr (From_Union (N));
+         when others =>
+            Write_Str ("Invalid Union_Id: ");
+            Write_Int (Int (N));
+      end case;
    end pn;
 
+   --------
+   -- pp --
+   --------
+
+   procedure pp (N : Union_Id) is
+   begin
+      pn (N);
+   end pp;
+
    ----------------
    -- Print_Char --
    ----------------
@@ -1471,6 +1500,15 @@ package body Treepr is
       Print_Node_Subtree (N);
    end pt;
 
+   ---------
+   -- ppp --
+   ---------
+
+   procedure ppp (N : Node_Id) is
+   begin
+      pt (N);
+   end ppp;
+
    -------------------
    -- Serial_Number --
    -------------------
diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads
index 3d05748fd78..683eb0db90b 100644
--- a/gcc/ada/treepr.ads
+++ b/gcc/ada/treepr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -57,25 +57,36 @@ package Treepr is
    --  Prints the subtree consisting of the given element list and all its
    --  referenced descendants.
 
+   --  The following debugging procedures are intended to be called from gdb
+
+   procedure pp (N : Union_Id);
+   pragma Export (Ada, pp);
+   --  Prints a node, node list, uint, or anything else that falls under
+   --  Union_Id.
+
+   procedure ppp (N : Node_Id);
+   pragma Export (Ada, ppp);
+   --  Same as Print_Node_Subtree
+
+   --  The following are no longer needed; you can use pp or ppp instead
+
    procedure pe (E : Elist_Id);
    pragma Export (Ada, pe);
-   --  Debugging procedure (to be called within gdb), same as Print_Tree_Elist
+   --  Same as Print_Tree_Elist
 
    procedure pl (L : Int);
    pragma Export (Ada, pl);
-   --  Debugging procedure (to be called within gdb), same as Print_Tree_List,
-   --  except that you can use e.g. 66 instead of -99999966. In other words
-   --  for the positive case we fill out to 8 digits on the left and add a
-   --  minus sign. This just saves some typing in the debugger.
+   --  Same as Print_Tree_List, except that you can use e.g. 66 instead of
+   --  -99999966. In other words for the positive case we fill out to 8 digits
+   --  on the left and add a minus sign. This just saves some typing in the
+   --  debugger.
 
-   procedure pn (N : Node_Id);
+   procedure pn (N : Union_Id);
    pragma Export (Ada, pn);
-   --  Debugging procedure (to be called within gdb)
-   --  same as Print_Tree_Node with Label = ""
+   --  Same as pp
 
    procedure pt (N : Node_Id);
    pragma Export (Ada, pt);
-   --  Debugging procedure (to be called within gdb)
-   --  same as Print_Node_Subtree
+   --  Same as ppp
 
 end Treepr;
diff --git a/gcc/ada/ttypes.ads b/gcc/ada/ttypes.ads
index 8b7749a50a1..ef57187c6b2 100644
--- a/gcc/ada/ttypes.ads
+++ b/gcc/ada/ttypes.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -102,46 +102,55 @@ package Ttypes is
    --  example, on some machines, Short_Float may be the same as Float, and
    --  Long_Long_Float may be the same as Long_Float.
 
-   Standard_Short_Short_Integer_Size   : constant Pos := Get_Char_Size;
-   Standard_Short_Short_Integer_Width  : constant Pos :=
-                           Width_From_Size (Standard_Short_Short_Integer_Size);
-
-   Standard_Short_Integer_Size         : constant Pos := Get_Short_Size;
-   Standard_Short_Integer_Width        : constant Pos :=
-                           Width_From_Size (Standard_Short_Integer_Size);
-
-   Standard_Integer_Size               : constant Pos := Get_Int_Size;
-   Standard_Integer_Width              : constant Pos :=
-                           Width_From_Size (Standard_Integer_Size);
-
-   Standard_Long_Integer_Size          : constant Pos := Get_Long_Size;
-   Standard_Long_Integer_Width         : constant Pos :=
-                           Width_From_Size (Standard_Long_Integer_Size);
-
-   Standard_Long_Long_Integer_Size     : constant Pos := Get_Long_Long_Size;
-   Standard_Long_Long_Integer_Width    : constant Pos :=
-                           Width_From_Size (Standard_Long_Long_Integer_Size);
-
-   Standard_Short_Float_Size           : constant Pos := Get_Float_Size;
-   Standard_Short_Float_Digits         : constant Pos :=
-                           Digits_From_Size (Standard_Short_Float_Size);
-
-   Standard_Float_Size                 : constant Pos := Get_Float_Size;
-   Standard_Float_Digits               : constant Pos :=
-                           Digits_From_Size (Standard_Float_Size);
-
-   Standard_Long_Float_Size            : constant Pos := Get_Double_Size;
-   Standard_Long_Float_Digits          : constant Pos :=
-                           Digits_From_Size (Standard_Long_Float_Size);
-
-   Standard_Long_Long_Float_Size       : constant Pos := Get_Long_Double_Size;
-   Standard_Long_Long_Float_Digits     : constant Pos :=
-                           Digits_From_Size (Standard_Long_Long_Float_Size);
-
-   Standard_Character_Size             : constant Pos := Get_Char_Size;
-
-   Standard_Wide_Character_Size        : constant Pos := 16;
-   Standard_Wide_Wide_Character_Size   : constant Pos := 32;
+   Standard_Short_Short_Integer_Size  : constant Pos := Get_Char_Size;
+   Standard_Short_Short_Integer_Width : constant Pos :=
+                                          Width_From_Size
+                                           (Standard_Short_Short_Integer_Size);
+
+   Standard_Short_Integer_Size        : constant Pos := Get_Short_Size;
+   Standard_Short_Integer_Width       : constant Pos :=
+                                          Width_From_Size
+                                            (Standard_Short_Integer_Size);
+
+   Standard_Integer_Size              : constant Pos := Get_Int_Size;
+   Standard_Integer_Width             : constant Pos :=
+                                          Width_From_Size
+                                            (Standard_Integer_Size);
+
+   Standard_Long_Integer_Size         : constant Pos := Get_Long_Size;
+   Standard_Long_Integer_Width        : constant Pos :=
+                                          Width_From_Size
+                                            (Standard_Long_Integer_Size);
+
+   Standard_Long_Long_Integer_Size    : constant Pos := Get_Long_Long_Size;
+   Standard_Long_Long_Integer_Width   : constant Pos :=
+                                          Width_From_Size
+                                            (Standard_Long_Long_Integer_Size);
+
+   Standard_Short_Float_Size          : constant Pos := Get_Float_Size;
+   Standard_Short_Float_Digits        : constant Pos :=
+                                          Digits_From_Size
+                                            (Standard_Short_Float_Size);
+
+   Standard_Float_Size                : constant Pos := Get_Float_Size;
+   Standard_Float_Digits              : constant Pos :=
+                                          Digits_From_Size
+                                            (Standard_Float_Size);
+
+   Standard_Long_Float_Size           : constant Pos := Get_Double_Size;
+   Standard_Long_Float_Digits         : constant Pos :=
+                                          Digits_From_Size
+                                            (Standard_Long_Float_Size);
+
+   Standard_Long_Long_Float_Size      : constant Pos := Get_Long_Double_Size;
+   Standard_Long_Long_Float_Digits    : constant Pos :=
+                                          Digits_From_Size
+                                            (Standard_Long_Long_Float_Size);
+
+   Standard_Character_Size            : constant Pos := Get_Char_Size;
+
+   Standard_Wide_Character_Size       : constant Pos := 16;
+   Standard_Wide_Wide_Character_Size  : constant Pos := 32;
    --  Standard wide character sizes
 
    --  Note: there is no specific control over the representation of
@@ -185,8 +194,12 @@ package Ttypes is
    ----------------------------------------
 
    Maximum_Alignment : constant Pos := Get_Maximum_Alignment;
-   --  The maximum alignment, in storage units, that an object or
-   --  type may require on the target machine.
+   --  The maximum alignment, in storage units, that an object or type may
+   --  require on the target machine.
+
+   System_Allocator_Alignment : constant Pos :=
+                                  Get_System_Allocator_Alignment;
+   --  The alignment in storage units of addresses returned by malloc
 
    Max_Unaligned_Field : constant Pos := Get_Max_Unaligned_Field;
    --  The maximum supported size in bits for a field that is not aligned
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 6c9839ddd14..a4f0948369a 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -501,8 +501,8 @@ begin
    Write_Line ("        X    turn off warnings for export/import");
    Write_Line ("        .x+  turn on warnings for non-local exception");
    Write_Line ("        .X*  turn off warnings for non-local exception");
-   Write_Line ("        y*+  turn on warnings for Ada 2005 incompatibility");
-   Write_Line ("        Y    turn off warnings for Ada 2005 incompatibility");
+   Write_Line ("        y*+  turn on warnings for Ada compatibility issues");
+   Write_Line ("        Y    turn off warnings for Ada compatibility issues");
    Write_Line ("        z*+  turn on warnings for suspicious " &
                                                   "unchecked conversion");
    Write_Line ("        Z    turn off warnings for suspicious " &
diff --git a/gcc/basic-block.h b/gcc/basic-block.h
index 41c35697a5f..e36b20a3892 100644
--- a/gcc/basic-block.h
+++ b/gcc/basic-block.h
@@ -804,7 +804,7 @@ extern rtx block_label (basic_block);
 extern bool purge_all_dead_edges (void);
 extern bool purge_dead_edges (basic_block);
 extern bool fixup_abnormal_edges (void);
-extern basic_block force_nonfallthru_and_redirect (edge, basic_block);
+extern basic_block force_nonfallthru_and_redirect (edge, basic_block, rtx);
 
 /* In cfgbuild.c.  */
 extern void find_many_sub_basic_blocks (sbitmap);
diff --git a/gcc/bt-load.c b/gcc/bt-load.c
index d8aab567166..a93d2b9bffe 100644
--- a/gcc/bt-load.c
+++ b/gcc/bt-load.c
@@ -558,7 +558,7 @@ compute_defs_uses_and_gen (fibheap_t all_btr_defs, btr_def *def_array,
 		      /* Check for sibcall.  */
 		      if (GET_CODE (pat) == PARALLEL)
 			for (i = XVECLEN (pat, 0) - 1; i >= 0; i--)
-			  if (GET_CODE (XVECEXP (pat, 0, i)) == RETURN)
+			  if (ANY_RETURN_P (XVECEXP (pat, 0, i)))
 			    {
 			      COMPL_HARD_REG_SET (call_saved,
 						  call_used_reg_set);
diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog
index 76569f101bd..44eae081011 100644
--- a/gcc/c-family/ChangeLog
+++ b/gcc/c-family/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-28  Dodji Seketeli  <dodji@redhat.com>
+
+	* c-pch.c (c_common_read_pch): Call linemap_add with LC_ENTER as
+	it's the first time it's being called on this main TU.
+
 2011-08-24  Richard Guenther  <rguenther@suse.de>
 
 	PR c/49396
diff --git a/gcc/c-family/c-pch.c b/gcc/c-family/c-pch.c
index 3c2fd18f063..7a289d622a8 100644
--- a/gcc/c-family/c-pch.c
+++ b/gcc/c-family/c-pch.c
@@ -446,7 +446,7 @@ c_common_read_pch (cpp_reader *pfile, const char *name,
   fclose (f);
 
   line_table->trace_includes = saved_trace_includes;
-  linemap_add (line_table, LC_RENAME, 0, saved_loc.file, saved_loc.line);
+  linemap_add (line_table, LC_ENTER, 0, saved_loc.file, saved_loc.line);
 
   /* Give the front end a chance to take action after a PCH file has
      been loaded.  */
diff --git a/gcc/c-typeck.c b/gcc/c-typeck.c
index bd932dba54a..1f08031e71d 100644
--- a/gcc/c-typeck.c
+++ b/gcc/c-typeck.c
@@ -9109,7 +9109,11 @@ c_process_expr_stmt (location_t loc, tree expr)
   exprv = expr;
   while (TREE_CODE (exprv) == COMPOUND_EXPR)
     exprv = TREE_OPERAND (exprv, 1);
-  if (DECL_P (exprv) || handled_component_p (exprv))
+  while (CONVERT_EXPR_P (exprv))
+    exprv = TREE_OPERAND (exprv, 0);
+  if (DECL_P (exprv)
+      || handled_component_p (exprv)
+      || TREE_CODE (exprv) == ADDR_EXPR)
     mark_exp_read (exprv);
 
   /* If the expression is not of a type to which we cannot assign a line
diff --git a/gcc/cfgcleanup.c b/gcc/cfgcleanup.c
index 717301354e7..396057cc19b 100644
--- a/gcc/cfgcleanup.c
+++ b/gcc/cfgcleanup.c
@@ -1081,11 +1081,20 @@ old_insns_match_p (int mode ATTRIBUTE_UNUSED, rtx i1, rtx i2)
   /* ??? Do not allow cross-jumping between different stack levels.  */
   p1 = find_reg_note (i1, REG_ARGS_SIZE, NULL);
   p2 = find_reg_note (i2, REG_ARGS_SIZE, NULL);
-  if (p1)
-    p1 = XEXP (p1, 0);
-  if (p2)
-    p2 = XEXP (p2, 0);
-  if (!rtx_equal_p (p1, p2))
+  if (p1 && p2)
+    {
+      p1 = XEXP (p1, 0);
+      p2 = XEXP (p2, 0);
+      if (!rtx_equal_p (p1, p2))
+        return dir_none;
+
+      /* ??? Worse, this adjustment had better be constant lest we
+         have differing incoming stack levels.  */
+      if (!frame_pointer_needed
+          && find_args_size_adjust (i1) == HOST_WIDE_INT_MIN)
+	return dir_none;
+    }
+  else if (p1 || p2)
     return dir_none;
 
   p1 = PATTERN (i1);
diff --git a/gcc/cfglayout.c b/gcc/cfglayout.c
index c62138f6d88..62ac6bfe151 100644
--- a/gcc/cfglayout.c
+++ b/gcc/cfglayout.c
@@ -767,6 +767,7 @@ fixup_reorder_chain (void)
     {
       edge e_fall, e_taken, e;
       rtx bb_end_insn;
+      rtx ret_label = NULL_RTX;
       basic_block nb, src_bb;
       edge_iterator ei;
 
@@ -786,6 +787,7 @@ fixup_reorder_chain (void)
       bb_end_insn = BB_END (bb);
       if (JUMP_P (bb_end_insn))
 	{
+	  ret_label = JUMP_LABEL (bb_end_insn);
 	  if (any_condjump_p (bb_end_insn))
 	    {
 	      /* This might happen if the conditional jump has side
@@ -899,7 +901,7 @@ fixup_reorder_chain (void)
 	 Note force_nonfallthru can delete E_FALL and thus we have to
 	 save E_FALL->src prior to the call to force_nonfallthru.  */
       src_bb = e_fall->src;
-      nb = force_nonfallthru_and_redirect (e_fall, e_fall->dest);
+      nb = force_nonfallthru_and_redirect (e_fall, e_fall->dest, ret_label);
       if (nb)
 	{
 	  nb->il.rtl->visited = 1;
diff --git a/gcc/cfgrtl.c b/gcc/cfgrtl.c
index b60041ad9c8..b3f045bbbcb 100644
--- a/gcc/cfgrtl.c
+++ b/gcc/cfgrtl.c
@@ -1117,10 +1117,13 @@ rtl_redirect_edge_and_branch (edge e, basic_block target)
 }
 
 /* Like force_nonfallthru below, but additionally performs redirection
-   Used by redirect_edge_and_branch_force.  */
+   Used by redirect_edge_and_branch_force.  JUMP_LABEL is used only
+   when redirecting to the EXIT_BLOCK, it is either ret_rtx or
+   simple_return_rtx, indicating which kind of returnjump to create.
+   It should be NULL otherwise.  */
 
 basic_block
-force_nonfallthru_and_redirect (edge e, basic_block target)
+force_nonfallthru_and_redirect (edge e, basic_block target, rtx jump_label)
 {
   basic_block jump_block, new_bb = NULL, src = e->src;
   rtx note;
@@ -1252,12 +1255,25 @@ force_nonfallthru_and_redirect (edge e, basic_block target)
   e->flags &= ~EDGE_FALLTHRU;
   if (target == EXIT_BLOCK_PTR)
     {
+      if (jump_label == ret_rtx)
+	{
 #ifdef HAVE_return
-	emit_jump_insn_after_setloc (gen_return (), BB_END (jump_block), loc);
-	JUMP_LABEL (BB_END (jump_block)) = ret_rtx;
+	  emit_jump_insn_after_setloc (gen_return (), BB_END (jump_block), loc);
 #else
-	gcc_unreachable ();
+	  gcc_unreachable ();
 #endif
+	}
+      else
+	{
+	  gcc_assert (jump_label == simple_return_rtx);
+#ifdef HAVE_simple_return
+	  emit_jump_insn_after_setloc (gen_simple_return (),
+				       BB_END (jump_block), loc);
+#else
+	  gcc_unreachable ();
+#endif
+	}
+      JUMP_LABEL (BB_END (jump_block)) = jump_label;
     }
   else
     {
@@ -1284,7 +1300,7 @@ force_nonfallthru_and_redirect (edge e, basic_block target)
 static basic_block
 rtl_force_nonfallthru (edge e)
 {
-  return force_nonfallthru_and_redirect (e, e->dest);
+  return force_nonfallthru_and_redirect (e, e->dest, NULL_RTX);
 }
 
 /* Redirect edge even at the expense of creating new jump insn or
@@ -1301,7 +1317,7 @@ rtl_redirect_edge_and_branch_force (edge e, basic_block target)
   /* In case the edge redirection failed, try to force it to be non-fallthru
      and redirect newly created simplejump.  */
   df_set_bb_dirty (e->src);
-  return force_nonfallthru_and_redirect (e, target);
+  return force_nonfallthru_and_redirect (e, target, NULL_RTX);
 }
 
 /* The given edge should potentially be a fallthru edge.  If that is in
diff --git a/gcc/combine.c b/gcc/combine.c
index f355f016dfd..6c3b17ca6ea 100644
--- a/gcc/combine.c
+++ b/gcc/combine.c
@@ -6303,7 +6303,7 @@ simplify_set (rtx x)
   rtx *cc_use;
 
   /* (set (pc) (return)) gets written as (return).  */
-  if (GET_CODE (dest) == PC && GET_CODE (src) == RETURN)
+  if (GET_CODE (dest) == PC && ANY_RETURN_P (src))
     return src;
 
   /* Now that we know for sure which bits of SRC we are using, see if we can
diff --git a/gcc/config/arm/arm-protos.h b/gcc/config/arm/arm-protos.h
index 235370483a1..4093c5688c4 100644
--- a/gcc/config/arm/arm-protos.h
+++ b/gcc/config/arm/arm-protos.h
@@ -47,6 +47,7 @@ extern bool arm_vector_mode_supported_p (enum machine_mode);
 extern bool arm_small_register_classes_for_mode_p (enum machine_mode);
 extern int arm_hard_regno_mode_ok (unsigned int, enum machine_mode);
 extern int const_ok_for_arm (HOST_WIDE_INT);
+extern int const_ok_for_op (HOST_WIDE_INT, enum rtx_code);
 extern int arm_split_constant (RTX_CODE, enum machine_mode, rtx,
 			       HOST_WIDE_INT, rtx, rtx, int);
 extern RTX_CODE arm_canonicalize_comparison (RTX_CODE, rtx *, rtx *);
diff --git a/gcc/config/arm/arm.c b/gcc/config/arm/arm.c
index 3162b30582e..0490da23b5e 100644
--- a/gcc/config/arm/arm.c
+++ b/gcc/config/arm/arm.c
@@ -64,6 +64,11 @@ typedef struct minipool_fixup   Mfix;
 
 void (*arm_lang_output_object_attributes_hook)(void);
 
+struct four_ints
+{
+  int i[4];
+};
+
 /* Forward function declarations.  */
 static bool arm_needs_doubleword_align (enum machine_mode, const_tree);
 static int arm_compute_static_chain_stack_bytes (void);
@@ -82,7 +87,6 @@ inline static int thumb1_index_register_rtx_p (rtx, int);
 static bool arm_legitimate_address_p (enum machine_mode, rtx, bool);
 static int thumb_far_jump_used_p (void);
 static bool thumb_force_lr_save (void);
-static int const_ok_for_op (HOST_WIDE_INT, enum rtx_code);
 static rtx emit_sfm (int, int);
 static unsigned arm_size_return_regs (void);
 static bool arm_assemble_integer (rtx, unsigned int, int);
@@ -129,7 +133,13 @@ static void arm_output_function_prologue (FILE *, HOST_WIDE_INT);
 static int arm_comp_type_attributes (const_tree, const_tree);
 static void arm_set_default_type_attributes (tree);
 static int arm_adjust_cost (rtx, rtx, rtx, int);
-static int count_insns_for_constant (HOST_WIDE_INT, int);
+static int optimal_immediate_sequence (enum rtx_code code,
+				       unsigned HOST_WIDE_INT val,
+				       struct four_ints *return_sequence);
+static int optimal_immediate_sequence_1 (enum rtx_code code,
+					 unsigned HOST_WIDE_INT val,
+					 struct four_ints *return_sequence,
+					 int i);
 static int arm_get_strip_length (int);
 static bool arm_function_ok_for_sibcall (tree, tree);
 static enum machine_mode arm_promote_function_mode (const_tree,
@@ -2375,7 +2385,7 @@ const_ok_for_arm (HOST_WIDE_INT i)
 }
 
 /* Return true if I is a valid constant for the operation CODE.  */
-static int
+int
 const_ok_for_op (HOST_WIDE_INT i, enum rtx_code code)
 {
   if (const_ok_for_arm (i))
@@ -2392,6 +2402,13 @@ const_ok_for_op (HOST_WIDE_INT i, enum rtx_code code)
 	return const_ok_for_arm (ARM_SIGN_EXTEND (~i));
 
     case PLUS:
+      /* See if we can use addw or subw.  */
+      if (TARGET_THUMB2
+	  && ((i & 0xfffff000) == 0
+	      || ((-i) & 0xfffff000) == 0))
+	return 1;
+      /* else fall through.  */
+
     case COMPARE:
     case EQ:
     case NE:
@@ -2507,68 +2524,41 @@ arm_split_constant (enum rtx_code code, enum machine_mode mode, rtx insn,
 			   1);
 }
 
-/* Return the number of instructions required to synthesize the given
-   constant, if we start emitting them from bit-position I.  */
-static int
-count_insns_for_constant (HOST_WIDE_INT remainder, int i)
-{
-  HOST_WIDE_INT temp1;
-  int step_size = TARGET_ARM ? 2 : 1;
-  int num_insns = 0;
-
-  gcc_assert (TARGET_ARM || i == 0);
-
-  do
-    {
-      int end;
-
-      if (i <= 0)
-	i += 32;
-      if (remainder & (((1 << step_size) - 1) << (i - step_size)))
-	{
-	  end = i - 8;
-	  if (end < 0)
-	    end += 32;
-	  temp1 = remainder & ((0x0ff << end)
-				    | ((i < end) ? (0xff >> (32 - end)) : 0));
-	  remainder &= ~temp1;
-	  num_insns++;
-	  i -= 8 - step_size;
-	}
-      i -= step_size;
-    } while (remainder);
-  return num_insns;
-}
-
+/* Return a sequence of integers, in RETURN_SEQUENCE that fit into
+   ARM/THUMB2 immediates, and add up to VAL.
+   Thr function return value gives the number of insns required.  */
 static int
-find_best_start (unsigned HOST_WIDE_INT remainder)
+optimal_immediate_sequence (enum rtx_code code, unsigned HOST_WIDE_INT val,
+			    struct four_ints *return_sequence)
 {
   int best_consecutive_zeros = 0;
   int i;
   int best_start = 0;
+  int insns1, insns2;
+  struct four_ints tmp_sequence;
 
   /* If we aren't targetting ARM, the best place to start is always at
-     the bottom.  */
-  if (! TARGET_ARM)
-    return 0;
-
-  for (i = 0; i < 32; i += 2)
+     the bottom, otherwise look more closely.  */
+  if (TARGET_ARM)
     {
-      int consecutive_zeros = 0;
-
-      if (!(remainder & (3 << i)))
+      for (i = 0; i < 32; i += 2)
 	{
-	  while ((i < 32) && !(remainder & (3 << i)))
-	    {
-	      consecutive_zeros += 2;
-	      i += 2;
-	    }
-	  if (consecutive_zeros > best_consecutive_zeros)
+	  int consecutive_zeros = 0;
+
+	  if (!(val & (3 << i)))
 	    {
-	      best_consecutive_zeros = consecutive_zeros;
-	      best_start = i - consecutive_zeros;
+	      while ((i < 32) && !(val & (3 << i)))
+		{
+		  consecutive_zeros += 2;
+		  i += 2;
+		}
+	      if (consecutive_zeros > best_consecutive_zeros)
+		{
+		  best_consecutive_zeros = consecutive_zeros;
+		  best_start = i - consecutive_zeros;
+		}
+	      i -= 2;
 	    }
-	  i -= 2;
 	}
     }
 
@@ -2595,13 +2585,161 @@ find_best_start (unsigned HOST_WIDE_INT remainder)
      the constant starting from `best_start', and also starting from
      zero (i.e. with bit 31 first to be output).  If `best_start' doesn't
      yield a shorter sequence, we may as well use zero.  */
+  insns1 = optimal_immediate_sequence_1 (code, val, return_sequence, best_start);
   if (best_start != 0
-      && ((((unsigned HOST_WIDE_INT) 1) << best_start) < remainder)
-      && (count_insns_for_constant (remainder, 0) <=
-	  count_insns_for_constant (remainder, best_start)))
-    best_start = 0;
+      && ((((unsigned HOST_WIDE_INT) 1) << best_start) < val))
+    {
+      insns2 = optimal_immediate_sequence_1 (code, val, &tmp_sequence, 0);
+      if (insns2 <= insns1)
+	{
+	  *return_sequence = tmp_sequence;
+	  insns1 = insns2;
+	}
+    }
+
+  return insns1;
+}
+
+/* As for optimal_immediate_sequence, but starting at bit-position I.  */
+static int
+optimal_immediate_sequence_1 (enum rtx_code code, unsigned HOST_WIDE_INT val,
+			     struct four_ints *return_sequence, int i)
+{
+  int remainder = val & 0xffffffff;
+  int insns = 0;
+
+  /* Try and find a way of doing the job in either two or three
+     instructions.
+     
+     In ARM mode we can use 8-bit constants, rotated to any 2-bit aligned
+     location.  We start at position I.  This may be the MSB, or
+     optimial_immediate_sequence may have positioned it at the largest block 
+     of zeros that are aligned on a 2-bit boundary. We then fill up the temps,
+     wrapping around to the top of the word when we drop off the bottom.
+     In the worst case this code should produce no more than four insns.
+
+     In Thumb2 mode, we can use 32/16-bit replicated constants, and 8-bit
+     constants, shifted to any arbitrary location.  We should always start
+     at the MSB.  */
+  do
+    {
+      int end;
+      int b1, b2, b3, b4;
+      unsigned HOST_WIDE_INT result;
+      int loc;
+
+      gcc_assert (insns < 4);
+
+      if (i <= 0)
+	i += 32;
+
+      /* First, find the next normal 12/8-bit shifted/rotated immediate.  */
+      if (remainder & ((TARGET_ARM ? (3 << (i - 2)) : (1 << (i - 1)))))
+	{
+	  loc = i;
+	  if (i <= 12 && TARGET_THUMB2 && code == PLUS)
+	    /* We can use addw/subw for the last 12 bits.  */
+	    result = remainder;
+	  else
+	    {
+	      /* Use an 8-bit shifted/rotated immediate.  */
+	      end = i - 8;
+	      if (end < 0)
+		end += 32;
+	      result = remainder & ((0x0ff << end)
+				   | ((i < end) ? (0xff >> (32 - end))
+						: 0));
+	      i -= 8;
+	    }
+	}
+      else
+	{
+	  /* Arm allows rotates by a multiple of two. Thumb-2 allows
+	     arbitrary shifts.  */
+	  i -= TARGET_ARM ? 2 : 1;
+	  continue;
+	}
+
+      /* Next, see if we can do a better job with a thumb2 replicated
+	 constant.
+       
+         We do it this way around to catch the cases like 0x01F001E0 where
+	 two 8-bit immediates would work, but a replicated constant would
+	 make it worse.
+       
+         TODO: 16-bit constants that don't clear all the bits, but still win.
+         TODO: Arithmetic splitting for set/add/sub, rather than bitwise.  */
+      if (TARGET_THUMB2)
+	{
+	  b1 = (remainder & 0xff000000) >> 24;
+	  b2 = (remainder & 0x00ff0000) >> 16;
+	  b3 = (remainder & 0x0000ff00) >> 8;
+	  b4 = remainder & 0xff;
 
-  return best_start;
+	  if (loc > 24)
+	    {
+	      /* The 8-bit immediate already found clears b1 (and maybe b2),
+		 but must leave b3 and b4 alone.  */
+
+	      /* First try to find a 32-bit replicated constant that clears
+		 almost everything.  We can assume that we can't do it in one,
+		 or else we wouldn't be here.  */
+	      unsigned int tmp = b1 & b2 & b3 & b4;
+	      unsigned int tmp2 = tmp + (tmp << 8) + (tmp << 16)
+				  + (tmp << 24);
+	      unsigned int matching_bytes = (tmp == b1) + (tmp == b2)
+					    + (tmp == b3) + (tmp == b4);
+	      if (tmp
+		  && (matching_bytes >= 3
+		      || (matching_bytes == 2
+			  && const_ok_for_op (remainder & ~tmp2, code))))
+		{
+		  /* At least 3 of the bytes match, and the fourth has at 
+		     least as many bits set, or two of the bytes match
+		     and it will only require one more insn to finish.  */
+		  result = tmp2;
+		  i = tmp != b1 ? 32
+		      : tmp != b2 ? 24
+		      : tmp != b3 ? 16
+		      : 8;
+		}
+
+	      /* Second, try to find a 16-bit replicated constant that can
+		 leave three of the bytes clear.  If b2 or b4 is already
+		 zero, then we can.  If the 8-bit from above would not
+		 clear b2 anyway, then we still win.  */
+	      else if (b1 == b3 && (!b2 || !b4
+			       || (remainder & 0x00ff0000 & ~result)))
+		{
+		  result = remainder & 0xff00ff00;
+		  i = 24;
+		}
+	    }
+	  else if (loc > 16)
+	    {
+	      /* The 8-bit immediate already found clears b2 (and maybe b3)
+		 and we don't get here unless b1 is alredy clear, but it will
+		 leave b4 unchanged.  */
+
+	      /* If we can clear b2 and b4 at once, then we win, since the
+		 8-bits couldn't possibly reach that far.  */
+	      if (b2 == b4)
+		{
+		  result = remainder & 0x00ff00ff;
+		  i = 16;
+		}
+	    }
+	}
+
+      return_sequence->i[insns++] = result;
+      remainder &= ~result;
+
+      if (code == SET || code == MINUS)
+	code = PLUS;
+    }
+  while (remainder);
+
+  return insns;
 }
 
 /* Emit an instruction with the indicated PATTERN.  If COND is
@@ -2618,7 +2756,6 @@ emit_constant_insn (rtx cond, rtx pattern)
 
 /* As above, but extra parameter GENERATE which, if clear, suppresses
    RTL generation.  */
-/* ??? This needs more work for thumb2.  */
 
 static int
 arm_gen_constant (enum rtx_code code, enum machine_mode mode, rtx cond,
@@ -2629,15 +2766,15 @@ arm_gen_constant (enum rtx_code code, enum machine_mode mode, rtx cond,
   int can_negate = 0;
   int final_invert = 0;
   int i;
-  int num_bits_set = 0;
   int set_sign_bit_copies = 0;
   int clear_sign_bit_copies = 0;
   int clear_zero_bit_copies = 0;
   int set_zero_bit_copies = 0;
-  int insns = 0;
+  int insns = 0, neg_insns, inv_insns;
   unsigned HOST_WIDE_INT temp1, temp2;
   unsigned HOST_WIDE_INT remainder = val & 0xffffffff;
-  int step_size = TARGET_ARM ? 2 : 1;
+  struct four_ints *immediates;
+  struct four_ints pos_immediates, neg_immediates, inv_immediates;
 
   /* Find out which operations are safe for a given CODE.  Also do a quick
      check for degenerate cases; these can occur when DImode operations
@@ -2646,7 +2783,6 @@ arm_gen_constant (enum rtx_code code, enum machine_mode mode, rtx cond,
     {
     case SET:
       can_invert = 1;
-      can_negate = 1;
       break;
 
     case PLUS:
@@ -2714,6 +2850,7 @@ arm_gen_constant (enum rtx_code code, enum machine_mode mode, rtx cond,
 					     gen_rtx_NOT (mode, source)));
 	  return 1;
 	}
+      final_invert = 1;
       break;
 
     case MINUS:
@@ -2736,7 +2873,6 @@ arm_gen_constant (enum rtx_code code, enum machine_mode mode, rtx cond,
 							    source)));
 	  return 1;
 	}
-      can_negate = 1;
 
       break;
 
@@ -3148,120 +3284,97 @@ arm_gen_constant (enum rtx_code code, enum machine_mode mode, rtx cond,
       break;
     }
 
-  for (i = 0; i < 32; i++)
-    if (remainder & (1 << i))
-      num_bits_set++;
-
-  if ((code == AND) || (can_invert && num_bits_set > 16))
-    remainder ^= 0xffffffff;
-  else if (code == PLUS && num_bits_set > 16)
-    remainder = (-remainder) & 0xffffffff;
-
-  /* For XOR, if more than half the bits are set and there's a sequence
-     of more than 8 consecutive ones in the pattern then we can XOR by the
-     inverted constant and then invert the final result; this may save an
-     instruction and might also lead to the final mvn being merged with
-     some other operation.  */
-  else if (code == XOR && num_bits_set > 16
-	   && (count_insns_for_constant (remainder ^ 0xffffffff,
-					 find_best_start
-					 (remainder ^ 0xffffffff))
-	       < count_insns_for_constant (remainder,
-					   find_best_start (remainder))))
-    {
-      remainder ^= 0xffffffff;
-      final_invert = 1;
+  /* Calculate what the instruction sequences would be if we generated it
+     normally, negated, or inverted.  */
+  if (code == AND)
+    /* AND cannot be split into multiple insns, so invert and use BIC.  */
+    insns = 99;
+  else
+    insns = optimal_immediate_sequence (code, remainder, &pos_immediates);
+
+  if (can_negate)
+    neg_insns = optimal_immediate_sequence (code, (-remainder) & 0xffffffff,
+					    &neg_immediates);
+  else
+    neg_insns = 99;
+
+  if (can_invert || final_invert)
+    inv_insns = optimal_immediate_sequence (code, remainder ^ 0xffffffff,
+					    &inv_immediates);
+  else
+    inv_insns = 99;
+
+  immediates = &pos_immediates;
+
+  /* Is the negated immediate sequence more efficient?  */
+  if (neg_insns < insns && neg_insns <= inv_insns)
+    {
+      insns = neg_insns;
+      immediates = &neg_immediates;
+    }
+  else
+    can_negate = 0;
+
+  /* Is the inverted immediate sequence more efficient?
+     We must allow for an extra NOT instruction for XOR operations, although
+     there is some chance that the final 'mvn' will get optimized later.  */
+  if ((inv_insns + 1) < insns || (!final_invert && inv_insns < insns))
+    {
+      insns = inv_insns;
+      immediates = &inv_immediates;
     }
   else
     {
       can_invert = 0;
-      can_negate = 0;
+      final_invert = 0;
     }
 
-  /* Now try and find a way of doing the job in either two or three
-     instructions.
-     We start by looking for the largest block of zeros that are aligned on
-     a 2-bit boundary, we then fill up the temps, wrapping around to the
-     top of the word when we drop off the bottom.
-     In the worst case this code should produce no more than four insns.
-     Thumb-2 constants are shifted, not rotated, so the MSB is always the
-     best place to start.  */
+  /* Now output the chosen sequence as instructions.  */
+  if (generate)
+    {
+      for (i = 0; i < insns; i++)
+	{
+	  rtx new_src, temp1_rtx;
 
-  /* ??? Use thumb2 replicated constants when the high and low halfwords are
-     the same.  */
-  {
-    /* Now start emitting the insns.  */
-    i = find_best_start (remainder);
-    do
-      {
-	int end;
+	  temp1 = immediates->i[i];
 
-	if (i <= 0)
-	  i += 32;
-	if (remainder & (3 << (i - 2)))
-	  {
-	    end = i - 8;
-	    if (end < 0)
-	      end += 32;
-	    temp1 = remainder & ((0x0ff << end)
-				 | ((i < end) ? (0xff >> (32 - end)) : 0));
-	    remainder &= ~temp1;
-
-	    if (generate)
-	      {
-		rtx new_src, temp1_rtx;
+	  if (code == SET || code == MINUS)
+	    new_src = (subtargets ? gen_reg_rtx (mode) : target);
+	  else if ((final_invert || i < (insns - 1)) && subtargets)
+	    new_src = gen_reg_rtx (mode);
+	  else
+	    new_src = target;
 
-		if (code == SET || code == MINUS)
-		  {
-		    new_src = (subtargets ? gen_reg_rtx (mode) : target);
-		    if (can_invert && code != MINUS)
-		      temp1 = ~temp1;
-		  }
-		else
-		  {
-		    if ((final_invert || remainder) && subtargets)
-		      new_src = gen_reg_rtx (mode);
-		    else
-		      new_src = target;
-		    if (can_invert)
-		      temp1 = ~temp1;
-		    else if (can_negate)
-		      temp1 = -temp1;
-		  }
+	  if (can_invert)
+	    temp1 = ~temp1;
+	  else if (can_negate)
+	    temp1 = -temp1;
 
-		temp1 = trunc_int_for_mode (temp1, mode);
-		temp1_rtx = GEN_INT (temp1);
+	  temp1 = trunc_int_for_mode (temp1, mode);
+	  temp1_rtx = GEN_INT (temp1);
 
-		if (code == SET)
-		  ;
-		else if (code == MINUS)
-		  temp1_rtx = gen_rtx_MINUS (mode, temp1_rtx, source);
-		else
-		  temp1_rtx = gen_rtx_fmt_ee (code, mode, source, temp1_rtx);
+	  if (code == SET)
+	    ;
+	  else if (code == MINUS)
+	    temp1_rtx = gen_rtx_MINUS (mode, temp1_rtx, source);
+	  else
+	    temp1_rtx = gen_rtx_fmt_ee (code, mode, source, temp1_rtx);
 
-		emit_constant_insn (cond,
-				    gen_rtx_SET (VOIDmode, new_src,
-						 temp1_rtx));
-		source = new_src;
-	      }
+	  emit_constant_insn (cond,
+			      gen_rtx_SET (VOIDmode, new_src,
+					   temp1_rtx));
+	  source = new_src;
 
-	    if (code == SET)
-	      {
-		can_invert = 0;
-		code = PLUS;
-	      }
-	    else if (code == MINUS)
+	  if (code == SET)
+	    {
+	      can_invert = 0;
+	      can_negate = 1;
 	      code = PLUS;
-
-	    insns++;
-	    i -= 8 - step_size;
-	  }
-	/* Arm allows rotates by a multiple of two. Thumb-2 allows arbitrary
-	   shifts.  */
-	i -= step_size;
-      }
-    while (remainder);
-  }
+	    }
+	  else if (code == MINUS)
+	    code = PLUS;
+	}
+    }
 
   if (final_invert)
     {
@@ -17723,6 +17836,7 @@ arm_final_prescan_insn (rtx insn)
 
   /* If we start with a return insn, we only succeed if we find another one.  */
   int seeking_return = 0;
+  enum rtx_code return_code = UNKNOWN;
 
   /* START_INSN will hold the insn from where we start looking.  This is the
      first insn after the following code_label if REVERSE is true.  */
@@ -17761,7 +17875,7 @@ arm_final_prescan_insn (rtx insn)
 	  else
 	    return;
 	}
-      else if (GET_CODE (body) == RETURN)
+      else if (ANY_RETURN_P (body))
         {
 	  start_insn = next_nonnote_insn (start_insn);
 	  if (GET_CODE (start_insn) == BARRIER)
@@ -17772,6 +17886,7 @@ arm_final_prescan_insn (rtx insn)
 	    {
 	      reverse = TRUE;
 	      seeking_return = 1;
+	      return_code = GET_CODE (body);
 	    }
 	  else
 	    return;
@@ -17812,11 +17927,15 @@ arm_final_prescan_insn (rtx insn)
 	  label = XEXP (XEXP (SET_SRC (body), 2), 0);
 	  then_not_else = FALSE;
 	}
-      else if (GET_CODE (XEXP (SET_SRC (body), 1)) == RETURN)
-	seeking_return = 1;
-      else if (GET_CODE (XEXP (SET_SRC (body), 2)) == RETURN)
+      else if (ANY_RETURN_P (XEXP (SET_SRC (body), 1)))
+	{
+	  seeking_return = 1;
+	  return_code = GET_CODE (XEXP (SET_SRC (body), 1));
+	}
+      else if (ANY_RETURN_P (XEXP (SET_SRC (body), 2)))
         {
 	  seeking_return = 1;
+	  return_code = GET_CODE (XEXP (SET_SRC (body), 2));
 	  then_not_else = FALSE;
         }
       else
@@ -17913,12 +18032,11 @@ arm_final_prescan_insn (rtx insn)
 		}
 	      /* Fail if a conditional return is undesirable (e.g. on a
 		 StrongARM), but still allow this if optimizing for size.  */
-	      else if (GET_CODE (scanbody) == RETURN
+	      else if (GET_CODE (scanbody) == return_code
 		       && !use_return_insn (TRUE, NULL)
 		       && !optimize_size)
 		fail = TRUE;
-	      else if (GET_CODE (scanbody) == RETURN
-		       && seeking_return)
+	      else if (GET_CODE (scanbody) == return_code)
 	        {
 		  arm_ccfsm_state = 2;
 		  succeed = TRUE;
diff --git a/gcc/config/arm/arm.md b/gcc/config/arm/arm.md
index 0f234003603..40341bd7c03 100644
--- a/gcc/config/arm/arm.md
+++ b/gcc/config/arm/arm.md
@@ -49,6 +49,15 @@
    (DOM_CC_X_OR_Y   2)
   ]
 )
+;; conditional compare combination
+(define_constants
+  [(CMP_CMP 0)
+   (CMN_CMP 1)
+   (CMP_CMN 2)
+   (CMN_CMN 3)
+   (NUM_OF_COND_CMP 4)
+  ]
+)
 
 ;; UNSPEC Usage:
 ;; Note: sin and cos are no-longer used.
@@ -708,21 +717,24 @@
 ;;  (plus (reg rN) (reg sp)) into (reg rN).  In this case reload will
 ;; put the duplicated register first, and not try the commutative version.
 (define_insn_and_split "*arm_addsi3"
-  [(set (match_operand:SI          0 "s_register_operand" "=r, k,r,r, k,r")
-	(plus:SI (match_operand:SI 1 "s_register_operand" "%rk,k,r,rk,k,rk")
-		 (match_operand:SI 2 "reg_or_int_operand" "rI,rI,k,L, L,?n")))]
+  [(set (match_operand:SI          0 "s_register_operand" "=r, k,r,r, k, r, k,r, k, r")
+	(plus:SI (match_operand:SI 1 "s_register_operand" "%rk,k,r,rk,k, rk,k,rk,k, rk")
+		 (match_operand:SI 2 "reg_or_int_operand" "rI,rI,k,Pj,Pj,L, L,PJ,PJ,?n")))]
   "TARGET_32BIT"
   "@
    add%?\\t%0, %1, %2
    add%?\\t%0, %1, %2
    add%?\\t%0, %2, %1
+   addw%?\\t%0, %1, %2
+   addw%?\\t%0, %1, %2
    sub%?\\t%0, %1, #%n2
    sub%?\\t%0, %1, #%n2
+   subw%?\\t%0, %1, #%n2
+   subw%?\\t%0, %1, #%n2
    #"
   "TARGET_32BIT
    && GET_CODE (operands[2]) == CONST_INT
-   && !(const_ok_for_arm (INTVAL (operands[2]))
-        || const_ok_for_arm (-INTVAL (operands[2])))
+   && !const_ok_for_op (INTVAL (operands[2]), PLUS)
    && (reload_completed || !arm_eliminable_register (operands[1]))"
   [(clobber (const_int 0))]
   "
@@ -731,8 +743,9 @@
 		      operands[1], 0);
   DONE;
   "
-  [(set_attr "length" "4,4,4,4,4,16")
-   (set_attr "predicable" "yes")]
+  [(set_attr "length" "4,4,4,4,4,4,4,4,4,16")
+   (set_attr "predicable" "yes")
+   (set_attr "arch" "*,*,*,t2,t2,*,*,t2,t2,*")]
 )
 
 (define_insn_and_split "*thumb1_addsi3"
@@ -8980,40 +8993,85 @@
    (set_attr "length" "8,12")]
 )
 
-;; ??? Is it worth using these conditional patterns in Thumb-2 mode?
 (define_insn "*cmp_ite0"
   [(set (match_operand 6 "dominant_cc_register" "")
 	(compare
 	 (if_then_else:SI
 	  (match_operator 4 "arm_comparison_operator"
-	   [(match_operand:SI 0 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 1 "arm_add_operand" "rI,L,rI,L")])
+	   [(match_operand:SI 0 "s_register_operand"
+	        "l,l,l,r,r,r,r,r,r")
+	    (match_operand:SI 1 "arm_add_operand"
+	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
 	  (match_operator:SI 5 "arm_comparison_operator"
-	   [(match_operand:SI 2 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 3 "arm_add_operand" "rI,rI,L,L")])
+	   [(match_operand:SI 2 "s_register_operand"
+	        "l,r,r,l,l,r,r,r,r")
+	    (match_operand:SI 3 "arm_add_operand"
+	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")])
 	  (const_int 0))
 	 (const_int 0)))]
-  "TARGET_ARM"
+  "TARGET_32BIT"
   "*
   {
-    static const char * const opcodes[4][2] =
+    static const char * const cmp1[NUM_OF_COND_CMP][2] =
+    {
+      {\"cmp%d5\\t%0, %1\",
+       \"cmp%d4\\t%2, %3\"},
+      {\"cmn%d5\\t%0, #%n1\",
+       \"cmp%d4\\t%2, %3\"},
+      {\"cmp%d5\\t%0, %1\",
+       \"cmn%d4\\t%2, #%n3\"},
+      {\"cmn%d5\\t%0, #%n1\",
+       \"cmn%d4\\t%2, #%n3\"}
+    };
+    static const char * const cmp2[NUM_OF_COND_CMP][2] =
     {
-      {\"cmp\\t%2, %3\;cmp%d5\\t%0, %1\",
-       \"cmp\\t%0, %1\;cmp%d4\\t%2, %3\"},
-      {\"cmp\\t%2, %3\;cmn%d5\\t%0, #%n1\",
-       \"cmn\\t%0, #%n1\;cmp%d4\\t%2, %3\"},
-      {\"cmn\\t%2, #%n3\;cmp%d5\\t%0, %1\",
-       \"cmp\\t%0, %1\;cmn%d4\\t%2, #%n3\"},
-      {\"cmn\\t%2, #%n3\;cmn%d5\\t%0, #%n1\",
-       \"cmn\\t%0, #%n1\;cmn%d4\\t%2, #%n3\"}
+      {\"cmp\\t%2, %3\",
+       \"cmp\\t%0, %1\"},
+      {\"cmp\\t%2, %3\",
+       \"cmn\\t%0, #%n1\"},
+      {\"cmn\\t%2, #%n3\",
+       \"cmp\\t%0, %1\"},
+      {\"cmn\\t%2, #%n3\",
+       \"cmn\\t%0, #%n1\"}
     };
+    static const char * const ite[2] =
+    {
+      \"it\\t%d5\",
+      \"it\\t%d4\"
+    };
+    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
+                                   CMP_CMP, CMN_CMP, CMP_CMP,
+                                   CMN_CMP, CMP_CMN, CMN_CMN};
     int swap =
       comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
 
-    return opcodes[which_alternative][swap];
+    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
+    if (TARGET_THUMB2) {
+      output_asm_insn (ite[swap], operands);
+    }
+    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
+    return \"\";
   }"
   [(set_attr "conds" "set")
-   (set_attr "length" "8")]
+   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
+   (set_attr_alternative "length"
+      [(const_int 6)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))])]
 )
 
 (define_insn "*cmp_ite1"
@@ -9021,35 +9079,81 @@
 	(compare
 	 (if_then_else:SI
 	  (match_operator 4 "arm_comparison_operator"
-	   [(match_operand:SI 0 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 1 "arm_add_operand" "rI,L,rI,L")])
+	   [(match_operand:SI 0 "s_register_operand"
+	        "l,l,l,r,r,r,r,r,r")
+	    (match_operand:SI 1 "arm_add_operand"
+	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
 	  (match_operator:SI 5 "arm_comparison_operator"
-	   [(match_operand:SI 2 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 3 "arm_add_operand" "rI,rI,L,L")])
+	   [(match_operand:SI 2 "s_register_operand"
+	        "l,r,r,l,l,r,r,r,r")
+	    (match_operand:SI 3 "arm_add_operand"
+	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")])
 	  (const_int 1))
 	 (const_int 0)))]
-  "TARGET_ARM"
+  "TARGET_32BIT"
   "*
   {
-    static const char * const opcodes[4][2] =
+    static const char * const cmp1[NUM_OF_COND_CMP][2] =
+    {
+      {\"cmp\\t%0, %1\",
+       \"cmp\\t%2, %3\"},
+      {\"cmn\\t%0, #%n1\",
+       \"cmp\\t%2, %3\"},
+      {\"cmp\\t%0, %1\",
+       \"cmn\\t%2, #%n3\"},
+      {\"cmn\\t%0, #%n1\",
+       \"cmn\\t%2, #%n3\"}
+    };
+    static const char * const cmp2[NUM_OF_COND_CMP][2] =
+    {
+      {\"cmp%d4\\t%2, %3\",
+       \"cmp%D5\\t%0, %1\"},
+      {\"cmp%d4\\t%2, %3\",
+       \"cmn%D5\\t%0, #%n1\"},
+      {\"cmn%d4\\t%2, #%n3\",
+       \"cmp%D5\\t%0, %1\"},
+      {\"cmn%d4\\t%2, #%n3\",
+       \"cmn%D5\\t%0, #%n1\"}
+    };
+    static const char * const ite[2] =
     {
-      {\"cmp\\t%0, %1\;cmp%d4\\t%2, %3\",
-       \"cmp\\t%2, %3\;cmp%D5\\t%0, %1\"},
-      {\"cmn\\t%0, #%n1\;cmp%d4\\t%2, %3\",
-       \"cmp\\t%2, %3\;cmn%D5\\t%0, #%n1\"},
-      {\"cmp\\t%0, %1\;cmn%d4\\t%2, #%n3\",
-       \"cmn\\t%2, #%n3\;cmp%D5\\t%0, %1\"},
-      {\"cmn\\t%0, #%n1\;cmn%d4\\t%2, #%n3\",
-       \"cmn\\t%2, #%n3\;cmn%D5\\t%0, #%n1\"}
+      \"it\\t%d4\",
+      \"it\\t%D5\"
     };
+    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
+                                   CMP_CMP, CMN_CMP, CMP_CMP,
+                                   CMN_CMP, CMP_CMN, CMN_CMN};
     int swap =
       comparison_dominates_p (GET_CODE (operands[5]),
 			      reverse_condition (GET_CODE (operands[4])));
 
-    return opcodes[which_alternative][swap];
+    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
+    if (TARGET_THUMB2) {
+      output_asm_insn (ite[swap], operands);
+    }
+    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
+    return \"\";
   }"
   [(set_attr "conds" "set")
-   (set_attr "length" "8")]
+   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
+   (set_attr_alternative "length"
+      [(const_int 6)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))])]
 )
 
 (define_insn "*cmp_and"
@@ -9057,34 +9161,80 @@
 	(compare
 	 (and:SI
 	  (match_operator 4 "arm_comparison_operator"
-	   [(match_operand:SI 0 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 1 "arm_add_operand" "rI,L,rI,L")])
+	   [(match_operand:SI 0 "s_register_operand" 
+	        "l,l,l,r,r,r,r,r,r")
+	    (match_operand:SI 1 "arm_add_operand" 
+	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
 	  (match_operator:SI 5 "arm_comparison_operator"
-	   [(match_operand:SI 2 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 3 "arm_add_operand" "rI,rI,L,L")]))
+	   [(match_operand:SI 2 "s_register_operand" 
+	        "l,r,r,l,l,r,r,r,r")
+	    (match_operand:SI 3 "arm_add_operand" 
+	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")]))
 	 (const_int 0)))]
-  "TARGET_ARM"
+  "TARGET_32BIT"
   "*
   {
-    static const char *const opcodes[4][2] =
+    static const char *const cmp1[NUM_OF_COND_CMP][2] =
     {
-      {\"cmp\\t%2, %3\;cmp%d5\\t%0, %1\",
-       \"cmp\\t%0, %1\;cmp%d4\\t%2, %3\"},
-      {\"cmp\\t%2, %3\;cmn%d5\\t%0, #%n1\",
-       \"cmn\\t%0, #%n1\;cmp%d4\\t%2, %3\"},
-      {\"cmn\\t%2, #%n3\;cmp%d5\\t%0, %1\",
-       \"cmp\\t%0, %1\;cmn%d4\\t%2, #%n3\"},
-      {\"cmn\\t%2, #%n3\;cmn%d5\\t%0, #%n1\",
-       \"cmn\\t%0, #%n1\;cmn%d4\\t%2, #%n3\"}
+      {\"cmp%d5\\t%0, %1\",
+       \"cmp%d4\\t%2, %3\"},
+      {\"cmn%d5\\t%0, #%n1\",
+       \"cmp%d4\\t%2, %3\"},
+      {\"cmp%d5\\t%0, %1\",
+       \"cmn%d4\\t%2, #%n3\"},
+      {\"cmn%d5\\t%0, #%n1\",
+       \"cmn%d4\\t%2, #%n3\"}
     };
+    static const char *const cmp2[NUM_OF_COND_CMP][2] =
+    {
+      {\"cmp\\t%2, %3\",
+       \"cmp\\t%0, %1\"},
+      {\"cmp\\t%2, %3\",
+       \"cmn\\t%0, #%n1\"},
+      {\"cmn\\t%2, #%n3\",
+       \"cmp\\t%0, %1\"},
+      {\"cmn\\t%2, #%n3\",
+       \"cmn\\t%0, #%n1\"}
+    };
+    static const char *const ite[2] =
+    {
+      \"it\\t%d5\",
+      \"it\\t%d4\"
+    };
+    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
+                                   CMP_CMP, CMN_CMP, CMP_CMP,
+                                   CMN_CMP, CMP_CMN, CMN_CMN};
     int swap =
       comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
 
-    return opcodes[which_alternative][swap];
+    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
+    if (TARGET_THUMB2) {
+      output_asm_insn (ite[swap], operands);
+    }
+    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
+    return \"\";
   }"
   [(set_attr "conds" "set")
    (set_attr "predicable" "no")
-   (set_attr "length" "8")]
+   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
+   (set_attr_alternative "length"
+      [(const_int 6)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))])]
 )
 
 (define_insn "*cmp_ior"
@@ -9092,34 +9242,80 @@
 	(compare
 	 (ior:SI
 	  (match_operator 4 "arm_comparison_operator"
-	   [(match_operand:SI 0 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 1 "arm_add_operand" "rI,L,rI,L")])
+	   [(match_operand:SI 0 "s_register_operand"
+	        "l,l,l,r,r,r,r,r,r")
+	    (match_operand:SI 1 "arm_add_operand"
+	        "lPy,lPy,lPy,rI,L,rI,L,rI,L")])
 	  (match_operator:SI 5 "arm_comparison_operator"
-	   [(match_operand:SI 2 "s_register_operand" "r,r,r,r")
-	    (match_operand:SI 3 "arm_add_operand" "rI,rI,L,L")]))
+	   [(match_operand:SI 2 "s_register_operand"
+	        "l,r,r,l,l,r,r,r,r")
+	    (match_operand:SI 3 "arm_add_operand"
+	        "lPy,rI,L,lPy,lPy,rI,rI,L,L")]))
 	 (const_int 0)))]
-  "TARGET_ARM"
+  "TARGET_32BIT"
   "*
-{
-  static const char *const opcodes[4][2] =
   {
-    {\"cmp\\t%0, %1\;cmp%D4\\t%2, %3\",
-     \"cmp\\t%2, %3\;cmp%D5\\t%0, %1\"},
-    {\"cmn\\t%0, #%n1\;cmp%D4\\t%2, %3\",
-     \"cmp\\t%2, %3\;cmn%D5\\t%0, #%n1\"},
-    {\"cmp\\t%0, %1\;cmn%D4\\t%2, #%n3\",
-     \"cmn\\t%2, #%n3\;cmp%D5\\t%0, %1\"},
-    {\"cmn\\t%0, #%n1\;cmn%D4\\t%2, #%n3\",
-     \"cmn\\t%2, #%n3\;cmn%D5\\t%0, #%n1\"}
-  };
-  int swap =
-    comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
-
-  return opcodes[which_alternative][swap];
-}
-"
+    static const char *const cmp1[NUM_OF_COND_CMP][2] =
+    {
+      {\"cmp\\t%0, %1\",
+       \"cmp\\t%2, %3\"},
+      {\"cmn\\t%0, #%n1\",
+       \"cmp\\t%2, %3\"},
+      {\"cmp\\t%0, %1\",
+       \"cmn\\t%2, #%n3\"},
+      {\"cmn\\t%0, #%n1\",
+       \"cmn\\t%2, #%n3\"}
+    };
+    static const char *const cmp2[NUM_OF_COND_CMP][2] =
+    {
+      {\"cmp%D4\\t%2, %3\",
+       \"cmp%D5\\t%0, %1\"},
+      {\"cmp%D4\\t%2, %3\",
+       \"cmn%D5\\t%0, #%n1\"},
+      {\"cmn%D4\\t%2, #%n3\",
+       \"cmp%D5\\t%0, %1\"},
+      {\"cmn%D4\\t%2, #%n3\",
+       \"cmn%D5\\t%0, #%n1\"}
+    };
+    static const char *const ite[2] =
+    {
+      \"it\\t%D4\",
+      \"it\\t%D5\"
+    };
+    static const int cmp_idx[9] = {CMP_CMP, CMP_CMP, CMP_CMN,
+                                   CMP_CMP, CMN_CMP, CMP_CMP,
+                                   CMN_CMP, CMP_CMN, CMN_CMN};
+    int swap =
+      comparison_dominates_p (GET_CODE (operands[5]), GET_CODE (operands[4]));
+
+    output_asm_insn (cmp1[cmp_idx[which_alternative]][swap], operands);
+    if (TARGET_THUMB2) {
+      output_asm_insn (ite[swap], operands);
+    }
+    output_asm_insn (cmp2[cmp_idx[which_alternative]][swap], operands);
+    return \"\";
+  }
+  "
   [(set_attr "conds" "set")
-   (set_attr "length" "8")]
+   (set_attr "arch" "t2,t2,t2,t2,t2,any,any,any,any")
+   (set_attr_alternative "length"
+      [(const_int 6)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (const_int 8)
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))
+       (if_then_else (eq_attr "is_thumb" "no")
+           (const_int 8)
+           (const_int 10))])]
 )
 
 (define_insn_and_split "*ior_scc_scc"
@@ -9131,11 +9327,11 @@
 		 [(match_operand:SI 4 "s_register_operand" "r")
 		  (match_operand:SI 5 "arm_add_operand" "rIL")])))
    (clobber (reg:CC CC_REGNUM))]
-  "TARGET_ARM
+  "TARGET_32BIT
    && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_OR_Y)
        != CCmode)"
   "#"
-  "TARGET_ARM && reload_completed"
+  "TARGET_32BIT && reload_completed"
   [(set (match_dup 7)
 	(compare
 	 (ior:SI
@@ -9164,9 +9360,9 @@
    (set (match_operand:SI 7 "s_register_operand" "=r")
 	(ior:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])
 		(match_op_dup 6 [(match_dup 4) (match_dup 5)])))]
-  "TARGET_ARM"
+  "TARGET_32BIT"
   "#"
-  "TARGET_ARM && reload_completed"
+  "TARGET_32BIT && reload_completed"
   [(set (match_dup 0)
 	(compare
 	 (ior:SI
@@ -9187,11 +9383,11 @@
 		 [(match_operand:SI 4 "s_register_operand" "r")
 		  (match_operand:SI 5 "arm_add_operand" "rIL")])))
    (clobber (reg:CC CC_REGNUM))]
-  "TARGET_ARM
+  "TARGET_32BIT
    && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
        != CCmode)"
   "#"
-  "TARGET_ARM && reload_completed
+  "TARGET_32BIT && reload_completed
    && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
        != CCmode)"
   [(set (match_dup 7)
@@ -9222,9 +9418,9 @@
    (set (match_operand:SI 7 "s_register_operand" "=r")
 	(and:SI (match_op_dup 3 [(match_dup 1) (match_dup 2)])
 		(match_op_dup 6 [(match_dup 4) (match_dup 5)])))]
-  "TARGET_ARM"
+  "TARGET_32BIT"
   "#"
-  "TARGET_ARM && reload_completed"
+  "TARGET_32BIT && reload_completed"
   [(set (match_dup 0)
 	(compare
 	 (and:SI
@@ -9249,11 +9445,11 @@
 		 [(match_operand:SI 4 "s_register_operand" "r,r,r")
 		  (match_operand:SI 5 "arm_add_operand" "rIL,rIL,rIL")])))
    (clobber (reg:CC CC_REGNUM))]
-  "TARGET_ARM
+  "TARGET_32BIT
    && (arm_select_dominance_cc_mode (operands[3], operands[6], DOM_CC_X_AND_Y)
        == CCmode)"
   "#"
-  "TARGET_ARM && reload_completed"
+  "TARGET_32BIT && reload_completed"
   [(parallel [(set (match_dup 0)
 		   (match_op_dup 3 [(match_dup 1) (match_dup 2)]))
 	      (clobber (reg:CC CC_REGNUM))])
diff --git a/gcc/config/arm/constraints.md b/gcc/config/arm/constraints.md
index f5b8521dd83..22df032108e 100644
--- a/gcc/config/arm/constraints.md
+++ b/gcc/config/arm/constraints.md
@@ -31,7 +31,7 @@
 ;; The following multi-letter normal constraints have been used:
 ;; in ARM/Thumb-2 state: Da, Db, Dc, Dn, Dl, DL, Dv, Dy, Di, Dz
 ;; in Thumb-1 state: Pa, Pb, Pc, Pd
-;; in Thumb-2 state: Ps, Pt, Pu, Pv, Pw, Px, Py
+;; in Thumb-2 state: Pj, PJ, Ps, Pt, Pu, Pv, Pw, Px, Py
 
 ;; The following memory constraints have been used:
 ;; in ARM/Thumb-2 state: Q, Ut, Uv, Uy, Un, Um, Us
@@ -75,6 +75,18 @@
 	   (and (match_code "const_int")
                 (match_test "(ival & 0xffff0000) == 0")))))
 
+(define_constraint "Pj"
+ "@internal A 12-bit constant suitable for an ADDW or SUBW instruction. (Thumb-2)"
+ (and (match_code "const_int")
+      (and (match_test "TARGET_THUMB2")
+	   (match_test "(ival & 0xfffff000) == 0"))))
+
+(define_constraint "PJ"
+ "@internal A constant that satisfies the Pj constrant if negated."
+ (and (match_code "const_int")
+      (and (match_test "TARGET_THUMB2")
+	   (match_test "((-ival) & 0xfffff000) == 0"))))
+
 (define_register_constraint "k" "STACK_REG"
  "@internal The stack register.")
 
diff --git a/gcc/config/arm/cortex-a9.md b/gcc/config/arm/cortex-a9.md
index b74ace8332a..12c19efb121 100644
--- a/gcc/config/arm/cortex-a9.md
+++ b/gcc/config/arm/cortex-a9.md
@@ -68,7 +68,8 @@ cortex_a9_p1_e2 + cortex_a9_p0_e1 + cortex_a9_p1_e1")
   "cortex_a9_mac_m1*2, cortex_a9_mac_m2, cortex_a9_p0_wb")
 (define_reservation "cortex_a9_mac"
   "cortex_a9_multcycle1*2 ,cortex_a9_mac_m2, cortex_a9_p0_wb")
-
+(define_reservation "cortex_a9_mult_long"
+  "cortex_a9_mac_m1*3, cortex_a9_mac_m2, cortex_a9_p0_wb")
 
 ;; Issue at the same time along the load store pipeline and
 ;; the VFP / Neon pipeline is not possible.
@@ -139,29 +140,35 @@ cortex_a9_p1_e2 + cortex_a9_p0_e1 + cortex_a9_p1_e1")
        (eq_attr "insn" "smlaxy"))
   "cortex_a9_mac16")
 
-
 (define_insn_reservation "cortex_a9_multiply" 4
   (and (eq_attr "tune" "cortexa9")
-       (eq_attr "insn" "mul"))
+       (eq_attr "insn" "mul,smmul,smmulr"))
        "cortex_a9_mult")
 
 (define_insn_reservation "cortex_a9_mac" 4
   (and (eq_attr "tune" "cortexa9")
-       (eq_attr "insn" "mla"))
+       (eq_attr "insn" "mla,smmla"))
        "cortex_a9_mac")
 
+(define_insn_reservation "cortex_a9_multiply_long" 5
+  (and (eq_attr "tune" "cortexa9")
+       (eq_attr "insn" "smull,umull,smulls,umulls,smlal,smlals,umlal,umlals"))
+       "cortex_a9_mult_long")
+
 ;; An instruction with a result in E2 can be forwarded
 ;; to E2 or E1 or M1 or the load store unit in the next cycle.
 
 (define_bypass 1 "cortex_a9_dp"
                  "cortex_a9_dp_shift, cortex_a9_multiply,
  cortex_a9_load1_2, cortex_a9_dp, cortex_a9_store1_2,
- cortex_a9_mult16, cortex_a9_mac16, cortex_a9_mac, cortex_a9_store3_4, cortex_a9_load3_4")
+ cortex_a9_mult16, cortex_a9_mac16, cortex_a9_mac, cortex_a9_store3_4, cortex_a9_load3_4, 
+ cortex_a9_multiply_long")
 
 (define_bypass 2 "cortex_a9_dp_shift"
                  "cortex_a9_dp_shift, cortex_a9_multiply,
  cortex_a9_load1_2, cortex_a9_dp, cortex_a9_store1_2,
- cortex_a9_mult16, cortex_a9_mac16, cortex_a9_mac, cortex_a9_store3_4, cortex_a9_load3_4")
+ cortex_a9_mult16, cortex_a9_mac16, cortex_a9_mac, cortex_a9_store3_4, cortex_a9_load3_4,
+ cortex_a9_multiply_long")
 
 ;; An instruction in the load store pipeline can provide
 ;; read access to a DP instruction in the P0 default pipeline
@@ -212,7 +219,7 @@ cortex_a9_store3_4, cortex_a9_store1_2,  cortex_a9_load3_4")
 
 (define_bypass 1
   "cortex_a9_fps"
-  "cortex_a9_fadd, cortex_a9_fps, cortex_a9_fcmp, cortex_a9_dp, cortex_a9_dp_shift, cortex_a9_multiply")
+  "cortex_a9_fadd, cortex_a9_fps, cortex_a9_fcmp, cortex_a9_dp, cortex_a9_dp_shift, cortex_a9_multiply, cortex_a9_multiply_long")
 
 ;; Scheduling on the FP_ADD pipeline.
 (define_reservation "ca9fp_add" "ca9_issue_vfp_neon + ca9fp_add1, ca9fp_add2, ca9fp_add3, ca9fp_add4")
diff --git a/gcc/config/i386/bmi2intrin.h b/gcc/config/i386/bmi2intrin.h
index f3ffa52a916..a72c9a985ee 100644
--- a/gcc/config/i386/bmi2intrin.h
+++ b/gcc/config/i386/bmi2intrin.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2011 Free Software Foundation, Inc.
 
    This file is part of GCC.
 
@@ -21,7 +21,7 @@
    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
    <http://www.gnu.org/licenses/>.  */
 
-#ifndef _X86INTRIN_H_INCLUDED
+#if !defined _X86INTRIN_H_INCLUDED && !defined _IMMINTRIN_H_INCLUDED
 # error "Never use <bmi2intrin.h> directly; include <x86intrin.h> instead."
 #endif
 
diff --git a/gcc/config/i386/bmiintrin.h b/gcc/config/i386/bmiintrin.h
index 1699c61d24e..af5d9dc6480 100644
--- a/gcc/config/i386/bmiintrin.h
+++ b/gcc/config/i386/bmiintrin.h
@@ -21,7 +21,7 @@
    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
    <http://www.gnu.org/licenses/>.  */
 
-#ifndef _X86INTRIN_H_INCLUDED
+#if !defined _X86INTRIN_H_INCLUDED && !defined _IMMINTRIN_H_INCLUDED
 # error "Never use <bmiintrin.h> directly; include <x86intrin.h> instead."
 #endif
 
diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c
index ce6fd80e11a..48b9be0b118 100644
--- a/gcc/config/i386/i386.c
+++ b/gcc/config/i386/i386.c
@@ -12268,7 +12268,7 @@ legitimize_tls_address (rtx x, enum tls_model model, bool for_mov)
 	  tp = get_thread_pointer (true);
 	  dest = force_reg (Pmode, gen_rtx_PLUS (Pmode, tp, dest));
 
-	  set_unique_reg_note (get_last_insn (), REG_EQUIV, x);
+	  set_unique_reg_note (get_last_insn (), REG_EQUAL, x);
 	}
       else
 	{
@@ -12315,7 +12315,7 @@ legitimize_tls_address (rtx x, enum tls_model model, bool for_mov)
 	    emit_insn (gen_tls_dynamic_gnu2_32 (base, tmp, pic));
 
 	  tp = get_thread_pointer (true);
-	  set_unique_reg_note (get_last_insn (), REG_EQUIV,
+	  set_unique_reg_note (get_last_insn (), REG_EQUAL,
 			       gen_rtx_MINUS (Pmode, tmp, tp));
 	}
       else
@@ -12331,7 +12331,7 @@ legitimize_tls_address (rtx x, enum tls_model model, bool for_mov)
 	      insns = get_insns ();
 	      end_sequence ();
 
-	      /* Attach a unique REG_EQUIV, to allow the RTL optimizers to
+	      /* Attach a unique REG_EQUAL, to allow the RTL optimizers to
 		 share the LD_BASE result with other LD model accesses.  */
 	      eqv = gen_rtx_UNSPEC (Pmode, gen_rtvec (1, const0_rtx),
 				    UNSPEC_TLS_LD_BASE);
@@ -12352,7 +12352,7 @@ legitimize_tls_address (rtx x, enum tls_model model, bool for_mov)
 	{
 	  dest = force_reg (Pmode, gen_rtx_PLUS (Pmode, dest, tp));
 
-	  set_unique_reg_note (get_last_insn (), REG_EQUIV, x);
+	  set_unique_reg_note (get_last_insn (), REG_EQUAL, x);
 	}
       break;
 
@@ -16512,52 +16512,29 @@ ix86_expand_convert_uns_sisf_sse (rtx target, rtx input)
 rtx
 ix86_build_const_vector (enum machine_mode mode, bool vect, rtx value)
 {
+  int i, n_elt;
   rtvec v;
+  enum machine_mode scalar_mode;
+
   switch (mode)
     {
     case V4SImode:
-      gcc_assert (vect);
-      v = gen_rtvec (4, value, value, value, value);
-      return gen_rtx_CONST_VECTOR (V4SImode, v);
-
     case V2DImode:
       gcc_assert (vect);
-      v = gen_rtvec (2, value, value);
-      return gen_rtx_CONST_VECTOR (V2DImode, v);
-
     case V8SFmode:
-      if (vect)
-	v = gen_rtvec (8, value, value, value, value,
-		       value, value, value, value);
-      else
-	v = gen_rtvec (8, value, CONST0_RTX (SFmode),
-		       CONST0_RTX (SFmode), CONST0_RTX (SFmode),
-		       CONST0_RTX (SFmode), CONST0_RTX (SFmode),
-		       CONST0_RTX (SFmode), CONST0_RTX (SFmode));
-      return gen_rtx_CONST_VECTOR (V8SFmode, v);
-
     case V4SFmode:
-      if (vect)
-	v = gen_rtvec (4, value, value, value, value);
-      else
-	v = gen_rtvec (4, value, CONST0_RTX (SFmode),
-		       CONST0_RTX (SFmode), CONST0_RTX (SFmode));
-      return gen_rtx_CONST_VECTOR (V4SFmode, v);
-
     case V4DFmode:
-      if (vect)
-	v = gen_rtvec (4, value, value, value, value);
-      else
-	v = gen_rtvec (4, value, CONST0_RTX (DFmode),
-		       CONST0_RTX (DFmode), CONST0_RTX (DFmode));
-      return gen_rtx_CONST_VECTOR (V4DFmode, v);
-
     case V2DFmode:
-      if (vect)
-	v = gen_rtvec (2, value, value);
-      else
-	v = gen_rtvec (2, value, CONST0_RTX (DFmode));
-      return gen_rtx_CONST_VECTOR (V2DFmode, v);
+      n_elt = GET_MODE_NUNITS (mode);
+      v = rtvec_alloc (n_elt);
+      scalar_mode = GET_MODE_INNER (mode);
+
+      RTVEC_ELT (v, 0) = value;
+
+      for (i = 1; i < n_elt; ++i)
+	RTVEC_ELT (v, i) = vect ? value : CONST0_RTX (scalar_mode);
+
+      return gen_rtx_CONST_VECTOR (mode, v);
 
     default:
       gcc_unreachable ();
@@ -23661,10 +23638,12 @@ enum ix86_builtins
   IX86_BUILTIN_CEILPD,
   IX86_BUILTIN_TRUNCPD,
   IX86_BUILTIN_RINTPD,
+  IX86_BUILTIN_ROUNDPD_AZ,
   IX86_BUILTIN_FLOORPS,
   IX86_BUILTIN_CEILPS,
   IX86_BUILTIN_TRUNCPS,
   IX86_BUILTIN_RINTPS,
+  IX86_BUILTIN_ROUNDPS_AZ,
 
   IX86_BUILTIN_PTESTZ,
   IX86_BUILTIN_PTESTC,
@@ -23837,10 +23816,12 @@ enum ix86_builtins
   IX86_BUILTIN_CEILPD256,
   IX86_BUILTIN_TRUNCPD256,
   IX86_BUILTIN_RINTPD256,
+  IX86_BUILTIN_ROUNDPD_AZ256,
   IX86_BUILTIN_FLOORPS256,
   IX86_BUILTIN_CEILPS256,
   IX86_BUILTIN_TRUNCPS256,
   IX86_BUILTIN_RINTPS256,
+  IX86_BUILTIN_ROUNDPS_AZ256,
 
   IX86_BUILTIN_UNPCKHPD256,
   IX86_BUILTIN_UNPCKLPD256,
@@ -25063,11 +25044,15 @@ static const struct builtin_description bdesc_args[] =
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_roundpd, "__builtin_ia32_truncpd", IX86_BUILTIN_TRUNCPD, (enum rtx_code) ROUND_TRUNC, (int) V2DF_FTYPE_V2DF_ROUND },
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_roundpd, "__builtin_ia32_rintpd", IX86_BUILTIN_RINTPD, (enum rtx_code) ROUND_MXCSR, (int) V2DF_FTYPE_V2DF_ROUND },
 
+  { OPTION_MASK_ISA_ROUND, CODE_FOR_roundv2df2, "__builtin_ia32_roundpd_az", IX86_BUILTIN_ROUNDPD_AZ, UNKNOWN, (int) V2DF_FTYPE_V2DF },
+
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_roundps, "__builtin_ia32_floorps", IX86_BUILTIN_FLOORPS, (enum rtx_code) ROUND_FLOOR, (int) V4SF_FTYPE_V4SF_ROUND },
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_roundps, "__builtin_ia32_ceilps", IX86_BUILTIN_CEILPS, (enum rtx_code) ROUND_CEIL, (int) V4SF_FTYPE_V4SF_ROUND },
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_roundps, "__builtin_ia32_truncps", IX86_BUILTIN_TRUNCPS, (enum rtx_code) ROUND_TRUNC, (int) V4SF_FTYPE_V4SF_ROUND },
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_roundps, "__builtin_ia32_rintps", IX86_BUILTIN_RINTPS, (enum rtx_code) ROUND_MXCSR, (int) V4SF_FTYPE_V4SF_ROUND },
 
+  { OPTION_MASK_ISA_ROUND, CODE_FOR_roundv4sf2, "__builtin_ia32_roundps_az", IX86_BUILTIN_ROUNDPS_AZ, UNKNOWN, (int) V4SF_FTYPE_V4SF },
+
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_ptest, "__builtin_ia32_ptestz128", IX86_BUILTIN_PTESTZ, EQ, (int) INT_FTYPE_V2DI_V2DI_PTEST },
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_ptest, "__builtin_ia32_ptestc128", IX86_BUILTIN_PTESTC, LTU, (int) INT_FTYPE_V2DI_V2DI_PTEST },
   { OPTION_MASK_ISA_ROUND, CODE_FOR_sse4_1_ptest, "__builtin_ia32_ptestnzc128", IX86_BUILTIN_PTESTNZC, GTU, (int) INT_FTYPE_V2DI_V2DI_PTEST },
@@ -25185,11 +25170,15 @@ static const struct builtin_description bdesc_args[] =
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_roundpd256, "__builtin_ia32_truncpd256", IX86_BUILTIN_TRUNCPD256, (enum rtx_code) ROUND_TRUNC, (int) V4DF_FTYPE_V4DF_ROUND },
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_roundpd256, "__builtin_ia32_rintpd256", IX86_BUILTIN_RINTPD256, (enum rtx_code) ROUND_MXCSR, (int) V4DF_FTYPE_V4DF_ROUND },
 
+  { OPTION_MASK_ISA_AVX, CODE_FOR_roundv4df2, "__builtin_ia32_roundpd_az256", IX86_BUILTIN_ROUNDPD_AZ256, UNKNOWN, (int) V4DF_FTYPE_V4DF },
+
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_roundps256, "__builtin_ia32_floorps256", IX86_BUILTIN_FLOORPS256, (enum rtx_code) ROUND_FLOOR, (int) V8SF_FTYPE_V8SF_ROUND },
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_roundps256, "__builtin_ia32_ceilps256", IX86_BUILTIN_CEILPS256, (enum rtx_code) ROUND_CEIL, (int) V8SF_FTYPE_V8SF_ROUND },
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_roundps256, "__builtin_ia32_truncps256", IX86_BUILTIN_TRUNCPS256, (enum rtx_code) ROUND_TRUNC, (int) V8SF_FTYPE_V8SF_ROUND },
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_roundps256, "__builtin_ia32_rintps256", IX86_BUILTIN_RINTPS256, (enum rtx_code) ROUND_MXCSR, (int) V8SF_FTYPE_V8SF_ROUND },
 
+  { OPTION_MASK_ISA_AVX, CODE_FOR_roundv8sf2, "__builtin_ia32_roundps_az256", IX86_BUILTIN_ROUNDPS_AZ256, UNKNOWN, (int) V8SF_FTYPE_V8SF },
+
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_unpckhpd256,  "__builtin_ia32_unpckhpd256", IX86_BUILTIN_UNPCKHPD256, UNKNOWN, (int) V4DF_FTYPE_V4DF_V4DF },
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_unpcklpd256,  "__builtin_ia32_unpcklpd256", IX86_BUILTIN_UNPCKLPD256, UNKNOWN, (int) V4DF_FTYPE_V4DF_V4DF },
   { OPTION_MASK_ISA_AVX, CODE_FOR_avx_unpckhps256,  "__builtin_ia32_unpckhps256", IX86_BUILTIN_UNPCKHPS256, UNKNOWN, (int) V8SF_FTYPE_V8SF_V8SF },
@@ -28146,6 +28135,34 @@ ix86_builtin_vectorized_function (tree fndecl, tree type_out,
 	}
       break;
 
+    case BUILT_IN_ROUND:
+      /* The round insn does not trap on denormals.  */
+      if (flag_trapping_math || !TARGET_ROUND)
+	break;
+
+      if (out_mode == DFmode && in_mode == DFmode)
+	{
+	  if (out_n == 2 && in_n == 2)
+	    return ix86_builtins[IX86_BUILTIN_ROUNDPD_AZ];
+	  else if (out_n == 4 && in_n == 4)
+	    return ix86_builtins[IX86_BUILTIN_ROUNDPD_AZ256];
+	}
+      break;
+
+    case BUILT_IN_ROUNDF:
+      /* The round insn does not trap on denormals.  */
+      if (flag_trapping_math || !TARGET_ROUND)
+	break;
+
+      if (out_mode == SFmode && in_mode == SFmode)
+	{
+	  if (out_n == 4 && in_n == 4)
+	    return ix86_builtins[IX86_BUILTIN_ROUNDPS_AZ];
+	  else if (out_n == 8 && in_n == 8)
+	    return ix86_builtins[IX86_BUILTIN_ROUNDPS_AZ256];
+	}
+      break;
+
     case BUILT_IN_FMA:
       if (out_mode == DFmode && in_mode == DFmode)
 	{
@@ -30568,7 +30585,7 @@ ix86_pad_returns (void)
       rtx prev;
       bool replace = false;
 
-      if (!JUMP_P (ret) || GET_CODE (PATTERN (ret)) != RETURN
+      if (!JUMP_P (ret) || !ANY_RETURN_P (PATTERN (ret))
 	  || optimize_bb_for_size_p (bb))
 	continue;
       for (prev = PREV_INSN (ret); prev; prev = PREV_INSN (prev))
@@ -30619,7 +30636,7 @@ ix86_count_insn_bb (basic_block bb)
     {
       /* Only happen in exit blocks.  */
       if (JUMP_P (insn)
-	  && GET_CODE (PATTERN (insn)) == RETURN)
+	  && ANY_RETURN_P (PATTERN (insn)))
 	break;
 
       if (NONDEBUG_INSN_P (insn)
@@ -30692,7 +30709,7 @@ ix86_pad_short_function (void)
   FOR_EACH_EDGE (e, ei, EXIT_BLOCK_PTR->preds)
     {
       rtx ret = BB_END (e->src);
-      if (JUMP_P (ret) && GET_CODE (PATTERN (ret)) == RETURN)
+      if (JUMP_P (ret) && ANY_RETURN_P (PATTERN (ret)))
 	{
 	  int insn_count = ix86_count_insn (e->src);
 
diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md
index c5759e1c5d9..3502b8f44d8 100644
--- a/gcc/config/i386/i386.md
+++ b/gcc/config/i386/i386.md
@@ -6843,7 +6843,7 @@
   "@
    mul{<imodesuffix>}\t%2
    #"
-  [(set_attr "isa" "base,bmi2")
+  [(set_attr "isa" "*,bmi2")
    (set_attr "type" "imul,imulx")
    (set_attr "length_immediate" "0,*")
    (set (attr "athlon_decode")
@@ -9124,7 +9124,7 @@
 	return "sal{<imodesuffix>}\t{%2, %0|%0, %2}";
     }
 }
-  [(set_attr "isa" "base,base,bmi2")
+  [(set_attr "isa" "*,*,bmi2")
    (set (attr "type")
      (cond [(eq_attr "alternative" "1")
 	      (const_string "lea")
@@ -9195,7 +9195,7 @@
 	return "sal{l}\t{%2, %k0|%k0, %2}";
     }
 }
-  [(set_attr "isa" "base,base,bmi2")
+  [(set_attr "isa" "*,*,bmi2")
    (set (attr "type")
      (cond [(eq_attr "alternative" "1")
 	      (const_string "lea")
@@ -9779,7 +9779,7 @@
 	return "<shiftrt>{<imodesuffix>}\t{%2, %0|%0, %2}";
     }
 }
-  [(set_attr "isa" "base,bmi2")
+  [(set_attr "isa" "*,bmi2")
    (set_attr "type" "ishift,ishiftx")
    (set (attr "length_immediate")
      (if_then_else
@@ -9832,7 +9832,7 @@
 	return "<shiftrt>{l}\t{%2, %k0|%k0, %2}";
     }
 }
-  [(set_attr "isa" "base,bmi2")
+  [(set_attr "isa" "*,bmi2")
    (set_attr "type" "ishift,ishiftx")
    (set (attr "length_immediate")
      (if_then_else
@@ -10159,7 +10159,7 @@
 	return "<rotate>{<imodesuffix>}\t{%2, %0|%0, %2}";
     }
 }
-  [(set_attr "isa" "base,bmi2")
+  [(set_attr "isa" "*,bmi2")
    (set_attr "type" "rotate,rotatex")
    (set (attr "length_immediate")
      (if_then_else
@@ -10225,7 +10225,7 @@
 	return "<rotate>{l}\t{%2, %k0|%k0, %2}";
     }
 }
-  [(set_attr "isa" "base,bmi2")
+  [(set_attr "isa" "*,bmi2")
    (set_attr "type" "rotate,rotatex")
    (set (attr "length_immediate")
      (if_then_else
diff --git a/gcc/config/i386/immintrin.h b/gcc/config/i386/immintrin.h
index 3704df72c07..d2e715ff1df 100644
--- a/gcc/config/i386/immintrin.h
+++ b/gcc/config/i386/immintrin.h
@@ -60,6 +60,18 @@
 #include <avx2intrin.h>
 #endif
 
+#ifdef __LZCNT__
+#include <lzcntintrin.h>
+#endif
+
+#ifdef __BMI__
+#include <bmiintrin.h>
+#endif
+
+#ifdef __BMI2__
+#include <bmi2intrin.h>
+#endif
+
 #ifdef __RDRND__
 extern __inline int
 __attribute__((__gnu_inline__, __always_inline__, __artificial__))
diff --git a/gcc/config/i386/lzcntintrin.h b/gcc/config/i386/lzcntintrin.h
index 8df01d28ea3..31db7dc086c 100644
--- a/gcc/config/i386/lzcntintrin.h
+++ b/gcc/config/i386/lzcntintrin.h
@@ -21,7 +21,7 @@
    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
    <http://www.gnu.org/licenses/>.  */
 
-#ifndef _X86INTRIN_H_INCLUDED
+#if !defined _X86INTRIN_H_INCLUDED && !defined _IMMINTRIN_H_INCLUDED
 # error "Never use <lzcntintrin.h> directly; include <x86intrin.h> instead."
 #endif
 
diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md
index 566845bb6b3..fa22e9a11db 100644
--- a/gcc/config/i386/sse.md
+++ b/gcc/config/i386/sse.md
@@ -648,7 +648,7 @@
    (use (match_operand:VF 2 "nonimmediate_operand"    "xm,0, xm,x"))]
   "TARGET_SSE"
   "#"
-  "reload_completed"
+  "&& reload_completed"
   [(const_int 0)]
 {
   enum rtx_code absneg_op;
@@ -3708,7 +3708,7 @@
 	(vec_select:<ssehalfvecmode>
 	  (match_operand:VI8F_256 1 "nonimmediate_operand" "xm,x")
 	  (parallel [(const_int 0) (const_int 1)])))]
-  "TARGET_AVX"
+  "TARGET_AVX && !(MEM_P (operands[0]) && MEM_P (operands[1]))"
   "#"
   "&& reload_completed"
   [(const_int 0)]
@@ -3742,7 +3742,7 @@
 	  (match_operand:VI4F_256 1 "nonimmediate_operand" "xm,x")
 	  (parallel [(const_int 0) (const_int 1)
 		     (const_int 2) (const_int 3)])))]
-  "TARGET_AVX"
+  "TARGET_AVX && !(MEM_P (operands[0]) && MEM_P (operands[1]))"
   "#"
   "&& reload_completed"
   [(const_int 0)]
@@ -3779,7 +3779,7 @@
 		     (const_int 2) (const_int 3)
 		     (const_int 4) (const_int 5)
 		     (const_int 6) (const_int 7)])))]
-  "TARGET_AVX"
+  "TARGET_AVX && !(MEM_P (operands[0]) && MEM_P (operands[1]))"
   "#"
   "&& reload_completed"
   [(const_int 0)]
@@ -3822,7 +3822,7 @@
 		     (const_int 10) (const_int 11)
 		     (const_int 12) (const_int 13)
 		     (const_int 14) (const_int 15)])))]
-  "TARGET_AVX"
+  "TARGET_AVX && !(MEM_P (operands[0]) && MEM_P (operands[1]))"
   "#"
   "&& reload_completed"
   [(const_int 0)]
@@ -3876,9 +3876,9 @@
        (vec_select:SF
 	 (match_operand:V4SF 1 "memory_operand" "o")
 	 (parallel [(match_operand 2 "const_0_to_3_operand" "n")])))]
-  ""
+  "TARGET_SSE"
   "#"
-  "reload_completed"
+  "&& reload_completed"
   [(const_int 0)]
 {
   int i = INTVAL (operands[2]);
@@ -4726,6 +4726,9 @@
 
   /* Extract the even bytes and merge them back together.  */
   ix86_expand_vec_extract_even_odd (operands[0], t[5], t[4], 0);
+
+  set_unique_reg_note (get_last_insn (), REG_EQUAL,
+		       gen_rtx_MULT (V16QImode, operands[1], operands[2]));
   DONE;
 })
 
@@ -5179,6 +5182,9 @@
 
   /* Merge the parts back together.  */
   emit_insn (gen_vec_interleave_lowv4si (op0, t5, t6));
+
+  set_unique_reg_note (get_last_insn (), REG_EQUAL,
+		       gen_rtx_MULT (V4SImode, operands[1], operands[2]));
   DONE;
 })
 
@@ -5261,6 +5267,9 @@
       emit_insn (gen_addv2di3 (t6, t1, t4));
       emit_insn (gen_addv2di3 (op0, t6, t5));
     }
+
+  set_unique_reg_note (get_last_insn (), REG_EQUAL,
+		       gen_rtx_MULT (V2DImode, operands[1], operands[2]));
   DONE;
 })
 
@@ -9646,6 +9655,40 @@
    (set_attr "prefix" "orig,vex")
    (set_attr "mode" "<MODE>")])
 
+(define_expand "round<mode>2"
+  [(set (match_dup 4)
+	(plus:VF
+	  (match_operand:VF 1 "nonimmediate_operand" "")
+	  (match_dup 3)))
+   (set (match_operand:VF 0 "register_operand" "")
+	(unspec:VF
+	  [(match_dup 4) (match_dup 5)]
+	  UNSPEC_ROUND))]
+  "TARGET_ROUND && !flag_trapping_math"
+{
+  enum machine_mode scalar_mode;
+  const struct real_format *fmt;
+  REAL_VALUE_TYPE pred_half, half_minus_pred_half;
+  rtx half, vec_half;
+
+  scalar_mode = GET_MODE_INNER (<MODE>mode);
+
+  /* load nextafter (0.5, 0.0) */
+  fmt = REAL_MODE_FORMAT (scalar_mode);
+  real_2expN (&half_minus_pred_half, -(fmt->p) - 1, scalar_mode);
+  REAL_ARITHMETIC (pred_half, MINUS_EXPR, dconsthalf, half_minus_pred_half);
+  half = const_double_from_real_value (pred_half, scalar_mode);
+
+  vec_half = ix86_build_const_vector (<MODE>mode, true, half);
+  vec_half = force_reg (<MODE>mode, vec_half);
+
+  operands[3] = gen_reg_rtx (<MODE>mode);
+  emit_insn (gen_copysign<mode>3 (operands[3], vec_half, operands[1]));
+
+  operands[4] = gen_reg_rtx (<MODE>mode);
+  operands[5] = GEN_INT (ROUND_TRUNC);
+})
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; Intel SSE4.2 string/text processing instructions
@@ -9700,6 +9743,9 @@
 					   operands[2], operands[3],
 					   operands[4], operands[5],
 					   operands[6]));
+  if (!(flags || ecx || xmm0))
+    emit_note (NOTE_INSN_DELETED);
+
   DONE;
 }
   [(set_attr "type" "sselog")
@@ -9827,6 +9873,9 @@
     emit_insn (gen_sse4_2_pcmpistr_cconly (NULL, NULL,
 					   operands[2], operands[3],
 					   operands[4]));
+  if (!(flags || ecx || xmm0))
+    emit_note (NOTE_INSN_DELETED);
+
   DONE;
 }
   [(set_attr "type" "sselog")
diff --git a/gcc/config/mips/mips.c b/gcc/config/mips/mips.c
index 53542aabbb0..f5c4cbe60f6 100644
--- a/gcc/config/mips/mips.c
+++ b/gcc/config/mips/mips.c
@@ -10453,7 +10453,8 @@ mips_expand_epilogue (bool sibcall_p)
 	    regno = GP_REG_FIRST + 7;
 	  else
 	    regno = RETURN_ADDR_REGNUM;
-	  emit_jump_insn (gen_return_internal (gen_rtx_REG (Pmode, regno)));
+	  emit_jump_insn (gen_simple_return_internal (gen_rtx_REG (Pmode,
+								   regno)));
 	}
     }
 
diff --git a/gcc/config/mips/mips.md b/gcc/config/mips/mips.md
index d7e59f877f8..0606f92f7b6 100644
--- a/gcc/config/mips/mips.md
+++ b/gcc/config/mips/mips.md
@@ -777,6 +777,8 @@
 (define_code_iterator any_lt [lt ltu])
 (define_code_iterator any_le [le leu])
 
+(define_code_iterator any_return [return simple_return])
+
 ;; <u> expands to an empty string when doing a signed operation and
 ;; "u" when doing an unsigned operation.
 (define_code_attr u [(sign_extend "") (zero_extend "u")
@@ -798,7 +800,9 @@
 			 (xor "xor")
 			 (and "and")
 			 (plus "add")
-			 (minus "sub")])
+			 (minus "sub")
+			 (return "return")
+			 (simple_return "simple_return")])
 
 ;; <insn> expands to the name of the insn that implements a particular code.
 (define_code_attr insn [(ashift "sll")
@@ -5713,21 +5717,26 @@
 ;; allows jump optimizations to work better.
 
 (define_expand "return"
-  [(return)]
+  [(simple_return)]
   "mips_can_use_return_insn ()"
   { mips_expand_before_return (); })
 
-(define_insn "*return"
-  [(return)]
-  "mips_can_use_return_insn ()"
+(define_expand "simple_return"
+  [(simple_return)]
+  ""
+  { mips_expand_before_return (); })
+
+(define_insn "*<optab>"
+  [(any_return)]
+  ""
   "%*j\t$31%/"
   [(set_attr "type"	"jump")
    (set_attr "mode"	"none")])
 
 ;; Normal return.
 
-(define_insn "return_internal"
-  [(return)
+(define_insn "<optab>_internal"
+  [(any_return)
    (use (match_operand 0 "pmode_register_operand" ""))]
   ""
   "%*j\t%0%/"
diff --git a/gcc/config/rs6000/rs6000.opt b/gcc/config/rs6000/rs6000.opt
index 292308f60d0..fba4f1bcf98 100644
--- a/gcc/config/rs6000/rs6000.opt
+++ b/gcc/config/rs6000/rs6000.opt
@@ -526,5 +526,5 @@ Target Report Var(TARGET_POINTERS_TO_NESTED_FUNCTIONS) Init(1) Save
 Use/do not use r11 to hold the static link in calls to functions via pointers.
 
 msave-toc-indirect
-Target Undocumented Var(TARGET_SAVE_TOC_INDIRECT) Save Init(1)
-; Control whether we save the TOC in the prologue for indirect calls or generate the save inline
+Target Report Var(TARGET_SAVE_TOC_INDIRECT) Save
+Control whether we save the TOC in the prologue for indirect calls or generate the save inline
diff --git a/gcc/configure b/gcc/configure
index 0feb91111c0..b1dd57b6ff4 100755
--- a/gcc/configure
+++ b/gcc/configure
@@ -10888,6 +10888,8 @@ void (*const dtors65535) ()
 int
 main ()
 {
+  if (count != 65535)
+    abort ();
   return 0;
 }
 #endif
@@ -17913,7 +17915,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 17916 "configure"
+#line 17918 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -18019,7 +18021,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 18022 "configure"
+#line 18024 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
diff --git a/gcc/convert.c b/gcc/convert.c
index d72dda8fd82..a647193ca94 100644
--- a/gcc/convert.c
+++ b/gcc/convert.c
@@ -469,6 +469,9 @@ convert_to_integer (tree type, tree expr)
 	  break;
 
 	CASE_FLT_FN (BUILT_IN_ROUND):
+	  /* Only convert in ISO C99 mode.  */
+	  if (!TARGET_C99_FUNCTIONS)
+	    break;
 	  if (outprec < TYPE_PRECISION (integer_type_node)
 	      || (outprec == TYPE_PRECISION (integer_type_node)
 		  && !TYPE_UNSIGNED (type)))
@@ -487,11 +490,14 @@ convert_to_integer (tree type, tree expr)
 	    break;
 	  /* ... Fall through ...  */
 	CASE_FLT_FN (BUILT_IN_RINT):
+	  /* Only convert in ISO C99 mode.  */
+	  if (!TARGET_C99_FUNCTIONS)
+	    break;
 	  if (outprec < TYPE_PRECISION (integer_type_node)
 	      || (outprec == TYPE_PRECISION (integer_type_node)
 		  && !TYPE_UNSIGNED (type)))
 	    fn = mathfn_built_in (s_intype, BUILT_IN_IRINT);
-	  else if (outprec < TYPE_PRECISION (long_integer_type_node)
+	  else if (outprec == TYPE_PRECISION (long_integer_type_node)
 		   && !TYPE_UNSIGNED (type))
 	    fn = mathfn_built_in (s_intype, BUILT_IN_LRINT);
 	  else if (outprec == TYPE_PRECISION (long_long_integer_type_node)
diff --git a/gcc/coverage.c b/gcc/coverage.c
index 1a992973f78..24e0e3d87f2 100644
--- a/gcc/coverage.c
+++ b/gcc/coverage.c
@@ -1056,7 +1056,7 @@ coverage_init (const char *filename)
   strcpy (bbg_file_name, filename);
   strcat (bbg_file_name, GCOV_NOTE_SUFFIX);
 
-  if (flag_profile_use)
+  if (flag_branch_probabilities)
     read_counts_file ();
 }
 
diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog
index 390a7982ecb..315078aad33 100644
--- a/gcc/cp/ChangeLog
+++ b/gcc/cp/ChangeLog
@@ -1,3 +1,43 @@
+2011-08-29  Jason Merrill  <jason@redhat.com>
+
+	PR c++/50224
+	* semantics.c (finish_id_expression): Mark captured variables used.
+
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+	    Jason Merrill  <jason@redhat.com>
+
+	PR c++/50207
+	* class.c (finish_struct_1): Complain if the first field is
+	artificial.
+
+2011-08-29  Jason Merrill  <jason@redhat.com>
+
+	PR c++/50209
+	Core DR 994
+	* parser.c (cp_parser_default_argument): Use
+	cp_parser_initializer_clause.
+	(cp_parser_late_parsing_default_args): Likewise.
+
+2011-08-26  Jason Merrill  <jason@redhat.com>
+
+	Core DR 342
+	PR c++/48582
+	* pt.c (check_valid_ptrmem_cst_expr): A null member pointer value
+	is valid in C++11.
+	(convert_nontype_argument): Likewise.  Implicitly convert nullptr
+	and do constant folding.
+	* mangle.c (write_template_arg_literal): Mangle null member
+	pointer values as 0.
+	* call.c (null_member_pointer_value_p): New.
+	* cp-tree.h: Declare it.
+
+2011-08-25  Jason Merrill  <jason@redhat.com>
+
+	* call.c (convert_like_real): Remove redundant complain checks.
+
+	PR c++/50157
+	* call.c (convert_like_real): Exit early if bad and !tf_error.
+
 2011-08-23  Jason Merrill  <jason@redhat.com>
 
 	* typeck2.c (build_functional_cast): Don't try to avoid calling
diff --git a/gcc/cp/call.c b/gcc/cp/call.c
index e5f65b31c6c..84212603b1a 100644
--- a/gcc/cp/call.c
+++ b/gcc/cp/call.c
@@ -553,6 +553,23 @@ null_ptr_cst_p (tree t)
   return false;
 }
 
+/* Returns true iff T is a null member pointer value (4.11).  */
+
+bool
+null_member_pointer_value_p (tree t)
+{
+  tree type = TREE_TYPE (t);
+  if (!type)
+    return false;
+  else if (TYPE_PTRMEMFUNC_P (type))
+    return (TREE_CODE (t) == CONSTRUCTOR
+	    && integer_zerop (CONSTRUCTOR_ELT (t, 0)->value));
+  else if (TYPE_PTRMEM_P (type))
+    return integer_all_onesp (t);
+  else
+    return false;
+}
+
 /* Returns nonzero if PARMLIST consists of only default parms,
    ellipsis, and/or undeduced parameter packs.  */
 
@@ -5642,6 +5659,9 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
   diagnostic_t diag_kind;
   int flags;
 
+  if (convs->bad_p && !(complain & tf_error))
+    return error_mark_node;
+
   if (convs->bad_p
       && convs->kind != ck_user
       && convs->kind != ck_list
@@ -5688,15 +5708,12 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
 	  else if (t->kind == ck_identity)
 	    break;
 	}
-      if (complain & tf_error)
-	{
-	  permerror (input_location, "invalid conversion from %qT to %qT", TREE_TYPE (expr), totype);
-	  if (fn)
-	    permerror (DECL_SOURCE_LOCATION (fn),
-		       "  initializing argument %P of %qD", argnum, fn);
-	}
-      else
-	return error_mark_node;
+
+      permerror (input_location, "invalid conversion from %qT to %qT",
+		 TREE_TYPE (expr), totype);
+      if (fn)
+	permerror (DECL_SOURCE_LOCATION (fn),
+		   "  initializing argument %P of %qD", argnum, fn);
 
       return cp_convert (totype, expr);
     }
@@ -5733,11 +5750,8 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
 	       empty list, since that is handled separately in 8.5.4.  */
 	    && cand->num_convs > 0)
 	  {
-	    if (complain & tf_error)
-	      error ("converting to %qT from initializer list would use "
-		     "explicit constructor %qD", totype, convfn);
-	    else
-	      return error_mark_node;
+	    error ("converting to %qT from initializer list would use "
+		   "explicit constructor %qD", totype, convfn);
 	  }
 
 	/* Set user_conv_p on the argument conversions, so rvalue/base
@@ -5789,6 +5803,9 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
         }
       return expr;
     case ck_ambig:
+      /* We leave bad_p off ck_ambig because overload resolution considers
+	 it valid, it just fails when we try to perform it.  So we need to
+         check complain here, too.  */
       if (complain & tf_error)
 	{
 	  /* Call build_user_type_conversion again for the error.  */
@@ -5899,14 +5916,9 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
 	/* Copy-list-initialization doesn't actually involve a copy.  */
 	return expr;
       expr = build_temp (expr, totype, flags, &diag_kind, complain);
-      if (diag_kind && fn)
-	{
-	  if ((complain & tf_error))
-	    emit_diagnostic (diag_kind, DECL_SOURCE_LOCATION (fn), 0,
-			     "  initializing argument %P of %qD", argnum, fn);
-	  else if (diag_kind == DK_ERROR)
-	    return error_mark_node;
-	}
+      if (diag_kind && fn && complain)
+	emit_diagnostic (diag_kind, DECL_SOURCE_LOCATION (fn), 0,
+			 "  initializing argument %P of %qD", argnum, fn);
       return build_cplus_new (totype, expr, complain);
 
     case ck_ref_bind:
@@ -5916,13 +5928,10 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
 	if (convs->bad_p && TYPE_REF_IS_RVALUE (ref_type)
 	    && real_lvalue_p (expr))
 	  {
-	    if (complain & tf_error)
-	      {
-		error ("cannot bind %qT lvalue to %qT",
-		       TREE_TYPE (expr), totype);
-		if (fn)
-		  error ("  initializing argument %P of %q+D", argnum, fn);
-	      }
+	    error ("cannot bind %qT lvalue to %qT",
+		   TREE_TYPE (expr), totype);
+	    if (fn)
+	      error ("  initializing argument %P of %q+D", argnum, fn);
 	    return error_mark_node;
 	  }
 
@@ -5948,19 +5957,16 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
 	    if (!CP_TYPE_CONST_NON_VOLATILE_P (type)
 		&& !TYPE_REF_IS_RVALUE (ref_type))
 	      {
-		if (complain & tf_error)
-		  {
-		    /* If the reference is volatile or non-const, we
-		       cannot create a temporary.  */
-		    if (lvalue & clk_bitfield)
-		      error ("cannot bind bitfield %qE to %qT",
-			     expr, ref_type);
-		    else if (lvalue & clk_packed)
-		      error ("cannot bind packed field %qE to %qT",
-			     expr, ref_type);
-		    else
-		      error ("cannot bind rvalue %qE to %qT", expr, ref_type);
-		  }
+		/* If the reference is volatile or non-const, we
+		   cannot create a temporary.  */
+		if (lvalue & clk_bitfield)
+		  error ("cannot bind bitfield %qE to %qT",
+			 expr, ref_type);
+		else if (lvalue & clk_packed)
+		  error ("cannot bind packed field %qE to %qT",
+			 expr, ref_type);
+		else
+		  error ("cannot bind rvalue %qE to %qT", expr, ref_type);
 		return error_mark_node;
 	      }
 	    /* If the source is a packed field, and we must use a copy
@@ -5973,9 +5979,8 @@ convert_like_real (conversion *convs, tree expr, tree fn, int argnum,
 		&& CLASS_TYPE_P (type)
 		&& type_has_nontrivial_copy_init (type))
 	      {
-		if (complain & tf_error)
-		  error ("cannot bind packed field %qE to %qT",
-			 expr, ref_type);
+		error ("cannot bind packed field %qE to %qT",
+		       expr, ref_type);
 		return error_mark_node;
 	      }
 	    if (lvalue & clk_bitfield)
diff --git a/gcc/cp/class.c b/gcc/cp/class.c
index 6ebe7588cb8..2a4bc77aa5e 100644
--- a/gcc/cp/class.c
+++ b/gcc/cp/class.c
@@ -5795,10 +5795,25 @@ finish_struct_1 (tree t)
   /* Finish debugging output for this type.  */
   rest_of_type_compilation (t, ! LOCAL_CLASS_P (t));
 
-  if (TYPE_TRANSPARENT_AGGR (t) && first_field (t) == NULL_TREE)
+  if (TYPE_TRANSPARENT_AGGR (t))
     {
-      error ("type transparent class %qT does not have any fields", t);
-      TYPE_TRANSPARENT_AGGR (t) = 0;
+      tree field = first_field (t);
+      if (field == NULL_TREE || error_operand_p (field))
+	{
+	  error ("type transparent class %qT does not have any fields", t);
+	  TYPE_TRANSPARENT_AGGR (t) = 0;
+	}
+      else if (DECL_ARTIFICIAL (field))
+	{
+	  if (DECL_FIELD_IS_BASE (field))
+	    error ("type transparent class %qT has base classes", t);
+	  else
+	    {
+	      gcc_checking_assert (DECL_VIRTUAL_P (field));
+	      error ("type transparent class %qT has virtual functions", t);
+	    }
+	  TYPE_TRANSPARENT_AGGR (t) = 0;
+	}
     }
 }
 
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index 85959439397..d1256424def 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -4722,6 +4722,7 @@ extern tree build_addr_func			(tree);
 extern tree build_call_a			(tree, int, tree*);
 extern tree build_call_n			(tree, int, ...);
 extern bool null_ptr_cst_p			(tree);
+extern bool null_member_pointer_value_p		(tree);
 extern bool sufficient_parms_p			(const_tree);
 extern tree type_decays_to			(tree);
 extern tree build_user_type_conversion		(tree, tree, int);
diff --git a/gcc/cp/mangle.c b/gcc/cp/mangle.c
index 4c7cc79d4e3..1fcd999e585 100644
--- a/gcc/cp/mangle.c
+++ b/gcc/cp/mangle.c
@@ -2762,29 +2762,34 @@ write_template_arg_literal (const tree value)
   write_char ('L');
   write_type (TREE_TYPE (value));
 
-  switch (TREE_CODE (value))
-    {
-    case CONST_DECL:
-      write_integer_cst (DECL_INITIAL (value));
-      break;
+  /* Write a null member pointer value as (type)0, regardless of its
+     real representation.  */
+  if (null_member_pointer_value_p (value))
+    write_integer_cst (integer_zero_node);
+  else
+    switch (TREE_CODE (value))
+      {
+      case CONST_DECL:
+	write_integer_cst (DECL_INITIAL (value));
+	break;
 
-    case INTEGER_CST:
-      gcc_assert (!same_type_p (TREE_TYPE (value), boolean_type_node)
-		  || integer_zerop (value) || integer_onep (value));
-      write_integer_cst (value);
-      break;
+      case INTEGER_CST:
+	gcc_assert (!same_type_p (TREE_TYPE (value), boolean_type_node)
+		    || integer_zerop (value) || integer_onep (value));
+	write_integer_cst (value);
+	break;
 
-    case REAL_CST:
-      write_real_cst (value);
-      break;
+      case REAL_CST:
+	write_real_cst (value);
+	break;
 
-    case STRING_CST:
-      sorry ("string literal in function template signature");
-      break;
+      case STRING_CST:
+	sorry ("string literal in function template signature");
+	break;
 
-    default:
-      gcc_unreachable ();
-    }
+      default:
+	gcc_unreachable ();
+      }
 
   write_char ('E');
 }
@@ -2845,7 +2850,8 @@ write_template_arg (tree node)
     /* A template appearing as a template arg is a template template arg.  */
     write_template_template_arg (node);
   else if ((TREE_CODE_CLASS (code) == tcc_constant && code != PTRMEM_CST)
-	   || (abi_version_at_least (2) && code == CONST_DECL))
+	   || (abi_version_at_least (2) && code == CONST_DECL)
+	   || null_member_pointer_value_p (node))
     write_template_arg_literal (node);
   else if (DECL_P (node))
     {
diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 84b8c608f95..c862a7d0e88 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -16535,6 +16535,7 @@ cp_parser_default_argument (cp_parser *parser, bool template_parm_p)
   tree default_argument = NULL_TREE;
   bool saved_greater_than_is_operator_p;
   bool saved_local_variables_forbidden_p;
+  bool non_constant_p;
 
   /* Make sure that PARSER->GREATER_THAN_IS_OPERATOR_P is
      set correctly.  */
@@ -16548,7 +16549,9 @@ cp_parser_default_argument (cp_parser *parser, bool template_parm_p)
   if (template_parm_p)
     push_deferring_access_checks (dk_no_deferred);
   default_argument
-    = cp_parser_assignment_expression (parser, /*cast_p=*/false, NULL);
+    = cp_parser_initializer_clause (parser, &non_constant_p);
+  if (BRACE_ENCLOSED_INITIALIZER_P (default_argument))
+    maybe_warn_cpp0x (CPP0X_INITIALIZER_LISTS);
   if (template_parm_p)
     pop_deferring_access_checks ();
   parser->greater_than_is_operator_p = saved_greater_than_is_operator_p;
@@ -20731,6 +20734,7 @@ static void
 cp_parser_late_parsing_default_args (cp_parser *parser, tree fn)
 {
   bool saved_local_variables_forbidden_p;
+  bool non_constant_p;
   tree parm, parmdecl;
 
   /* While we're parsing the default args, we might (due to the
@@ -20775,12 +20779,14 @@ cp_parser_late_parsing_default_args (cp_parser *parser, tree fn)
       start_lambda_scope (parmdecl);
 
       /* Parse the assignment-expression.  */
-      parsed_arg = cp_parser_assignment_expression (parser, /*cast_p=*/false, NULL);
+      parsed_arg = cp_parser_initializer_clause (parser, &non_constant_p);
       if (parsed_arg == error_mark_node)
 	{
 	  cp_parser_pop_lexer (parser);
 	  continue;
 	}
+      if (BRACE_ENCLOSED_INITIALIZER_P (parsed_arg))
+	maybe_warn_cpp0x (CPP0X_INITIALIZER_LISTS);
 
       if (!processing_template_decl)
 	parsed_arg = check_default_argument (TREE_VALUE (parm), parsed_arg);
diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c
index 3c6b2c54a99..1f43ff1fbf0 100644
--- a/gcc/cp/pt.c
+++ b/gcc/cp/pt.c
@@ -5240,6 +5240,8 @@ check_valid_ptrmem_cst_expr (tree type, tree expr,
   STRIP_NOPS (expr);
   if (expr && (null_ptr_cst_p (expr) || TREE_CODE (expr) == PTRMEM_CST))
     return true;
+  if (cxx_dialect >= cxx0x && null_member_pointer_value_p (expr))
+    return true;
   if (complain & tf_error)
     {
       error ("%qE is not a valid template argument for type %qT",
@@ -5550,6 +5552,17 @@ convert_nontype_argument (tree type, tree expr, tsubst_flags_t complain)
   else
     expr = mark_rvalue_use (expr);
 
+  /* 14.3.2/5: The null pointer{,-to-member} conversion is applied
+     to a non-type argument of "nullptr".  */
+  if (expr == nullptr_node
+      && (TYPE_PTR_P (type) || TYPE_PTR_TO_MEMBER_P (type)))
+    expr = convert (type, expr);
+
+  /* In C++11, non-type template arguments can be arbitrary constant
+     expressions.  But don't fold a PTRMEM_CST to a CONSTRUCTOR yet.  */
+  if (cxx_dialect >= cxx0x && TREE_CODE (expr) != PTRMEM_CST)
+    expr = maybe_constant_value (expr);
+
   /* HACK: Due to double coercion, we can get a
      NOP_EXPR<REFERENCE_TYPE>(ADDR_EXPR<POINTER_TYPE> (arg)) here,
      which is the tree that we built on the first call (see
@@ -5658,6 +5671,8 @@ convert_nontype_argument (tree type, tree expr, tsubst_flags_t complain)
       if (DECL_P (expr) && DECL_TEMPLATE_PARM_P (expr))
 	/* Non-type template parameters are OK.  */
 	;
+      else if (cxx_dialect >= cxx0x && integer_zerop (expr))
+	/* Null pointer values are OK in C++11.  */;
       else if (TREE_CODE (expr) != ADDR_EXPR
 	       && TREE_CODE (expr_type) != ARRAY_TYPE)
 	{
@@ -5785,6 +5800,10 @@ convert_nontype_argument (tree type, tree expr, tsubst_flags_t complain)
 	    return error_mark_node;
 	}
 
+      if (cxx_dialect >= cxx0x && integer_zerop (expr))
+	/* Null pointer values are OK in C++11.  */
+	return perform_qualification_conversions (type, expr);
+
       expr = convert_nontype_argument_function (type, expr);
       if (!expr || expr == error_mark_node)
 	return expr;
diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c
index 5deb2ebfbd1..07f53b5cd12 100644
--- a/gcc/cp/semantics.c
+++ b/gcc/cp/semantics.c
@@ -2949,6 +2949,9 @@ finish_id_expression (tree id_expression,
 	  tree lambda_expr = NULL_TREE;
 	  tree initializer = convert_from_reference (decl);
 
+	  /* Mark it as used now even if the use is ill-formed.  */
+	  mark_used (decl);
+
 	  /* Core issue 696: "[At the July 2009 meeting] the CWG expressed
 	     support for an approach in which a reference to a local
 	     [constant] automatic variable in a nested class or lambda body
diff --git a/gcc/df-problems.c b/gcc/df-problems.c
index e547b67c55f..89284541394 100644
--- a/gcc/df-problems.c
+++ b/gcc/df-problems.c
@@ -3376,7 +3376,7 @@ df_note_bb_compute (unsigned int bb_index,
       while (*mws_rec)
 	{
 	  struct df_mw_hardreg *mws = *mws_rec;
-	  if ((DF_MWS_REG_DEF_P (mws))
+	  if (DF_MWS_REG_USE_P (mws)
 	      && !df_ignore_stack_reg (mws->start_regno))
 	    {
 	      bool really_add_notes = debug_insn != 0;
diff --git a/gcc/df-scan.c b/gcc/df-scan.c
index de2ae82853a..deaa9f96d53 100644
--- a/gcc/df-scan.c
+++ b/gcc/df-scan.c
@@ -3181,6 +3181,7 @@ df_uses_record (struct df_collection_rec *collection_rec,
       }
 
     case RETURN:
+    case SIMPLE_RETURN:
       break;
 
     case ASM_OPERANDS:
diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi
index ad6b6ff84eb..1dd760d6264 100644
--- a/gcc/doc/invoke.texi
+++ b/gcc/doc/invoke.texi
@@ -815,7 +815,8 @@ See RS/6000 and PowerPC Options.
 -mrecip -mrecip=@var{opt} -mno-recip -mrecip-precision @gol
 -mno-recip-precision @gol
 -mveclibabi=@var{type} -mfriz -mno-friz @gol
--mpointers-to-nested-functions -mno-pointers-to-nested-functions}
+-mpointers-to-nested-functions -mno-pointers-to-nested-functions @gol
+-msave-toc-indirect -mno-save-toc-indirect}
 
 @emph{RX Options}
 @gccoptlist{-m64bit-doubles  -m32bit-doubles  -fpu  -nofpu@gol
@@ -16444,6 +16445,15 @@ static chain value to be loaded in register @var{r11}.  The
 not be able to call through pointers to nested functions or pointers
 to functions compiled in other languages that use the static chain if
 you use the @option{-mno-pointers-to-nested-functions}.
+
+@item -msave-toc-indirect
+@itemx -mno-save-toc-indirect
+@opindex msave-toc-indirect
+Generate (do not generate) code to save the TOC value in the reserved
+stack location in the function prologue if the function calls through
+a pointer on AIX and 64-bit Linux systems.  If the TOC value is not
+saved in the prologue, it is saved just before the call through the
+pointer.  The @option{-mno-save-toc-indirect} option is the default.
 @end table
 
 @node RX Options
diff --git a/gcc/doc/md.texi b/gcc/doc/md.texi
index da5b799e6bc..ffb8843633e 100644
--- a/gcc/doc/md.texi
+++ b/gcc/doc/md.texi
@@ -4992,6 +4992,20 @@ some class of functions only requires one instruction to implement a
 return.  Normally, the applicable functions are those which do not need
 to save any registers or allocate stack space.
 
+It is valid for this pattern to expand to an instruction using
+@code{simple_return} if no epilogue is required.
+
+@cindex @code{simple_return} instruction pattern
+@item @samp{simple_return}
+Subroutine return instruction.  This instruction pattern name should be
+defined only if a single instruction can do all the work of returning
+from a function on a path where no epilogue is required.  This pattern
+is very similar to the @code{return} instruction pattern, but it is emitted
+only by the shrink-wrapping optimization on paths where the function
+prologue has not been executed, and a function return should occur without
+any of the effects of the epilogue.  Additional uses may be introduced on
+paths where both the prologue and the epilogue have executed.
+
 @findex reload_completed
 @findex leaf_function_p
 For such machines, the condition specified in this pattern should only
diff --git a/gcc/doc/rtl.texi b/gcc/doc/rtl.texi
index b5cb285110d..4cb51eec1aa 100644
--- a/gcc/doc/rtl.texi
+++ b/gcc/doc/rtl.texi
@@ -2915,6 +2915,13 @@ placed in @code{pc} to return to the caller.
 Note that an insn pattern of @code{(return)} is logically equivalent to
 @code{(set (pc) (return))}, but the latter form is never used.
 
+@findex simple_return
+@item (simple_return)
+Like @code{(return)}, but truly represents only a function return, while
+@code{(return)} may represent an insn that also performs other functions
+of the function epilogue.  Like @code{(return)}, this may also occur in
+conditional jumps.
+
 @findex call
 @item (call @var{function} @var{nargs})
 Represents a function call.  @var{function} is a @code{mem} expression
@@ -3044,7 +3051,7 @@ Represents several side effects performed in parallel.  The square
 brackets stand for a vector; the operand of @code{parallel} is a
 vector of expressions.  @var{x0}, @var{x1} and so on are individual
 side effect expressions---expressions of code @code{set}, @code{call},
-@code{return}, @code{clobber} or @code{use}.
+@code{return}, @code{simple_return}, @code{clobber} or @code{use}.
 
 ``In parallel'' means that first all the values used in the individual
 side-effects are computed, and second all the actual side-effects are
@@ -3683,14 +3690,16 @@ and @code{call_insn} insns:
 @table @code
 @findex PATTERN
 @item PATTERN (@var{i})
-An expression for the side effect performed by this insn.  This must be
-one of the following codes: @code{set}, @code{call}, @code{use},
-@code{clobber}, @code{return}, @code{asm_input}, @code{asm_output},
-@code{addr_vec}, @code{addr_diff_vec}, @code{trap_if}, @code{unspec},
-@code{unspec_volatile}, @code{parallel}, @code{cond_exec}, or @code{sequence}.  If it is a @code{parallel},
-each element of the @code{parallel} must be one these codes, except that
-@code{parallel} expressions cannot be nested and @code{addr_vec} and
-@code{addr_diff_vec} are not permitted inside a @code{parallel} expression.
+An expression for the side effect performed by this insn.  This must
+be one of the following codes: @code{set}, @code{call}, @code{use},
+@code{clobber}, @code{return}, @code{simple_return}, @code{asm_input},
+@code{asm_output}, @code{addr_vec}, @code{addr_diff_vec},
+@code{trap_if}, @code{unspec}, @code{unspec_volatile},
+@code{parallel}, @code{cond_exec}, or @code{sequence}.  If it is a
+@code{parallel}, each element of the @code{parallel} must be one these
+codes, except that @code{parallel} expressions cannot be nested and
+@code{addr_vec} and @code{addr_diff_vec} are not permitted inside a
+@code{parallel} expression.
 
 @findex INSN_CODE
 @item INSN_CODE (@var{i})
diff --git a/gcc/emit-rtl.c b/gcc/emit-rtl.c
index 25628e40bc2..c94e7438c91 100644
--- a/gcc/emit-rtl.c
+++ b/gcc/emit-rtl.c
@@ -2444,6 +2444,8 @@ unshare_all_rtl_again (rtx insn)
       {
 	reset_used_flags (PATTERN (p));
 	reset_used_flags (REG_NOTES (p));
+	if (CALL_P (p))
+	  reset_used_flags (CALL_INSN_FUNCTION_USAGE (p));
       }
 
   /* Make sure that virtual stack slots are not shared.  */
@@ -2518,6 +2520,7 @@ verify_rtx_sharing (rtx orig, rtx insn)
     case PC:
     case CC0:
     case RETURN:
+    case SIMPLE_RETURN:
     case SCRATCH:
       return;
       /* SCRATCH must be shared because they represent distinct values.  */
@@ -2610,6 +2613,8 @@ verify_rtl_sharing (void)
       {
 	reset_used_flags (PATTERN (p));
 	reset_used_flags (REG_NOTES (p));
+	if (CALL_P (p))
+	  reset_used_flags (CALL_INSN_FUNCTION_USAGE (p));
 	if (GET_CODE (PATTERN (p)) == SEQUENCE)
 	  {
 	    int i;
@@ -2621,6 +2626,8 @@ verify_rtl_sharing (void)
 		gcc_assert (INSN_P (q));
 		reset_used_flags (PATTERN (q));
 		reset_used_flags (REG_NOTES (q));
+		if (CALL_P (q))
+		  reset_used_flags (CALL_INSN_FUNCTION_USAGE (q));
 	      }
 	  }
       }
@@ -2630,6 +2637,8 @@ verify_rtl_sharing (void)
       {
 	verify_rtx_sharing (PATTERN (p), p);
 	verify_rtx_sharing (REG_NOTES (p), p);
+	if (CALL_P (p))
+	  verify_rtx_sharing (CALL_INSN_FUNCTION_USAGE (p), p);
       }
 
   timevar_pop (TV_VERIFY_RTL_SHARING);
@@ -2646,6 +2655,9 @@ unshare_all_rtl_in_chain (rtx insn)
       {
 	PATTERN (insn) = copy_rtx_if_shared (PATTERN (insn));
 	REG_NOTES (insn) = copy_rtx_if_shared (REG_NOTES (insn));
+	if (CALL_P (insn))
+	  CALL_INSN_FUNCTION_USAGE (insn)
+	    = copy_rtx_if_shared (CALL_INSN_FUNCTION_USAGE (insn));
       }
 }
 
@@ -2725,6 +2737,7 @@ repeat:
     case PC:
     case CC0:
     case RETURN:
+    case SIMPLE_RETURN:
     case SCRATCH:
       /* SCRATCH must be shared because they represent distinct values.  */
       return;
@@ -2845,6 +2858,7 @@ repeat:
     case PC:
     case CC0:
     case RETURN:
+    case SIMPLE_RETURN:
       return;
 
     case DEBUG_INSN:
@@ -5008,7 +5022,7 @@ classify_insn (rtx x)
     return CODE_LABEL;
   if (GET_CODE (x) == CALL)
     return CALL_INSN;
-  if (GET_CODE (x) == RETURN)
+  if (ANY_RETURN_P (x))
     return JUMP_INSN;
   if (GET_CODE (x) == SET)
     {
@@ -5264,6 +5278,7 @@ copy_insn_1 (rtx orig)
     case PC:
     case CC0:
     case RETURN:
+    case SIMPLE_RETURN:
       return orig;
     case CLOBBER:
       if (REG_P (XEXP (orig, 0)) && REGNO (XEXP (orig, 0)) < FIRST_PSEUDO_REGISTER)
@@ -5521,6 +5536,7 @@ init_emit_regs (void)
   /* Assign register numbers to the globally defined register rtx.  */
   pc_rtx = gen_rtx_fmt_ (PC, VOIDmode);
   ret_rtx = gen_rtx_fmt_ (RETURN, VOIDmode);
+  simple_return_rtx = gen_rtx_fmt_ (SIMPLE_RETURN, VOIDmode);
   cc0_rtx = gen_rtx_fmt_ (CC0, VOIDmode);
   stack_pointer_rtx = gen_raw_REG (Pmode, STACK_POINTER_REGNUM);
   frame_pointer_rtx = gen_raw_REG (Pmode, FRAME_POINTER_REGNUM);
diff --git a/gcc/expr.c b/gcc/expr.c
index ee16b6a469e..e29f3f6f4f9 100644
--- a/gcc/expr.c
+++ b/gcc/expr.c
@@ -3548,131 +3548,151 @@ mem_autoinc_base (rtx mem)
    verified, via immediate operand or auto-inc.  If the adjustment
    cannot be trivially extracted, the return value is INT_MIN.  */
 
-int
-fixup_args_size_notes (rtx prev, rtx last, int end_args_size)
+HOST_WIDE_INT
+find_args_size_adjust (rtx insn)
 {
-  int args_size = end_args_size;
-  bool saw_unknown = false;
-  rtx insn;
+  rtx dest, set, pat;
+  int i;
 
-  for (insn = last; insn != prev; insn = PREV_INSN (insn))
-    {
-      rtx dest, set, pat;
-      HOST_WIDE_INT this_delta = 0;
-      int i;
+  pat = PATTERN (insn);
+  set = NULL;
 
-      if (!NONDEBUG_INSN_P (insn))
-	continue;
-      pat = PATTERN (insn);
-      set = NULL;
+  /* Look for a call_pop pattern.  */
+  if (CALL_P (insn))
+    {
+      /* We have to allow non-call_pop patterns for the case
+	 of emit_single_push_insn of a TLS address.  */
+      if (GET_CODE (pat) != PARALLEL)
+	return 0;
 
-      /* Look for a call_pop pattern.  */
-      if (CALL_P (insn))
+      /* All call_pop have a stack pointer adjust in the parallel.
+	 The call itself is always first, and the stack adjust is
+	 usually last, so search from the end.  */
+      for (i = XVECLEN (pat, 0) - 1; i > 0; --i)
 	{
-          /* We have to allow non-call_pop patterns for the case
-	     of emit_single_push_insn of a TLS address.  */
-	  if (GET_CODE (pat) != PARALLEL)
+	  set = XVECEXP (pat, 0, i);
+	  if (GET_CODE (set) != SET)
 	    continue;
-
-	  /* All call_pop have a stack pointer adjust in the parallel.
-	     The call itself is always first, and the stack adjust is
-	     usually last, so search from the end.  */
-	  for (i = XVECLEN (pat, 0) - 1; i > 0; --i)
-	    {
-	      set = XVECEXP (pat, 0, i);
-	      if (GET_CODE (set) != SET)
-		continue;
-	      dest = SET_DEST (set);
-	      if (dest == stack_pointer_rtx)
-		break;
-	    }
-	  /* We'd better have found the stack pointer adjust.  */
-	  if (i == 0)
-	    continue;
-	  /* Fall through to process the extracted SET and DEST
-	     as if it was a standalone insn.  */
+	  dest = SET_DEST (set);
+	  if (dest == stack_pointer_rtx)
+	    break;
 	}
-      else if (GET_CODE (pat) == SET)
-	set = pat;
-      else if ((set = single_set (insn)) != NULL)
-	;
-      else if (GET_CODE (pat) == PARALLEL)
+      /* We'd better have found the stack pointer adjust.  */
+      if (i == 0)
+	return 0;
+      /* Fall through to process the extracted SET and DEST
+	 as if it was a standalone insn.  */
+    }
+  else if (GET_CODE (pat) == SET)
+    set = pat;
+  else if ((set = single_set (insn)) != NULL)
+    ;
+  else if (GET_CODE (pat) == PARALLEL)
+    {
+      /* ??? Some older ports use a parallel with a stack adjust
+	 and a store for a PUSH_ROUNDING pattern, rather than a
+	 PRE/POST_MODIFY rtx.  Don't force them to update yet...  */
+      /* ??? See h8300 and m68k, pushqi1.  */
+      for (i = XVECLEN (pat, 0) - 1; i >= 0; --i)
 	{
-	  /* ??? Some older ports use a parallel with a stack adjust
-	     and a store for a PUSH_ROUNDING pattern, rather than a
-	     PRE/POST_MODIFY rtx.  Don't force them to update yet...  */
-	  /* ??? See h8300 and m68k, pushqi1.  */
-	  for (i = XVECLEN (pat, 0) - 1; i >= 0; --i)
-	    {
-	      set = XVECEXP (pat, 0, i);
-	      if (GET_CODE (set) != SET)
-		continue;
-	      dest = SET_DEST (set);
-	      if (dest == stack_pointer_rtx)
-		break;
-
-	      /* We do not expect an auto-inc of the sp in the parallel.  */
-	      gcc_checking_assert (mem_autoinc_base (dest)
-				   != stack_pointer_rtx);
-	      gcc_checking_assert (mem_autoinc_base (SET_SRC (set))
-				   != stack_pointer_rtx);
-	    }
-	  if (i < 0)
+	  set = XVECEXP (pat, 0, i);
+	  if (GET_CODE (set) != SET)
 	    continue;
+	  dest = SET_DEST (set);
+	  if (dest == stack_pointer_rtx)
+	    break;
+
+	  /* We do not expect an auto-inc of the sp in the parallel.  */
+	  gcc_checking_assert (mem_autoinc_base (dest) != stack_pointer_rtx);
+	  gcc_checking_assert (mem_autoinc_base (SET_SRC (set))
+			       != stack_pointer_rtx);
 	}
+      if (i < 0)
+	return 0;
+    }
+  else
+    return 0;
+
+  dest = SET_DEST (set);
+
+  /* Look for direct modifications of the stack pointer.  */
+  if (REG_P (dest) && REGNO (dest) == STACK_POINTER_REGNUM)
+    {
+      /* Look for a trivial adjustment, otherwise assume nothing.  */
+      /* Note that the SPU restore_stack_block pattern refers to
+	 the stack pointer in V4SImode.  Consider that non-trivial.  */
+      if (SCALAR_INT_MODE_P (GET_MODE (dest))
+	  && GET_CODE (SET_SRC (set)) == PLUS
+	  && XEXP (SET_SRC (set), 0) == stack_pointer_rtx
+	  && CONST_INT_P (XEXP (SET_SRC (set), 1)))
+	return INTVAL (XEXP (SET_SRC (set), 1));
+      /* ??? Reload can generate no-op moves, which will be cleaned
+	 up later.  Recognize it and continue searching.  */
+      else if (rtx_equal_p (dest, SET_SRC (set)))
+	return 0;
       else
-	continue;
-      dest = SET_DEST (set);
-
-      /* Look for direct modifications of the stack pointer.  */
-      if (REG_P (dest) && REGNO (dest) == STACK_POINTER_REGNUM)
-	{
-	  gcc_assert (!saw_unknown);
-	  /* Look for a trivial adjustment, otherwise assume nothing.  */
-	  /* Note that the SPU restore_stack_block pattern refers to
-	     the stack pointer in V4SImode.  Consider that non-trivial.  */
-	  if (SCALAR_INT_MODE_P (GET_MODE (dest))
-	      && GET_CODE (SET_SRC (set)) == PLUS
-	      && XEXP (SET_SRC (set), 0) == stack_pointer_rtx
-	      && CONST_INT_P (XEXP (SET_SRC (set), 1)))
-	    this_delta = INTVAL (XEXP (SET_SRC (set), 1));
-	  /* ??? Reload can generate no-op moves, which will be cleaned
-	     up later.  Recognize it and continue searching.  */
-	  else if (rtx_equal_p (dest, SET_SRC (set)))
-	    this_delta = 0;
-	  else
-	    saw_unknown = true;
-	}
+	return HOST_WIDE_INT_MIN;
+    }
+  else
+    {
+      rtx mem, addr;
+
       /* Otherwise only think about autoinc patterns.  */
-      else if (mem_autoinc_base (dest) == stack_pointer_rtx)
+      if (mem_autoinc_base (dest) == stack_pointer_rtx)
 	{
-	  rtx addr = XEXP (dest, 0);
-	  gcc_assert (!saw_unknown);
-	  switch (GET_CODE (addr))
-	    {
-	    case PRE_INC:
-	    case POST_INC:
-	      this_delta = GET_MODE_SIZE (GET_MODE (dest));
-	      break;
-	    case PRE_DEC:
-	    case POST_DEC:
-	      this_delta = -GET_MODE_SIZE (GET_MODE (dest));
-	      break;
-	    case PRE_MODIFY:
-	    case POST_MODIFY:
-	      addr = XEXP (addr, 1);
-	      gcc_assert (GET_CODE (addr) == PLUS);
-	      gcc_assert (XEXP (addr, 0) == stack_pointer_rtx);
-	      gcc_assert (CONST_INT_P (XEXP (addr, 1)));
-	      this_delta = INTVAL (XEXP (addr, 1));
-	      break;
-	    default:
-	      gcc_unreachable ();
-	    }
+	  mem = dest;
+	  gcc_checking_assert (mem_autoinc_base (SET_SRC (set))
+			       != stack_pointer_rtx);
 	}
+      else if (mem_autoinc_base (SET_SRC (set)) == stack_pointer_rtx)
+	mem = SET_SRC (set);
       else
+	return 0;
+
+      addr = XEXP (mem, 0);
+      switch (GET_CODE (addr))
+	{
+	case PRE_INC:
+	case POST_INC:
+	  return GET_MODE_SIZE (GET_MODE (mem));
+	case PRE_DEC:
+	case POST_DEC:
+	  return -GET_MODE_SIZE (GET_MODE (mem));
+	case PRE_MODIFY:
+	case POST_MODIFY:
+	  addr = XEXP (addr, 1);
+	  gcc_assert (GET_CODE (addr) == PLUS);
+	  gcc_assert (XEXP (addr, 0) == stack_pointer_rtx);
+	  gcc_assert (CONST_INT_P (XEXP (addr, 1)));
+	  return INTVAL (XEXP (addr, 1));
+	default:
+	  gcc_unreachable ();
+	}
+    }
+}
+
+int
+fixup_args_size_notes (rtx prev, rtx last, int end_args_size)
+{
+  int args_size = end_args_size;
+  bool saw_unknown = false;
+  rtx insn;
+
+  for (insn = last; insn != prev; insn = PREV_INSN (insn))
+    {
+      HOST_WIDE_INT this_delta;
+
+      if (!NONDEBUG_INSN_P (insn))
+	continue;
+
+      this_delta = find_args_size_adjust (insn);
+      if (this_delta == 0)
 	continue;
 
+      gcc_assert (!saw_unknown);
+      if (this_delta == HOST_WIDE_INT_MIN)
+	saw_unknown = true;
+
       add_reg_note (insn, REG_ARGS_SIZE, GEN_INT (args_size));
 #ifdef STACK_GROWS_DOWNWARD
       this_delta = -this_delta;
@@ -10148,6 +10168,17 @@ string_constant (tree arg, tree *ptr_offset)
 				    fold_convert (sizetype, lower_bound));
 	    }
 	}
+      else if (TREE_CODE (TREE_OPERAND (arg, 0)) == MEM_REF)
+	{
+	  array = TREE_OPERAND (TREE_OPERAND (arg, 0), 0);
+	  offset = TREE_OPERAND (TREE_OPERAND (arg, 0), 1);
+	  if (TREE_CODE (array) != ADDR_EXPR)
+	    return 0;
+	  array = TREE_OPERAND (array, 0);
+	  if (TREE_CODE (array) != STRING_CST
+	      && TREE_CODE (array) != VAR_DECL)
+	    return 0;
+	}
       else
 	return 0;
     }
diff --git a/gcc/final.c b/gcc/final.c
index 4d7e629a7dc..328599c42c4 100644
--- a/gcc/final.c
+++ b/gcc/final.c
@@ -2492,7 +2492,7 @@ final_scan_insn (rtx insn, FILE *file, int optimize_p ATTRIBUTE_UNUSED,
 	        delete_insn (insn);
 		break;
 	      }
-	    else if (GET_CODE (SET_SRC (body)) == RETURN)
+	    else if (ANY_RETURN_P (SET_SRC (body)))
 	      /* Replace (set (pc) (return)) with (return).  */
 	      PATTERN (insn) = body = SET_SRC (body);
 
diff --git a/gcc/fold-const.c b/gcc/fold-const.c
index 01c5570e28b..5807a5533ba 100644
--- a/gcc/fold-const.c
+++ b/gcc/fold-const.c
@@ -1867,9 +1867,6 @@ fold_convert_loc (location_t loc, tree type, tree arg)
       || TREE_CODE (orig) == ERROR_MARK)
     return error_mark_node;
 
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (orig))
-    return fold_build1_loc (loc, NOP_EXPR, type, arg);
-
   switch (TREE_CODE (type))
     {
     case POINTER_TYPE:
@@ -2017,6 +2014,8 @@ fold_convert_loc (location_t loc, tree type, tree arg)
       return fold_build1_loc (loc, NOP_EXPR, type, tem);
 
     default:
+      if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (orig))
+	return fold_build1_loc (loc, NOP_EXPR, type, arg);
       gcc_unreachable ();
     }
  fold_convert_exit:
@@ -5929,17 +5928,22 @@ extract_muldiv_1 (tree t, tree c, enum tree_code code, tree wide_type,
 }
 
 /* Return a node which has the indicated constant VALUE (either 0 or
-   1), and is of the indicated TYPE.  */
+   1 for scalars or {-1,-1,..} or {0,0,...} for vectors),
+   and is of the indicated TYPE.  */
 
 tree
-constant_boolean_node (int value, tree type)
+constant_boolean_node (bool value, tree type)
 {
   if (type == integer_type_node)
     return value ? integer_one_node : integer_zero_node;
   else if (type == boolean_type_node)
     return value ? boolean_true_node : boolean_false_node;
+  else if (TREE_CODE (type) == VECTOR_TYPE)
+    return build_vector_from_val (type,
+				  build_int_cst (TREE_TYPE (type),
+						 value ? -1 : 0));
   else
-    return build_int_cst (type, value);
+    return fold_convert (type, value ? integer_one_node : integer_zero_node);
 }
 
 
@@ -7668,8 +7672,8 @@ fold_unary_loc (location_t loc, enum tree_code code, tree type, tree op0)
 			       TREE_OPERAND (op0, 1));
 	  else if (!INTEGRAL_TYPE_P (type))
 	    return build3_loc (loc, COND_EXPR, type, op0,
-			       fold_convert (type, boolean_true_node),
-			       fold_convert (type, boolean_false_node));
+			       constant_boolean_node (true, type),
+			       constant_boolean_node (false, type));
 	}
 
       /* Handle cases of two conversions in a row.  */
@@ -13202,8 +13206,7 @@ fold_binary_loc (location_t loc,
 	return build_complex (type, arg0, arg1);
       if (TREE_CODE (arg0) == REALPART_EXPR
 	  && TREE_CODE (arg1) == IMAGPART_EXPR
-	  && (TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (arg0, 0)))
-	      == TYPE_MAIN_VARIANT (type))
+	  && TREE_TYPE (TREE_OPERAND (arg0, 0)) == type
 	  && operand_equal_p (TREE_OPERAND (arg0, 0),
 			      TREE_OPERAND (arg1, 0), 0))
 	return omit_one_operand_loc (loc, type, TREE_OPERAND (arg0, 0),
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5cab38d5c85..d47e4115582 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,36 @@
+2011-08-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/50225
+	* trans-decl.c (gfc_generate_function_code): Nullify polymorphic
+	allocatable function results.
+
+2011-08-29  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-decl.c (generate_coarray_sym_init): Use
+	GFC_CAF_COARRAY_STATIC for static coarrays.
+
+2011-08-28  Dodji Seketeli  <dodji@redhat.com>
+
+	* scanner.c (load_file): Don't abuse LC_RENAME reason while
+	(indirectly) calling linemap_add.
+
+2011-08-26  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-decl.c (get_proc_pointer_decl): Set DECL_TLS_MODEL
+	if threadprivate.
+	* symbol.c (check_conflict): Allow threadprivate attribute with
+	FL_PROCEDURE if proc_pointer.
+
+2011-08-25  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/50050
+	* expr.c (gfc_free_shape): Do nothing if shape is NULL.
+	(free_expr0): Remove redundant NULL shape check.
+	* resolve.c (check_host_association): Ditto.
+	* trans-expr.c (gfc_trans_subarray_assign): Assert that shape is
+	non-NULL.
+	* trans-io.c (transfer_array_component): Ditto.
+
 2011-08-25  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-array.c (gfc_conv_descriptor_token): Add assert.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b050b116ca5..3c09a2a99c4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -409,6 +409,9 @@ gfc_clear_shape (mpz_t *shape, int rank)
 void
 gfc_free_shape (mpz_t **shape, int rank)
 {
+  if (*shape == NULL)
+    return;
+
   gfc_clear_shape (*shape, rank);
   free (*shape);
   *shape = NULL;
@@ -490,8 +493,7 @@ free_expr0 (gfc_expr *e)
     }
 
   /* Free a shape array.  */
-  if (e->shape != NULL)
-    gfc_free_shape (&e->shape, e->rank);
+  gfc_free_shape (&e->shape, e->rank);
 
   gfc_free_ref_list (e->ref);
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e3427230c88..436c16045cb 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5198,8 +5198,7 @@ check_host_association (gfc_expr *e)
 	      && sym->attr.contained)
 	{
 	  /* Clear the shape, since it might not be valid.  */
-	  if (e->shape != NULL)
-	    gfc_free_shape (&e->shape, e->rank);
+	  gfc_free_shape (&e->shape, e->rank);
 
 	  /* Give the expression the right symtree!  */
 	  gfc_find_sym_tree (e->symtree->name, NULL, 1, &st);
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 0c127d49e02..120d55022b8 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -1887,6 +1887,11 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
   int len, line_len;
   bool first_line;
   const char *filename;
+  /* If realfilename and displayedname are different and non-null then
+     surely realfilename is the preprocessed form of
+     displayedname.  */
+  bool preprocessed_p = (realfilename && displayedname
+			 && strcmp (realfilename, displayedname));
 
   filename = displayedname ? displayedname : realfilename;
 
@@ -1925,9 +1930,24 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
 	}
     }
 
-  /* Load the file.  */
+  /* Load the file.
 
-  f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
+     A "non-initial" file means a file that is being included.  In
+     that case we are creating an LC_ENTER map.
+
+     An "initial" file means a main file; one that is not included.
+     That file has already got at least one (surely more) line map(s)
+     created by gfc_init.  So the subsequent map created in that case
+     must have LC_RENAME reason.
+
+     This latter case is not true for a preprocessed file.  In that
+     case, although the file is "initial", the line maps created by
+     gfc_init was used during the preprocessing of the file.  Now that
+     the preprocessing is over and we are being fed the result of that
+     preprocessing, we need to create a brand new line map for the
+     preprocessed file, so the reason is going to be LC_ENTER.  */
+
+  f = get_file (filename, (initial && !preprocessed_p) ? LC_RENAME : LC_ENTER);
   if (!initial)
     add_file_change (f->filename, f->inclusion_line);
   current_file = f;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 126a52b9e7e..ce4ab3d1c38 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -673,7 +673,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
 	  conf2 (codimension);
 	  conf2 (dimension);
 	  conf2 (function);
-	  conf2 (threadprivate);
+	  if (!attr->proc_pointer)
+	    conf2 (threadprivate);
 	}
 
       if (!attr->proc_pointer)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1059a42f8ab..44363c298ae 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1534,6 +1534,11 @@ get_proc_pointer_decl (gfc_symbol *sym)
 						  false, true);
     }
 
+  /* Handle threadprivate procedure pointers.  */
+  if (sym->attr.threadprivate
+      && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
+    DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
+
   attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
   decl_attributes (&decl, attributes, 0);
 
@@ -4236,7 +4241,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
 
   tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
 			     build_int_cst (integer_type_node,
-					    GFC_CAF_COARRAY_ALLOC), /* type.  */
+					    GFC_CAF_COARRAY_STATIC), /* type.  */
 			     token, null_pointer_node, /* token, stat.  */
 			     null_pointer_node, /* errgmsg, errmsg_len.  */
 			     build_int_cst (integer_type_node, 0));
@@ -5210,17 +5215,25 @@ gfc_generate_function_code (gfc_namespace * ns)
     {
       tree result = get_proc_result (sym);
 
-      if (result != NULL_TREE
-	    && sym->attr.function
-	    && !sym->attr.pointer)
+      if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
 	{
 	  if (sym->attr.allocatable && sym->attr.dimension == 0
 	      && sym->result == sym)
 	    gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result),
 							 null_pointer_node));
+	  else if (sym->ts.type == BT_CLASS
+		   && CLASS_DATA (sym)->attr.allocatable
+		   && sym->attr.dimension == 0 && sym->result == sym)
+	    {
+	      tmp = CLASS_DATA (sym)->backend_decl;
+	      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+				     TREE_TYPE (tmp), result, tmp, NULL_TREE);
+	      gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
+							null_pointer_node));
+	    }
 	  else if (sym->ts.type == BT_DERIVED
-	      && sym->ts.u.derived->attr.alloc_comp
-	      && !sym->attr.allocatable)
+		   && sym->ts.u.derived->attr.alloc_comp
+		   && !sym->attr.allocatable)
 	    {
 	      rank = sym->as ? sym->as->rank : 0;
 	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 628930a340d..ea65c022cf5 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4428,6 +4428,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
   gfc_add_block_to_block (&block, &loop.pre);
   gfc_add_block_to_block (&block, &loop.post);
 
+  gcc_assert (lss->shape != NULL);
   gfc_free_shape (&lss->shape, cm->as->rank);
   gfc_cleanup_loop (&loop);
 
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 2ae34d8f25a..931565d72fe 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1999,6 +1999,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where)
   gfc_add_block_to_block (&block, &loop.pre);
   gfc_add_block_to_block (&block, &loop.post);
 
+  gcc_assert (ss->shape != NULL);
   gfc_free_shape (&ss->shape, cm->as->rank);
   gfc_cleanup_loop (&loop);
 
diff --git a/gcc/function.c b/gcc/function.c
index c94680c76b7..27fe70328c6 100644
--- a/gcc/function.c
+++ b/gcc/function.c
@@ -5306,7 +5306,11 @@ static void
 emit_return_into_block (basic_block bb)
 {
   rtx jump = emit_jump_insn_after (gen_return (), BB_END (bb));
-  JUMP_LABEL (jump) = ret_rtx;
+  rtx pat = PATTERN (jump);
+  if (GET_CODE (pat) == PARALLEL)
+    pat = XVECEXP (pat, 0, 0);
+  gcc_assert (ANY_RETURN_P (pat));
+  JUMP_LABEL (jump) = pat;
 }
 #endif /* HAVE_return */
 
diff --git a/gcc/genemit.c b/gcc/genemit.c
index ccad725d943..662d8ca59b3 100644
--- a/gcc/genemit.c
+++ b/gcc/genemit.c
@@ -169,6 +169,9 @@ gen_exp (rtx x, enum rtx_code subroutine_type, char *used)
     case RETURN:
       printf ("ret_rtx");
       return;
+    case SIMPLE_RETURN:
+      printf ("simple_return_rtx");
+      return;
     case CLOBBER:
       if (REG_P (XEXP (x, 0)))
 	{
@@ -489,8 +492,8 @@ gen_expand (rtx expand)
 	  || (GET_CODE (next) == PARALLEL
 	      && ((GET_CODE (XVECEXP (next, 0, 0)) == SET
 		   && GET_CODE (SET_DEST (XVECEXP (next, 0, 0))) == PC)
-		  || GET_CODE (XVECEXP (next, 0, 0)) == RETURN))
-	  || GET_CODE (next) == RETURN)
+		  || ANY_RETURN_P (XVECEXP (next, 0, 0))))
+	  || ANY_RETURN_P (next))
 	printf ("  emit_jump_insn (");
       else if ((GET_CODE (next) == SET && GET_CODE (SET_SRC (next)) == CALL)
 	       || GET_CODE (next) == CALL
@@ -607,7 +610,7 @@ gen_split (rtx split)
 	  || (GET_CODE (next) == PARALLEL
 	      && GET_CODE (XVECEXP (next, 0, 0)) == SET
 	      && GET_CODE (SET_DEST (XVECEXP (next, 0, 0))) == PC)
-	  || GET_CODE (next) == RETURN)
+	  || ANY_RETURN_P (next))
 	printf ("  emit_jump_insn (");
       else if ((GET_CODE (next) == SET && GET_CODE (SET_SRC (next)) == CALL)
 	       || GET_CODE (next) == CALL
diff --git a/gcc/gengenrtl.c b/gcc/gengenrtl.c
index a61995876ba..67688aca98c 100644
--- a/gcc/gengenrtl.c
+++ b/gcc/gengenrtl.c
@@ -131,6 +131,7 @@ special_rtx (int idx)
 	  || strcmp (defs[idx].enumname, "PC") == 0
 	  || strcmp (defs[idx].enumname, "CC0") == 0
 	  || strcmp (defs[idx].enumname, "RETURN") == 0
+	  || strcmp (defs[idx].enumname, "SIMPLE_RETURN") == 0
 	  || strcmp (defs[idx].enumname, "CONST_VECTOR") == 0);
 }
 
diff --git a/gcc/gimple-fold.c b/gcc/gimple-fold.c
index 12b2d4e4a4b..19f34000654 100644
--- a/gcc/gimple-fold.c
+++ b/gcc/gimple-fold.c
@@ -2987,8 +2987,9 @@ gimple_fold_stmt_to_constant_1 (gimple stmt, tree (*valueize) (tree))
 		  && TREE_CODE (op1) == INTEGER_CST)
 		{
 		  tree off = fold_convert (ptr_type_node, op1);
-		  return build_fold_addr_expr
-			   (fold_build2 (MEM_REF,
+		  return build_fold_addr_expr_loc
+			   (loc,
+			    fold_build2 (MEM_REF,
 					 TREE_TYPE (TREE_TYPE (op0)),
 					 unshare_expr (op0), off));
 		}
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 85033a99865..a22b5d3121f 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -7349,7 +7349,10 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
 		{
 		  tree type = TREE_TYPE (TREE_OPERAND (*expr_p, 1));
 
-		  if (!AGGREGATE_TYPE_P (type))
+		  /* Vector comparisons need no boolification.  */
+		  if (TREE_CODE (type) == VECTOR_TYPE)
+		    goto expr_2;
+		  else if (!AGGREGATE_TYPE_P (type))
 		    {
 		      tree org_type = TREE_TYPE (*expr_p);
 		      *expr_p = gimple_boolify (*expr_p);
diff --git a/gcc/go/gofrontend/expressions.cc b/gcc/go/gofrontend/expressions.cc
index a082012ce41..8957acb0c8a 100644
--- a/gcc/go/gofrontend/expressions.cc
+++ b/gcc/go/gofrontend/expressions.cc
@@ -3845,7 +3845,7 @@ Unsafe_type_conversion_expression::do_get_tree(Translate_context* context)
     go_assert((et->points_to() != NULL
 		&& et->points_to()->channel_type() != NULL)
 	       || et->is_nil_type());
-  else if (t->is_unsafe_pointer_type())
+  else if (t->points_to() != NULL)
     go_assert(et->points_to() != NULL || et->is_nil_type());
   else if (et->is_unsafe_pointer_type())
     go_assert(t->points_to() != NULL);
@@ -3908,7 +3908,7 @@ class Unary_expression : public Expression
  public:
   Unary_expression(Operator op, Expression* expr, source_location location)
     : Expression(EXPRESSION_UNARY, location),
-      op_(op), escapes_(true), expr_(expr)
+      op_(op), escapes_(true), create_temp_(false), expr_(expr)
   { }
 
   // Return the operator.
@@ -3929,6 +3929,15 @@ class Unary_expression : public Expression
     this->escapes_ = false;
   }
 
+  // Record that this is an address expression which should create a
+  // temporary variable if necessary.  This is used for method calls.
+  void
+  set_create_temp()
+  {
+    go_assert(this->op_ == OPERATOR_AND);
+    this->create_temp_ = true;
+  }
+
   // Apply unary opcode OP to UVAL, setting VAL.  Return true if this
   // could be done, false if not.
   static bool
@@ -4004,6 +4013,9 @@ class Unary_expression : public Expression
   // Normally true.  False if this is an address expression which does
   // not escape the current function.
   bool escapes_;
+  // True if this is an address expression which should create a
+  // temporary variable if necessary.
+  bool create_temp_;
   // The operand.
   Expression* expr_;
 };
@@ -4428,7 +4440,10 @@ Unary_expression::do_check_types(Gogo*)
 
     case OPERATOR_AND:
       if (!this->expr_->is_addressable())
-	this->report_error(_("invalid operand for unary %<&%>"));
+	{
+	  if (!this->create_temp_)
+	    this->report_error(_("invalid operand for unary %<&%>"));
+	}
       else
 	this->expr_->address_taken(this->escapes_);
       break;
@@ -4486,12 +4501,15 @@ Unary_expression::do_get_tree(Translate_context* context)
       return fold_build1_loc(loc, BIT_NOT_EXPR, TREE_TYPE(expr), expr);
 
     case OPERATOR_AND:
-      // We should not see a non-constant constructor here; cases
-      // where we would see one should have been moved onto the heap
-      // at parse time.  Taking the address of a nonconstant
-      // constructor will not do what the programmer expects.
-      go_assert(TREE_CODE(expr) != CONSTRUCTOR || TREE_CONSTANT(expr));
-      go_assert(TREE_CODE(expr) != ADDR_EXPR);
+      if (!this->create_temp_)
+	{
+	  // We should not see a non-constant constructor here; cases
+	  // where we would see one should have been moved onto the
+	  // heap at parse time.  Taking the address of a nonconstant
+	  // constructor will not do what the programmer expects.
+	  go_assert(TREE_CODE(expr) != CONSTRUCTOR || TREE_CONSTANT(expr));
+	  go_assert(TREE_CODE(expr) != ADDR_EXPR);
+	}
 
       // Build a decl for a constant constructor.
       if (TREE_CODE(expr) == CONSTRUCTOR && TREE_CONSTANT(expr))
@@ -4510,6 +4528,22 @@ Unary_expression::do_get_tree(Translate_context* context)
 	  expr = decl;
 	}
 
+      if (this->create_temp_
+	  && !TREE_ADDRESSABLE(TREE_TYPE(expr))
+	  && !DECL_P(expr)
+	  && TREE_CODE(expr) != INDIRECT_REF
+	  && TREE_CODE(expr) != COMPONENT_REF)
+	{
+	  tree tmp = create_tmp_var(TREE_TYPE(expr), get_name(expr));
+	  DECL_IGNORED_P(tmp) = 1;
+	  DECL_INITIAL(tmp) = expr;
+	  TREE_ADDRESSABLE(tmp) = 1;
+	  return build2_loc(loc, COMPOUND_EXPR,
+			    build_pointer_type(TREE_TYPE(expr)),
+			    build1_loc(loc, DECL_EXPR, void_type_node, tmp),
+			    build_fold_addr_expr_loc(loc, tmp));
+	}
+
       return build_fold_addr_expr_loc(loc, expr);
 
     case OPERATOR_MULT:
@@ -6798,9 +6832,7 @@ Expression::comparison_tree(Translate_context* context, Operator op,
 int
 Bound_method_expression::do_traverse(Traverse* traverse)
 {
-  if (Expression::traverse(&this->expr_, traverse) == TRAVERSE_EXIT)
-    return TRAVERSE_EXIT;
-  return Expression::traverse(&this->method_, traverse);
+  return Expression::traverse(&this->expr_, traverse);
 }
 
 // Return the type of a bound method expression.  The type of this
@@ -6811,7 +6843,12 @@ Bound_method_expression::do_traverse(Traverse* traverse)
 Type*
 Bound_method_expression::do_type()
 {
-  return this->method_->type();
+  if (this->method_->is_function())
+    return this->method_->func_value()->type();
+  else if (this->method_->is_function_declaration())
+    return this->method_->func_declaration_value()->type();
+  else
+    return Type::make_error_type();
 }
 
 // Determine the types of a method expression.
@@ -6819,9 +6856,7 @@ Bound_method_expression::do_type()
 void
 Bound_method_expression::do_determine_type(const Type_context*)
 {
-  this->method_->determine_type_no_context();
-  Type* mtype = this->method_->type();
-  Function_type* fntype = mtype == NULL ? NULL : mtype->function_type();
+  Function_type* fntype = this->type()->function_type();
   if (fntype == NULL || !fntype->is_method())
     this->expr_->determine_type_no_context();
   else
@@ -6836,14 +6871,12 @@ Bound_method_expression::do_determine_type(const Type_context*)
 void
 Bound_method_expression::do_check_types(Gogo*)
 {
-  Type* type = this->method_->type()->deref();
-  if (type == NULL
-      || type->function_type() == NULL
-      || !type->function_type()->is_method())
+  if (!this->method_->is_function()
+      && !this->method_->is_function_declaration())
     this->report_error(_("object is not a method"));
   else
     {
-      Type* rtype = type->function_type()->receiver()->type()->deref();
+      Type* rtype = this->type()->function_type()->receiver()->type()->deref();
       Type* etype = (this->expr_type_ != NULL
 		     ? this->expr_type_
 		     : this->expr_->type());
@@ -6881,14 +6914,13 @@ Bound_method_expression::do_dump_expression(Ast_dump_context* ast_dump_context)
       ast_dump_context->ostream() << ")";
     }
     
-  ast_dump_context->ostream() << ".";
-  ast_dump_context->dump_expression(method_);
+  ast_dump_context->ostream() << "." << this->method_->name();
 }
 
 // Make a method expression.
 
 Bound_method_expression*
-Expression::make_bound_method(Expression* expr, Expression* method,
+Expression::make_bound_method(Expression* expr, Named_object* method,
 			      source_location location)
 {
   return new Bound_method_expression(expr, method, location);
@@ -7225,7 +7257,7 @@ Builtin_call_expression::do_lower(Gogo* gogo, Named_object* function,
 	  this->set_is_error();
 	  return this;
 	}
-      return this->lower_varargs(gogo, function, inserter, slice_type, 2);
+      this->lower_varargs(gogo, function, inserter, slice_type, 2);
     }
 
   return this;
@@ -8807,12 +8839,14 @@ Expression*
 Call_expression::do_lower(Gogo* gogo, Named_object* function,
 			  Statement_inserter* inserter, int)
 {
+  source_location loc = this->location();
+
   // A type cast can look like a function call.
   if (this->fn_->is_type_expression()
       && this->args_ != NULL
       && this->args_->size() == 1)
     return Expression::make_cast(this->fn_->type(), this->args_->front(),
-				 this->location());
+				 loc);
 
   // Recognize a call to a builtin function.
   Func_expression* fne = this->fn_->func_expression();
@@ -8820,7 +8854,7 @@ Call_expression::do_lower(Gogo* gogo, Named_object* function,
       && fne->named_object()->is_function_declaration()
       && fne->named_object()->func_declaration_value()->type()->is_builtin())
     return new Builtin_call_expression(gogo, this->fn_, this->args_,
-				       this->is_varargs_, this->location());
+				       this->is_varargs_, loc);
 
   // Handle an argument which is a call to a function which returns
   // multiple results.
@@ -8864,8 +8898,7 @@ Call_expression::do_lower(Gogo* gogo, Named_object* function,
 	   ++p)
 	{
 	  Temporary_statement* temp = Statement::make_temporary(p->type(),
-								NULL,
-								p->location());
+								NULL, loc);
 	  inserter->insert(temp);
 	  temps->push_back(temp);
 	}
@@ -8881,8 +8914,58 @@ Call_expression::do_lower(Gogo* gogo, Named_object* function,
       const Typed_identifier_list* parameters = fntype->parameters();
       go_assert(parameters != NULL && !parameters->empty());
       Type* varargs_type = parameters->back().type();
-      return this->lower_varargs(gogo, function, inserter, varargs_type,
-				 parameters->size());
+      this->lower_varargs(gogo, function, inserter, varargs_type,
+			  parameters->size());
+    }
+
+  // If this is call to a method, call the method directly passing the
+  // object as the first parameter.
+  Bound_method_expression* bme = this->fn_->bound_method_expression();
+  if (bme != NULL)
+    {
+      Named_object* method = bme->method();
+      Expression* first_arg = bme->first_argument();
+
+      // We always pass a pointer when calling a method.
+      if (first_arg->type()->points_to() == NULL
+	  && !first_arg->type()->is_error())
+	{
+	  first_arg = Expression::make_unary(OPERATOR_AND, first_arg, loc);
+	  // We may need to create a temporary variable so that we can
+	  // take the address.  We can't do that here because it will
+	  // mess up the order of evaluation.
+	  Unary_expression* ue = static_cast<Unary_expression*>(first_arg);
+	  ue->set_create_temp();
+	}
+
+      // If we are calling a method which was inherited from an
+      // embedded struct, and the method did not get a stub, then the
+      // first type may be wrong.
+      Type* fatype = bme->first_argument_type();
+      if (fatype != NULL)
+	{
+	  if (fatype->points_to() == NULL)
+	    fatype = Type::make_pointer_type(fatype);
+	  first_arg = Expression::make_unsafe_cast(fatype, first_arg, loc);
+	}
+
+      Expression_list* new_args = new Expression_list();
+      new_args->push_back(first_arg);
+      if (this->args_ != NULL)
+	{
+	  for (Expression_list::const_iterator p = this->args_->begin();
+	       p != this->args_->end();
+	       ++p)
+	    new_args->push_back(*p);
+	}
+
+      // We have to change in place because this structure may be
+      // referenced by Call_result_expressions.  We can't delete the
+      // old arguments, because we may be traversing them up in some
+      // caller.  FIXME.
+      this->args_ = new_args;
+      this->fn_ = Expression::make_func_reference(method, NULL,
+						  bme->location());
     }
 
   return this;
@@ -8895,13 +8978,13 @@ Call_expression::do_lower(Gogo* gogo, Named_object* function,
 // calling; the last of these parameters will be the varargs
 // parameter.
 
-Expression*
+void
 Call_expression::lower_varargs(Gogo* gogo, Named_object* function,
 			       Statement_inserter* inserter,
 			       Type* varargs_type, size_t param_count)
 {
   if (this->varargs_are_lowered_)
-    return this;
+    return;
 
   source_location loc = this->location();
 
@@ -8912,7 +8995,7 @@ Call_expression::lower_varargs(Gogo* gogo, Named_object* function,
   if (arg_count < param_count - 1)
     {
       // Not enough arguments; will be caught in check_types.
-      return this;
+      return;
     }
 
   Expression_list* old_args = this->args_;
@@ -8944,7 +9027,7 @@ Call_expression::lower_varargs(Gogo* gogo, Named_object* function,
       else if (this->is_varargs_)
 	{
 	  this->report_error(_("too many arguments"));
-	  return this;
+	  return;
 	}
       else
 	{
@@ -8962,6 +9045,7 @@ Call_expression::lower_varargs(Gogo* gogo, Named_object* function,
 	    }
 	  Expression* val =
 	    Expression::make_slice_composite_literal(varargs_type, vals, loc);
+	  gogo->lower_expression(function, inserter, &val);
 	  new_args->push_back(val);
 	}
     }
@@ -8975,12 +9059,6 @@ Call_expression::lower_varargs(Gogo* gogo, Named_object* function,
   // Builtin_call_expression which refer to them.  FIXME.
   this->args_ = new_args;
   this->varargs_are_lowered_ = true;
-
-  // Lower all the new subexpressions.
-  Expression* ret = this;
-  gogo->lower_expression(function, inserter, &ret);
-  go_assert(ret == this);
-  return ret;
 }
 
 // Get the function type.  This can return NULL in error cases.
@@ -9104,10 +9182,28 @@ Call_expression::do_determine_type(const Type_context*)
       Typed_identifier_list::const_iterator pt;
       if (parameters != NULL)
 	pt = parameters->begin();
+      bool first = true;
       for (Expression_list::const_iterator pa = this->args_->begin();
 	   pa != this->args_->end();
 	   ++pa)
 	{
+	  if (first)
+	    {
+	      first = false;
+	      // If this is a method, the first argument is the
+	      // receiver.
+	      if (fntype != NULL && fntype->is_method())
+		{
+		  Type* rtype = fntype->receiver()->type();
+		  // The receiver is always passed as a pointer.
+		  if (rtype->points_to() == NULL)
+		    rtype = Type::make_pointer_type(rtype);
+		  Type_context subcontext(rtype, false);
+		  (*pa)->determine_type(&subcontext);
+		  continue;
+		}
+	    }
+
 	  if (parameters != NULL && pt != parameters->end())
 	    {
 	      Type_context subcontext(pt->type(), false);
@@ -9174,35 +9270,28 @@ Call_expression::do_check_types(Gogo*)
       return;
     }
 
-  if (fntype->is_method())
+  bool is_method = fntype->is_method();
+  if (is_method)
     {
-      // We don't support pointers to methods, so the function has to
-      // be a bound method expression.
-      Bound_method_expression* bme = this->fn_->bound_method_expression();
-      if (bme == NULL)
-	{
-	  this->report_error(_("method call without object"));
-	  return;
-	}
-      Type* first_arg_type = bme->first_argument()->type();
-      if (first_arg_type->points_to() == NULL)
+      go_assert(this->args_ != NULL && !this->args_->empty());
+      Type* rtype = fntype->receiver()->type();
+      Expression* first_arg = this->args_->front();
+      // The language permits copying hidden fields for a method
+      // receiver.  We dereference the values since receivers are
+      // always passed as pointers.
+      std::string reason;
+      if (!Type::are_assignable_hidden_ok(rtype->deref(),
+					  first_arg->type()->deref(),
+					  &reason))
 	{
-	  // When passing a value, we need to check that we are
-	  // permitted to copy it.  The language permits copying
-	  // hidden fields for a method receiver.
-	  std::string reason;
-	  if (!Type::are_assignable_hidden_ok(fntype->receiver()->type(),
-					      first_arg_type, &reason))
+	  if (reason.empty())
+	    this->report_error(_("incompatible type for receiver"));
+	  else
 	    {
-	      if (reason.empty())
-		this->report_error(_("incompatible type for receiver"));
-	      else
-		{
-		  error_at(this->location(),
-			   "incompatible type for receiver (%s)",
-			   reason.c_str());
-		  this->set_is_error();
-		}
+	      error_at(this->location(),
+		       "incompatible type for receiver (%s)",
+		       reason.c_str());
+	      this->set_is_error();
 	    }
 	}
     }
@@ -9217,25 +9306,30 @@ Call_expression::do_check_types(Gogo*)
 	this->report_error(_("not enough arguments"));
     }
   else if (parameters == NULL)
-    this->report_error(_("too many arguments"));
+    {
+      if (!is_method || this->args_->size() > 1)
+	this->report_error(_("too many arguments"));
+    }
   else
     {
       int i = 0;
-      Typed_identifier_list::const_iterator pt = parameters->begin();
-      for (Expression_list::const_iterator pa = this->args_->begin();
-	   pa != this->args_->end();
-	   ++pa, ++pt, ++i)
-	{
-	  if (pt == parameters->end())
+      Expression_list::const_iterator pa = this->args_->begin();
+      if (is_method)
+	++pa;
+      for (Typed_identifier_list::const_iterator pt = parameters->begin();
+	   pt != parameters->end();
+	   ++pt, ++pa, ++i)
+	{
+	  if (pa == this->args_->end())
 	    {
-	      this->report_error(_("too many arguments"));
+	      this->report_error(_("not enough arguments"));
 	      return;
 	    }
 	  this->check_argument_type(i + 1, pt->type(), (*pa)->type(),
 				    (*pa)->location(), false);
 	}
-      if (pt != parameters->end())
-	this->report_error(_("not enough arguments"));
+      if (pa != this->args_->end())
+	this->report_error(_("too many arguments"));
     }
 }
 
@@ -9249,65 +9343,6 @@ Call_expression::do_must_eval_in_order() const
   return this->result_count() > 0;
 }
 
-// Get the function and the first argument to use when calling a bound
-// method.
-
-tree
-Call_expression::bound_method_function(Translate_context* context,
-				       Bound_method_expression* bound_method,
-				       tree* first_arg_ptr)
-{
-  Expression* first_argument = bound_method->first_argument();
-  tree first_arg = first_argument->get_tree(context);
-  if (first_arg == error_mark_node)
-    return error_mark_node;
-
-  // We always pass a pointer to the first argument when calling a
-  // method.
-  if (first_argument->type()->points_to() == NULL)
-    {
-      tree pointer_to_arg_type = build_pointer_type(TREE_TYPE(first_arg));
-      if (TREE_ADDRESSABLE(TREE_TYPE(first_arg))
-	  || DECL_P(first_arg)
-	  || TREE_CODE(first_arg) == INDIRECT_REF
-	  || TREE_CODE(first_arg) == COMPONENT_REF)
-	{
-	  first_arg = build_fold_addr_expr(first_arg);
-	  if (DECL_P(first_arg))
-	    TREE_ADDRESSABLE(first_arg) = 1;
-	}
-      else
-	{
-	  tree tmp = create_tmp_var(TREE_TYPE(first_arg),
-				    get_name(first_arg));
-	  DECL_IGNORED_P(tmp) = 0;
-	  DECL_INITIAL(tmp) = first_arg;
-	  first_arg = build2(COMPOUND_EXPR, pointer_to_arg_type,
-			     build1(DECL_EXPR, void_type_node, tmp),
-			     build_fold_addr_expr(tmp));
-	  TREE_ADDRESSABLE(tmp) = 1;
-	}
-      if (first_arg == error_mark_node)
-	return error_mark_node;
-    }
-
-  Type* fatype = bound_method->first_argument_type();
-  if (fatype != NULL)
-    {
-      if (fatype->points_to() == NULL)
-	fatype = Type::make_pointer_type(fatype);
-      Btype* bfatype = fatype->get_backend(context->gogo());
-      first_arg = fold_convert(type_to_tree(bfatype), first_arg);
-      if (first_arg == error_mark_node
-	  || TREE_TYPE(first_arg) == error_mark_node)
-	return error_mark_node;
-    }
-
-  *first_arg_ptr = first_arg;
-
-  return bound_method->method()->get_tree(context);
-}
-
 // Get the function and the first argument to use when calling an
 // interface method.
 
@@ -9347,35 +9382,46 @@ Call_expression::do_get_tree(Translate_context* context)
   source_location location = this->location();
 
   Func_expression* func = this->fn_->func_expression();
-  Bound_method_expression* bound_method = this->fn_->bound_method_expression();
   Interface_field_reference_expression* interface_method =
     this->fn_->interface_field_reference_expression();
   const bool has_closure = func != NULL && func->closure() != NULL;
-  const bool is_method = bound_method != NULL || interface_method != NULL;
-  go_assert(!fntype->is_method() || is_method);
+  const bool is_interface_method = interface_method != NULL;
 
   int nargs;
   tree* args;
   if (this->args_ == NULL || this->args_->empty())
     {
-      nargs = is_method ? 1 : 0;
+      nargs = is_interface_method ? 1 : 0;
       args = nargs == 0 ? NULL : new tree[nargs];
     }
+  else if (fntype->parameters() == NULL || fntype->parameters()->empty())
+    {
+      // Passing a receiver parameter.
+      go_assert(!is_interface_method
+		&& fntype->is_method()
+		&& this->args_->size() == 1);
+      nargs = 1;
+      args = new tree[nargs];
+      args[0] = this->args_->front()->get_tree(context);
+    }
   else
     {
       const Typed_identifier_list* params = fntype->parameters();
-      go_assert(params != NULL);
 
       nargs = this->args_->size();
-      int i = is_method ? 1 : 0;
+      int i = is_interface_method ? 1 : 0;
       nargs += i;
       args = new tree[nargs];
 
       Typed_identifier_list::const_iterator pp = params->begin();
-      Expression_list::const_iterator pe;
-      for (pe = this->args_->begin();
-	   pe != this->args_->end();
-	   ++pe, ++pp, ++i)
+      Expression_list::const_iterator pe = this->args_->begin();
+      if (!is_interface_method && fntype->is_method())
+	{
+	  args[i] = (*pe)->get_tree(context);
+	  ++pe;
+	  ++i;
+	}
+      for (; pe != this->args_->end(); ++pe, ++pp, ++i)
 	{
 	  go_assert(pp != params->end());
 	  tree arg_val = (*pe)->get_tree(context);
@@ -9404,14 +9450,10 @@ Call_expression::do_get_tree(Translate_context* context)
   tree fn;
   if (has_closure)
     fn = func->get_tree_without_closure(gogo);
-  else if (!is_method)
+  else if (!is_interface_method)
     fn = this->fn_->get_tree(context);
-  else if (bound_method != NULL)
-    fn = this->bound_method_function(context, bound_method, &args[0]);
-  else if (interface_method != NULL)
-    fn = this->interface_method_function(context, interface_method, &args[0]);
   else
-    go_unreachable();
+    fn = this->interface_method_function(context, interface_method, &args[0]);
 
   if (fn == error_mark_node || TREE_TYPE(fn) == error_mark_node)
     {
diff --git a/gcc/go/gofrontend/expressions.h b/gcc/go/gofrontend/expressions.h
index ec59846f2f0..bb4f23e5810 100644
--- a/gcc/go/gofrontend/expressions.h
+++ b/gcc/go/gofrontend/expressions.h
@@ -192,7 +192,7 @@ class Expression
   // Make an expression which is a method bound to its first
   // parameter.
   static Bound_method_expression*
-  make_bound_method(Expression* object, Expression* method, source_location);
+  make_bound_method(Expression* object, Named_object* method, source_location);
 
   // Make an index or slice expression.  This is a parser expression
   // which represents LEFT[START:END].  END may be NULL, meaning an
@@ -1244,6 +1244,11 @@ class Call_expression : public Expression
   is_varargs() const
   { return this->is_varargs_; }
 
+  // Note that varargs have already been lowered.
+  void
+  set_varargs_are_lowered()
+  { this->varargs_are_lowered_ = true; }
+
   // Whether this call is being deferred.
   bool
   is_deferred() const
@@ -1307,7 +1312,7 @@ class Call_expression : public Expression
   { this->args_ = args; }
 
   // Let a builtin expression lower varargs.
-  Expression*
+  void
   lower_varargs(Gogo*, Named_object* function, Statement_inserter* inserter,
 		Type* varargs_type, size_t param_count);
 
@@ -1324,9 +1329,6 @@ class Call_expression : public Expression
   check_argument_type(int, const Type*, const Type*, source_location, bool);
 
   tree
-  bound_method_function(Translate_context*, Bound_method_expression*, tree*);
-
-  tree
   interface_method_function(Translate_context*,
 			    Interface_field_reference_expression*,
 			    tree*);
@@ -1636,7 +1638,7 @@ class Map_index_expression : public Expression
 class Bound_method_expression : public Expression
 {
  public:
-  Bound_method_expression(Expression* expr, Expression* method,
+  Bound_method_expression(Expression* expr, Named_object* method,
 			  source_location location)
     : Expression(EXPRESSION_BOUND_METHOD, location),
       expr_(expr), expr_type_(NULL), method_(method)
@@ -1654,8 +1656,8 @@ class Bound_method_expression : public Expression
   first_argument_type() const
   { return this->expr_type_; }
 
-  // Return the reference to the method function.
-  Expression*
+  // Return the method function.
+  Named_object*
   method()
   { return this->method_; }
 
@@ -1680,8 +1682,7 @@ class Bound_method_expression : public Expression
   Expression*
   do_copy()
   {
-    return new Bound_method_expression(this->expr_->copy(),
-				       this->method_->copy(),
+    return new Bound_method_expression(this->expr_->copy(), this->method_,
 				       this->location());
   }
 
@@ -1699,8 +1700,8 @@ class Bound_method_expression : public Expression
   // NULL in the normal case, non-NULL when using a method from an
   // anonymous field which does not require a stub.
   Type* expr_type_;
-  // The method itself.  This is a Func_expression.
-  Expression* method_;
+  // The method itself.
+  Named_object* method_;
 };
 
 // A reference to a field in a struct.
diff --git a/gcc/go/gofrontend/gogo.cc b/gcc/go/gofrontend/gogo.cc
index 4aafe412bc5..c544eba8d2f 100644
--- a/gcc/go/gofrontend/gogo.cc
+++ b/gcc/go/gofrontend/gogo.cc
@@ -1268,6 +1268,12 @@ Lower_parse_tree::function(Named_object* no)
 int
 Lower_parse_tree::statement(Block* block, size_t* pindex, Statement* sorig)
 {
+  // Because we explicitly traverse the statement's contents
+  // ourselves, we want to skip block statements here.  There is
+  // nothing to lower in a block statement.
+  if (sorig->is_block_statement())
+    return TRAVERSE_CONTINUE;
+
   Statement_inserter hold_inserter(this->inserter_);
   this->inserter_ = Statement_inserter(block, pindex);
 
diff --git a/gcc/go/gofrontend/statements.cc b/gcc/go/gofrontend/statements.cc
index f653ef6fdb6..e6462274dff 100644
--- a/gcc/go/gofrontend/statements.cc
+++ b/gcc/go/gofrontend/statements.cc
@@ -1808,10 +1808,6 @@ Statement::make_dec_statement(Expression* expr)
 // Class Thunk_statement.  This is the base class for go and defer
 // statements.
 
-const char* const Thunk_statement::thunk_field_fn = "fn";
-
-const char* const Thunk_statement::thunk_field_receiver = "receiver";
-
 // Constructor.
 
 Thunk_statement::Thunk_statement(Statement_classification classification,
@@ -1862,8 +1858,7 @@ Thunk_statement::is_simple(Function_type* fntype) const
   // If this calls something which is not a simple function, then we
   // need a thunk.
   Expression* fn = this->call_->call_expression()->fn();
-  if (fn->bound_method_expression() != NULL
-      || fn->interface_field_reference_expression() != NULL)
+  if (fn->interface_field_reference_expression() != NULL)
     return false;
 
   return true;
@@ -1918,14 +1913,6 @@ Thunk_statement::do_check_types(Gogo*)
 	this->report_error("expected call expression");
       return;
     }
-  Function_type* fntype = ce->get_function_type();
-  if (fntype != NULL && fntype->is_method())
-    {
-      Expression* fn = ce->fn();
-      if (fn->bound_method_expression() == NULL
-	  && fn->interface_field_reference_expression() == NULL)
-	this->report_error(_("no object for method call"));
-    }
 }
 
 // The Traverse class used to find and simplify thunk statements.
@@ -1991,6 +1978,29 @@ Gogo::simplify_thunk_statements()
   this->traverse(&thunk_traverse);
 }
 
+// Return true if the thunk function is a constant, which means that
+// it does not need to be passed to the thunk routine.
+
+bool
+Thunk_statement::is_constant_function() const
+{
+  Call_expression* ce = this->call_->call_expression();
+  Function_type* fntype = ce->get_function_type();
+  if (fntype == NULL)
+    {
+      go_assert(saw_errors());
+      return false;
+    }
+  if (fntype->is_builtin())
+    return true;
+  Expression* fn = ce->fn();
+  if (fn->func_expression() != NULL)
+    return fn->func_expression()->closure() == NULL;
+  if (fn->interface_field_reference_expression() != NULL)
+    return true;
+  return false;
+}
+
 // Simplify complex thunk statements into simple ones.  A complicated
 // thunk statement is one which takes anything other than zero
 // parameters or a single pointer parameter.  We rewrite it into code
@@ -2028,17 +2038,15 @@ Thunk_statement::simplify_statement(Gogo* gogo, Named_object* function,
     return false;
 
   Expression* fn = ce->fn();
-  Bound_method_expression* bound_method = fn->bound_method_expression();
   Interface_field_reference_expression* interface_method =
     fn->interface_field_reference_expression();
-  const bool is_method = bound_method != NULL || interface_method != NULL;
 
   source_location location = this->location();
 
   std::string thunk_name = Gogo::thunk_name();
 
   // Build the thunk.
-  this->build_thunk(gogo, thunk_name, fntype);
+  this->build_thunk(gogo, thunk_name);
 
   // Generate code to call the thunk.
 
@@ -2046,38 +2054,11 @@ Thunk_statement::simplify_statement(Gogo* gogo, Named_object* function,
   // argument to the thunk.
 
   Expression_list* vals = new Expression_list();
-  if (fntype->is_builtin())
-    ;
-  else if (!is_method)
+  if (!this->is_constant_function())
     vals->push_back(fn);
-  else if (interface_method != NULL)
-    vals->push_back(interface_method->expr());
-  else if (bound_method != NULL)
-    {
-      vals->push_back(bound_method->method());
-      Expression* first_arg = bound_method->first_argument();
-
-      // We always pass a pointer when calling a method.
-      if (first_arg->type()->points_to() == NULL)
-	first_arg = Expression::make_unary(OPERATOR_AND, first_arg, location);
 
-      // If we are calling a method which was inherited from an
-      // embedded struct, and the method did not get a stub, then the
-      // first type may be wrong.
-      Type* fatype = bound_method->first_argument_type();
-      if (fatype != NULL)
-	{
-	  if (fatype->points_to() == NULL)
-	    fatype = Type::make_pointer_type(fatype);
-	  Type* unsafe = Type::make_pointer_type(Type::make_void_type());
-	  first_arg = Expression::make_cast(unsafe, first_arg, location);
-	  first_arg = Expression::make_cast(fatype, first_arg, location);
-	}
-
-      vals->push_back(first_arg);
-    }
-  else
-    go_unreachable();
+  if (interface_method != NULL)
+    vals->push_back(interface_method->expr());
 
   if (ce->args() != NULL)
     {
@@ -2152,45 +2133,33 @@ Thunk_statement::build_struct(Function_type* fntype)
   Call_expression* ce = this->call_->call_expression();
   Expression* fn = ce->fn();
 
+  if (!this->is_constant_function())
+    {
+      // The function to call.
+      fields->push_back(Struct_field(Typed_identifier("fn", fntype,
+						      location)));
+    }
+
+  // If this thunk statement calls a method on an interface, we pass
+  // the interface object to the thunk.
   Interface_field_reference_expression* interface_method =
     fn->interface_field_reference_expression();
   if (interface_method != NULL)
     {
-      // If this thunk statement calls a method on an interface, we
-      // pass the interface object to the thunk.
-      Typed_identifier tid(Thunk_statement::thunk_field_fn,
-			   interface_method->expr()->type(),
+      Typed_identifier tid("object", interface_method->expr()->type(),
 			   location);
       fields->push_back(Struct_field(tid));
     }
-  else if (!fntype->is_builtin())
-    {
-      // The function to call.
-      Typed_identifier tid(Go_statement::thunk_field_fn, fntype, location);
-      fields->push_back(Struct_field(tid));
-    }
-  else if (ce->is_recover_call())
+
+  // The predeclared recover function has no argument.  However, we
+  // add an argument when building recover thunks.  Handle that here.
+  if (ce->is_recover_call())
     {
-      // The predeclared recover function has no argument.  However,
-      // we add an argument when building recover thunks.  Handle that
-      // here.
       fields->push_back(Struct_field(Typed_identifier("can_recover",
 						      Type::lookup_bool_type(),
 						      location)));
     }
 
-  if (fn->bound_method_expression() != NULL)
-    {
-      go_assert(fntype->is_method());
-      Type* rtype = fntype->receiver()->type();
-      // We always pass the receiver as a pointer.
-      if (rtype->points_to() == NULL)
-	rtype = Type::make_pointer_type(rtype);
-      Typed_identifier tid(Thunk_statement::thunk_field_receiver, rtype,
-			   location);
-      fields->push_back(Struct_field(tid));
-    }
-
   const Expression_list* args = ce->args();
   if (args != NULL)
     {
@@ -2213,8 +2182,7 @@ Thunk_statement::build_struct(Function_type* fntype)
 // artificial, function.
 
 void
-Thunk_statement::build_thunk(Gogo* gogo, const std::string& thunk_name,
-			     Function_type* fntype)
+Thunk_statement::build_thunk(Gogo* gogo, const std::string& thunk_name)
 {
   source_location location = this->location();
 
@@ -2301,43 +2269,33 @@ Thunk_statement::build_thunk(Gogo* gogo, const std::string& thunk_name,
   thunk_parameter = Expression::make_unary(OPERATOR_MULT, thunk_parameter,
 					   location);
 
-  Bound_method_expression* bound_method = ce->fn()->bound_method_expression();
   Interface_field_reference_expression* interface_method =
     ce->fn()->interface_field_reference_expression();
 
   Expression* func_to_call;
   unsigned int next_index;
-  if (!fntype->is_builtin())
-    {
-      func_to_call = Expression::make_field_reference(thunk_parameter,
-						      0, location);
-      next_index = 1;
-    }
-  else
+  if (this->is_constant_function())
     {
-      go_assert(bound_method == NULL && interface_method == NULL);
       func_to_call = ce->fn();
       next_index = 0;
     }
-
-  if (bound_method != NULL)
+  else
     {
-      Expression* r = Expression::make_field_reference(thunk_parameter, 1,
-						       location);
-      // The main program passes in a function pointer from the
-      // interface expression, so here we can make a bound method in
-      // all cases.
-      func_to_call = Expression::make_bound_method(r, func_to_call,
-						   location);
-      next_index = 2;
+      func_to_call = Expression::make_field_reference(thunk_parameter,
+						      0, location);
+      next_index = 1;
     }
-  else if (interface_method != NULL)
+
+  if (interface_method != NULL)
     {
       // The main program passes the interface object.
+      go_assert(next_index == 0);
+      Expression* r = Expression::make_field_reference(thunk_parameter, 0,
+						       location);
       const std::string& name(interface_method->name());
-      func_to_call = Expression::make_interface_field_reference(func_to_call,
-								name,
+      func_to_call = Expression::make_interface_field_reference(r, name,
 								location);
+      next_index = 1;
     }
 
   Expression_list* call_params = new Expression_list();
@@ -2373,6 +2331,13 @@ Thunk_statement::build_thunk(Gogo* gogo, const std::string& thunk_name,
 
   Call_expression* call = Expression::make_call(func_to_call, call_params,
 						false, location);
+
+  // This call expression was already lowered before entering the
+  // thunk statement.  Don't try to lower varargs again, as that will
+  // cause confusion for, e.g., method calls which already have a
+  // receiver parameter.
+  call->set_varargs_are_lowered();
+
   Statement* call_statement = Statement::make_statement(call);
 
   gogo->add_statement(call_statement);
diff --git a/gcc/go/gofrontend/statements.h b/gcc/go/gofrontend/statements.h
index 8b5263bb820..0a87a8b733c 100644
--- a/gcc/go/gofrontend/statements.h
+++ b/gcc/go/gofrontend/statements.h
@@ -906,21 +906,17 @@ class Thunk_statement : public Statement
   bool
   is_simple(Function_type*) const;
 
+  // Return whether the thunk function is a constant.
+  bool
+  is_constant_function() const;
+
   // Build the struct to use for a complex case.
   Struct_type*
   build_struct(Function_type* fntype);
 
   // Build the thunk.
   void
-  build_thunk(Gogo*, const std::string&, Function_type* fntype);
-
-  // The field name used in the thunk structure for the function
-  // pointer.
-  static const char* const thunk_field_fn;
-
-  // The field name used in the thunk structure for the receiver, if
-  // there is one.
-  static const char* const thunk_field_receiver;
+  build_thunk(Gogo*, const std::string&);
 
   // Set the name to use for thunk field N.
   void
diff --git a/gcc/go/gofrontend/types.cc b/gcc/go/gofrontend/types.cc
index 4b2ceeb4560..cf404a36496 100644
--- a/gcc/go/gofrontend/types.cc
+++ b/gcc/go/gofrontend/types.cc
@@ -6085,10 +6085,7 @@ Method::bind_method(Expression* expr, source_location location) const
       // the child class.
       return this->do_bind_method(expr, location);
     }
-
-  Expression* func = Expression::make_func_reference(this->stub_, NULL,
-						     location);
-  return Expression::make_bound_method(expr, func, location);
+  return Expression::make_bound_method(expr, this->stub_, location);
 }
 
 // Return the named object associated with a method.  This may only be
@@ -6130,9 +6127,8 @@ Named_method::do_receiver_location() const
 Expression*
 Named_method::do_bind_method(Expression* expr, source_location location) const
 {
-  Expression* func = Expression::make_func_reference(this->named_object_, NULL,
-						     location);
-  Bound_method_expression* bme = Expression::make_bound_method(expr, func,
+  Named_object* no = this->named_object_;
+  Bound_method_expression* bme = Expression::make_bound_method(expr, no,
 							       location);
   // If this is not a local method, and it does not use a stub, then
   // the real method expects a different type.  We need to cast the
diff --git a/gcc/gthr-posix.h b/gcc/gthr-posix.h
index b1d499dcc3d..46054f6a7c2 100644
--- a/gcc/gthr-posix.h
+++ b/gcc/gthr-posix.h
@@ -244,16 +244,15 @@ __gthread_active_p (void)
 static inline int
 __gthread_active_p (void)
 {
-  static void *const __gthread_active_ptr
-    = __extension__ (void *) &__gthrw_(
 /* Android's C library does not provide pthread_cancel, check for
    `pthread_create' instead.  */
 #ifndef __BIONIC__
-				       pthread_cancel
+  static void *const __gthread_active_ptr
+    = __extension__ (void *) &__gthrw_(pthread_cancel);
 #else
-				       pthread_create
+  static void *const __gthread_active_ptr
+    = __extension__ (void *) &__gthrw_(pthread_create);
 #endif
-				       );
   return __gthread_active_ptr != 0;
 }
 
diff --git a/gcc/ifcvt.c b/gcc/ifcvt.c
index cf3d245e707..0fcacb6141f 100644
--- a/gcc/ifcvt.c
+++ b/gcc/ifcvt.c
@@ -3796,6 +3796,7 @@ find_if_case_1 (basic_block test_bb, edge then_edge, edge else_edge)
   basic_block then_bb = then_edge->dest;
   basic_block else_bb = else_edge->dest;
   basic_block new_bb;
+  rtx else_target = NULL_RTX;
   int then_bb_index;
 
   /* If we are partitioning hot/cold basic blocks, we don't want to
@@ -3845,6 +3846,13 @@ find_if_case_1 (basic_block test_bb, edge then_edge, edge else_edge)
 				    predictable_edge_p (then_edge)))))
     return FALSE;
 
+  if (else_bb == EXIT_BLOCK_PTR)
+    {
+      rtx jump = BB_END (else_edge->src);
+      gcc_assert (JUMP_P (jump));
+      else_target = JUMP_LABEL (jump);
+    }
+
   /* Registers set are dead, or are predicable.  */
   if (! dead_or_predicable (test_bb, then_bb, else_bb,
 			    single_succ_edge (then_bb), 1))
@@ -3864,6 +3872,9 @@ find_if_case_1 (basic_block test_bb, edge then_edge, edge else_edge)
       redirect_edge_succ (FALLTHRU_EDGE (test_bb), else_bb);
       new_bb = 0;
     }
+  else if (else_bb == EXIT_BLOCK_PTR)
+    new_bb = force_nonfallthru_and_redirect (FALLTHRU_EDGE (test_bb),
+					     else_bb, else_target);
   else
     new_bb = redirect_edge_and_branch_force (FALLTHRU_EDGE (test_bb),
 					     else_bb);
diff --git a/gcc/jump.c b/gcc/jump.c
index 8dc78f2aceb..0273adf4af6 100644
--- a/gcc/jump.c
+++ b/gcc/jump.c
@@ -29,7 +29,8 @@ along with GCC; see the file COPYING3.  If not see
    JUMP_LABEL internal field.  With this we can detect labels that
    become unused because of the deletion of all the jumps that
    formerly used them.  The JUMP_LABEL info is sometimes looked
-   at by later passes.
+   at by later passes.  For return insns, it contains either a
+   RETURN or a SIMPLE_RETURN rtx.
 
    The subroutines redirect_jump and invert_jump are used
    from other passes as well.  */
@@ -775,10 +776,10 @@ condjump_p (const_rtx insn)
     return (GET_CODE (x) == IF_THEN_ELSE
 	    && ((GET_CODE (XEXP (x, 2)) == PC
 		 && (GET_CODE (XEXP (x, 1)) == LABEL_REF
-		     || GET_CODE (XEXP (x, 1)) == RETURN))
+		     || ANY_RETURN_P (XEXP (x, 1))))
 		|| (GET_CODE (XEXP (x, 1)) == PC
 		    && (GET_CODE (XEXP (x, 2)) == LABEL_REF
-			|| GET_CODE (XEXP (x, 2)) == RETURN))));
+			|| ANY_RETURN_P (XEXP (x, 2))))));
 }
 
 /* Return nonzero if INSN is a (possibly) conditional jump inside a
@@ -807,11 +808,11 @@ condjump_in_parallel_p (const_rtx insn)
     return 0;
   if (XEXP (SET_SRC (x), 2) == pc_rtx
       && (GET_CODE (XEXP (SET_SRC (x), 1)) == LABEL_REF
-	  || GET_CODE (XEXP (SET_SRC (x), 1)) == RETURN))
+	  || ANY_RETURN_P (XEXP (SET_SRC (x), 1))))
     return 1;
   if (XEXP (SET_SRC (x), 1) == pc_rtx
       && (GET_CODE (XEXP (SET_SRC (x), 2)) == LABEL_REF
-	  || GET_CODE (XEXP (SET_SRC (x), 2)) == RETURN))
+	  || ANY_RETURN_P (XEXP (SET_SRC (x), 2))))
     return 1;
   return 0;
 }
@@ -873,8 +874,9 @@ any_condjump_p (const_rtx insn)
   a = GET_CODE (XEXP (SET_SRC (x), 1));
   b = GET_CODE (XEXP (SET_SRC (x), 2));
 
-  return ((b == PC && (a == LABEL_REF || a == RETURN))
-	  || (a == PC && (b == LABEL_REF || b == RETURN)));
+  return ((b == PC && (a == LABEL_REF || a == RETURN || a == SIMPLE_RETURN))
+	  || (a == PC
+	      && (b == LABEL_REF || b == RETURN || b == SIMPLE_RETURN)));
 }
 
 /* Return the label of a conditional jump.  */
@@ -911,6 +913,7 @@ returnjump_p_1 (rtx *loc, void *data ATTRIBUTE_UNUSED)
   switch (GET_CODE (x))
     {
     case RETURN:
+    case SIMPLE_RETURN:
     case EH_RETURN:
       return true;
 
diff --git a/gcc/lto-streamer-in.c b/gcc/lto-streamer-in.c
index 331eba8bd30..bae21d5bc4a 100644
--- a/gcc/lto-streamer-in.c
+++ b/gcc/lto-streamer-in.c
@@ -98,21 +98,22 @@ canon_file_name (const char *string)
 {
   void **slot;
   struct string_slot s_slot;
+  size_t len = strlen (string);
+
   s_slot.s = string;
-  s_slot.len = strlen (string);
+  s_slot.len = len;
 
   slot = htab_find_slot (file_name_hash_table, &s_slot, INSERT);
   if (*slot == NULL)
     {
-      size_t len;
       char *saved_string;
       struct string_slot *new_slot;
 
-      len = strlen (string);
       saved_string = (char *) xmalloc (len + 1);
       new_slot = XCNEW (struct string_slot);
-      strcpy (saved_string, string);
+      memcpy (saved_string, string, len + 1);
       new_slot->s = saved_string;
+      new_slot->len = len;
       *slot = new_slot;
       return saved_string;
     }
diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog
index 48903907e00..6e1e187e0c4 100644
--- a/gcc/lto/ChangeLog
+++ b/gcc/lto/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-28  Dodji Seketeli  <dodji@redhat.com>
+
+	* lto-lang.c (lto_init): Likewise.  Also, avoid calling
+	linemap_add twice.
+
 2011-08-11  Martin Jambor  <mjambor@suse.cz>
 
 	* lto.c (uniquify_nodes): Use main variant's BINFO too.
diff --git a/gcc/lto/lto-lang.c b/gcc/lto/lto-lang.c
index 83c41e6c1aa..d469fb93b6a 100644
--- a/gcc/lto/lto-lang.c
+++ b/gcc/lto/lto-lang.c
@@ -1081,8 +1081,7 @@ lto_init (void)
   flag_generate_lto = flag_wpa;
 
   /* Initialize libcpp line maps for gcc_assert to work.  */
-  linemap_add (line_table, LC_RENAME, 0, NULL, 0);
-  linemap_add (line_table, LC_RENAME, 0, NULL, 0);
+  linemap_add (line_table, LC_ENTER, 0, NULL, 0);
 
   /* Create the basic integer types.  */
   build_common_tree_nodes (flag_signed_char, /*short_double=*/false);
diff --git a/gcc/po/ChangeLog b/gcc/po/ChangeLog
index 755812872e7..b8e1e0c6a2a 100644
--- a/gcc/po/ChangeLog
+++ b/gcc/po/ChangeLog
@@ -1,3 +1,7 @@
+2011-08-28  Joseph Myers  <joseph@codesourcery.com>
+
+	* ja.po: Update.
+
 2011-08-05  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	* EXCLUDES (config/fp-bit.c, config/fp-bit.h): Remove.
diff --git a/gcc/po/ja.po b/gcc/po/ja.po
index 87b14865ffc..ccab076786a 100644
--- a/gcc/po/ja.po
+++ b/gcc/po/ja.po
@@ -17,10 +17,10 @@
 # Yasuaki Taniguchi <yasuakit@gmail.com>, 2010, 2011
 msgid ""
 msgstr ""
-"Project-Id-Version: gcc 4.6-b20101218\n"
+"Project-Id-Version: gcc 4.6.1\n"
 "Report-Msgid-Bugs-To: http://gcc.gnu.org/bugs.html\n"
 "POT-Creation-Date: 2011-06-21 10:27+0000\n"
-"PO-Revision-Date: 2011-01-28 23:06+0900\n"
+"PO-Revision-Date: 2011-08-28 15:06+0900\n"
 "Last-Translator: Yasuaki Taniguchi <yasuakit@gmail.com>\n"
 "Language-Team: Japanese <translation-team-ja@lists.sourceforge.net>\n"
 "Language: ja\n"
@@ -5567,7 +5567,6 @@ msgstr ""
 
 #: config/mn10300/mn10300.opt:56
 #, fuzzy
-#| msgid "Allow gcc to use the repeat/erepeat instructions"
 msgid "Allow gcc to generate LIW instructions"
 msgstr "gcc � repeat/erepeat 命令を使用�る��を許��る"
 
@@ -6385,7 +6384,6 @@ msgstr "SSE4.1 � SSE4.2 �組�込�関数�コード生�をサ�ート
 
 #: config/i386/i386.opt:328
 #, fuzzy
-#| msgid "'-msse5' was removed"
 msgid "%<-msse5%> was removed"
 msgstr "'-msse5' �削除�れ���"
 
@@ -7544,9 +7542,8 @@ msgid "Make the linker relaxation machine assume that a program counter wrap-aro
 msgstr ""
 
 #: config/crx/crx.opt:23
-#, fuzzy
 msgid "Support multiply accumulate instructions"
-msgstr "乗算-加算浮動�数点命令をを使用�る"
+msgstr "乗算-加算浮動�数点命令を使用�る"
 
 #: config/crx/crx.opt:27
 msgid "Do not use push to store function arguments"
@@ -8196,7 +8193,6 @@ msgstr "TDA 領域ã�«ã�¨ã�£ã�¦æœ›ã�¾ã�—ã�„最大データサイズを設定ã�™ã‚
 
 #: config/v850/v850.opt:71
 #, fuzzy
-#| msgid "Enforce strict alignment"
 msgid "Do not enforce strict alignment"
 msgstr "厳密�整列を強制�る"
 
@@ -8218,7 +8214,6 @@ msgstr "v850e1 プロセッサ用�コンパイル�る"
 
 #: config/v850/v850.opt:94
 #, fuzzy
-#| msgid "Compile for the v850e processor"
 msgid "Compile for the v850es variant of the v850e1"
 msgstr "v850e プロセッサ用�コンパイル�る"
 
@@ -8744,7 +8739,6 @@ msgstr ""
 
 #: config/microblaze/microblaze.opt:92
 #, fuzzy
-#| msgid "Use hardware floating point converstion instructions"
 msgid "Use hardware floating point conversion instructions"
 msgstr "�ードウェア浮動�数点変�命令を使用�る"
 
@@ -9199,11 +9193,11 @@ msgstr "副作用完了点�則を破る�能性��る場��警告�る
 
 #: c-family/c.opt:590
 msgid "Warn about signed-unsigned comparisons"
-msgstr "符�付�/符�無��比較�関��警告�る"
+msgstr "符�付�/符�無��比較�関��警告�る"
 
 #: c-family/c.opt:594
 msgid "Warn when overload promotes from unsigned to signed"
-msgstr "オー�ーロード�符�無��ら符�付��格上���る場��警告�る"
+msgstr "オー�ーロード�符�無��ら符�付��格上���る場��警告�る"
 
 #: c-family/c.opt:598
 msgid "Warn about uncasted NULL used as sentinel"
@@ -9278,9 +9272,8 @@ msgid "In C++, nonzero means warn about deprecated conversion from string litera
 msgstr ""
 
 #: c-family/c.opt:674
-#, fuzzy
 msgid "Warn when a pointer differs in signedness in an assignment"
-msgstr "オー�ーロード�符�無��ら符�付��格上���る場��警告�る"
+msgstr "オー�ーロード�符�無��ら符�付��格上���る場��警告�る"
 
 #: c-family/c.opt:678
 msgid "A synonym for -std=c89 (for C) or -std=c++98 (for C++)"
@@ -9665,7 +9658,6 @@ msgstr "ファイルをインクルード�る���ファイル�を�マ
 
 #: c-family/c.opt:1140 c-family/c.opt:1144
 #, fuzzy
-#| msgid "Conform to the ISO 1998 C++ standard with GNU extensions"
 msgid "Conform to the ISO 1998 C++ standard revised by the 2003 technical corrigendum"
 msgstr "ISO 1998 C++ 標準� GNU 拡張付��準拠��る"
 
@@ -10126,7 +10118,6 @@ msgstr "無�味� null �インタ検査を削除�る"
 
 #: common.opt:946
 #, fuzzy
-#| msgid "Try to allow the linker to turn PIC calls into direct calls"
 msgid "Try to convert virtual calls to direct ones."
 msgstr "リンカ� PIC 呼�出�を直接呼�出��変更�る��を許��るよ��試�る"
 
@@ -11357,13 +11348,11 @@ msgstr "引数�複素数型���れ�����ん"
 
 #: go/gofrontend/expressions.cc:7578
 #, fuzzy
-#| msgid "argument must have complex type"
 msgid "complex arguments must have identical types"
 msgstr "引数�複素数型���れ�����ん"
 
 #: go/gofrontend/expressions.cc:7580
 #, fuzzy
-#| msgid "argument must have complex type"
 msgid "complex arguments must have floating-point type"
 msgstr "引数�複素数型���れ�����ん"
 
@@ -11982,7 +11971,6 @@ msgstr "%q+D �異�る型��定義�れ���"
 
 #: c-decl.c:1818
 #, fuzzy, gcc-internal-format
-#| msgid "redefinition of typedef %q+D with different type"
 msgid "redefinition of typedef %q+D with variably modified type"
 msgstr "%q+D �異�る型��定義�れ���"
 
@@ -13713,13 +13701,11 @@ msgstr "�明� property 属性��"
 
 #: c-parser.c:7964 cp/parser.c:23167
 #, fuzzy, gcc-internal-format
-#| msgid "missing %<(%> after %<#pragma pack%> - ignored"
 msgid "missing %<=%> (after %<getter%> attribute)"
 msgstr "%<#pragma pack%> �後� %<(%> ��り��ん - 無視�れ���"
 
 #: c-parser.c:7967 cp/parser.c:23170
 #, fuzzy, gcc-internal-format
-#| msgid "missing %<(%> after %<#pragma pack%> - ignored"
 msgid "missing %<=%> (after %<setter%> attribute)"
 msgstr "%<#pragma pack%> �後� %<(%> ��り��ん - 無視�れ���"
 
@@ -15619,7 +15605,6 @@ msgstr "verify_cgraph_node �失敗����"
 
 #: cgraphunit.c:817
 #, fuzzy, gcc-internal-format
-#| msgid "weakref attribute must appear before alias attribute"
 msgid "%<weakref%> attribute should be accompanied with an %<alias%> attribute"
 msgstr "弱��照属性�別�属性より��出����れ�����ん"
 
@@ -15630,13 +15615,11 @@ msgstr "%<externally_visible%> 属性ã�¯å…¬é–‹ã‚ªãƒ–ジェクトã�«é–¢ã�—ã�¦ã�®ã
 
 #: cgraphunit.c:881
 #, fuzzy, gcc-internal-format
-#| msgid "%qE attribute ignored because %qT is already defined"
 msgid "%<weakref%> attribute ignored because function is defined"
 msgstr "%qE 属性� %qT �既�定義�れ��る��無視�れ��"
 
 #: cgraphunit.c:919
 #, fuzzy, gcc-internal-format
-#| msgid "%qE attribute ignored because %qT is already defined"
 msgid "%<weakref%> attribute ignored because variable is initialized"
 msgstr "%qE 属性� %qT �既�定義�れ��る��無視�れ��"
 
@@ -17186,7 +17169,6 @@ msgstr "-iplugindir <dir> オプションã�Œ gcc ドライãƒ�ã�‹ã‚‰æ¸¡ã�•ã‚Œã�¾ã
 
 #: profile.c:417
 #, fuzzy, gcc-internal-format
-#| msgid "corrupted profile info: run_max * runs < sum_max"
 msgid "corrupted profile info: edge count exceeds maximal count"
 msgstr "破���プロファイル情報: run_max * runs < sum_max ��"
 
@@ -18908,7 +18890,6 @@ msgstr "一貫性���値を��プロファイルを修正�����
 
 #: value-prof.c:476
 #, fuzzy, gcc-internal-format, gfc-internal-format
-#| msgid "corrupted value profile: %s profiler overall count (%d) does not match BB count (%d)"
 msgid "corrupted value profile: %s profile counter (%d out of %d) inconsistent with basic-block count (%d)"
 msgstr "破���値�プロファイル��: %s プロファイル���計数 (%d) � BB 数 (%d) �一致���ん"
 
@@ -19207,7 +19188,7 @@ msgstr "%qT �� %qT �ら�変����値�変更��る�も�れ
 #: c-family/c-common.c:2120
 #, gcc-internal-format
 msgid "large integer implicitly truncated to unsigned type"
-msgstr "大��整数�暗黙�符�無�型�切り詰�られ���"
+msgstr "大��整数�暗黙�符�無�型�切り詰�られ���"
 
 #: c-family/c-common.c:2126 c-family/c-common.c:2133 c-family/c-common.c:2141
 #, gcc-internal-format
@@ -19267,12 +19248,12 @@ msgstr "データ型�範囲制��よ���比較�常� true ��り
 #: c-family/c-common.c:3597
 #, gcc-internal-format
 msgid "comparison of unsigned expression >= 0 is always true"
-msgstr "符�無��� >= 0 ���比較�常� true ��"
+msgstr "符�無��� >= 0 ���比較�常� true ��"
 
 #: c-family/c-common.c:3607
 #, gcc-internal-format
 msgid "comparison of unsigned expression < 0 is always false"
-msgstr "符�無��� < 0 ���比較�常� false ��"
+msgstr "符�無��� < 0 ���比較�常� false ��"
 
 #: c-family/c-common.c:3649
 #, gcc-internal-format
@@ -19547,7 +19528,6 @@ msgstr "%q+D 用�整列�最低 %d ���れ�����ん"
 
 #: c-family/c-common.c:6690
 #, fuzzy, gcc-internal-format
-#| msgid "inline function %q+D cannot be declared weak"
 msgid "inline function %q+D declared weak"
 msgstr "インライン関数 %q+D を弱����宣言����ん"
 
@@ -20093,7 +20073,7 @@ msgstr "型 %qT � %qT �間��比較��"
 #: c-family/c-common.c:9361
 #, gcc-internal-format
 msgid "comparison between signed and unsigned integer expressions"
-msgstr "符�付��符�無��整数��間��比較��"
+msgstr "符�付��符�無��整数��間��比較��"
 
 #: c-family/c-common.c:9412
 #, gcc-internal-format
@@ -20103,12 +20083,12 @@ msgstr ""
 #: c-family/c-common.c:9415
 #, gcc-internal-format
 msgid "comparison of promoted ~unsigned with constant"
-msgstr "~��転�れ�格上�符�無�型�定数��比較��"
+msgstr "~��転�れ�格上�符�無�型�定数��比較��"
 
 #: c-family/c-common.c:9425
 #, gcc-internal-format
 msgid "comparison of promoted ~unsigned with unsigned"
-msgstr "~��転�れ�符�無�型�符�無�型��比較��"
+msgstr "~��転�れ�格上�符�無�型�符�無�型��比較��"
 
 #: c-family/c-format.c:127 c-family/c-format.c:314
 #, gcc-internal-format
@@ -20371,7 +20351,7 @@ msgstr "被演算�番��代入�抑制�共�使�れ����"
 #: c-family/c-format.c:2206
 #, gcc-internal-format
 msgid "operand number specified for format taking no argument"
-msgstr "被演算�番��引数を�ら��書��指定�����"
+msgstr "被演算�番��引数を�ら��書��指定�れ����"
 
 #: c-family/c-format.c:2291
 #, gcc-internal-format
@@ -21609,7 +21589,6 @@ msgstr "�的変数 %q+D � dllimport �マーク�れ����"
 
 #: config/avr/avr.c:252
 #, fuzzy, gcc-internal-format
-#| msgid "unrecognized argument to --help= option: %q.*s"
 msgid "unrecognized argument to -mmcu= option: %qs"
 msgstr "--help= オプション���識����引数��: %q.*s"
 
@@ -22347,13 +22326,11 @@ msgstr "最後�引数� 2 ビット�値���れ�����ん"
 
 #: config/i386/i386.c:26380
 #, fuzzy, gcc-internal-format
-#| msgid "the fifth argument must be a 8-bit immediate"
 msgid "the fifth argument must be an 8-bit immediate"
 msgstr "第五引数� 8 ビット�値���れ�����ん"
 
 #: config/i386/i386.c:26475
 #, fuzzy, gcc-internal-format
-#| msgid "the third argument must be a 8-bit immediate"
 msgid "the third argument must be an 8-bit immediate"
 msgstr "第三引数� 8 ビット�値���れ�����ん"
 
@@ -24195,13 +24172,11 @@ msgstr ""
 
 #: config/spu/spu.c:549
 #, fuzzy, gcc-internal-format, gfc-internal-format
-#| msgid "bad value (%s) for -mcmodel= switch"
 msgid "bad value (%s) for -march= switch"
 msgstr "-mcmodel= スイッ�用�誤��値 %s ��"
 
 #: config/spu/spu.c:560
 #, fuzzy, gcc-internal-format, gfc-internal-format
-#| msgid "bad value %qs for -mtune switch"
 msgid "bad value (%s) for -mtune= switch"
 msgstr "-mtune スイッ�用�間���値 %qs ��"
 
@@ -24736,7 +24711,6 @@ msgstr ""
 
 #: cp/call.c:5730 cp/cvt.c:1625
 #, fuzzy, gcc-internal-format
-#| msgid "offset of %q+D is not ABI-compliant and may change in a future version of GCC"
 msgid "scoped enum %qT will not promote to an integral type in a future version of GCC"
 msgstr "%q+D �オフセット� ABI ����������将���ージョン� GCC ��変更��る�も�れ��ん"
 
@@ -24878,7 +24852,6 @@ msgstr ""
 
 #: cp/call.c:8070
 #, fuzzy, gcc-internal-format
-#| msgid "could not convert %qE to %qT"
 msgid "could not convert %qE from %qT to %qT"
 msgstr "%qE �ら %qT �変�����ん"
 
@@ -26745,84 +26718,84 @@ msgid "conflicting specifiers in declaration of %qs"
 msgstr "`%s' �宣言�矛盾�����"
 
 #: cp/decl.c:8329 cp/decl.c:8332 cp/decl.c:8335
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "ISO C++ forbids declaration of %qs with no type"
-msgstr "ISO C �メン����メン�宣言を����"
+msgstr "ISO C++ ��型�無� %qs �宣言を�止�����"
 
 #: cp/decl.c:8360 cp/decl.c:8382
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<signed%> or %<unsigned%> invalid for %qs"
-msgstr "short, 符������符���� `%s' ����無効��"
+msgstr "%<signed%> ��� %<unsigned%> � %qs �対���無効��"
 
 #: cp/decl.c:8362
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<signed%> and %<unsigned%> specified together for %qs"
-msgstr "符�付��符�無�� `%s' �対��一緒�与�られ����"
+msgstr "%<signed%> � %<unsigned%> � %qs �対��両方指定�れ����"
 
 #: cp/decl.c:8364
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<long long%> invalid for %qs"
-msgstr "`%s' �対�� complex ���切��"
+msgstr "%<long long%> � %qs �対���無効��"
 
 #: cp/decl.c:8366
 #, gcc-internal-format
 msgid "%<__int128%> invalid for %qs"
-msgstr ""
+msgstr "%<__int128%> � %qs �対���無効��"
 
 #: cp/decl.c:8368
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<long%> invalid for %qs"
-msgstr "`%s' �対�� complex ���切��"
+msgstr "%<long%> � %qs �対���無効��"
 
 #: cp/decl.c:8370
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<short%> invalid for %qs"
-msgstr "`%s' �対�� complex ���切��"
+msgstr "%<short%> � %qs �対���無効��"
 
 #: cp/decl.c:8372
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<long%> or %<short%> invalid for %qs"
-msgstr "`%s' �対�� long, short, signed ��� unsigned ���切��"
+msgstr "%<long%> ��� %<short%> � %qs �対���無効��"
 
 #: cp/decl.c:8374
 #, gcc-internal-format
 msgid "%<long%>, %<int%>, %<short%>, or %<char%> invalid for %qs"
-msgstr ""
+msgstr "%<long%>�%<int%>�%<short%>���� %<char%> � %qs �対���無効��"
 
 #: cp/decl.c:8376
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<long%> or %<short%> specified with char for %qs"
-msgstr "`%s' �対�� char ��も� long ��� short �指定�れ����"
+msgstr "%<long%> ��� %<short%> � char �共� %qs �対��指定�れ����"
 
 #: cp/decl.c:8378
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<long%> and %<short%> specified together for %qs"
-msgstr "long � short � `%s' �対��一緒�指定�れ����"
+msgstr "%<long%> �よ� %<short%> � %qs �対��両方指定�れ����"
 
 #: cp/decl.c:8384
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<short%> or %<long%> invalid for %qs"
-msgstr "short, 符������符���� `%s' ����無効��"
+msgstr "%<short%> ��� %<long%> � %qs �対���無効��"
 
 #: cp/decl.c:8392
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "long, short, signed or unsigned used invalidly for %qs"
-msgstr "`%s' �対�る long, short, singed や unsigned �使用���切��"
+msgstr "long, short, signed ��� unsigned �使用� %qs �対���無効��"
 
 #: cp/decl.c:8401
 #, gcc-internal-format
 msgid "%<__int128%> is not supported by this target"
-msgstr ""
+msgstr "��ターゲット�� %<__int128%> �サ�ート�れ����ん"
 
 #: cp/decl.c:8407
 #, gcc-internal-format
 msgid "ISO C++ does not support %<__int128%> for %qs"
-msgstr ""
+msgstr "ISO C++ � %<__int128%> を %qs �対���サ�ート�����ん"
 
 #: cp/decl.c:8477
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "complex invalid for %qs"
-msgstr "`%s' �対�� complex ���切��"
+msgstr "complex � %qs �対���無効��"
 
 #: cp/decl.c:8505
 #, gcc-internal-format
@@ -26837,7 +26810,7 @@ msgstr "�メン� `%s' を `mutable' ��宣言����ん"
 #: cp/decl.c:8534
 #, gcc-internal-format
 msgid "%<%T::%D%> is not a valid declarator"
-msgstr ""
+msgstr "%<%T::%D%> �有効�宣言����り��ん"
 
 #: cp/decl.c:8543
 #, gcc-internal-format
@@ -26852,32 +26825,32 @@ msgstr "仮引数 `%s' �指定�れ�記憶クラス"
 #: cp/decl.c:8554
 #, gcc-internal-format
 msgid "storage class specifiers invalid in parameter declarations"
-msgstr "仮引数宣言�中�記憶クラス指定��無効��"
+msgstr "仮引数宣言�中�記憶域クラス指定�無効��"
 
 #: cp/decl.c:8560
 #, gcc-internal-format
 msgid "a parameter cannot be declared %<constexpr%>"
-msgstr ""
+msgstr "仮引数� %<constexpr%> ���宣言�������ん"
 
 #: cp/decl.c:8569
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "%<virtual%> outside class declaration"
-msgstr "クラス宣言�外�� virtual 指定�����"
+msgstr "%<virtual%> �クラス宣言外�使用�れ����"
 
 #: cp/decl.c:8587
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "multiple storage classes in declaration of %qs"
-msgstr "`%s' �宣言����複数��存クラス"
+msgstr "%qs �宣言内�複数�記憶域クラス��り��"
 
 #: cp/decl.c:8610
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "storage class specified for %qs"
-msgstr "%s �対�る記憶クラス指定� `%s'"
+msgstr "%qs �対��記憶域クラス�指定�れ����"
 
 #: cp/decl.c:8614
-#, fuzzy, gcc-internal-format
+#, gcc-internal-format
 msgid "storage class specified for parameter %qs"
-msgstr "仮引数 `%s' �指定�れ�記憶クラス"
+msgstr "仮引数 %qs �対��記憶域クラスタ指定�れ����"
 
 #: cp/decl.c:8627
 #, fuzzy, gcc-internal-format
@@ -31579,7 +31552,6 @@ msgstr ""
 
 #: cp/semantics.c:6838
 #, fuzzy, gcc-internal-format
-#| msgid "%qE is not initialized"
 msgid "%qD used in its own initializer"
 msgstr "%qE ��期化�れ����ん"
 
@@ -31660,7 +31632,6 @@ msgstr ""
 
 #: cp/semantics.c:7621
 #, fuzzy, gcc-internal-format
-#| msgid "enumerator value for %qE is not an integer constant expression"
 msgid "use of the value of the object being constructed in a constant expression"
 msgstr "%qE �列挙値�整数定数����り��ん"
 
@@ -31681,13 +31652,11 @@ msgstr ""
 
 #: cp/semantics.c:7792
 #, fuzzy, gcc-internal-format
-#| msgid "initializer element is not a constant expression"
 msgid "division by zero is not a constant-expression"
 msgstr "�期化���素�定数����り��ん"
 
 #: cp/semantics.c:7897
 #, fuzzy, gcc-internal-format
-#| msgid "nonconstant array index in initializer"
 msgid "non-constant array initialization"
 msgstr "�期化�内��定数��列インデックス��り��"
 
@@ -38664,7 +38633,6 @@ msgstr ""
 
 #: fortran/resolve.c:2737
 #, fuzzy, gcc-internal-format, gfc-internal-format
-#| msgid "pointers are not permitted as case values"
 msgid "Coindexed argument not permitted in '%s' call at %L"
 msgstr "case �値����インタ�許��れ����ん"
 
@@ -42286,7 +42254,6 @@ msgstr "インスタンス変数 `%s' � %s �宣言�れ����"
 
 #: objc/objc-act.c:6025
 #, fuzzy, gcc-internal-format
-#| msgid "invalid use of flexible array member"
 msgid "instance variable %qs uses flexible array member"
 msgstr "�変�列メン��無効�使用法��"
 
diff --git a/gcc/print-rtl.c b/gcc/print-rtl.c
index 9336f006aa5..db9c0fbbdd0 100644
--- a/gcc/print-rtl.c
+++ b/gcc/print-rtl.c
@@ -328,6 +328,8 @@ print_rtx (const_rtx in_rtx)
 	    fprintf (outfile, "\n%s%*s -> ", print_rtx_head, indent * 2, "");
 	    if (GET_CODE (JUMP_LABEL (in_rtx)) == RETURN)
 	      fprintf (outfile, "return");
+	    else if (GET_CODE (JUMP_LABEL (in_rtx)) == SIMPLE_RETURN)
+	      fprintf (outfile, "simple_return");
 	    else
 	      fprintf (outfile, "%d", INSN_UID (JUMP_LABEL (in_rtx)));
 	  }
diff --git a/gcc/reorg.c b/gcc/reorg.c
index cf5e7e1b868..8880545a74c 100644
--- a/gcc/reorg.c
+++ b/gcc/reorg.c
@@ -161,8 +161,11 @@ static rtx *unfilled_firstobj;
 #define unfilled_slots_next	\
   ((rtx *) obstack_next_free (&unfilled_slots_obstack))
 
-/* Points to the label before the end of the function.  */
-static rtx end_of_function_label;
+/* Points to the label before the end of the function, or before a
+   return insn.  */
+static rtx function_return_label;
+/* Likewise for a simple_return.  */
+static rtx function_simple_return_label;
 
 /* Mapping between INSN_UID's and position in the code since INSN_UID's do
    not always monotonically increase.  */
@@ -175,7 +178,7 @@ static int stop_search_p (rtx, int);
 static int resource_conflicts_p (struct resources *, struct resources *);
 static int insn_references_resource_p (rtx, struct resources *, bool);
 static int insn_sets_resource_p (rtx, struct resources *, bool);
-static rtx find_end_label (void);
+static rtx find_end_label (rtx);
 static rtx emit_delay_sequence (rtx, rtx, int);
 static rtx add_to_delay_list (rtx, rtx);
 static rtx delete_from_delay_slot (rtx);
@@ -231,6 +234,15 @@ first_active_target_insn (rtx insn)
   return next_active_insn (insn);
 }
 
+/* Return true iff INSN is a simplejump, or any kind of return insn.  */
+
+static bool
+simplejump_or_return_p (rtx insn)
+{
+  return (JUMP_P (insn)
+	  && (simplejump_p (insn) || ANY_RETURN_P (PATTERN (insn))));
+}
+
 /* Return TRUE if this insn should stop the search for insn to fill delay
    slots.  LABELS_P indicates that labels should terminate the search.
    In all cases, jumps terminate the search.  */
@@ -346,23 +358,34 @@ insn_sets_resource_p (rtx insn, struct resources *res,
 
    ??? There may be a problem with the current implementation.  Suppose
    we start with a bare RETURN insn and call find_end_label.  It may set
-   end_of_function_label just before the RETURN.  Suppose the machinery
+   function_return_label just before the RETURN.  Suppose the machinery
    is able to fill the delay slot of the RETURN insn afterwards.  Then
-   end_of_function_label is no longer valid according to the property
+   function_return_label is no longer valid according to the property
    described above and find_end_label will still return it unmodified.
    Note that this is probably mitigated by the following observation:
-   once end_of_function_label is made, it is very likely the target of
+   once function_return_label is made, it is very likely the target of
    a jump, so filling the delay slot of the RETURN will be much more
-   difficult.  */
+   difficult.
+   KIND is either simple_return_rtx or ret_rtx, indicating which type of
+   return we're looking for.  */
 
 static rtx
-find_end_label (void)
+find_end_label (rtx kind)
 {
   rtx insn;
+  rtx *plabel;
+
+  if (kind == ret_rtx)
+    plabel = &function_return_label;
+  else
+    {
+      gcc_assert (kind == simple_return_rtx);
+      plabel = &function_simple_return_label;
+    }
 
   /* If we found one previously, return it.  */
-  if (end_of_function_label)
-    return end_of_function_label;
+  if (*plabel)
+    return *plabel;
 
   /* Otherwise, see if there is a label at the end of the function.  If there
      is, it must be that RETURN insns aren't needed, so that is our return
@@ -377,44 +400,45 @@ find_end_label (void)
 
   /* When a target threads its epilogue we might already have a
      suitable return insn.  If so put a label before it for the
-     end_of_function_label.  */
+     function_return_label.  */
   if (BARRIER_P (insn)
       && JUMP_P (PREV_INSN (insn))
-      && GET_CODE (PATTERN (PREV_INSN (insn))) == RETURN)
+      && PATTERN (PREV_INSN (insn)) == kind)
     {
       rtx temp = PREV_INSN (PREV_INSN (insn));
-      end_of_function_label = gen_label_rtx ();
-      LABEL_NUSES (end_of_function_label) = 0;
+      rtx label = gen_label_rtx ();
+      LABEL_NUSES (label) = 0;
 
-      /* Put the label before an USE insns that may precede the RETURN insn.  */
+      /* Put the label before any USE insns that may precede the RETURN
+	 insn.  */
       while (GET_CODE (temp) == USE)
 	temp = PREV_INSN (temp);
 
-      emit_label_after (end_of_function_label, temp);
+      emit_label_after (label, temp);
+      *plabel = label;
     }
 
   else if (LABEL_P (insn))
-    end_of_function_label = insn;
+    *plabel = insn;
   else
     {
-      end_of_function_label = gen_label_rtx ();
-      LABEL_NUSES (end_of_function_label) = 0;
+      rtx label = gen_label_rtx ();
+      LABEL_NUSES (label) = 0;
       /* If the basic block reorder pass moves the return insn to
 	 some other place try to locate it again and put our
-	 end_of_function_label there.  */
-      while (insn && ! (JUMP_P (insn)
-		        && (GET_CODE (PATTERN (insn)) == RETURN)))
+	 function_return_label there.  */
+      while (insn && ! (JUMP_P (insn) && (PATTERN (insn) == kind)))
 	insn = PREV_INSN (insn);
       if (insn)
 	{
 	  insn = PREV_INSN (insn);
 
-	  /* Put the label before an USE insns that may proceed the
+	  /* Put the label before any USE insns that may precede the
 	     RETURN insn.  */
 	  while (GET_CODE (insn) == USE)
 	    insn = PREV_INSN (insn);
 
-	  emit_label_after (end_of_function_label, insn);
+	  emit_label_after (label, insn);
 	}
       else
 	{
@@ -424,19 +448,16 @@ find_end_label (void)
 	      && ! HAVE_return
 #endif
 	      )
-	    {
-	      /* The RETURN insn has its delay slot filled so we cannot
-		 emit the label just before it.  Since we already have
-		 an epilogue and cannot emit a new RETURN, we cannot
-		 emit the label at all.  */
-	      end_of_function_label = NULL_RTX;
-	      return end_of_function_label;
-	    }
+	    /* The RETURN insn has its delay slot filled so we cannot
+	       emit the label just before it.  Since we already have
+	       an epilogue and cannot emit a new RETURN, we cannot
+	       emit the label at all.  */
+	    return NULL_RTX;
 #endif /* HAVE_epilogue */
 
 	  /* Otherwise, make a new label and emit a RETURN and BARRIER,
 	     if needed.  */
-	  emit_label (end_of_function_label);
+	  emit_label (label);
 #ifdef HAVE_return
 	  /* We don't bother trying to create a return insn if the
 	     epilogue has filled delay-slots; we would have to try and
@@ -455,13 +476,14 @@ find_end_label (void)
 	    }
 #endif
 	}
+      *plabel = label;
     }
 
   /* Show one additional use for this label so it won't go away until
      we are done.  */
-  ++LABEL_NUSES (end_of_function_label);
+  ++LABEL_NUSES (*plabel);
 
-  return end_of_function_label;
+  return *plabel;
 }
 
 /* Put INSN and LIST together in a SEQUENCE rtx of LENGTH, and replace
@@ -809,10 +831,8 @@ optimize_skip (rtx insn)
   if ((next_trial == next_active_insn (JUMP_LABEL (insn))
        && ! (next_trial == 0 && crtl->epilogue_delay_list != 0))
       || (next_trial != 0
-	  && JUMP_P (next_trial)
-	  && JUMP_LABEL (insn) == JUMP_LABEL (next_trial)
-	  && (simplejump_p (next_trial)
-	      || GET_CODE (PATTERN (next_trial)) == RETURN)))
+	  && simplejump_or_return_p (next_trial)
+	  && JUMP_LABEL (insn) == JUMP_LABEL (next_trial)))
     {
       if (eligible_for_annul_false (insn, 0, trial, flags))
 	{
@@ -831,13 +851,11 @@ optimize_skip (rtx insn)
 	 branch, thread our jump to the target of that branch.  Don't
 	 change this into a RETURN here, because it may not accept what
 	 we have in the delay slot.  We'll fix this up later.  */
-      if (next_trial && JUMP_P (next_trial)
-	  && (simplejump_p (next_trial)
-	      || GET_CODE (PATTERN (next_trial)) == RETURN))
+      if (next_trial && simplejump_or_return_p (next_trial))
 	{
 	  rtx target_label = JUMP_LABEL (next_trial);
 	  if (ANY_RETURN_P (target_label))
-	    target_label = find_end_label ();
+	    target_label = find_end_label (target_label);
 
 	  if (target_label)
 	    {
@@ -951,7 +969,7 @@ rare_destination (rtx insn)
 	     return.  */
 	  return 2;
 	case JUMP_INSN:
-	  if (GET_CODE (PATTERN (insn)) == RETURN)
+	  if (ANY_RETURN_P (PATTERN (insn)))
 	    return 1;
 	  else if (simplejump_p (insn)
 		   && jump_count++ < 10)
@@ -1368,8 +1386,7 @@ steal_delay_list_from_fallthrough (rtx insn, rtx condition, rtx seq,
   /* We can't do anything if SEQ's delay insn isn't an
      unconditional branch.  */
 
-  if (! simplejump_p (XVECEXP (seq, 0, 0))
-      && GET_CODE (PATTERN (XVECEXP (seq, 0, 0))) != RETURN)
+  if (! simplejump_or_return_p (XVECEXP (seq, 0, 0)))
     return delay_list;
 
   for (i = 1; i < XVECLEN (seq, 0); i++)
@@ -2383,7 +2400,7 @@ fill_simple_delay_slots (int non_jumps_p)
 	      if (new_label != 0)
 		new_label = get_label_before (new_label);
 	      else
-		new_label = find_end_label ();
+		new_label = find_end_label (simple_return_rtx);
 
 	      if (new_label)
 	        {
@@ -2515,7 +2532,8 @@ fill_simple_delay_slots (int non_jumps_p)
 
 /* Follow any unconditional jump at LABEL;
    return the ultimate label reached by any such chain of jumps.
-   Return ret_rtx if the chain ultimately leads to a return instruction.
+   Return a suitable return rtx if the chain ultimately leads to a
+   return instruction.
    If LABEL is not followed by a jump, return LABEL.
    If the chain loops or we can't find end, return LABEL,
    since that tells caller to avoid changing the insn.  */
@@ -2536,7 +2554,7 @@ follow_jumps (rtx label)
 	&& JUMP_P (insn)
 	&& JUMP_LABEL (insn) != NULL_RTX
 	&& ((any_uncondjump_p (insn) && onlyjump_p (insn))
-	    || GET_CODE (PATTERN (insn)) == RETURN)
+	    || ANY_RETURN_P (PATTERN (insn)))
 	&& (next = NEXT_INSN (insn))
 	&& BARRIER_P (next));
        depth++)
@@ -3003,16 +3021,14 @@ fill_slots_from_thread (rtx insn, rtx condition, rtx thread,
 
       gcc_assert (thread_if_true);
 
-      if (new_thread && JUMP_P (new_thread)
-	  && (simplejump_p (new_thread)
-	      || GET_CODE (PATTERN (new_thread)) == RETURN)
+      if (new_thread && simplejump_or_return_p (new_thread)
 	  && redirect_with_delay_list_safe_p (insn,
 					      JUMP_LABEL (new_thread),
 					      delay_list))
 	new_thread = follow_jumps (JUMP_LABEL (new_thread));
 
       if (ANY_RETURN_P (new_thread))
-	label = find_end_label ();
+	label = find_end_label (new_thread);
       else if (LABEL_P (new_thread))
 	label = new_thread;
       else
@@ -3362,7 +3378,7 @@ relax_delay_slots (rtx first)
 	{
 	  target_label = skip_consecutive_labels (follow_jumps (target_label));
 	  if (ANY_RETURN_P (target_label))
-	    target_label = find_end_label ();
+	    target_label = find_end_label (target_label);
 
 	  if (target_label && next_active_insn (target_label) == next
 	      && ! condjump_in_parallel_p (insn))
@@ -3377,9 +3393,8 @@ relax_delay_slots (rtx first)
 	  /* See if this jump conditionally branches around an unconditional
 	     jump.  If so, invert this jump and point it to the target of the
 	     second jump.  */
-	  if (next && JUMP_P (next)
+	  if (next && simplejump_or_return_p (next)
 	      && any_condjump_p (insn)
-	      && (simplejump_p (next) || GET_CODE (PATTERN (next)) == RETURN)
 	      && target_label
 	      && next_active_insn (target_label) == next_active_insn (next)
 	      && no_labels_between_p (insn, next))
@@ -3421,8 +3436,7 @@ relax_delay_slots (rtx first)
 	 Don't do this if we expect the conditional branch to be true, because
 	 we would then be making the more common case longer.  */
 
-      if (JUMP_P (insn)
-	  && (simplejump_p (insn) || GET_CODE (PATTERN (insn)) == RETURN)
+      if (simplejump_or_return_p (insn)
 	  && (other = prev_active_insn (insn)) != 0
 	  && any_condjump_p (other)
 	  && no_labels_between_p (other, insn)
@@ -3463,10 +3477,10 @@ relax_delay_slots (rtx first)
 	 Only do so if optimizing for size since this results in slower, but
 	 smaller code.  */
       if (optimize_function_for_size_p (cfun)
-	  && GET_CODE (PATTERN (delay_insn)) == RETURN
+	  && ANY_RETURN_P (PATTERN (delay_insn))
 	  && next
 	  && JUMP_P (next)
-	  && GET_CODE (PATTERN (next)) == RETURN)
+	  && PATTERN (next) == PATTERN (delay_insn))
 	{
 	  rtx after;
 	  int i;
@@ -3505,73 +3519,71 @@ relax_delay_slots (rtx first)
 	continue;
 
       target_label = JUMP_LABEL (delay_insn);
+      if (target_label && ANY_RETURN_P (target_label))
+	continue;
 
-      if (!ANY_RETURN_P (target_label))
-	{
-	  /* If this jump goes to another unconditional jump, thread it, but
-	     don't convert a jump into a RETURN here.  */
-	  trial = skip_consecutive_labels (follow_jumps (target_label));
-	  if (ANY_RETURN_P (trial))
-	    trial = find_end_label ();
-
-	  if (trial && trial != target_label
-	      && redirect_with_delay_slots_safe_p (delay_insn, trial, insn))
-	    {
-	      reorg_redirect_jump (delay_insn, trial);
-	      target_label = trial;
-	    }
+      /* If this jump goes to another unconditional jump, thread it, but
+	 don't convert a jump into a RETURN here.  */
+      trial = skip_consecutive_labels (follow_jumps (target_label));
+      if (ANY_RETURN_P (trial))
+	trial = find_end_label (trial);
 
-	  /* If the first insn at TARGET_LABEL is redundant with a previous
-	     insn, redirect the jump to the following insn and process again.
-	     We use next_real_insn instead of next_active_insn so we
-	     don't skip USE-markers, or we'll end up with incorrect
-	     liveness info.  */
-	  trial = next_real_insn (target_label);
-	  if (trial && GET_CODE (PATTERN (trial)) != SEQUENCE
-	      && redundant_insn (trial, insn, 0)
-	      && ! can_throw_internal (trial))
-	    {
-	      /* Figure out where to emit the special USE insn so we don't
-		 later incorrectly compute register live/death info.  */
-	      rtx tmp = next_active_insn (trial);
-	      if (tmp == 0)
-		tmp = find_end_label ();
+      if (trial && trial != target_label
+	  && redirect_with_delay_slots_safe_p (delay_insn, trial, insn))
+	{
+	  reorg_redirect_jump (delay_insn, trial);
+	  target_label = trial;
+	}
 
-	      if (tmp)
-	        {
-		  /* Insert the special USE insn and update dataflow info.  */
-		  update_block (trial, tmp);
+      /* If the first insn at TARGET_LABEL is redundant with a previous
+	 insn, redirect the jump to the following insn and process again.
+	 We use next_real_insn instead of next_active_insn so we
+	 don't skip USE-markers, or we'll end up with incorrect
+	 liveness info.  */
+      trial = next_real_insn (target_label);
+      if (trial && GET_CODE (PATTERN (trial)) != SEQUENCE
+	  && redundant_insn (trial, insn, 0)
+	  && ! can_throw_internal (trial))
+	{
+	  /* Figure out where to emit the special USE insn so we don't
+	     later incorrectly compute register live/death info.  */
+	  rtx tmp = next_active_insn (trial);
+	  if (tmp == 0)
+	    tmp = find_end_label (simple_return_rtx);
 
-		  /* Now emit a label before the special USE insn, and
-		     redirect our jump to the new label.  */
-		  target_label = get_label_before (PREV_INSN (tmp));
-		  reorg_redirect_jump (delay_insn, target_label);
-		  next = insn;
-		  continue;
-		}
+	  if (tmp)
+	    {
+	      /* Insert the special USE insn and update dataflow info.  */
+	      update_block (trial, tmp);
+	      
+	      /* Now emit a label before the special USE insn, and
+		 redirect our jump to the new label.  */
+	      target_label = get_label_before (PREV_INSN (tmp));
+	      reorg_redirect_jump (delay_insn, target_label);
+	      next = insn;
+	      continue;
 	    }
+	}
 
-	  /* Similarly, if it is an unconditional jump with one insn in its
-	     delay list and that insn is redundant, thread the jump.  */
-	  if (trial && GET_CODE (PATTERN (trial)) == SEQUENCE
-	      && XVECLEN (PATTERN (trial), 0) == 2
-	      && JUMP_P (XVECEXP (PATTERN (trial), 0, 0))
-	      && (simplejump_p (XVECEXP (PATTERN (trial), 0, 0))
-		  || GET_CODE (PATTERN (XVECEXP (PATTERN (trial), 0, 0))) == RETURN)
-	      && redundant_insn (XVECEXP (PATTERN (trial), 0, 1), insn, 0))
+      /* Similarly, if it is an unconditional jump with one insn in its
+	 delay list and that insn is redundant, thread the jump.  */
+      if (trial && GET_CODE (PATTERN (trial)) == SEQUENCE
+	  && XVECLEN (PATTERN (trial), 0) == 2
+	  && JUMP_P (XVECEXP (PATTERN (trial), 0, 0))
+	  && simplejump_or_return_p (XVECEXP (PATTERN (trial), 0, 0))
+	  && redundant_insn (XVECEXP (PATTERN (trial), 0, 1), insn, 0))
+	{
+	  target_label = JUMP_LABEL (XVECEXP (PATTERN (trial), 0, 0));
+	  if (ANY_RETURN_P (target_label))
+	    target_label = find_end_label (target_label);
+	  
+	  if (target_label
+	      && redirect_with_delay_slots_safe_p (delay_insn, target_label,
+						   insn))
 	    {
-	      target_label = JUMP_LABEL (XVECEXP (PATTERN (trial), 0, 0));
-	      if (ANY_RETURN_P (target_label))
-		target_label = find_end_label ();
-
-	      if (target_label
-	          && redirect_with_delay_slots_safe_p (delay_insn, target_label,
-						       insn))
-		{
-		  reorg_redirect_jump (delay_insn, target_label);
-		  next = insn;
-		  continue;
-		}
+	      reorg_redirect_jump (delay_insn, target_label);
+	      next = insn;
+	      continue;
 	    }
 	}
 
@@ -3640,8 +3652,7 @@ relax_delay_slots (rtx first)
 	 a RETURN here.  */
       if (! INSN_ANNULLED_BRANCH_P (delay_insn)
 	  && any_condjump_p (delay_insn)
-	  && next && JUMP_P (next)
-	  && (simplejump_p (next) || GET_CODE (PATTERN (next)) == RETURN)
+	  && next && simplejump_or_return_p (next)
 	  && next_active_insn (target_label) == next_active_insn (next)
 	  && no_labels_between_p (insn, next))
 	{
@@ -3649,7 +3660,7 @@ relax_delay_slots (rtx first)
 	  rtx old_label = JUMP_LABEL (delay_insn);
 
 	  if (ANY_RETURN_P (label))
-	    label = find_end_label ();
+	    label = find_end_label (label);
 
 	  /* find_end_label can generate a new label. Check this first.  */
 	  if (label
@@ -3710,7 +3721,8 @@ static void
 make_return_insns (rtx first)
 {
   rtx insn, jump_insn, pat;
-  rtx real_return_label = end_of_function_label;
+  rtx real_return_label = function_return_label;
+  rtx real_simple_return_label = function_simple_return_label;
   int slots, i;
 
 #ifdef DELAY_SLOTS_FOR_EPILOGUE
@@ -3728,15 +3740,22 @@ make_return_insns (rtx first)
      made for END_OF_FUNCTION_LABEL.  If so, set up anything we can't change
      into a RETURN to jump to it.  */
   for (insn = first; insn; insn = NEXT_INSN (insn))
-    if (JUMP_P (insn) && GET_CODE (PATTERN (insn)) == RETURN)
+    if (JUMP_P (insn) && ANY_RETURN_P (PATTERN (insn)))
       {
-	real_return_label = get_label_before (insn);
+	rtx t = get_label_before (insn);
+	if (PATTERN (insn) == ret_rtx)
+	  real_return_label = t;
+	else
+	  real_simple_return_label = t;
 	break;
       }
 
   /* Show an extra usage of REAL_RETURN_LABEL so it won't go away if it
      was equal to END_OF_FUNCTION_LABEL.  */
-  LABEL_NUSES (real_return_label)++;
+  if (real_return_label)
+    LABEL_NUSES (real_return_label)++;
+  if (real_simple_return_label)
+    LABEL_NUSES (real_simple_return_label)++;
 
   /* Clear the list of insns to fill so we can use it.  */
   obstack_free (&unfilled_slots_obstack, unfilled_firstobj);
@@ -3744,13 +3763,27 @@ make_return_insns (rtx first)
   for (insn = first; insn; insn = NEXT_INSN (insn))
     {
       int flags;
+      rtx kind, real_label;
 
       /* Only look at filled JUMP_INSNs that go to the end of function
 	 label.  */
       if (!NONJUMP_INSN_P (insn)
 	  || GET_CODE (PATTERN (insn)) != SEQUENCE
-	  || !JUMP_P (XVECEXP (PATTERN (insn), 0, 0))
-	  || JUMP_LABEL (XVECEXP (PATTERN (insn), 0, 0)) != end_of_function_label)
+	  || !jump_to_label_p (XVECEXP (PATTERN (insn), 0, 0)))
+	continue;
+
+      if (JUMP_LABEL (XVECEXP (PATTERN (insn), 0, 0)) == function_return_label)
+	{
+	  kind = ret_rtx;
+	  real_label = real_return_label;
+	}
+      else if (JUMP_LABEL (XVECEXP (PATTERN (insn), 0, 0))
+	       == function_simple_return_label)
+	{
+	  kind = simple_return_rtx;
+	  real_label = real_simple_return_label;
+	}
+      else
 	continue;
 
       pat = PATTERN (insn);
@@ -3758,14 +3791,12 @@ make_return_insns (rtx first)
 
       /* If we can't make the jump into a RETURN, try to redirect it to the best
 	 RETURN and go on to the next insn.  */
-      if (! reorg_redirect_jump (jump_insn, ret_rtx))
+      if (!reorg_redirect_jump (jump_insn, kind))
 	{
 	  /* Make sure redirecting the jump will not invalidate the delay
 	     slot insns.  */
-	  if (redirect_with_delay_slots_safe_p (jump_insn,
-						real_return_label,
-						insn))
-	    reorg_redirect_jump (jump_insn, real_return_label);
+	  if (redirect_with_delay_slots_safe_p (jump_insn, real_label, insn))
+	    reorg_redirect_jump (jump_insn, real_label);
 	  continue;
 	}
 
@@ -3805,7 +3836,7 @@ make_return_insns (rtx first)
 	 RETURN, delete the SEQUENCE and output the individual insns,
 	 followed by the RETURN.  Then set things up so we try to find
 	 insns for its delay slots, if it needs some.  */
-      if (GET_CODE (PATTERN (jump_insn)) == RETURN)
+      if (ANY_RETURN_P (PATTERN (jump_insn)))
 	{
 	  rtx prev = PREV_INSN (insn);
 
@@ -3822,13 +3853,16 @@ make_return_insns (rtx first)
       else
 	/* It is probably more efficient to keep this with its current
 	   delay slot as a branch to a RETURN.  */
-	reorg_redirect_jump (jump_insn, real_return_label);
+	reorg_redirect_jump (jump_insn, real_label);
     }
 
   /* Now delete REAL_RETURN_LABEL if we never used it.  Then try to fill any
      new delay slots we have created.  */
-  if (--LABEL_NUSES (real_return_label) == 0)
+  if (real_return_label != NULL_RTX && --LABEL_NUSES (real_return_label) == 0)
     delete_related_insns (real_return_label);
+  if (real_simple_return_label != NULL_RTX
+      && --LABEL_NUSES (real_simple_return_label) == 0)
+    delete_related_insns (real_simple_return_label);
 
   fill_simple_delay_slots (1);
   fill_simple_delay_slots (0);
@@ -3842,6 +3876,7 @@ dbr_schedule (rtx first)
 {
   rtx insn, next, epilogue_insn = 0;
   int i;
+  bool need_return_insns;
 
   /* If the current function has no insns other than the prologue and
      epilogue, then do not try to fill any delay slots.  */
@@ -3897,7 +3932,7 @@ dbr_schedule (rtx first)
   init_resource_info (epilogue_insn);
 
   /* Show we haven't computed an end-of-function label yet.  */
-  end_of_function_label = 0;
+  function_return_label = function_simple_return_label = NULL_RTX;
 
   /* Initialize the statistics for this function.  */
   memset (num_insns_needing_delays, 0, sizeof num_insns_needing_delays);
@@ -3919,13 +3954,21 @@ dbr_schedule (rtx first)
   /* If we made an end of function label, indicate that it is now
      safe to delete it by undoing our prior adjustment to LABEL_NUSES.
      If it is now unused, delete it.  */
-  if (end_of_function_label && --LABEL_NUSES (end_of_function_label) == 0)
-    delete_related_insns (end_of_function_label);
+  if (function_return_label && --LABEL_NUSES (function_return_label) == 0)
+    delete_related_insns (function_return_label);
+  if (function_simple_return_label
+      && --LABEL_NUSES (function_simple_return_label) == 0)
+    delete_related_insns (function_simple_return_label);
 
+  need_return_insns = false;
 #ifdef HAVE_return
-  if (HAVE_return && end_of_function_label != 0)
-    make_return_insns (first);
+  need_return_insns |= HAVE_return && function_return_label != 0;
+#endif
+#ifdef HAVE_simple_return
+  need_return_insns |= HAVE_simple_return && function_simple_return_label != 0;
 #endif
+  if (need_return_insns)
+    make_return_insns (first);
 
   /* Delete any USE insns made by update_block; subsequent passes don't need
      them or know how to deal with them.  */
diff --git a/gcc/resource.c b/gcc/resource.c
index ae541fea951..1a8cb1be494 100644
--- a/gcc/resource.c
+++ b/gcc/resource.c
@@ -492,7 +492,7 @@ find_dead_or_set_registers (rtx target, struct resources *res,
 	  if (jump_count++ < 10)
 	    {
 	      if (any_uncondjump_p (this_jump_insn)
-		  || GET_CODE (PATTERN (this_jump_insn)) == RETURN)
+		  || ANY_RETURN_P (PATTERN (this_jump_insn)))
 		{
 		  next = JUMP_LABEL (this_jump_insn);
 		  if (ANY_RETURN_P (next))
@@ -829,7 +829,7 @@ mark_set_resources (rtx x, struct resources *res, int in_dest,
 static bool
 return_insn_p (const_rtx insn)
 {
-  if (JUMP_P (insn) && GET_CODE (PATTERN (insn)) == RETURN)
+  if (JUMP_P (insn) && ANY_RETURN_P (PATTERN (insn)))
     return true;
 
   if (NONJUMP_INSN_P (insn) && GET_CODE (PATTERN (insn)) == SEQUENCE)
diff --git a/gcc/rtl.c b/gcc/rtl.c
index 52e9e9ce3a8..0e11eeffa09 100644
--- a/gcc/rtl.c
+++ b/gcc/rtl.c
@@ -256,6 +256,7 @@ copy_rtx (rtx orig)
     case PC:
     case CC0:
     case RETURN:
+    case SIMPLE_RETURN:
     case SCRATCH:
       /* SCRATCH must be shared because they represent distinct values.  */
       return orig;
diff --git a/gcc/rtl.def b/gcc/rtl.def
index a7de8f7b4aa..b098123cc59 100644
--- a/gcc/rtl.def
+++ b/gcc/rtl.def
@@ -296,6 +296,12 @@ DEF_RTL_EXPR(CALL, "call", "ee", RTX_EXTRA)
 
 DEF_RTL_EXPR(RETURN, "return", "", RTX_EXTRA)
 
+/* Like RETURN, but truly represents only a function return, while
+   RETURN may represent an insn that also performs other functions
+   of the function epilogue.  Like RETURN, this may also occur in
+   conditional jumps.  */
+DEF_RTL_EXPR(SIMPLE_RETURN, "simple_return", "", RTX_EXTRA)
+
 /* Special for EH return from subroutine.  */
 
 DEF_RTL_EXPR(EH_RETURN, "eh_return", "", RTX_EXTRA)
diff --git a/gcc/rtl.h b/gcc/rtl.h
index e8aa7aba002..860f6c47af2 100644
--- a/gcc/rtl.h
+++ b/gcc/rtl.h
@@ -432,8 +432,9 @@ struct GTY((variable_size)) rtvec_def {
   (JUMP_P (INSN) && (GET_CODE (PATTERN (INSN)) == ADDR_VEC || \
 		     GET_CODE (PATTERN (INSN)) == ADDR_DIFF_VEC))
 
-/* Predicate yielding nonzero iff X is a return.  */
-#define ANY_RETURN_P(X) ((X) == ret_rtx)
+/* Predicate yielding nonzero iff X is a return or simple_return.  */
+#define ANY_RETURN_P(X) \
+  (GET_CODE (X) == RETURN || GET_CODE (X) == SIMPLE_RETURN)
 
 /* 1 if X is a unary operator.  */
 
@@ -2111,6 +2112,7 @@ enum global_rtl_index
   GR_PC,
   GR_CC0,
   GR_RETURN,
+  GR_SIMPLE_RETURN,
   GR_STACK_POINTER,
   GR_FRAME_POINTER,
 /* For register elimination to work properly these hard_frame_pointer_rtx,
@@ -2206,6 +2208,7 @@ extern struct target_rtl *this_target_rtl;
 /* Standard pieces of rtx, to be substituted directly into things.  */
 #define pc_rtx                  (global_rtl[GR_PC])
 #define ret_rtx                 (global_rtl[GR_RETURN])
+#define simple_return_rtx       (global_rtl[GR_SIMPLE_RETURN])
 #define cc0_rtx                 (global_rtl[GR_CC0])
 
 /* All references to certain hard regs, except those created
@@ -2508,6 +2511,7 @@ extern void emit_jump (rtx);
 /* In expr.c */
 extern rtx move_by_pieces (rtx, rtx, unsigned HOST_WIDE_INT,
 			   unsigned int, int);
+extern HOST_WIDE_INT find_args_size_adjust (rtx);
 extern int fixup_args_size_notes (rtx, rtx, int);
 
 /* In cfgrtl.c */
diff --git a/gcc/rtlanal.c b/gcc/rtlanal.c
index 7fa3ca6f315..d6e84a22221 100644
--- a/gcc/rtlanal.c
+++ b/gcc/rtlanal.c
@@ -1,7 +1,7 @@
 /* Analyze RTL for GNU compiler.
    Copyright (C) 1987, 1988, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
-   1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-   Free Software Foundation, Inc.
+   1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -4273,6 +4273,11 @@ nonzero_bits1 (const_rtx x, enum machine_mode mode, const_rtx known_x,
 	nonzero = -1;
       break;
 
+    case CLRSB:
+      /* This is at most the number of bits in the mode minus 1.  */
+      nonzero = ((unsigned HOST_WIDE_INT) 1 << (floor_log2 (mode_width))) - 1;
+      break;
+
     case PARITY:
       nonzero = 1;
       break;
diff --git a/gcc/sched-vis.c b/gcc/sched-vis.c
index 25a0b600d10..8c15788eecd 100644
--- a/gcc/sched-vis.c
+++ b/gcc/sched-vis.c
@@ -554,6 +554,9 @@ print_pattern (char *buf, const_rtx x, int verbose)
     case RETURN:
       sprintf (buf, "return");
       break;
+    case SIMPLE_RETURN:
+      sprintf (buf, "simple_return");
+      break;
     case CALL:
       print_exp (buf, x, verbose);
       break;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c904def866d..95c78825a1e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,93 @@
+2011-08-30  Christian Bruel  <christian.bruel@st.com>
+
+	* g++.dg/bprob/bprob.exp (feedback_options): Set -fbranch-probabilities.
+	* gcc.misc-tests/bprob.exp (feedback_options): Likewise.
+	
+2011-08-29  Jason Merrill  <jason@redhat.com>
+
+	PR c++/50224
+	* g++.dg/cpp0x/lambda/lambda-use2.C: New.
+
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+	    Jason Merrill  <jason@redhat.com>
+
+	* g++.dg/dfp/base.C: New test.
+
+2011-08-29  Jason Merrill  <jason@redhat.com>
+
+	Core DR 994
+	PR c++/50209
+	* g++.dg/cpp0x/initlist58.C: New.
+
+2011-08-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/50225
+	* gfortran.dg/class_result_1.f03: New.
+
+2011-08-29  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/48722
+	* gcc.target/i386/pr48722.c: New test.
+
+2011-08-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/50192
+	* gfortran.dg/widechar_compare_1.f90:  New test.
+
+2011-08-26  Jason Merrill  <jason@redhat.com>
+
+	Core DR 342
+	PR c++/48582
+	* g++.dg/abi/mangle50.C: New.
+
+2011-08-27  Uros Bizjak  <ubizjak@gmail.com>
+
+	PR target/50202
+	* gcc.target/i386/pr50202.c: New test.
+
+2011-08-26  Uros Bizjak  <ubizjak@gmail.com>
+
+	* gcc.target/i386/sse_4_1-round-vec.c: New test.
+	* gcc.target/i386/sse_4_1-roundf-vec.c: New test.
+	* gcc.target/i386/avx-round-vec.c: New test.
+	* gcc.target/i386/avx-roundf-vec.c: New test.
+
+2011-08-26  Jakub Jelinek  <jakub@redhat.com>
+
+	* gcc.target/i386/cmpxchg16b-1.c: Match also space after the
+	instruction.
+
+	PR c/50179
+	* c-c++-common/Wunused-var-14.c: New test.
+
+2011-08-26  Tom de Vries  <tom@codesourcery.com>
+
+	* gcc.dg/tree-ssa/ivopts-lt.c: New test.
+
+2011-08-26  Jiangning Liu  <jiangning.liu@arm.com>
+
+	* gcc.target/arm/thumb2-cond-cmp-1.c: New.
+	* gcc.target/arm/thumb2-cond-cmp-2.c: Likewise.
+	* gcc.target/arm/thumb2-cond-cmp-3.c: Likewise.
+	* gcc.target/arm/thumb2-cond-cmp-4.c: Likewise.
+
+2011-08-26  Andrew Stubbs  <ams@codesourcery.com>
+
+	* gcc.target/arm/thumb2-replicated-constant1.c: New file.
+	* gcc.target/arm/thumb2-replicated-constant2.c: New file.
+	* gcc.target/arm/thumb2-replicated-constant3.c: New file.
+	* gcc.target/arm/thumb2-replicated-constant4.c: New file.
+
+2011-08-25  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/50050
+	* gfortran.dg/pointer_comp_init_1.f90: New test.
+
+2011-08-25  Jason Merrill  <jason@redhat.com>
+
+	PR c++/50157
+	* g++.dg/cpp0x/sfinae27.C: New.
+
 2011-08-25  Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.dg/coarray_lib_token_4.f90: New.
diff --git a/gcc/testsuite/c-c++-common/Wunused-var-14.c b/gcc/testsuite/c-c++-common/Wunused-var-14.c
new file mode 100644
index 00000000000..389febae8c6
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/Wunused-var-14.c
@@ -0,0 +1,13 @@
+/* PR c/50179 */
+/* { dg-options "-Wunused" } */
+/* { dg-do compile } */
+
+void bar (int, ...);
+
+char *
+foo (void)
+{
+  bar (1, (__extension__ ({ static char b[2]; b[0] = 1; b; })));
+  bar (1, ({ static char c[2]; c[0] = 1; c; }));
+  return ({ static char d[2]; d[0] = 1; d; });
+}
diff --git a/gcc/testsuite/g++.dg/abi/mangle50.C b/gcc/testsuite/g++.dg/abi/mangle50.C
new file mode 100644
index 00000000000..df7afb97edc
--- /dev/null
+++ b/gcc/testsuite/g++.dg/abi/mangle50.C
@@ -0,0 +1,25 @@
+// DR 342, PR c++/48582
+// { dg-options -std=c++0x }
+
+struct A;
+template < void * = nullptr > void f() { }
+template < void (A::*)() = nullptr > void g() { }
+template < int A::* = nullptr > void h() { }
+
+int main()
+{
+  // { dg-final { scan-assembler "_Z1fILPv0EEvv" } }
+  f();
+  f<nullptr>();
+
+  // { dg-final { scan-assembler "_Z1gILM1AFvvE0EEvv" } }
+  g();
+  g<nullptr>();
+
+  // { dg-final { scan-assembler "_Z1fILPv0EEvv" } }
+  h();
+  h<nullptr>();
+
+  constexpr void * ptr = nullptr;
+  f<ptr>();
+}
diff --git a/gcc/testsuite/g++.dg/bprob/bprob.exp b/gcc/testsuite/g++.dg/bprob/bprob.exp
index 8a46cf7beef..3f75a2e647d 100644
--- a/gcc/testsuite/g++.dg/bprob/bprob.exp
+++ b/gcc/testsuite/g++.dg/bprob/bprob.exp
@@ -51,7 +51,7 @@ if $tracelevel then {
 load_lib profopt.exp
 
 set profile_options "-fprofile-arcs"
-set feedback_options "-fprofile-use"
+set feedback_options "-fbranch-probabilities"
 
 # Main loop.
 foreach profile_option $profile_options feedback_option $feedback_options {
diff --git a/gcc/testsuite/g++.dg/cpp0x/initlist58.C b/gcc/testsuite/g++.dg/cpp0x/initlist58.C
new file mode 100644
index 00000000000..dfb9f0cd508
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/initlist58.C
@@ -0,0 +1,17 @@
+// PR c++/50209
+// { dg-options -std=c++0x }
+
+struct S { int i,j; };
+
+struct A
+{
+  static void f (S = {1,2});
+};
+
+void f (S = {3,4});
+
+int main()
+{
+  A::f();
+  f();
+}
diff --git a/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-use2.C b/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-use2.C
new file mode 100644
index 00000000000..695a0b43292
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/lambda/lambda-use2.C
@@ -0,0 +1,11 @@
+// PR c++/50224
+// { dg-options "-std=c++0x -Wunused-parameter" }
+
+struct T;
+
+void m(T& t) // ERROR here
+{
+  [&]{
+    t; // ``t`` is referenced here
+  };
+}
diff --git a/gcc/testsuite/g++.dg/cpp0x/sfinae27.C b/gcc/testsuite/g++.dg/cpp0x/sfinae27.C
new file mode 100644
index 00000000000..93327ba9cc5
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/sfinae27.C
@@ -0,0 +1,20 @@
+// PR c++/50157
+// { dg-options -std=c++0x }
+
+template<class T>
+T val();
+
+template<class T, class Arg, class =
+  decltype(::new T(val<Arg>()))
+>
+auto test(int) -> char;
+
+template<class, class>
+auto test(...) -> char (&)[2];
+
+struct P {
+  explicit operator bool(); // (#13)
+};
+
+typedef decltype(test<bool, P>(0)) type; // OK
+typedef decltype(test<float, P>(0)) type2; // Error (#17)
diff --git a/gcc/testsuite/g++.dg/dfp/base.C b/gcc/testsuite/g++.dg/dfp/base.C
new file mode 100644
index 00000000000..3e5dc50bafe
--- /dev/null
+++ b/gcc/testsuite/g++.dg/dfp/base.C
@@ -0,0 +1,23 @@
+// PR c++/50207
+// { dg-do compile }
+
+namespace std
+{
+  namespace decimal
+  {
+    template <class _Fmt> struct _FmtTraits;
+    class decimal32;
+    template <> struct _FmtTraits <decimal32>
+    {
+      static const long _NumBytes = 4UL;
+    };
+    template <class _Tr> class _DecBase
+    {
+      unsigned char _Bytes[_Tr::_NumBytes];
+    };
+    class decimal32 : public _DecBase <_FmtTraits <decimal32> >	// { dg-error "has base" }
+    {
+      decimal32 () { }
+    };
+  }
+}
diff --git a/gcc/testsuite/gcc.dg/pr50132.c b/gcc/testsuite/gcc.dg/pr50132.c
new file mode 100644
index 00000000000..84a9c731f8b
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr50132.c
@@ -0,0 +1,10 @@
+/* { dg-do compile } */
+/* { dg-options "-Os -fno-asynchronous-unwind-tables -g" } */
+
+void bar (long double n);
+
+void foo (int c)
+{
+  if (c)
+    bar (0);
+}
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ivopts-lt.c b/gcc/testsuite/gcc.dg/tree-ssa/ivopts-lt.c
new file mode 100644
index 00000000000..29d9d6046d5
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/tree-ssa/ivopts-lt.c
@@ -0,0 +1,20 @@
+/* { dg-do compile } */
+/* { dg-options "-O2 -fdump-tree-ivopts" } */
+
+void
+f1 (char *p, unsigned long int i, unsigned long int n)
+{
+  p += i;
+  do
+    {
+      *p = '\0';
+      p += 1;
+      i++;
+    }
+  while (i < n);
+}
+
+/* { dg-final { scan-tree-dump-times "PHI" 1 "ivopts"} } */
+/* { dg-final { scan-tree-dump-times "PHI <p_" 1 "ivopts"} } */
+/* { dg-final { scan-tree-dump-times "p_\[0-9\]* <" 1 "ivopts"} } */
+/* { dg-final { cleanup-tree-dump "ivopts" } } */
diff --git a/gcc/testsuite/gcc.misc-tests/bprob.exp b/gcc/testsuite/gcc.misc-tests/bprob.exp
index c05eced541b..e579b36bed0 100644
--- a/gcc/testsuite/gcc.misc-tests/bprob.exp
+++ b/gcc/testsuite/gcc.misc-tests/bprob.exp
@@ -48,7 +48,7 @@ if $tracelevel then {
 load_lib profopt.exp
 
 set profile_options "-fprofile-arcs"
-set feedback_options "-fprofile-use"
+set feedback_options "-fbranch-probabilities"
 
 foreach profile_option $profile_options feedback_option $feedback_options {
     foreach src [lsort [glob -nocomplain $srcdir/$subdir/bprob-*.c]] {
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-1.c b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-1.c
new file mode 100644
index 00000000000..45ab605e72e
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-1.c
@@ -0,0 +1,13 @@
+/* Use conditional compare */
+/* { dg-options "-O2" } */
+/* { dg-skip-if "" { arm_thumb1_ok } } */
+/* { dg-final { scan-assembler "cmpne" } } */
+
+int f(int i, int j) 
+{
+  if ( (i == '+') || (j == '-') ) {
+    return 1;
+  } else {
+    return 0;
+  }
+}
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-2.c b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-2.c
new file mode 100644
index 00000000000..17d9a8f76d6
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-2.c
@@ -0,0 +1,13 @@
+/* Use conditional compare */                                                                                         
+/* { dg-options "-O2" } */
+/* { dg-skip-if "" { arm_thumb1_ok } } */
+/* { dg-final { scan-assembler "cmpeq" } } */
+
+int f(int i, int j) 
+{
+  if ( (i == '+') && (j == '-') ) {
+    return 1;
+  } else {
+    return 0;
+  }
+}
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-3.c b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-3.c
new file mode 100644
index 00000000000..6b2a79b1a9e
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-3.c
@@ -0,0 +1,12 @@
+/* Use conditional compare */                                                                                         
+/* { dg-options "-O2" } */
+/* { dg-skip-if "" { arm_thumb1_ok } } */
+/* { dg-final { scan-assembler "cmpgt" } } */
+
+int f(int i, int j)
+{
+  if ( (i >= '+') ? (j > '-') : 0)
+    return 1;
+  else
+    return 0;
+}
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-4.c b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-4.c
new file mode 100644
index 00000000000..80e1076fd13
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-cond-cmp-4.c
@@ -0,0 +1,12 @@
+/* Use conditional compare */                                                                                         
+/* { dg-options "-O2" } */
+/* { dg-skip-if "" { arm_thumb1_ok } } */
+/* { dg-final { scan-assembler "cmpgt" } } */
+
+int f(int i, int j)
+{
+  if ( (i >= '+') ? (j <= '-') : 1)
+    return 1;
+  else
+    return 0;
+}
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant1.c b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant1.c
new file mode 100644
index 00000000000..e10ea03758b
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant1.c
@@ -0,0 +1,27 @@
+/* Ensure simple replicated constant immediates work.  */
+/* { dg-options "-mthumb -O2" } */
+/* { dg-require-effective-target arm_thumb2_ok } */
+
+int
+foo1 (int a)
+{
+  return a + 0xfefefefe;
+}
+
+/* { dg-final { scan-assembler "add.*#-16843010" } } */
+
+int
+foo2 (int a)
+{
+  return a - 0xab00ab00;
+}
+
+/* { dg-final { scan-assembler "sub.*#-1426019584" } } */
+
+int
+foo3 (int a)
+{
+  return a & 0x00cd00cd;
+}
+
+/* { dg-final { scan-assembler "and.*#13435085" } } */
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant2.c b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant2.c
new file mode 100644
index 00000000000..3739adba59d
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant2.c
@@ -0,0 +1,75 @@
+/* Ensure split constants can use replicated patterns.  */
+/* { dg-options "-mthumb -O2" } */
+/* { dg-require-effective-target arm_thumb2_ok } */
+
+int
+foo1 (int a)
+{
+  return a + 0xfe00fe01;
+}
+
+/* { dg-final { scan-assembler "add.*#-33489408" } } */
+/* { dg-final { scan-assembler "add.*#1" } } */
+
+int
+foo2 (int a)
+{
+  return a + 0xdd01dd00;
+}
+
+/* { dg-final { scan-assembler "add.*#-587145984" } } */
+/* { dg-final { scan-assembler "add.*#65536" } } */
+
+int
+foo3 (int a)
+{
+  return a + 0x00443344;
+}
+
+/* { dg-final { scan-assembler "add.*#4456516" } } */
+/* { dg-final { scan-assembler "add.*#13056" } } */
+
+int
+foo4 (int a)
+{
+  return a + 0x77330033;
+}
+
+/* { dg-final { scan-assembler "add.*#1996488704" } } */
+/* { dg-final { scan-assembler "add.*#3342387" } } */
+
+int
+foo5 (int a)
+{
+  return a + 0x11221122;
+}
+
+/* { dg-final { scan-assembler "add.*#285217024" } } */
+/* { dg-final { scan-assembler "add.*#2228258" } } */
+
+int
+foo6 (int a)
+{
+  return a + 0x66666677;
+}
+
+/* { dg-final { scan-assembler "add.*#1717986918" } } */
+/* { dg-final { scan-assembler "add.*#17" } } */
+
+int
+foo7 (int a)
+{
+  return a + 0x99888888;
+}
+
+/* { dg-final { scan-assembler "add.*#-2004318072" } } */
+/* { dg-final { scan-assembler "add.*#285212672" } } */
+
+int
+foo8 (int a)
+{
+  return a + 0xdddddfff;
+}
+
+/* { dg-final { scan-assembler "add.*#-572662307" } } */
+/* { dg-final { scan-assembler "addw.*#546" } } */
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant3.c b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant3.c
new file mode 100644
index 00000000000..eb6ad443c53
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant3.c
@@ -0,0 +1,28 @@
+/* Ensure negated/inverted replicated constant immediates work.  */
+/* { dg-options "-mthumb -O2" } */
+/* { dg-require-effective-target arm_thumb2_ok } */
+
+int
+foo1 (int a)
+{
+  return a | 0xffffff00;
+}
+
+/* { dg-final { scan-assembler "orn.*#255" } } */
+
+int
+foo2 (int a)
+{
+  return a & 0xffeeffee;
+}
+
+/* { dg-final { scan-assembler "bic.*#1114129" } } */
+
+int
+foo3 (int a)
+{
+  return a & 0xaaaaaa00;
+}
+
+/* { dg-final { scan-assembler "and.*#-1431655766" } } */
+/* { dg-final { scan-assembler "bic.*#170" } } */
diff --git a/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant4.c b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant4.c
new file mode 100644
index 00000000000..24efdcf34e2
--- /dev/null
+++ b/gcc/testsuite/gcc.target/arm/thumb2-replicated-constant4.c
@@ -0,0 +1,22 @@
+/* Ensure replicated constants don't make things worse.  */
+/* { dg-options "-mthumb -O2" } */
+/* { dg-require-effective-target arm_thumb2_ok } */
+
+int
+foo1 (int a)
+{
+  /* It might be tempting to use 0x01000100, but it wouldn't help. */
+  return a + 0x01f001e0;
+}
+
+/* { dg-final { scan-assembler "add.*#32505856" } } */
+/* { dg-final { scan-assembler "add.*#480" } } */
+
+int
+foo2 (int a)
+{
+  return a + 0x0f100e10;
+}
+
+/* { dg-final { scan-assembler "add.*#252706816" } } */
+/* { dg-final { scan-assembler "add.*#3600" } } */
diff --git a/gcc/testsuite/gcc.target/i386/avx-round-vec.c b/gcc/testsuite/gcc.target/i386/avx-round-vec.c
new file mode 100644
index 00000000000..d9514c17ddb
--- /dev/null
+++ b/gcc/testsuite/gcc.target/i386/avx-round-vec.c
@@ -0,0 +1,54 @@
+/* { dg-do run } */
+/* { dg-options "-O2 -ffast-math -ftree-vectorize -mavx" } */
+/* { dg-require-effective-target avx } */
+/* { dg-skip-if "no M_PI" { vxworks_kernel } } */
+
+#include "avx-check.h"
+
+#include <math.h>
+
+extern double floor (double);
+
+#define NUM 64
+
+static void
+__attribute__((__target__("fpmath=sse")))
+init_src (double *src)
+{
+  int i, sign = 1;
+  double f = rand ();
+
+  for (i = 0; i < NUM; i++)
+    {
+      src[i] = (i + 1) * f * M_PI * sign;
+      if (i < (NUM / 2))
+	{
+          if ((i % 6) == 0)
+	    f = f * src[i];
+        }
+      else if (i == (NUM / 2))
+	f = rand ();
+      else if ((i % 6) == 0)
+	f = 1 / (f * (i + 1) * src[i] * M_PI * sign);
+      sign = -sign;
+    }
+}
+
+static void
+__attribute__((__target__("fpmath=387")))
+avx_test (void)
+{
+  double a[NUM];
+  double r[NUM];
+  int i;
+
+  init_src (a);
+
+  for (i = 0; i < NUM; i++)
+    r[i] = round (a[i]);
+
+  /* check results:  */
+  for (i = 0; i < NUM; i++)
+    if (r[i] != round (a[i]))
+      abort();
+}
diff --git a/gcc/testsuite/gcc.target/i386/avx-roundf-vec.c b/gcc/testsuite/gcc.target/i386/avx-roundf-vec.c
new file mode 100644
index 00000000000..ec4c16691c2
--- /dev/null
+++ b/gcc/testsuite/gcc.target/i386/avx-roundf-vec.c
@@ -0,0 +1,54 @@
+/* { dg-do run } */
+/* { dg-options "-O2 -ffast-math -ftree-vectorize -mavx" } */
+/* { dg-require-effective-target avx } */
+/* { dg-skip-if "no M_PI" { vxworks_kernel } } */
+
+#include "avx-check.h"
+
+#include <math.h>
+
+extern float roundf (float);
+
+#define NUM 64
+
+static void
+__attribute__((__target__("fpmath=sse")))
+init_src (float *src)
+{
+  int i, sign = 1;
+  float f = rand ();
+
+  for (i = 0; i < NUM; i++)
+    {
+      src[i] = (i + 1) * f * M_PI * sign;
+      if (i < (NUM / 2))
+	{
+          if ((i % 6) == 0)
+	    f = f * src[i];
+        }
+      else if (i == (NUM / 2))
+	f = rand ();
+      else if ((i % 6) == 0)
+	f = 1 / (f * (i + 1) * src[i] * M_PI * sign);
+      sign = -sign;
+    }
+}
+
+static void
+__attribute__((__target__("fpmath=387")))
+avx_test (void)
+{
+  float a[NUM];
+  float r[NUM];
+  int i;
+
+  init_src (a);
+
+  for (i = 0; i < NUM; i++)
+    r[i] = roundf (a[i]);
+
+  /* check results:  */
+  for (i = 0; i < NUM; i++)
+    if (r[i] != roundf (a[i]))
+      abort();
+}
diff --git a/gcc/testsuite/gcc.target/i386/cmpxchg16b-1.c b/gcc/testsuite/gcc.target/i386/cmpxchg16b-1.c
index a78017aa2c5..e3402014e52 100644
--- a/gcc/testsuite/gcc.target/i386/cmpxchg16b-1.c
+++ b/gcc/testsuite/gcc.target/i386/cmpxchg16b-1.c
@@ -10,4 +10,4 @@ void test(TItype x_128)
   m_128 = __sync_val_compare_and_swap (&m_128, x_128, m_128);
 }
 
-/* { dg-final { scan-assembler "cmpxchg16b" } } */
+/* { dg-final { scan-assembler "cmpxchg16b\[ \\t]" } } */
diff --git a/gcc/testsuite/gcc.target/i386/pr48722.c b/gcc/testsuite/gcc.target/i386/pr48722.c
new file mode 100644
index 00000000000..a35fe7e22ae
--- /dev/null
+++ b/gcc/testsuite/gcc.target/i386/pr48722.c
@@ -0,0 +1,13 @@
+/* PR middle-end/48722 */
+/* { dg-do compile } */
+/* { dg-options "-Os -mno-push-args" } */
+
+extern long long a;
+extern int b;
+void bar (int, long long);
+
+void
+foo (void)
+{
+  bar (a > 0x85, b);
+}
diff --git a/gcc/testsuite/gcc.target/i386/pr50202.c b/gcc/testsuite/gcc.target/i386/pr50202.c
new file mode 100644
index 00000000000..2023ec86d8d
--- /dev/null
+++ b/gcc/testsuite/gcc.target/i386/pr50202.c
@@ -0,0 +1,15 @@
+/* { dg-do compile } */
+/* { dg-options "-O -fno-tree-dse -fno-dce -msse4" } */
+/* { dg-require-effective-target sse4 } */
+
+typedef char __v16qi __attribute__ ((__vector_size__ (16)));
+
+__v16qi v;
+int i;
+
+void
+foo (void)
+{
+  i = __builtin_ia32_pcmpistri128 (v, v, 255);
+  i = 255;
+}
diff --git a/gcc/testsuite/gcc.target/i386/sse4_1-round-vec.c b/gcc/testsuite/gcc.target/i386/sse4_1-round-vec.c
new file mode 100644
index 00000000000..dcd36cd2b11
--- /dev/null
+++ b/gcc/testsuite/gcc.target/i386/sse4_1-round-vec.c
@@ -0,0 +1,54 @@
+/* { dg-do run } */
+/* { dg-options "-O2 -ffast-math -ftree-vectorize -msse4.1" } */
+/* { dg-require-effective-target sse4 } */
+/* { dg-skip-if "no M_PI" { vxworks_kernel } } */
+
+#include "sse4_1-check.h"
+
+#include <math.h>
+
+extern double round (double);
+
+#define NUM 64
+
+static void
+__attribute__((__target__("fpmath=sse")))
+init_src (double *src)
+{
+  int i, sign = 1;
+  double f = rand ();
+
+  for (i = 0; i < NUM; i++)
+    {
+      src[i] = (i + 1) * f * M_PI * sign;
+      if (i < (NUM / 2))
+	{
+          if ((i % 6) == 0)
+	    f = f * src[i];
+        }
+      else if (i == (NUM / 2))
+	f = rand ();
+      else if ((i % 6) == 0)
+	f = 1 / (f * (i + 1) * src[i] * M_PI * sign);
+      sign = -sign;
+    }
+}
+
+static void
+__attribute__((__target__("fpmath=387")))
+sse4_1_test (void)
+{
+  double a[NUM];
+  double r[NUM];
+  int i;
+
+  init_src (a);
+
+  for (i = 0; i < NUM; i++)
+    r[i] = round (a[i]);
+
+  /* check results:  */
+  for (i = 0; i < NUM; i++)
+    if (r[i] != round (a[i]))
+      abort();
+}
diff --git a/gcc/testsuite/gcc.target/i386/sse4_1-roundf-vec.c b/gcc/testsuite/gcc.target/i386/sse4_1-roundf-vec.c
new file mode 100644
index 00000000000..d64660a1a91
--- /dev/null
+++ b/gcc/testsuite/gcc.target/i386/sse4_1-roundf-vec.c
@@ -0,0 +1,54 @@
+/* { dg-do run } */
+/* { dg-options "-O2 -ffast-math -ftree-vectorize -msse4.1" } */
+/* { dg-require-effective-target sse4 } */
+/* { dg-skip-if "no M_PI" { vxworks_kernel } } */
+
+#include "sse4_1-check.h"
+
+#include <math.h>
+
+extern float roundf (float);
+
+#define NUM 64
+
+static void
+__attribute__((__target__("fpmath=sse")))
+init_src (float *src)
+{
+  int i, sign = 1;
+  float f = rand ();
+
+  for (i = 0; i < NUM; i++)
+    {
+      src[i] = (i + 1) * f * M_PI * sign;
+      if (i < (NUM / 2))
+	{
+          if ((i % 6) == 0)
+	    f = f * src[i];
+        }
+      else if (i == (NUM / 2))
+	f = rand ();
+      else if ((i % 6) == 0)
+	f = 1 / (f * (i + 1) * src[i] * M_PI * sign);
+      sign = -sign;
+    }
+}
+
+static void
+__attribute__((__target__("fpmath=387")))
+sse4_1_test (void)
+{
+  float a[NUM];
+  float r[NUM];
+  int i;
+
+  init_src (a);
+
+  for (i = 0; i < NUM; i++)
+    r[i] = roundf (a[i]);
+
+  /* check results:  */
+  for (i = 0; i < NUM; i++)
+    if (r[i] != roundf (a[i]))
+      abort();
+}
diff --git a/gcc/testsuite/gfortran.dg/class_result_1.f03 b/gcc/testsuite/gfortran.dg/class_result_1.f03
new file mode 100644
index 00000000000..f1f542bb121
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_result_1.f03
@@ -0,0 +1,62 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! PR 50225: [OOP] The allocation status for polymorphic allocatable function results is not set properly
+!
+! Contributed by Arjen Markus <arjen.markus895@gmail.com>
+
+module points2d
+
+  implicit none
+
+  type point2d
+      real :: x, y
+  end type
+
+contains
+
+ subroutine print( point )
+   class(point2d) :: point
+   write(*,'(2f10.4)') point%x, point%y
+ end subroutine
+
+ subroutine random_vector( point )
+   class(point2d) :: point
+   call random_number( point%x )
+   call random_number( point%y )
+   point%x = 2.0 * (point%x - 0.5)
+   point%y = 2.0 * (point%y - 0.5)
+ end subroutine
+
+ function add_vector( point, vector )
+   class(point2d), intent(in)  :: point, vector
+   class(point2d), allocatable :: add_vector
+   allocate( add_vector )
+   add_vector%x = point%x + vector%x
+   add_vector%y = point%y + vector%y
+ end function
+
+end module points2d
+
+
+program random_walk
+
+  use points2d
+  implicit none
+
+  type(point2d), target   :: point_2d, vector_2d
+  class(point2d), pointer :: point, vector
+  integer :: i
+
+  point  => point_2d
+  vector => vector_2d
+
+  do i=1,2
+    call random_vector(point)
+    call random_vector(vector)
+    call print(add_vector(point, vector))
+  end do
+
+end program random_walk
+
+! { dg-final { cleanup-modules "points2d" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90 b/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90
new file mode 100644
index 00000000000..44f360e9826
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/50050
+! ICE whilst trying to access NULL shape.
+
+! Reduced from the FoX library http://www1.gly.bris.ac.uk/~walker/FoX/
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+module m_common_attrs
+  implicit none
+
+  type dict_item
+  end type dict_item
+
+  type dict_item_ptr
+     type(dict_item), pointer :: d => null()
+  end type dict_item_ptr
+
+contains
+
+  subroutine add_item_to_dict()
+    type(dict_item_ptr), pointer :: tempList(:)
+    integer :: n
+
+    allocate(tempList(0:n+1)) 
+  end subroutine add_item_to_dict
+
+end module m_common_attrs
+
+! { dg-final { cleanup-modules "m_common_attrs" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_compare_1.f90 b/gcc/testsuite/gfortran.dg/widechar_compare_1.f90
new file mode 100644
index 00000000000..44101104cc1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_compare_1.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! PR 50192 - on little-endian systems, this used to fail.
+program main
+  character(kind=4,len=2) :: c1, c2
+  c1 = 4_' '
+  c2 = 4_' '
+  c1(1:1) = transfer(257, mold=c1(1:1))
+  c2(1:1) = transfer(64, mold=c2(1:1))
+  if (c1 < c2) call abort
+end program main
diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c
index b266d1bc554..bcb8ba9b742 100644
--- a/gcc/tree-cfg.c
+++ b/gcc/tree-cfg.c
@@ -3193,25 +3193,55 @@ verify_gimple_comparison (tree type, tree op0, tree op1)
      effective type the comparison is carried out in.  Instead
      we require that either the first operand is trivially
      convertible into the second, or the other way around.
-     The resulting type of a comparison may be any integral type.
      Because we special-case pointers to void we allow
      comparisons of pointers with the same mode as well.  */
-  if ((!useless_type_conversion_p (op0_type, op1_type)
-       && !useless_type_conversion_p (op1_type, op0_type)
-       && (!POINTER_TYPE_P (op0_type)
-	   || !POINTER_TYPE_P (op1_type)
-	   || TYPE_MODE (op0_type) != TYPE_MODE (op1_type)))
-      || !INTEGRAL_TYPE_P (type)
-      || (TREE_CODE (type) != BOOLEAN_TYPE
-	  && TYPE_PRECISION (type) != 1))
-    {
-      error ("type mismatch in comparison expression");
-      debug_generic_expr (type);
+  if (!useless_type_conversion_p (op0_type, op1_type)
+      && !useless_type_conversion_p (op1_type, op0_type)
+      && (!POINTER_TYPE_P (op0_type)
+	  || !POINTER_TYPE_P (op1_type)
+	  || TYPE_MODE (op0_type) != TYPE_MODE (op1_type)))
+    {
+      error ("mismatching comparison operand types");
       debug_generic_expr (op0_type);
       debug_generic_expr (op1_type);
       return true;
     }
 
+  /* The resulting type of a comparison may be an effective boolean type.  */
+  if (INTEGRAL_TYPE_P (type)
+      && (TREE_CODE (type) == BOOLEAN_TYPE
+	  || TYPE_PRECISION (type) == 1))
+    ;
+  /* Or an integer vector type with the same size and element count
+     as the comparison operand types.  */
+  else if (TREE_CODE (type) == VECTOR_TYPE
+	   && TREE_CODE (TREE_TYPE (type)) == INTEGER_TYPE)
+    {
+      if (TREE_CODE (op0_type) != VECTOR_TYPE
+	  || TREE_CODE (op1_type) != VECTOR_TYPE)
+        {
+          error ("non-vector operands in vector comparison");
+          debug_generic_expr (op0_type);
+          debug_generic_expr (op1_type);
+          return true;
+        }
+
+      if (TYPE_VECTOR_SUBPARTS (type) != TYPE_VECTOR_SUBPARTS (op0_type)
+	  || (GET_MODE_SIZE (TYPE_MODE (type))
+	      != GET_MODE_SIZE (TYPE_MODE (op0_type))))
+        {
+          error ("invalid vector comparison resulting type");
+          debug_generic_expr (type);
+          return true;
+        }
+    }
+  else
+    {
+      error ("bogus comparison result type");
+      debug_generic_expr (type);
+      return true;
+    }
+
   return false;
 }
 
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index e24c7866208..2c4b5bf7395 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -820,6 +820,8 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
 	       infer them and MEM_ATTR caching will share MEM_REFs
 	       with differently-typed op0s.  */
 	    && TREE_CODE (TREE_OPERAND (node, 0)) != INTEGER_CST
+	    /* Released SSA_NAMES have no TREE_TYPE.  */
+	    && TREE_TYPE (TREE_OPERAND (node, 0)) != NULL_TREE
 	    /* Same pointer types, but ignoring POINTER_TYPE vs.
 	       REFERENCE_TYPE.  */
 	    && (TREE_TYPE (TREE_TYPE (TREE_OPERAND (node, 0)))
@@ -1186,6 +1188,8 @@ dump_generic_node (pretty_printer *buffer, tree node, int spc, int flags,
 		     can't infer them and MEM_ATTR caching will share
 		     MEM_REFs with differently-typed op0s.  */
 		  && TREE_CODE (TREE_OPERAND (op0, 0)) != INTEGER_CST
+		  /* Released SSA_NAMES have no TREE_TYPE.  */
+		  && TREE_TYPE (TREE_OPERAND (op0, 0)) != NULL_TREE
 		  /* Same pointer types, but ignoring POINTER_TYPE vs.
 		     REFERENCE_TYPE.  */
 		  && (TREE_TYPE (TREE_TYPE (TREE_OPERAND (op0, 0)))
diff --git a/gcc/tree-ssa-loop-ivopts.c b/gcc/tree-ssa-loop-ivopts.c
index 0efa716c9b1..67d04647c8b 100644
--- a/gcc/tree-ssa-loop-ivopts.c
+++ b/gcc/tree-ssa-loop-ivopts.c
@@ -176,6 +176,7 @@ struct cost_pair
   tree value;		/* For final value elimination, the expression for
 			   the final value of the iv.  For iv elimination,
 			   the new bound to compare with.  */
+  enum tree_code comp;	/* For iv elimination, the comparison.  */
   int inv_expr_id;      /* Loop invariant expression id.  */
 };
 
@@ -297,6 +298,9 @@ struct ivopts_data
 
   /* Whether the loop body includes any function calls.  */
   bool body_includes_call;
+
+  /* Whether the loop body can only be exited via single exit.  */
+  bool loop_single_exit_p;
 };
 
 /* An assignment of iv candidates to uses.  */
@@ -770,15 +774,13 @@ contains_abnormal_ssa_name_p (tree expr)
   return false;
 }
 
-/*  Returns tree describing number of iterations determined from
+/*  Returns the structure describing number of iterations determined from
     EXIT of DATA->current_loop, or NULL if something goes wrong.  */
 
-static tree
-niter_for_exit (struct ivopts_data *data, edge exit,
-                struct tree_niter_desc **desc_p)
+static struct tree_niter_desc *
+niter_for_exit (struct ivopts_data *data, edge exit)
 {
-  struct tree_niter_desc* desc = NULL;
-  tree niter;
+  struct tree_niter_desc *desc;
   void **slot;
 
   if (!data->niters)
@@ -791,37 +793,31 @@ niter_for_exit (struct ivopts_data *data, edge exit,
 
   if (!slot)
     {
-      /* Try to determine number of iterations.  We must know it
-	 unconditionally (i.e., without possibility of # of iterations
-	 being zero).  Also, we cannot safely work with ssa names that
-	 appear in phi nodes on abnormal edges, so that we do not create
-	 overlapping life ranges for them (PR 27283).  */
+      /* Try to determine number of iterations.  We cannot safely work with ssa
+         names that appear in phi nodes on abnormal edges, so that we do not
+         create overlapping life ranges for them (PR 27283).  */
       desc = XNEW (struct tree_niter_desc);
-      if (number_of_iterations_exit (data->current_loop,
-				     exit, desc, true)
-	  && integer_zerop (desc->may_be_zero)
-     	  && !contains_abnormal_ssa_name_p (desc->niter))
-	niter = desc->niter;
-      else
-	niter = NULL_TREE;
-
-      desc->niter = niter;
+      if (!number_of_iterations_exit (data->current_loop,
+				      exit, desc, true)
+     	  || contains_abnormal_ssa_name_p (desc->niter))
+	{
+	  XDELETE (desc);
+	  desc = NULL;
+	}
       slot = pointer_map_insert (data->niters, exit);
       *slot = desc;
     }
   else
-    niter = ((struct tree_niter_desc *) *slot)->niter;
+    desc = (struct tree_niter_desc *) *slot;
 
-  if (desc_p)
-    *desc_p = (struct tree_niter_desc *) *slot;
-  return niter;
+  return desc;
 }
 
-/* Returns tree describing number of iterations determined from
+/* Returns the structure describing number of iterations determined from
    single dominating exit of DATA->current_loop, or NULL if something
    goes wrong.  */
 
-static tree
+static struct tree_niter_desc *
 niter_for_single_dom_exit (struct ivopts_data *data)
 {
   edge exit = single_dom_exit (data->current_loop);
@@ -829,7 +825,7 @@ niter_for_single_dom_exit (struct ivopts_data *data)
   if (!exit)
     return NULL;
 
-  return niter_for_exit (data, exit, NULL);
+  return niter_for_exit (data, exit);
 }
 
 /* Hash table equality function for expressions.  */
@@ -1174,12 +1170,17 @@ find_induction_variables (struct ivopts_data *data)
 
   if (dump_file && (dump_flags & TDF_DETAILS))
     {
-      tree niter = niter_for_single_dom_exit (data);
+      struct tree_niter_desc *niter = niter_for_single_dom_exit (data);
 
       if (niter)
 	{
 	  fprintf (dump_file, "  number of iterations ");
-	  print_generic_expr (dump_file, niter, TDF_SLIM);
+	  print_generic_expr (dump_file, niter->niter, TDF_SLIM);
+	  if (!integer_zerop (niter->may_be_zero))
+	    {
+	      fprintf (dump_file, "; zero if ");
+	      print_generic_expr (dump_file, niter->may_be_zero, TDF_SLIM);
+	    }
 	  fprintf (dump_file, "\n\n");
     	};
 
@@ -2217,7 +2218,10 @@ add_candidate_1 (struct ivopts_data *data,
   struct iv_cand *cand = NULL;
   tree type, orig_type;
 
-  if (base)
+  /* For non-original variables, make sure their values are computed in a type
+     that does not invoke undefined behavior on overflows (since in general,
+     we cannot prove that these induction variables are non-wrapping).  */
+  if (pos != IP_ORIGINAL)
     {
       orig_type = TREE_TYPE (base);
       type = generic_type_for (orig_type);
@@ -2663,13 +2667,13 @@ infinite_cost_p (comp_cost cost)
 
 /* Sets cost of (USE, CANDIDATE) pair to COST and record that it depends
    on invariants DEPENDS_ON and that the value used in expressing it
-   is VALUE.  */
+   is VALUE, and in case of iv elimination the comparison operator is COMP.  */
 
 static void
 set_use_iv_cost (struct ivopts_data *data,
 		 struct iv_use *use, struct iv_cand *cand,
 		 comp_cost cost, bitmap depends_on, tree value,
-                 int inv_expr_id)
+		 enum tree_code comp, int inv_expr_id)
 {
   unsigned i, s;
 
@@ -2685,6 +2689,7 @@ set_use_iv_cost (struct ivopts_data *data,
       use->cost_map[cand->id].cost = cost;
       use->cost_map[cand->id].depends_on = depends_on;
       use->cost_map[cand->id].value = value;
+      use->cost_map[cand->id].comp = comp;
       use->cost_map[cand->id].inv_expr_id = inv_expr_id;
       return;
     }
@@ -2705,6 +2710,7 @@ found:
   use->cost_map[i].cost = cost;
   use->cost_map[i].depends_on = depends_on;
   use->cost_map[i].value = value;
+  use->cost_map[i].comp = comp;
   use->cost_map[i].inv_expr_id = inv_expr_id;
 }
 
@@ -4257,14 +4263,15 @@ determine_use_iv_cost_generic (struct ivopts_data *data,
   if (cand->pos == IP_ORIGINAL
       && cand->incremented_at == use->stmt)
     {
-      set_use_iv_cost (data, use, cand, zero_cost, NULL, NULL_TREE, -1);
+      set_use_iv_cost (data, use, cand, zero_cost, NULL, NULL_TREE,
+                       ERROR_MARK, -1);
       return true;
     }
 
   cost = get_computation_cost (data, use, cand, false, &depends_on,
                                NULL, &inv_expr_id);
 
-  set_use_iv_cost (data, use, cand, cost, depends_on, NULL_TREE,
+  set_use_iv_cost (data, use, cand, cost, depends_on, NULL_TREE, ERROR_MARK,
                    inv_expr_id);
 
   return !infinite_cost_p (cost);
@@ -4292,7 +4299,7 @@ determine_use_iv_cost_address (struct ivopts_data *data,
       else if (cand->pos == IP_AFTER_USE || cand->pos == IP_BEFORE_USE)
 	cost = infinite_cost;
     }
-  set_use_iv_cost (data, use, cand, cost, depends_on, NULL_TREE,
+  set_use_iv_cost (data, use, cand, cost, depends_on, NULL_TREE, ERROR_MARK,
                    inv_expr_id);
 
   return !infinite_cost_p (cost);
@@ -4368,16 +4375,261 @@ iv_elimination_compare (struct ivopts_data *data, struct iv_use *use)
   return (exit->flags & EDGE_TRUE_VALUE ? EQ_EXPR : NE_EXPR);
 }
 
+static tree
+strip_wrap_conserving_type_conversions (tree exp)
+{
+  while (tree_ssa_useless_type_conversion (exp)
+	 && (nowrap_type_p (TREE_TYPE (exp))
+	     == nowrap_type_p (TREE_TYPE (TREE_OPERAND (exp, 0)))))
+    exp = TREE_OPERAND (exp, 0);
+  return exp;
+}
+
+/* Walk the SSA form and check whether E == WHAT.  Fairly simplistic, we
+   check for an exact match.  */
+
+static bool
+expr_equal_p (tree e, tree what)
+{
+  gimple stmt;
+  enum tree_code code;
+
+  e = strip_wrap_conserving_type_conversions (e);
+  what = strip_wrap_conserving_type_conversions (what);
+
+  code = TREE_CODE (what);
+  if (TREE_TYPE (e) != TREE_TYPE (what))
+    return false;
+
+  if (operand_equal_p (e, what, 0))
+    return true;
+
+  if (TREE_CODE (e) != SSA_NAME)
+    return false;
+
+  stmt = SSA_NAME_DEF_STMT (e);
+  if (gimple_code (stmt) != GIMPLE_ASSIGN
+      || gimple_assign_rhs_code (stmt) != code)
+    return false;
+
+  switch (get_gimple_rhs_class (code))
+    {
+    case GIMPLE_BINARY_RHS:
+      if (!expr_equal_p (gimple_assign_rhs2 (stmt), TREE_OPERAND (what, 1)))
+	return false;
+      /* Fallthru.  */
+
+    case GIMPLE_UNARY_RHS:
+    case GIMPLE_SINGLE_RHS:
+      return expr_equal_p (gimple_assign_rhs1 (stmt), TREE_OPERAND (what, 0));
+    default:
+      return false;
+    }
+}
+
+/* Returns true if we can prove that BASE - OFFSET does not overflow.  For now,
+   we only detect the situation that BASE = SOMETHING + OFFSET, where the
+   calculation is performed in non-wrapping type.
+
+   TODO: More generally, we could test for the situation that
+	 BASE = SOMETHING + OFFSET' and OFFSET is between OFFSET' and zero.
+	 This would require knowing the sign of OFFSET.
+
+	 Also, we only look for the first addition in the computation of BASE.
+	 More complex analysis would be better, but introducing it just for
+	 this optimization seems like an overkill.  */
+
+static bool
+difference_cannot_overflow_p (tree base, tree offset)
+{
+  enum tree_code code;
+  tree e1, e2;
+
+  if (!nowrap_type_p (TREE_TYPE (base)))
+    return false;
+
+  base = expand_simple_operations (base);
+
+  if (TREE_CODE (base) == SSA_NAME)
+    {
+      gimple stmt = SSA_NAME_DEF_STMT (base);
+
+      if (gimple_code (stmt) != GIMPLE_ASSIGN)
+	return false;
+
+      code = gimple_assign_rhs_code (stmt);
+      if (get_gimple_rhs_class (code) != GIMPLE_BINARY_RHS)
+	return false;
+
+      e1 = gimple_assign_rhs1 (stmt);
+      e2 = gimple_assign_rhs2 (stmt);
+    }
+  else
+    {
+      code = TREE_CODE (base);
+      if (get_gimple_rhs_class (code) != GIMPLE_BINARY_RHS)
+	return false;
+      e1 = TREE_OPERAND (base, 0);
+      e2 = TREE_OPERAND (base, 1);
+    }
+
+  /* TODO: deeper inspection may be necessary to prove the equality.  */
+  switch (code)
+    {
+    case PLUS_EXPR:
+      return expr_equal_p (e1, offset) || expr_equal_p (e2, offset);
+    case POINTER_PLUS_EXPR:
+      return expr_equal_p (e2, offset);
+
+    default:
+      return false;
+    }
+}
+
+/* Tries to replace loop exit by one formulated in terms of a LT_EXPR
+   comparison with CAND.  NITER describes the number of iterations of
+   the loops.  If successful, the comparison in COMP_P is altered accordingly.
+
+   We aim to handle the following situation:
+
+   sometype *base, *p;
+   int a, b, i;
+
+   i = a;
+   p = p_0 = base + a;
+
+   do
+     {
+       bla (*p);
+       p++;
+       i++;
+     }
+   while (i < b);
+
+   Here, the number of iterations of the loop is (a + 1 > b) ? 0 : b - a - 1.
+   We aim to optimize this to
+
+   p = p_0 = base + a;
+   do
+     {
+       bla (*p);
+       p++;
+     }
+   while (p < p_0 - a + b);
+
+   This preserves the correctness, since the pointer arithmetics does not
+   overflow.  More precisely:
+
+   1) if a + 1 <= b, then p_0 - a + b is the final value of p, hence there is no
+      overflow in computing it or the values of p.
+   2) if a + 1 > b, then we need to verify that the expression p_0 - a does not
+      overflow.  To prove this, we use the fact that p_0 = base + a.  */
+
+static bool
+iv_elimination_compare_lt (struct ivopts_data *data,
+                           struct iv_cand *cand, enum tree_code *comp_p,
+			   struct tree_niter_desc *niter)
+{
+  tree cand_type, a, b, mbz, nit_type = TREE_TYPE (niter->niter), offset;
+  struct affine_tree_combination nit, tmpa, tmpb;
+  enum tree_code comp;
+  HOST_WIDE_INT step;
+
+  /* We need to know that the candidate induction variable does not overflow.
+     While more complex analysis may be used to prove this, for now just
+     check that the variable appears in the original program and that it
+     is computed in a type that guarantees no overflows.  */
+  cand_type = TREE_TYPE (cand->iv->base);
+  if (cand->pos != IP_ORIGINAL || !nowrap_type_p (cand_type))
+    return false;
+
+  /* Make sure that the loop iterates till the loop bound is hit, as otherwise
+     the calculation of the BOUND could overflow, making the comparison
+     invalid.  */
+  if (!data->loop_single_exit_p)
+    return false;
+
+  /* We need to be able to decide whether candidate is increasing or decreasing
+     in order to choose the right comparison operator.  */
+  if (!cst_and_fits_in_hwi (cand->iv->step))
+    return false;
+  step = int_cst_value (cand->iv->step);
+
+  /* Check that the number of iterations matches the expected pattern:
+     a + 1 > b ? 0 : b - a - 1.  */
+  mbz = niter->may_be_zero;
+  if (TREE_CODE (mbz) == GT_EXPR)
+    {
+      /* Handle a + 1 > b.  */
+      tree op0 = TREE_OPERAND (mbz, 0);
+      if (TREE_CODE (op0) == PLUS_EXPR && integer_onep (TREE_OPERAND (op0, 1)))
+	{
+	  a = TREE_OPERAND (op0, 0);
+	  b = TREE_OPERAND (mbz, 1);
+	}
+      else
+	return false;
+    }
+  else if (TREE_CODE (mbz) == LT_EXPR)
+    {
+      tree op1 = TREE_OPERAND (mbz, 1);
+
+      /* Handle b < a + 1.  */
+      if (TREE_CODE (op1) == PLUS_EXPR && integer_onep (TREE_OPERAND (op1, 1)))
+        {
+          a = TREE_OPERAND (op1, 0);
+          b = TREE_OPERAND (mbz, 0);
+        }
+      else
+	return false;
+    }
+  else
+    return false;
+
+  /* Expected number of iterations is B - A - 1.  Check that it matches
+     the actual number, i.e., that B - A - NITER = 1.  */
+  tree_to_aff_combination (niter->niter, nit_type, &nit);
+  tree_to_aff_combination (fold_convert (nit_type, a), nit_type, &tmpa);
+  tree_to_aff_combination (fold_convert (nit_type, b), nit_type, &tmpb);
+  aff_combination_scale (&nit, double_int_minus_one);
+  aff_combination_scale (&tmpa, double_int_minus_one);
+  aff_combination_add (&tmpb, &tmpa);
+  aff_combination_add (&tmpb, &nit);
+  if (tmpb.n != 0 || !double_int_equal_p (tmpb.offset, double_int_one))
+    return false;
+
+  /* Finally, check that CAND->IV->BASE - CAND->IV->STEP * A does not
+     overflow.  */
+  offset = fold_build2 (MULT_EXPR, TREE_TYPE (cand->iv->step),
+			cand->iv->step,
+			fold_convert (TREE_TYPE (cand->iv->step), a));
+  if (!difference_cannot_overflow_p (cand->iv->base, offset))
+    return false;
+
+  /* Determine the new comparison operator.  */
+  comp = step < 0 ? GT_EXPR : LT_EXPR;
+  if (*comp_p == NE_EXPR)
+    *comp_p = comp;
+  else if (*comp_p == EQ_EXPR)
+    *comp_p = invert_tree_comparison (comp, false);
+  else
+    gcc_unreachable ();
+
+  return true;
+}
+
 /* Check whether it is possible to express the condition in USE by comparison
-   of candidate CAND.  If so, store the value compared with to BOUND.  */
+   of candidate CAND.  If so, store the value compared with to BOUND, and the
+   comparison operator to COMP.  */
 
 static bool
 may_eliminate_iv (struct ivopts_data *data,
-		  struct iv_use *use, struct iv_cand *cand, tree *bound)
+		  struct iv_use *use, struct iv_cand *cand, tree *bound,
+		  enum tree_code *comp)
 {
   basic_block ex_bb;
   edge exit;
-  tree nit, period;
+  tree period;
   struct loop *loop = data->current_loop;
   aff_tree bnd;
   struct tree_niter_desc *desc = NULL;
@@ -4399,8 +4651,8 @@ may_eliminate_iv (struct ivopts_data *data,
   if (flow_bb_inside_loop_p (loop, exit->dest))
     return false;
 
-  nit = niter_for_exit (data, exit, &desc);
-  if (!nit)
+  desc = niter_for_exit (data, exit);
+  if (!desc)
     return false;
 
   /* Determine whether we can use the variable to test the exit condition.
@@ -4409,17 +4661,17 @@ may_eliminate_iv (struct ivopts_data *data,
   period = iv_period (cand->iv);
 
   /* If the number of iterations is constant, compare against it directly.  */
-  if (TREE_CODE (nit) == INTEGER_CST)
+  if (TREE_CODE (desc->niter) == INTEGER_CST)
     {
       /* See cand_value_at.  */
       if (stmt_after_increment (loop, cand, use->stmt))
         {
-          if (!tree_int_cst_lt (nit, period))
+          if (!tree_int_cst_lt (desc->niter, period))
             return false;
         }
       else
         {
-          if (tree_int_cst_lt (period, nit))
+          if (tree_int_cst_lt (period, desc->niter))
             return false;
         }
     }
@@ -4438,7 +4690,7 @@ may_eliminate_iv (struct ivopts_data *data,
       if (double_int_ucmp (max_niter, period_value) > 0)
         {
           /* See if we can take advantage of infered loop bound information.  */
-          if (loop_only_exit_p (loop, exit))
+          if (data->loop_single_exit_p)
             {
               if (!estimated_loop_iterations (loop, true, &max_niter))
                 return false;
@@ -4451,13 +4703,26 @@ may_eliminate_iv (struct ivopts_data *data,
         }
     }
 
-  cand_value_at (loop, cand, use->stmt, nit, &bnd);
+  cand_value_at (loop, cand, use->stmt, desc->niter, &bnd);
 
   *bound = aff_combination_to_tree (&bnd);
+  *comp = iv_elimination_compare (data, use);
+
   /* It is unlikely that computing the number of iterations using division
      would be more profitable than keeping the original induction variable.  */
   if (expression_expensive_p (*bound))
     return false;
+
+  /* Sometimes, it is possible to handle the situation that the number of
+     iterations may be zero unless additional assumtions by using <
+     instead of != in the exit condition.
+
+     TODO: we could also calculate the value MAY_BE_ZERO ? 0 : NITER and
+	   base the exit condition on it.  However, that is often too
+	   expensive.  */
+  if (!integer_zerop (desc->may_be_zero))
+    return iv_elimination_compare_lt (data, cand, comp, desc);
+
   return true;
 }
 
@@ -4492,16 +4757,18 @@ determine_use_iv_cost_condition (struct ivopts_data *data,
   bool ok;
   int elim_inv_expr_id = -1, express_inv_expr_id = -1, inv_expr_id;
   tree *control_var, *bound_cst;
+  enum tree_code comp = ERROR_MARK;
 
   /* Only consider real candidates.  */
   if (!cand->iv)
     {
-      set_use_iv_cost (data, use, cand, infinite_cost, NULL, NULL_TREE, -1);
+      set_use_iv_cost (data, use, cand, infinite_cost, NULL, NULL_TREE,
+		       ERROR_MARK, -1);
       return false;
     }
 
   /* Try iv elimination.  */
-  if (may_eliminate_iv (data, use, cand, &bound))
+  if (may_eliminate_iv (data, use, cand, &bound, &comp))
     {
       elim_cost = force_var_cost (data, bound, &depends_on_elim);
       if (elim_cost.cost == 0)
@@ -4572,10 +4839,11 @@ determine_use_iv_cost_condition (struct ivopts_data *data,
       depends_on = depends_on_express;
       depends_on_express = NULL;
       bound = NULL_TREE;
+      comp = ERROR_MARK;
       inv_expr_id = express_inv_expr_id;
     }
 
-  set_use_iv_cost (data, use, cand, cost, depends_on, bound, inv_expr_id);
+  set_use_iv_cost (data, use, cand, cost, depends_on, bound, comp, inv_expr_id);
 
   if (depends_on_elim)
     BITMAP_FREE (depends_on_elim);
@@ -6215,7 +6483,7 @@ rewrite_use_compare (struct ivopts_data *data,
           fprintf (dump_file, "Replacing exit test: ");
           print_gimple_stmt (dump_file, use->stmt, 0, TDF_SLIM);
         }
-      compare = iv_elimination_compare (data, use);
+      compare = cp->comp;
       bound = unshare_expr (fold_convert (var_type, bound));
       op = force_gimple_operand (bound, &stmts, true, NULL_TREE);
       if (stmts)
@@ -6445,7 +6713,7 @@ tree_ssa_iv_optimize_loop (struct ivopts_data *data, struct loop *loop)
 {
   bool changed = false;
   struct iv_ca *iv_ca;
-  edge exit;
+  edge exit = single_dom_exit (loop);
   basic_block *body;
 
   gcc_assert (!data->niters);
@@ -6456,7 +6724,6 @@ tree_ssa_iv_optimize_loop (struct ivopts_data *data, struct loop *loop)
     {
       fprintf (dump_file, "Processing loop %d\n", loop->num);
 
-      exit = single_dom_exit (loop);
       if (exit)
 	{
 	  fprintf (dump_file, "  single exit %d -> %d, exit condition ",
@@ -6473,6 +6740,8 @@ tree_ssa_iv_optimize_loop (struct ivopts_data *data, struct loop *loop)
   renumber_gimple_stmt_uids_in_blocks (body, loop->num_nodes);
   free (body);
 
+  data->loop_single_exit_p = exit != NULL && loop_only_exit_p (loop, exit);
+
   /* For each ssa name determines whether it behaves as an induction variable
      in some loop.  */
   if (!find_induction_variables (data))
diff --git a/gcc/tree.def b/gcc/tree.def
index d4b3cb98d6e..ea255d5805d 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -704,7 +704,10 @@ DEFTREECODE (TRUTH_NOT_EXPR, "truth_not_expr", tcc_expression, 1)
    The others are allowed only for integer (or pointer or enumeral)
    or real types.
    In all cases the operands will have the same type,
-   and the value is always the type used by the language for booleans.  */
+   and the value is either the type used by the language for booleans
+   or an integer vector type of the same size and with the same number
+   of elements as the comparison operands.  True for a vector of
+   comparison results has all bits set while false is equal to zero.  */
 DEFTREECODE (LT_EXPR, "lt_expr", tcc_comparison, 2)
 DEFTREECODE (LE_EXPR, "le_expr", tcc_comparison, 2)
 DEFTREECODE (GT_EXPR, "gt_expr", tcc_comparison, 2)
diff --git a/gcc/tree.h b/gcc/tree.h
index 1f56c499c49..06f67f425d9 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -5274,7 +5274,7 @@ extern tree build_simple_mem_ref_loc (location_t, tree);
 extern double_int mem_ref_offset (const_tree);
 extern tree reference_alias_ptr_type (const_tree);
 extern tree build_invariant_address (tree, tree, HOST_WIDE_INT);
-extern tree constant_boolean_node (int, tree);
+extern tree constant_boolean_node (bool, tree);
 extern tree div_if_zero_remainder (enum tree_code, const_tree, const_tree);
 
 extern bool tree_swap_operands_p (const_tree, const_tree, bool);
diff --git a/gcc/var-tracking.c b/gcc/var-tracking.c
index f67b3f5d183..ae45e5215ed 100644
--- a/gcc/var-tracking.c
+++ b/gcc/var-tracking.c
@@ -8488,13 +8488,13 @@ create_entry_value (rtx rtl, cselib_val *val)
   cselib_val *val2;
   struct elt_loc_list *el;
   el = (struct elt_loc_list *) ggc_alloc_cleared_atomic (sizeof (*el));
-  el->next = val->locs;
   el->loc = gen_rtx_ENTRY_VALUE (GET_MODE (rtl));
   ENTRY_VALUE_EXP (el->loc) = rtl;
-  el->setting_insn = get_insns ();
-  val->locs = el;
   val2 = cselib_lookup_from_insn (el->loc, GET_MODE (rtl), true,
 				  VOIDmode, get_insns ());
+  el->next = val->locs;
+  el->setting_insn = get_insns ();
+  val->locs = el;
   if (val2
       && val2 != val
       && val2->locs
diff --git a/gcc/varasm.c b/gcc/varasm.c
index a612888d6f3..e83bebbb04e 100644
--- a/gcc/varasm.c
+++ b/gcc/varasm.c
@@ -2592,6 +2592,12 @@ decode_addr_const (tree exp, struct addr_const *value)
 		     * tree_low_cst (TREE_OPERAND (target, 1), 0));
 	  target = TREE_OPERAND (target, 0);
 	}
+      else if (TREE_CODE (target) == MEM_REF
+	       && TREE_CODE (TREE_OPERAND (target, 0)) == ADDR_EXPR)
+	{
+	  offset += mem_ref_offset (target).low;
+	  target = TREE_OPERAND (TREE_OPERAND (target, 0), 0);
+	}
       else if (TREE_CODE (target) == INDIRECT_REF
 	       && TREE_CODE (TREE_OPERAND (target, 0)) == NOP_EXPR
 	       && TREE_CODE (TREE_OPERAND (TREE_OPERAND (target, 0), 0))