[multiple changes]

2004-03-19  Arnaud Charlet  <charlet@act-europe.fr>

	* ada-tree.h: Update copyright notice.
	Minor reformatting.

2004-03-19  Olivier Hainque  <hainque@act-europe.fr>

	* decl.c (gnat_to_gnu_entity, case E_Exception): Handle VMS exceptions
	as regular exception objects and not as mere integers representing the
	condition code.  The latter approach required some dynamics to mask off
	severity bits, which did not fit well into the GCC table based model.
	(gnat_to_gnu_entity, objects): Don't supply an external name for VMS
	exception data objects. We don't it and it would conflict with the other
	external symbol we have to generate for such exceptions.

	* trans.c (tree_transform, case N_Exception_Handler): Remove part of
	the special code for VMS exceptions, since these are now represented
	as regular exceptions objects.

From-SVN: r79686

gcc/ada/ChangeLog

+2004-03-19  Arnaud Charlet  <charlet@act-europe.fr>
+
+	* ada-tree.h: Update copyright notice.
+	Minor reformatting.
+
+2004-03-19  Olivier Hainque  <hainque@act-europe.fr>
+
+	* decl.c (gnat_to_gnu_entity, case E_Exception): Handle VMS exceptions
+	as regular exception objects and not as mere integers representing the
+	condition code.  The latter approach required some dynamics to mask off
+	severity bits, which did not fit well into the GCC table based model.
+	(gnat_to_gnu_entity, objects): Don't supply an external name for VMS
+	exception data objects. We don't it and it would conflict with the other
+	external symbol we have to generate for such exceptions.
+
+	* trans.c (tree_transform, case N_Exception_Handler): Remove part of
+	the special code for VMS exceptions, since these are now represented
+	as regular exceptions objects.
+
 2004-03-19 Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
 
 	* decl.c (debug_no_type_hash): Remove.

