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
-- 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);
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;
------------------------------------------------------------
-- 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.
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 --
------------
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;
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;
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;
-- 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;
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.
Top.Private_Data := GCC_Exception.all'Address;
Set_Setup_And_Not_Propagated (Top);
-
end Setup_Exception;
-------------------
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,
&& (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)
{
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;
}
return (int) our_size == our_size;
}
\f
-/* 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);
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;
}
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;
}
\f
/* Get the unpadded version of a GNAT type. */
struct attrib *next;
enum attr_type type;
tree name;
- tree arg;
+ tree args;
Node_Id error_point;
};
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];
#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
} _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. */
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)
{
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,
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;
projects / gcc.git / commitdiff