* bindgen.adb: Minor reformatting

	* cstand.adb: Minor reformatting

	* fmap.adb: Minor reformatting
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fmap.ads:
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fname-uf.adb: Minor reformatting.  New names of stuff in Fmap.
	Add use clause for Fmap.

	* make.adb: Minor reformatting

	* osint.adb: Minor reformatting.  Change of names in Fmap.
	Add use clause for Fmap.

	* prj-env.adb: Minor reformatting

	* prj-env.ads: Minor reformatting

	* switch.adb: Minor reformatting.  Do proper raise of Bad_Switch if
	error found (there were odd exceptions to this general rule in
	-gnatec/-gnatem processing)

	* raise.c (__gnat_eh_personality): Exception handling personality
	routine for Ada.  Still in rough state, inspired from the C++ version
	and still containing a bunch of debugging artifacts.
	(parse_lsda_header, get_ttype_entry): Local (static) helpers, also
	inspired from the C++ library.

	* raise.c (eh_personality): Add comments. Part of work for the GCC 3
	exception handling integration.

	* Makefile.in: Remove use of 5smastop.adb which is obsolete.
	(HIE_SOURCES): Add s-secsta.ad{s,b}.
	(HIE_OBJS): Add s-fat*.o
	(RAVEN_SOURCES): Remove files that are no longer required. Add
	interrupt handling files.
	(RAVEN_MOD): Removed, no longer needed.

	* a-ngelfu.adb: Remove ??? comment for inappropriate Inline_Always
	Add 2001 to copyright date

	* g-regpat.adb: Change pragma Inline_Always to Inline. There is no
	need to force universal inlining for these cases.

	* s-taprob.adb: Minor clean ups so that this unit can be used in
	Ravenscar HI.

	* exp_ch7.adb: Allow use of secondary stack in HI mode.
	Disallow it when pragma Restrictions (No_Secondary_Stack) is specified.

	* prj-tree.ads (Project_Node_Record): Add comments for components
	Pkg_Id and Case_Insensitive.

	* g-socket.adb: Minor reformatting. Found while reading code.

	* prj-tree.ads: Minor reformatting


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

1 files changed, 525 insertions, 1 deletions

diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c
index 43d630795a8..2d48db80693 100644
--- a/gcc/ada/raise.c
+++ b/gcc/ada/raise.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *                            $Revision: 1.1 $
+ *                            $Revision$
  *                                                                          *
  *             Copyright (C) 1992-2001, Free Software Foundation, Inc.      *
  *                                                                          *
@@ -84,3 +84,527 @@ __gnat_unhandled_terminate ()
     __gnat_os_exit (1);
 #endif
 }
