From 13b802d70d691cdc8dd1157523d517f822313e88 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 19 Nov 2004 10:54:53 +0000 Subject: [PATCH] * 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. : 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 --- gcc/ada/a-exexpr.adb | 64 ++++++++++++++++++++++++++++++++++++++-------------- gcc/ada/decl.c | 41 +++++++++++++++++++++------------ gcc/ada/gigi.h | 6 ++++- gcc/ada/raise.c | 10 ++++---- gcc/ada/trans.c | 22 ++++++++---------- gcc/ada/utils.c | 16 ++++++++++++- 6 files changed, 110 insertions(+), 49 deletions(-) diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb index 913c0e8..ea9ce67 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 f76ad64..d5c56b5 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 233c22b..20784c1 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 77a712b..7de1f77 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 4f04da7..162e6ac 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 50753af5..e2205d0 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; -- 2.7.4