gcc/ada/ada-tree.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2003 Free Software Foundation, Inc.          *
+ *          Copyright (C) 1992-2004 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- *
@@ -34,32 +34,32 @@ enum gnat_tree_code {
 #undef DEFTREECODE
 
 /* A tree to hold a loop ID.  */
-struct tree_loop_id GTY(()) 
+struct tree_loop_id GTY(())
 {
   struct tree_common common;
   struct nesting *loop_id;
 };
 
 /* The language-specific tree.  */
-union lang_tree_node 
+union lang_tree_node
   GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"),
        chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
 {
-  union tree_node GTY ((tag ("0"), 
-			desc ("tree_node_structure (&%h)"))) 
+  union tree_node GTY ((tag ("0"),
+			desc ("tree_node_structure (&%h)")))
     generic;
   struct tree_loop_id GTY ((tag ("1"))) loop_id;
 };
 
 /* Ada uses the lang_decl and lang_type fields to hold more trees.  */
-struct lang_decl GTY(()) 
+struct lang_decl GTY(())
 {
-  union lang_tree_node 
+  union lang_tree_node
     GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"))) t;
 };
 struct lang_type GTY(())
 {
-  union lang_tree_node 
+  union lang_tree_node
     GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"))) t;
 };
 

gcc/ada/decl.c

@@ -365,34 +365,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       goto object;
 
     case E_Exception:
-      /* If this is not a VMS exception, treat it as a normal object.
-	 Otherwise, make an object at the specific address of character
-	 type, point to it, and convert it to integer, and mask off
-	 the lower 3 bits.  */
-      if (! Is_VMS_Exception (gnat_entity))
-	goto object;
-
-      /* Allocate the global object that we use to get the value of the
-	 exception.  */
-      gnu_decl = create_var_decl (gnu_entity_id,
-				  (Present (Interface_Name (gnat_entity))
-				   ? create_concat_name (gnat_entity, 0)
-				   : NULL_TREE),
-				  char_type_node, NULL_TREE, 0, 0, 1, 1,
-				  0);
-
-      /* Now return the expression giving the desired value.  */
-      gnu_decl
-	= build_binary_op (BIT_AND_EXPR, integer_type_node,
-			   convert (integer_type_node,
-				    build_unary_op (ADDR_EXPR, NULL_TREE,
-						    gnu_decl)),
-			   build_unary_op (NEGATE_EXPR, integer_type_node,
-					   build_int_2 (7, 0)));
-
-      save_gnu_tree (gnat_entity, gnu_decl, 1);
-      saved = 1;
-      break;
+      /* We used to special case VMS exceptions here to directly map them to
+	 their associated condition code.  Since this code had to be masked
+	 dynamically to strip off the severity bits, this caused trouble in
+	 the GCC/ZCX case because the "type" pointers we store in the tables
+	 have to be static.  We now don't special case here anymore, and let
+	 the regular processing take place, which leaves us with a regular
+	 exception data object for VMS exceptions too.  The condition code
+	 mapping is taken care of by the front end and the bitmasking by the
+	 runtime library.   */
+      goto object;
 
     case E_Discriminant:
     case E_Component:
@@ -1017,13 +999,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		      (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
 	  gnu_expr = convert (gnu_type, gnu_expr);
 
-	/* This name is external or there was a name specified, use it.
-	   Don't use the Interface_Name if there is an address clause.
-	   (see CD30005).  */
-	if ((Present (Interface_Name (gnat_entity))
-	     && No (Address_Clause (gnat_entity)))
-	    || (Is_Public (gnat_entity)
-		&& (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity))))
+	/* If this name is external or there was a name specified, use it,
+	   unless this is a VMS exception object since this would conflict
+	   with the symbol we need to export in addition.  Don't use the
+	   Interface_Name if there is an address clause (see CD30005).  */
+	if (! Is_VMS_Exception (gnat_entity)
+	    &&
+	    ((Present (Interface_Name (gnat_entity))
+	      && No (Address_Clause (gnat_entity)))
+	     ||
+	     (Is_Public (gnat_entity)
+	      && (! Is_Imported (gnat_entity) || Is_Exported (gnat_entity)))))
 	  gnu_ext_name = create_concat_name (gnat_entity, 0);
 
 	if (const_flag)

gcc/ada/trans.c

@@ -3636,30 +3636,14 @@ tree_transform (Node_Id gnat_node)
 		  if (Present (Renamed_Object (gnat_ex_id)))
 		    gnat_ex_id = Renamed_Object (gnat_ex_id);
 
-		  /* ??? Note that we have to use gnat_to_gnu_entity here
-		     since the type of the exception will be wrong in the
-		     VMS case and that's exactly what this test is for.  */
 		  gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0);
 
-		  /* If this was a VMS exception, check import_code
-		     against the value of the exception.  */
-		  if (TREE_CODE (TREE_TYPE (gnu_expr)) == INTEGER_TYPE)
-		    this_choice
-		      = build_binary_op
-			(EQ_EXPR, integer_type_node,
-			 build_component_ref
-			 (build_unary_op
-			  (INDIRECT_REF, NULL_TREE,
-			   TREE_VALUE (gnu_except_ptr_stack)),
-			  get_identifier ("import_code"), NULL_TREE, 0),
-			 gnu_expr);
-		  else
-		    this_choice
-		      = build_binary_op
-			(EQ_EXPR, integer_type_node,
-			 TREE_VALUE (gnu_except_ptr_stack),
-			 convert
-			 (TREE_TYPE (TREE_VALUE (gnu_except_ptr_stack)),
+		  this_choice
+		    = build_binary_op
+		      (EQ_EXPR, integer_type_node,
+		       TREE_VALUE (gnu_except_ptr_stack),
+		       convert
+		         (TREE_TYPE (TREE_VALUE (gnu_except_ptr_stack)),
 			  build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr)));
 
 		  /* If this is the distinguished exception "Non_Ada_Error"
@@ -3742,6 +3726,9 @@ tree_transform (Node_Id gnat_node)
 
  		  gnu_etype
 		    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
+
+		  /* The Non_Ada_Error case for VMS exceptions is handled
+		     by the personality routine.  */
  		}
  	      else
  		gigi_abort (337);