+
+/* Below is the eh personality routine for Ada to be called when the GCC
+   mechanism is used.
+
+   ??? It is currently inspired from the one for C++, needs cleanups and
+   additional comments. It also contains a big bunch of debugging code that
+   we shall get rid of at some point.  */
+
+#ifdef IN_RTS   /* For eh personality routine */
+
+/* ??? Does it make any sense to leave this for the compiler ?   */
+
+#include "dwarf2.h"
+#include "unwind.h"
+#include "unwind-dw2-fde.h"
+#include "unwind-pe.h"
+
+/* First define a set of useful structures and helper routines.  */
+
+typedef struct _Unwind_Context _Unwind_Context;
+
+struct lsda_header_info
+{
+  _Unwind_Ptr Start;
+  _Unwind_Ptr LPStart;
+  _Unwind_Ptr ttype_base;
+  const unsigned char *TType;
+  const unsigned char *action_table;
+  unsigned char ttype_encoding;
+  unsigned char call_site_encoding;
+};
+
+typedef struct lsda_header_info lsda_header_info;
+
+typedef enum {false = 0, true = 1} bool;
+
+static const unsigned char *
+parse_lsda_header (_Unwind_Context *context, const unsigned char *p,
+		   lsda_header_info *info)
+{
+  _Unwind_Ptr tmp;
+  unsigned char lpstart_encoding;
+
+  info->Start = (context ? _Unwind_GetRegionStart (context) : 0);
+
+  /* Find @LPStart, the base to which landing pad offsets are relative.  */
+  lpstart_encoding = *p++;
+  if (lpstart_encoding != DW_EH_PE_omit)
+    p = read_encoded_value (context, lpstart_encoding, p, &info->LPStart);
+  else
+    info->LPStart = info->Start;
+  
+  /* Find @TType, the base of the handler and exception spec type data.  */
+  info->ttype_encoding = *p++;
+  if (info->ttype_encoding != DW_EH_PE_omit)
+    {
+      p = read_uleb128 (p, &tmp);
+      info->TType = p + tmp;
+    }
+  else
+    info->TType = 0;
+
+  /* The encoding and length of the call-site table; the action table
+     immediately follows.  */
+  info->call_site_encoding = *p++;
+  p = read_uleb128 (p, &tmp);
+  info->action_table = p + tmp;
+
+  return p;
+}
+
+
+static const _Unwind_Ptr
+get_ttype_entry (_Unwind_Context *context, lsda_header_info *info, long i)
+{
+  _Unwind_Ptr ptr;
+
+  i *= size_of_encoded_value (info->ttype_encoding);
+  read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr);
+
+  return ptr;
+}
+
+/* This is the structure of exception objects as built by the GNAT runtime
+   library (a-except.adb). The layouts should exactly match, and the "common"
+   header is mandated by the exception handling ABI.  */
+
+struct _GNAT_Exception {
+  struct _Unwind_Exception common;
+
+  _Unwind_Ptr id;
+
+  char handled_by_others;
+  char has_cleanup;
+  char select_cleanups;
+};
+
+
+/* The two constants below are specific ttype identifiers for special
+   exception ids. Their value is currently hardcoded at the gigi level
+   (see N_Exception_Handler).  */
+
+#define GNAT_OTHERS_ID      ((_Unwind_Ptr) 0x0)
+#define GNAT_ALL_OTHERS_ID  ((_Unwind_Ptr) 0x1)
+
+
+/* The DB stuff below is there for debugging purposes only.  */
+
+#define DB_PHASES     0x1
+#define DB_SEARCH     0x2
+#define DB_ECLASS     0x4
+#define DB_MATCH      0x8
+#define DB_SAW        0x10
+#define DB_FOUND      0x20
+#define DB_INSTALL    0x40
+#define DB_CALLS      0x80
+
+#define AEHP_DB_SPECS \
+(DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH)
+
+#undef AEHP_DB_SPECS
+
+#ifdef AEHP_DB_SPECS
+static int db_specs = AEHP_DB_SPECS;
+#else
+static int db_specs = 0;
+#endif
+
+#define START_DB(what) do { if (what & db_specs) {
+#define END_DB(what)        } \
+                           } while (0);
+
+/* The "action" stuff below if also there for debugging purposes only.  */
+
+typedef struct {
+  _Unwind_Action action;
+  char * description;
+}  action_description_t;
+
+action_description_t action_descriptions [] = {
+  { _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
+  { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
+  { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
+  { _UA_FORCE_UNWIND,  "FORCE_UNWIND" },
+  { -1, (char *)0 }
+};
+
+static void
+decode_actions (actions)
+     _Unwind_Action actions;
+{
+  int i;
+
+  action_description_t * a = action_descriptions;
+
+  printf ("\n");
+  while (a->description != (char *)0)
+    {
+      if (actions & a->action)
+	{
+	  printf ("%s ", a->description);
+	}
+
+      a ++;
+    }
+
+  printf (" : ");
+}
+
+/* The following is defined from a-except.adb. It's purpose is to enable
+   automatic backtraces upon exception raise, as provided through the 
+   GNAT.Traceback facilities.  */
+extern void
+__gnat_notify_handled_exception (void * handler, bool others, bool db_notify);
+
+/* Below is the eh personality routine per se.  */
+
+_Unwind_Reason_Code
+__gnat_eh_personality (int version,
+		       _Unwind_Action actions,
+		       _Unwind_Exception_Class exception_class,
+		       struct _Unwind_Exception *ue_header,
+		       struct _Unwind_Context *context)
+{
+  enum found_handler_type
+  {
+    found_nothing,
+    found_terminate,
+    found_cleanup,
+    found_handler
+  } found_type;
+
+  lsda_header_info info;
+  const unsigned char *language_specific_data;
+  const unsigned char *action_record;
+  const unsigned char *p;
+  _Unwind_Ptr landing_pad, ip;
+  int handler_switch_value;
+
+  bool hit_others_handler;
+
+  struct _GNAT_Exception * gnat_exception;
+
+  if (version != 1)
+    return _URC_FATAL_PHASE1_ERROR;
+
+  START_DB (DB_PHASES);
+  decode_actions (actions);
+  END_DB (DB_PHASES);
+ 
+  if (strcmp ( ((char *)&exception_class), "GNU") != 0
+      || strcmp ( ((char *)&exception_class)+4, "Ada") != 0)
+    {
+      START_DB (DB_SEARCH);
+      printf ("              Exception Class doesn't match for ip = %p\n", ip);
+      END_DB (DB_SEARCH);
+      START_DB (DB_FOUND);
+      printf ("              => FOUND nothing\n");
+      END_DB (DB_FOUND);
+      return _URC_CONTINUE_UNWIND;
+    }
+
+  gnat_exception = (struct _GNAT_Exception *) ue_header;
+
+  START_DB (DB_PHASES);
+  if (gnat_exception->select_cleanups)
+    {
+      printf ("(select_cleanups) :\n");
+    }
+  else
+    {
+      printf (" :\n");
+    }
+  END_DB (DB_PHASES);
+
+  language_specific_data = (const unsigned char *)
+    _Unwind_GetLanguageSpecificData (context);
+
+  /* If no LSDA, then there are no handlers or cleanups.  */
+  if (! language_specific_data)
+    {
+      ip = _Unwind_GetIP (context) - 1;
+
+      START_DB (DB_SEARCH);
+      printf ("              No Language Specific Data for ip = %p\n", ip);
+      END_DB (DB_SEARCH);
+      START_DB (DB_FOUND);
+      printf ("              => FOUND nothing\n");
+      END_DB (DB_FOUND);
+      return _URC_CONTINUE_UNWIND;
+    }
+  
+  /* Parse the LSDA header.  */
+  p = parse_lsda_header (context, language_specific_data, &info);
+  info.ttype_base = base_of_encoded_value (info.ttype_encoding, context);
+  ip = _Unwind_GetIP (context) - 1;
+  landing_pad = 0;
+  action_record = 0;
+  handler_switch_value = 0;
+
+  /* Search the call-site table for the action associated with this IP.  */
+  while (p < info.action_table)
+    {
+      _Unwind_Ptr cs_start, cs_len, cs_lp, cs_action;
+
+      /* Note that all call-site encodings are "absolute" displacements.  */
+      p = read_encoded_value (0, info.call_site_encoding, p, &cs_start);
+      p = read_encoded_value (0, info.call_site_encoding, p, &cs_len);
+      p = read_encoded_value (0, info.call_site_encoding, p, &cs_lp);
+      p = read_uleb128 (p, &cs_action);
+
+      /* The table is sorted, so if we've passed the ip, stop.  */
+      if (ip < info.Start + cs_start)
+ 	p = info.action_table;
+      else if (ip < info.Start + cs_start + cs_len)
+	{
+	  if (cs_lp)
+	    landing_pad = info.LPStart + cs_lp;
+	  if (cs_action)
+	    action_record = info.action_table + cs_action - 1;
+	  goto found_something;
+	}
+    }
+
+  START_DB (DB_SEARCH);
+  printf ("              No Action entry for ip = %p\n", ip);
+  END_DB (DB_SEARCH);
+
+  /* If ip is not present in the table, call terminate.  This is for
+     a destructor inside a cleanup, or a library routine the compiler
+     was not expecting to throw.
+     
+     found_type = 
+     (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate);
+  
+     ??? Does this have a mapping in Ada semantics ?  */
+
+  found_type = found_nothing;
+
+  goto do_something;
+
+ found_something:
+
+  found_type = found_nothing;
+  
+  if (landing_pad == 0)
+    {
+      /* If ip is present, and has a null landing pad, there are
+	 no cleanups or handlers to be run.  */
+      START_DB (DB_SEARCH);
+      printf ("              No Landing Pad for ip = %p\n", ip);
+      END_DB (DB_SEARCH);
+    }
+  else if (action_record == 0)
+    {
+      START_DB (DB_SEARCH);
+      printf ("              Null Action Record for ip = %p <===\n", ip);
+      END_DB (DB_SEARCH);
+    }
+  else
+    {
+      signed long ar_filter, ar_disp;
+
+      signed long cleanup_filter = 0;
+      signed long handler_filter = 0;
+
+      START_DB (DB_SEARCH);
+      printf ("              Landing Pad + Action Record for ip = %p\n", ip);
+      END_DB (DB_SEARCH);
+
+      START_DB (DB_MATCH);
+      printf ("              => Search for exception matching id %p\n", 
+	      gnat_exception->id);
+      END_DB (DB_MATCH);
+
+      /* Otherwise we have a catch handler or exception specification.  */
+
+      while (1)
+	{
+	  _Unwind_Ptr tmp;
+
+	  p = action_record;
+	  p = read_sleb128 (p, &tmp); ar_filter = tmp;
+	  read_sleb128 (p, &tmp); ar_disp = tmp;
+
+	  START_DB (DB_MATCH);
+	  printf ("ar_filter  %d\n", ar_filter);
+	  END_DB (DB_MATCH);
+
+	  if (ar_filter == 0)
+	    {
+	      /* Zero filter values are cleanups. We should not be seeing
+		 this for GNU-Ada though
+		 saw_cleanup = true;  */
+	      START_DB (DB_SEARCH);
+	      printf ("              Null Filter for ip = %p <===\n", ip);
+	      END_DB (DB_SEARCH);
+	    }
+	  else if (ar_filter > 0)
+	    {
+	      _Unwind_Ptr lp_id = get_ttype_entry (context, &info, ar_filter);
+	      
+	      START_DB (DB_MATCH);
+	      printf ("catch_type ");
+	      
+	      switch (lp_id)
+		{
+		case GNAT_ALL_OTHERS_ID:
+		  printf ("GNAT_ALL_OTHERS_ID\n");		
+		  break;
+		  
+		case GNAT_OTHERS_ID:
+		  printf ("GNAT_OTHERS_ID\n");
+		  break;
+		  
+		default:
+		  printf ("%p\n", lp_id);
+		  break;
+		}
+
+	      END_DB (DB_MATCH);
+
+	      if (lp_id == GNAT_ALL_OTHERS_ID)
+		{
+		  START_DB (DB_SAW);
+		  printf ("              => SAW cleanup\n");
+		  END_DB (DB_SAW);
+
+		  cleanup_filter = ar_filter;
+		  gnat_exception->has_cleanup = true;
+		}
+
+	      hit_others_handler = 
+		(lp_id == GNAT_OTHERS_ID && gnat_exception->handled_by_others);
+
+	      if (hit_others_handler || lp_id == gnat_exception->id)
+		{
+		  START_DB (DB_SAW);
+		  printf ("              => SAW handler\n");
+		  END_DB (DB_SAW);
+
+		  handler_filter = ar_filter;     
+		}
+	    }
+	  else
+	    {
+	      /* Negative filter values are for C++ exception specifications.
+		 Should not be there for Ada :/  */
+	    }
+
+	  if (actions & _UA_SEARCH_PHASE)
+	    {
+	      if (handler_filter)
+		{
+		  found_type = found_handler;
+		  handler_switch_value = handler_filter;
+		  break;
+		}
+
+	      if (cleanup_filter)
+		{
+		  found_type = found_cleanup;
+		}
+	    }
+
+	  if (actions & _UA_CLEANUP_PHASE)
+	    {
+	      if (handler_filter)
+		{
+		  found_type = found_handler;
+		  handler_switch_value = handler_filter;
+		  break;
+		}
+		
+	      if (cleanup_filter)
+		{
+		  found_type = found_cleanup;
+		  handler_switch_value = cleanup_filter;
+		  break;
+		}
+	    }
+
+	  if (ar_disp == 0)
+	    break;
+	  action_record = p + ar_disp;
+	}
+    }
+
+ do_something:
+  if (found_type == found_nothing) {
+    START_DB (DB_FOUND);
+    printf ("              => FOUND nothing\n");
+    END_DB (DB_FOUND);
+
+    return _URC_CONTINUE_UNWIND;
+  }
+
+   if (actions & _UA_SEARCH_PHASE)
+    {
+      START_DB (DB_FOUND);
+      printf ("              => Computing return for SEARCH\n");
+      END_DB (DB_FOUND);
+
+      if (found_type == found_cleanup
+	  && !gnat_exception->select_cleanups)
+	{
+	  START_DB (DB_FOUND);
+	  printf ("              => FOUND cleanup\n");
+	  END_DB (DB_FOUND);
+
+	  return _URC_CONTINUE_UNWIND;
+	}
+
+      START_DB (DB_FOUND);
+      printf ("              => FOUND handler\n");
+      END_DB (DB_FOUND);
+
+      return _URC_HANDLER_FOUND;
+    }
+
+ install_context:
+   
+   START_DB (DB_INSTALL);
+   printf ("              => INSTALLING context for filter %d\n",
+	   handler_switch_value);
+   END_DB (DB_INSTALL);
+
+   if (found_type == found_terminate)
+     {
+       /* Should not have this for Ada ?  */
+       START_DB (DB_INSTALL);
+       printf ("              => FOUND terminate <===\n");
+       END_DB (DB_INSTALL);
+     }
+
+   
+   /* Signal that we are going to enter a handler, which will typically
+      enable the debugger to take control and possibly output an automatic
+      backtrace. Note that we are supposed to provide the handler's entry
+      point here but we don't have it.
+    */
+   __gnat_notify_handled_exception
+     ((void *)landing_pad, hit_others_handler, true);
+      
+
+   /* The GNU-Ada exception handlers know how to find the exception
+      occurrence without having to pass it as an argument so there
+      is no need to feed any specific register with this information.
+	 
+      This is why the two following lines are commented out.  */
+
+   /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0),
+      (_Unwind_Ptr) &xh->unwindHeader);  */
+
+  _Unwind_SetGR (context, __builtin_eh_return_data_regno (1),
+		 handler_switch_value);
+
+  _Unwind_SetIP (context, landing_pad);
+
+  return _URC_INSTALL_CONTEXT;
+}
+
+
+#endif   /* IN_RTS - For eh personality routine   */