[Ada] fix tasking problems on ia64-linux and handling of Machine_Attribute
Arnaud Charlet
charlet@adacore.com
Fri Nov 19 10:50:00 GMT 2004
Tested on ia64-linux, committed on mainline.
Fix tasking problems on ia64-linux:
Exception handler choices have to be materialized in the GCC EH tables,
and the GCC model for that is a pointer to some exception type information
or 0 for C++ catch all statements. In Ada, plain exception choices such as
Constraint_Error are materialized by a pointer to the corresponding exception
Id, and special values are used for "others" and "all others" choices because
they don't behave quite like "catch all" in C++. Those special values used to
be harcoded dummy addresses: (void *)0 for "others" and (void *)1 for "all
others", which was not very clean to start with. Besides, this scheme turned
out to be problematic when exposed to some of the various possible EH pointer
encoding policies, as demonstrated by the testcase on ia64-linux, in which
an "all others" handler was just bypassed, causing a rendez-vous not to be
terminated as it should have, in turn resulting in an unexpected hang.
The fix is to use the address of a dummy object for "others" and "all others"
(one object for each case) instead of the hardcoded dummy addresses, which is
much cleaner and more flexible with respect to the possible pointer encoding
policies.
Testcase:
-- $ gnatmake p.adb
-- $ p
-- ... is expected to terminate and output nothing.
-- The front-end expanded code involves a "when all others" choice to
-- deal with the rendez-vous exceptional completion in the task. This
-- choice would be missed if the address stored in the exception table
-- was not suited for some cases of underlying EH pointer encoding,
-- resulting in a not executed rendez-vous termination and then a hang.
with Ada.Text_IO; use Ada.Text_IO;
procedure P is
task T is entry E; end T;
task body T is
begin
accept E do raise Constraint_Error; end;
exception
when Constraint_Error => raise;
when others => Put_Line ("Wrong exception propagated");
end;
begin
T.E;
exception
when Constraint_Error => null;
end;
Also fix problems with pragma Machine_Attribute:
GCC expects attribute arguments to be provided as a TREE_LIST of entries
with TREE_VALUES filled. For an attribute argument in a Machine_Attribute
pragma, gigi was passing a bare IDENTIFIER node as the GCC attribute
"args", which clearly did not match the back-end expectations. This is
fixed by constructing the appropriate TREE_LIST in build_attr_list, and
the "arg" component of the gigi "attrib" structure has been renamed "args"
along the way, and by propagating Machine_Attributes to subtypes.
Testcase:
-- $ gcc -c p.adb
-- Expected output:
-- p.ads:1: warning: `regparm' attribute requires an integer constant argument
-- It used to ICE before this change.
procedure P (X : Integer);
pragma Machine_Attribute (P, "regparm", "1");
procedure P (X : Integer) is
begin null; end;
2004-11-18 Olivier Hainque <hainque@adacore.com>
* 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.
-------------- next part --------------
Index: a-exexpr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/a-exexpr.adb,v
retrieving revision 1.8
diff -u -p -r1.8 a-exexpr.adb
--- a-exexpr.adb 27 Oct 2004 12:28:57 -0000 1.8
+++ a-exexpr.adb 19 Nov 2004 10:34:36 -0000
@@ -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;
-------------------
Index: gigi.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gigi.h,v
retrieving revision 1.31
diff -u -p -r1.31 gigi.h
--- gigi.h 13 Sep 2004 10:18:39 -0000 1.31
+++ gigi.h 19 Nov 2004 10:34:36 -0000
@@ -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[(in
#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
Index: raise.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/raise.c,v
retrieving revision 1.16
diff -u -p -r1.16 raise.c
--- raise.c 1 Sep 2004 10:46:46 -0000 1.16
+++ raise.c 19 Nov 2004 10:34:36 -0000
@@ -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. */
Index: trans.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/trans.c,v
retrieving revision 1.82
diff -u -p -r1.82 trans.c
--- trans.c 27 Oct 2004 13:55:45 -0000 1.82
+++ trans.c 19 Nov 2004 10:34:36 -0000
@@ -2299,24 +2299,22 @@ Exception_Handler_to_gnu_zcx (Node_Id gn
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.
-
- ??? 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.
+ id, or to a dummy object for "others" and "all others".
- 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)
{
Index: utils.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/utils.c,v
retrieving revision 1.85
diff -u -p -r1.85 utils.c
--- utils.c 4 Oct 2004 14:56:04 -0000 1.85
+++ utils.c 19 Nov 2004 10:34:36 -0000
@@ -613,6 +613,20 @@ init_gigi_decls (tree long_long_float_ty
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 at
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;
Index: decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/decl.c,v
retrieving revision 1.60
diff -u -p -r1.60 decl.c
--- decl.c 27 Oct 2004 12:29:59 -0000 1.60
+++ decl.c 19 Nov 2004 10:34:36 -0000
@@ -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_entit
&& (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_entit
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
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. */
More information about the Gcc-patches
mailing list