* a-exexpr.adb (Others_Value, All_Others_Value): New variables, the

	address of which may be used to represent "others" and "all others"
	choices in exception tables, instead of the current harcoded
	(void *)0 and (void *)1.
	(Setup_Exception): Do nothing in the GNAT SJLJ case.

	* gigi.h (others_decl, all_others_decl): New decls representing the
	new Others_Value and All_Others_Value objects.
	(struct attrib): Rename "arg" component as "args", since GCC expects a
	list of arguments in there.

	* raise.c (GNAT_OTHERS, GNAT_ALL_OTHERS): Are now the address of the
	corresponding objects exported by a-exexpr, instead of hardcoded dummy
	addresses.

	* trans.c (Exception_Handler_to_gnu_zcx): Use the address of
	others_decl and all_others_decl instead of hardcoded dummy addresses
	to represent "others" and "all others" choices, which is cleaner and
	more flexible with respect to the possible eh pointer encoding policies.

	* utils.c (init_gigi_decls): Initialize others_decl and all_others_decl.
	(process_attributes): Account for the naming change of the "args"
	attribute list entry component.

	* decl.c (build_attr_list): Rename into prepend_attributes to allow
	cumulating attributes for different entities into a single list.
	(gnat_to_gnu_entity): Use prepend_attributes to build the list of
	attributes for the current entity and propagate first subtype
	attributes to other subtypes.
	<E_Procedure>: Attribute arguments are attr->args and not
	attr->arg any more.
	(build_attr_list): Ditto. Make attr->args a TREE_LIST when there is an
	argument provided, as this is what GCC expects. Use NULL_TREE instead
	of 0 for trees.


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

6 files changed, 110 insertions, 49 deletions

diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb
index 913c0e8e186..ea9ce671ca7 100644
--- a/gcc/ada/a-exexpr.adb
+++ b/gcc/ada/a-exexpr.adb
@@ -131,7 +131,7 @@ package body Exception_Propagation is
 
    type GNAT_GCC_Exception is record
       Header : Unwind_Exception;
-      --  ABI Exception header first.
+      --  ABI Exception header first
 
       Id : Exception_Id;
       --  GNAT Exception identifier.  This is filled by Propagate_Exception
@@ -146,7 +146,7 @@ package body Exception_Propagation is
       --  an exception is not handled.
 
       Next_Exception : EOA;
-      --  Used to create a linked list of exception occurrences.
+      --  Used to create a linked list of exception occurrences
    end record;
 
    pragma Convention (C, GNAT_GCC_Exception);
@@ -204,9 +204,9 @@ package body Exception_Propagation is
       UW_Argument  : System.Address);
    pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
 
-   --------------------------------------------
-   -- Occurrence stack management facilities --
-   --------------------------------------------
+   ------------------------------------------------------------------
+   -- Occurrence Stack Management Facilities for the GCC-EH Scheme --
+   ------------------------------------------------------------------
 
    function Remove
      (Top   : EOA;
@@ -245,7 +245,7 @@ package body Exception_Propagation is
    ------------------------------------------------------------
 
    --  As of today, these are only used by the C implementation of the
-   --  propagation personality routine to avoid having to rely on a C
+   --  GCC propagation personality routine to avoid having to rely on a C
    --  counterpart of the whole exception_data structure, which is both
    --  painful and error prone. These subprograms could be moved to a
    --  more widely visible location if need be.
@@ -268,6 +268,20 @@ package body Exception_Propagation is
       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 --
+   ---------------------------------------------------------------------------
+
+   --  Currently, these only have their address taken and compared so there is
+   --  no real point having whole exception data blocks allocated. In any case
+   --  the types should match what gigi and the personality routine expect.
+
+   Others_Value : constant Integer := 16#BEEF#;
+   pragma Export (C, Others_Value, "__gnat_others_value");
+
+   All_Others_Value : constant Integer := 16#BEEF#;
+   pragma Export (C, All_Others_Value, "__gnat_all_others_value");
+
    ------------
    -- Remove --
    ------------
@@ -360,7 +374,7 @@ package body Exception_Propagation is
 
    function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
       GCC_E : GNAT_GCC_Exception_Access :=
-        To_GNAT_GCC_Exception (E.Private_Data);
+                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;
@@ -371,7 +385,7 @@ package body Exception_Propagation is
 
    procedure Clear_Setup_And_Not_Propagated (E : EOA) is
       GCC_E : GNAT_GCC_Exception_Access :=
-        To_GNAT_GCC_Exception (E.Private_Data);
+                To_GNAT_GCC_Exception (E.Private_Data);
    begin
       pragma Assert (GCC_E /= null);
       GCC_E.Header.Private1 := 0;
@@ -383,7 +397,7 @@ package body Exception_Propagation is
 
    procedure Set_Setup_And_Not_Propagated (E : EOA) is
       GCC_E : GNAT_GCC_Exception_Access :=
-        To_GNAT_GCC_Exception (E.Private_Data);
+                To_GNAT_GCC_Exception (E.Private_Data);
    begin
       pragma Assert (GCC_E /= null);
       GCC_E.Header.Private1 := Setup_Key;
@@ -393,10 +407,17 @@ package body Exception_Propagation is
    -- Setup_Exception --
    ---------------------
 
-   --  In this implementation of the exception propagation scheme, this
-   --  subprogram should be understood as: Setup the exception occurrence
+   --  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.
 
+   --  In the GNAT-SJLJ case this "stack" only exists implicitely, by way of
+   --  local occurrence declarations together with save/restore operations
+   --  generated by the front-end, and this routine has nothing to do.
+
+   --  The differenciation is done here and not in the callers to avoid having
+   --  to spread out the test in numerous places.
+
    procedure Setup_Exception
      (Excep    : EOA;
       Current  : EOA;
@@ -407,12 +428,22 @@ package body Exception_Propagation is
       GCC_Exception : GNAT_GCC_Exception_Access;
 
    begin
+      --  Just return if we're not in the GCC-EH case. What is otherwise
+      --  performed is useless and even harmful since it potentially involves
+      --  dynamic allocations that would never be released, and participates
+      --  in the Setup_And_Not_Propagated predicate management, only properly
+      --  handled by the rest of the GCC-EH scheme.
 
-      --  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.
+      if Zero_Cost_Exceptions = 0 then
+         return;
+      end if;
+
+      --  Otherwise, 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.
@@ -461,7 +492,6 @@ package body Exception_Propagation is
       Top.Private_Data := GCC_Exception.all'Address;
 
       Set_Setup_And_Not_Propagated (Top);
-
    end Setup_Exception;
 
    -------------------
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index f76ad645ea0..d5c56b5e306 100644
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -83,7 +83,7 @@ static struct incomplete
 static void copy_alias_set (tree, tree);
 static tree substitution_list (Entity_Id, Entity_Id, tree, bool);
 static bool allocatable_size_p (tree, bool);
-static struct attrib *build_attr_list (Entity_Id);
+static void prepend_attributes (Entity_Id, struct attrib **);
 static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
 static bool is_variable_size (tree);
 static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
@@ -298,9 +298,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  && (kind == E_Function || kind == E_Procedure)))
     force_global++, this_global = true;
 
