Commit ee575992 by Arnaud Charlet

a-exexpr.adb (Others_Value, [...]): New variables...

	* 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.

From-SVN: r90900
parent f5a0cbf1
......@@ -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;
-------------------
......
......@@ -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. */
......
......@@ -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
......
......@@ -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. */
......
......@@ -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)
{
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment