[multiple changes]

2012-07-09  Thomas Quinot  <quinot@adacore.com>

	* einfo.adb (Set_Reverse_Storage_Order): Update assertion,
	flag is now valid for array types as well.

2012-07-09  Tristan Gingold  <gingold@adacore.com>

	* tracebak.c: Implement __gnat_backtrace for Win64 SEH.

2012-07-09  Robert Dewar  <dewar@adacore.com>

	* einfo.ads: Minor reformatting.

2012-07-09  Javier Miranda  <miranda@adacore.com>

	* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): Handle as
	renaming_as_body renamings of predefined dispatching equality
	and unequality operators.

2012-07-09  Robert Dewar  <dewar@adacore.com>

	* rident.ads: Do not instantiate r-ident.ads, this is now an
	independent unit.

2012-07-09  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Write_DT): Avoid runtime crash of this debugging
	routine.
	* sem_disp.adb (Find_Dispatching_Time): Protect this routine
	against partially decorated entities.

2012-07-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Check_Size): Reject a size clause that specifies
	a value greater than Int'Last for a scalar type.

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* sem_ch9.adb (Allows_Lock_Free_Implementation): type must support
	atomic operation moved to the protected body case. No non-elementary
	out parameter moved to the protected declaration case. Functions have
	only one lock-free restriction.
	(Analyze_Protected_Type_Declaration): Issue a warning when
	Priority given with Lock_Free.

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* sem_dim.adb: Grammar of aspect Dimension fixed.

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* freeze.adb (Freeze_Record_Type): Code reorg in order to avoid
	pushing and popping the scope stack whenever a delayed aspect occurs.

2012-07-09  Gary Dismukes  <dismukes@adacore.com>

	* s-os_lib.ads: Remove pragma Elaborate_Body, as
	this is now unnecessary due to recently added pragma Preelaborate.

2012-07-09  Jose Ruiz  <ruiz@adacore.com>

	* s-taprop-mingw.adb (Set_Priority): Remove the code that was
	previously in place to reorder the ready queue when a task drops
	its priority due to the loss of inherited priority.

From-SVN: r189377

1 files changed, 71 insertions, 1 deletions

diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c
index ff2a3b6..b65dbc7 100644
--- a/gcc/ada/tracebak.c
+++ b/gcc/ada/tracebak.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *            Copyright (C) 2000-2011, Free Software Foundation, Inc.       *
+ *            Copyright (C) 2000-2012, 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- *
@@ -106,6 +106,76 @@ extern void (*Unlock_Task) (void);
 
 #include "tb-ivms.c"
 
+#elif defined (_WIN64) && defined (__SEH__)
+
+#include <windows.h>
+
+int
+__gnat_backtrace (void **array,
+                  int size,
+                  void *exclude_min,
+                  void *exclude_max,
+                  int skip_frames)
+{
+  CONTEXT context;
+  UNWIND_HISTORY_TABLE history;
+  int i;
+
+  /* Get the context.  */
+  RtlCaptureContext (&context);
+
+  /* Setup unwind history table (a cached to speed-up unwinding).  */
+  memset (&history, 0, sizeof (history));
+
+  i = 0;
+  while (1)
+    {
+      PRUNTIME_FUNCTION RuntimeFunction;
+      KNONVOLATILE_CONTEXT_POINTERS NvContext;
+      ULONG64 ImageBase;
+      VOID *HandlerData;
+      ULONG64 EstablisherFrame;
+
+      /* Get function metadata.  */
+      RuntimeFunction = RtlLookupFunctionEntry
+	(context.Rip, &ImageBase, &history);
+
+      if (!RuntimeFunction)
+	{
+	  /* In case of failure, assume this is a leaf function.  */
+	  context.Rip = *(ULONG64 **) context.Rsp;
+	  context.Rsp += 8;
+	}
+      else
+	{
+	  /* Unwind.  */
+	  memset (&NvContext, 0, sizeof (KNONVOLATILE_CONTEXT_POINTERS));
+	  RtlVirtualUnwind (0, ImageBase, context.Rip, RuntimeFunction,
+			    &context, &HandlerData, &EstablisherFrame,
+			    &NvContext);
+	}
+
+      /* 0 means bottom of the stack.  */
+      if (context.Rip == 0)
+	break;
+
+      /* Skip frames.  */
+      if (skip_frames)
+	{
+	  skip_frames--;
+	  continue;
+	}
+      /* Excluded frames.  */
+      if ((void *)context.Rip >= exclude_min
+	  && (void *)context.Rip <= exclude_max)
+	continue;
+
+      array[i++] = context.Rip - 2;
+      if (i >= size)
+	break;
+    }
+  return i;
+}
 #else
 
 /* No target specific implementation.  */