-  /* Handle any attributes.  */
+  /* Handle any attributes directly attached to the entity.  */
   if (Has_Gigi_Rep_Item (gnat_entity))
-    attr_list = build_attr_list (gnat_entity);
+    prepend_attributes (gnat_entity, &attr_list);
+
+  /* Machine_Attributes on types are expected to be propagated to subtypes.
+     The corresponding Gigi_Rep_Items are only attached to the first subtype
+     though, so we handle the propagation here.  */
+  if (Is_Type (gnat_entity) && Base_Type (gnat_entity) != gnat_entity
+      && !Is_First_Subtype (gnat_entity)
+      && Has_Gigi_Rep_Item (First_Subtype (Base_Type (gnat_entity))))
+    prepend_attributes (First_Subtype (Base_Type (gnat_entity)), &attr_list);
 
   switch (kind)
     {
@@ -3598,7 +3606,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    attr->next = attr_list;
 	    attr->type = ATTR_MACHINE_ATTRIBUTE;
 	    attr->name = get_identifier ("stdcall");
-	    attr->arg = NULL_TREE;
+	    attr->args = NULL_TREE;
 	    attr->error_point = gnat_entity;
 	    attr_list = attr;
 	  }
@@ -4365,12 +4373,11 @@ allocatable_size_p (tree gnu_size, bool static_p)
   return (int) our_size == our_size;
 }
 
-/* Return a list of attributes for GNAT_ENTITY, if any.  */
+/* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any.  */
 
-static struct attrib *
-build_attr_list (Entity_Id gnat_entity)
+static void
+prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
 {
-  struct attrib *attr_list = 0;
   Node_Id gnat_temp;
 
   for (gnat_temp = First_Rep_Item (gnat_entity); Present (gnat_temp);
@@ -4378,7 +4385,7 @@ build_attr_list (Entity_Id gnat_entity)
     if (Nkind (gnat_temp) == N_Pragma)
       {
 	struct attrib *attr;
-	tree gnu_arg0 = 0, gnu_arg1 = 0;
+	tree gnu_arg0 = NULL_TREE, gnu_arg1 = NULL_TREE;
 	Node_Id gnat_assoc = Pragma_Argument_Associations (gnat_temp);
 	enum attr_type etype;
 
@@ -4424,17 +4431,23 @@ build_attr_list (Entity_Id gnat_entity)
 	  }
 
 	attr = (struct attrib *) xmalloc (sizeof (struct attrib));
-	attr->next = attr_list;
+	attr->next = *attr_list;
 	attr->type = etype;
 	attr->name = gnu_arg0;
-	attr->arg = gnu_arg1;
+
+	/* If we have an argument specified together with an attribute name,
+	   make it a single TREE_VALUE entry in a list of arguments, as GCC
+	   expects it.  */
+	if (gnu_arg1 != NULL_TREE)
+	  attr->args = build_tree_list (NULL_TREE, gnu_arg1);
+	else
+	  attr->args = NULL_TREE;
+
 	attr->error_point
 	  = Present (Next (First (gnat_assoc)))
 	    ? Expression (Next (First (gnat_assoc))) : gnat_temp;
-	attr_list = attr;
+	*attr_list = attr;
       }
-
-  return attr_list;
 }
 
 /* Get the unpadded version of a GNAT type.  */
diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h
index 233c22be5ed..20784c1b5d2 100644
--- a/gcc/ada/gigi.h
+++ b/gcc/ada/gigi.h
@@ -297,7 +297,7 @@ struct attrib
   struct attrib *next;
   enum attr_type type;
   tree name;
-  tree arg;
+  tree args;
   Node_Id error_point;
 };
 
@@ -340,6 +340,8 @@ enum standard_datatypes
   ADT_raise_nodefer_decl,
   ADT_begin_handler_decl,
   ADT_end_handler_decl,
+  ADT_others_decl,
+  ADT_all_others_decl,
   ADT_LAST};
 
 extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
@@ -363,6 +365,8 @@ extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
 #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 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]
 #define end_handler_decl gnat_std_decls[(int) ADT_end_handler_decl]
 
 /* Routines expected by the gcc back-end. They must have exactly the same
diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c
index 77a712b63ed..7de1f7754b7 100644
--- a/gcc/ada/raise.c
+++ b/gcc/ada/raise.c
@@ -480,11 +480,13 @@ typedef struct
 } _GNAT_Exception;
 
 /* 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).  */
+   exception ids.  Their type should match what a-exexpr exports.  */
 
-#define GNAT_OTHERS      ((_Unwind_Ptr) 0x0)
-#define GNAT_ALL_OTHERS  ((_Unwind_Ptr) 0x1)
+extern const int __gnat_others_value;
+#define GNAT_OTHERS      ((_Unwind_Ptr) &__gnat_others_value)
+
+extern const int __gnat_all_others_value;
+#define GNAT_ALL_OTHERS  ((_Unwind_Ptr) &__gnat_all_others_value)
 
 /* Describe the useful region data associated with an unwind context.  */
 
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 4f04da7e8f6..162e6acc198 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -2299,24 +2299,22 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
      handler can catch, with special cases for others and all others cases.
 
      Each exception type is actually identified by a pointer to the exception
-     id, with special value zero for "others" and one for "all others". Beware
-     that these special values are known and used by the personality routine to
-     identify the corresponding specific kinds of handlers.
+     id, or to a dummy object for "others" and "all others".
 
-     ??? For initial time frame reasons, the others and all_others cases have
-     been handled using specific type trees, but this somehow hides information
-     from the back-end, which expects NULL to be passed for catch all and
-     end_cleanup to be used for cleanups.
-
-     Care should be taken to ensure that the control flow impact of such
-     clauses is rendered in some way. lang_eh_type_covers is doing the trick
+     Care should be taken to ensure that the control flow impact of "others"
+     and "all others" is known to GCC. lang_eh_type_covers is doing the trick
      currently.  */
   for (gnat_temp = First (Exception_Choices (gnat_node));
        gnat_temp; gnat_temp = Next (gnat_temp))
     {
       if (Nkind (gnat_temp) == N_Others_Choice)
-	gnu_etype = (All_Others (gnat_temp) ? integer_one_node
-		     : integer_zero_node);
+	{
+	  tree gnu_expr
+	    = All_Others (gnat_temp) ? all_others_decl : others_decl;
+
+	  gnu_etype
+	    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
+	}
       else if (Nkind (gnat_temp) == N_Identifier
 	       || Nkind (gnat_temp) == N_Expanded_Name)
 	{
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 50753af5363..e2205d0353f 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -613,6 +613,20 @@ init_gigi_decls (tree long_long_float_type, tree exception_type)
 				       endlink)),
        NULL_TREE, false, true, true, NULL, Empty);
 
+  /* 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.  */
+
+  others_decl
+    = create_var_decl (get_identifier ("OTHERS"),
+		       get_identifier ("__gnat_others_value"),
+		       integer_type_node, 0, 1, 0, 1, 1, 0, Empty);
+
+  all_others_decl
+    = create_var_decl (get_identifier ("ALL_OTHERS"),
+		       get_identifier ("__gnat_all_others_value"),
+		       integer_type_node, 0, 1, 0, 1, 1, 0, Empty);
+
   /* Hooks to call when entering/leaving an exception handler.  */
   begin_handler_decl
     = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE,
@@ -1550,7 +1564,7 @@ process_attributes (tree decl, struct attrib *attr_list)
     switch (attr_list->type)
       {
       case ATTR_MACHINE_ATTRIBUTE:
-	decl_attributes (&decl, tree_cons (attr_list->name, attr_list->arg,
+	decl_attributes (&decl, tree_cons (attr_list->name, attr_list->args,
 					   NULL_TREE),
 			 ATTR_FLAG_TYPE_IN_PLACE);
 	break;