+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.
* *
* 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- *
#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;
};
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:
(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)
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"
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);
projects / platform / upstream / gcc.git / commitdiff