aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gcc-interface
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/gcc-interface')
-rw-r--r--gcc/ada/gcc-interface/gigi.h4
-rw-r--r--gcc/ada/gcc-interface/trans.c73
-rw-r--r--gcc/ada/gcc-interface/utils2.c24
3 files changed, 48 insertions, 53 deletions
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 4ddd0f0..a957de5 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -312,9 +312,9 @@ extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
tree t, int num);
-/* Return a label to branch to for the exception type in KIND or NULL_TREE
+/* Return a label to branch to for the exception type in KIND or Empty
if none. */
-extern tree get_exception_label (char kind);
+extern Entity_Id get_exception_label (char kind);
/* If nonzero, pretend we are allocating at global level. */
extern int force_global;
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index a757937..0e46e5a 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -211,9 +211,9 @@ typedef struct loop_info_d *loop_info;
static GTY(()) vec<loop_info, va_gc> *gnu_loop_stack;
/* The stacks for N_{Push,Pop}_*_Label. */
-static GTY(()) vec<tree, va_gc> *gnu_constraint_error_label_stack;
-static GTY(()) vec<tree, va_gc> *gnu_storage_error_label_stack;
-static GTY(()) vec<tree, va_gc> *gnu_program_error_label_stack;
+static vec<Entity_Id> gnu_constraint_error_label_stack;
+static vec<Entity_Id> gnu_storage_error_label_stack;
+static vec<Entity_Id> gnu_program_error_label_stack;
/* Map GNAT tree codes to GCC tree codes for simple expressions. */
static enum tree_code gnu_codes[Number_Node_Kinds];
@@ -226,7 +226,6 @@ static void record_code_position (Node_Id);
static void insert_code_for (Node_Id);
static void add_cleanup (tree, Node_Id);
static void add_stmt_list (List_Id);
-static void push_exception_label_stack (vec<tree, va_gc> **, Entity_Id);
static tree build_stmt_group (List_Id, bool);
static inline bool stmt_group_may_fallthru (void);
static enum gimplify_status gnat_gimplify_stmt (tree *);
@@ -647,9 +646,10 @@ gigi (Node_Id gnat_root,
gnat_install_builtins ();
vec_safe_push (gnu_except_ptr_stack, NULL_TREE);
- vec_safe_push (gnu_constraint_error_label_stack, NULL_TREE);
- vec_safe_push (gnu_storage_error_label_stack, NULL_TREE);
- vec_safe_push (gnu_program_error_label_stack, NULL_TREE);
+
+ gnu_constraint_error_label_stack.safe_push (Empty);
+ gnu_storage_error_label_stack.safe_push (Empty);
+ gnu_program_error_label_stack.safe_push (Empty);
/* Process any Pragma Ident for the main unit. */
if (Present (Ident_String (Main_Unit)))
@@ -5614,7 +5614,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
const bool with_extra_info
= Exception_Extra_Info
&& !No_Exception_Handlers_Set ()
- && !get_exception_label (kind);
+ && No (get_exception_label (kind));
tree gnu_result = NULL_TREE, gnu_cond = NULL_TREE;
/* The following processing is not required for correctness. Its purpose is
@@ -7271,8 +7271,9 @@ gnat_to_gnu (Node_Id gnat_node)
break;
case N_Goto_Statement:
- gnu_result
- = build1 (GOTO_EXPR, void_type_node, gnat_to_gnu (Name (gnat_node)));
+ gnu_expr = gnat_to_gnu (Name (gnat_node));
+ gnu_result = build1 (GOTO_EXPR, void_type_node, gnu_expr);
+ TREE_USED (gnu_expr) = 1;
break;
/***************************/
@@ -7492,30 +7493,36 @@ gnat_to_gnu (Node_Id gnat_node)
break;
case N_Push_Constraint_Error_Label:
- push_exception_label_stack (&gnu_constraint_error_label_stack,
- Exception_Label (gnat_node));
+ gnu_constraint_error_label_stack.safe_push (Exception_Label (gnat_node));
break;
case N_Push_Storage_Error_Label:
- push_exception_label_stack (&gnu_storage_error_label_stack,
- Exception_Label (gnat_node));
+ gnu_storage_error_label_stack.safe_push (Exception_Label (gnat_node));
break;
case N_Push_Program_Error_Label:
- push_exception_label_stack (&gnu_program_error_label_stack,
- Exception_Label (gnat_node));
+ gnu_program_error_label_stack.safe_push (Exception_Label (gnat_node));
break;
case N_Pop_Constraint_Error_Label:
- gnu_constraint_error_label_stack->pop ();
+ gnat_temp = gnu_constraint_error_label_stack.pop ();
+ if (Present (gnat_temp)
+ && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))
+ Warn_If_No_Local_Raise (gnat_temp);
break;
case N_Pop_Storage_Error_Label:
- gnu_storage_error_label_stack->pop ();
+ gnat_temp = gnu_storage_error_label_stack.pop ();
+ if (Present (gnat_temp)
+ && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))
+ Warn_If_No_Local_Raise (gnat_temp);
break;
case N_Pop_Program_Error_Label:
- gnu_program_error_label_stack->pop ();
+ gnat_temp = gnu_program_error_label_stack.pop ();
+ if (Present (gnat_temp)
+ && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))
+ Warn_If_No_Local_Raise (gnat_temp);
break;
/******************************/
@@ -8029,20 +8036,6 @@ gnat_to_gnu_external (Node_Id gnat_node)
return gnu_result;
}
-/* Subroutine of above to push the exception label stack. GNU_STACK is
- a pointer to the stack to update and GNAT_LABEL, if present, is the
- label to push onto the stack. */
-
-static void
-push_exception_label_stack (vec<tree, va_gc> **gnu_stack, Entity_Id gnat_label)
-{
- tree gnu_label = (Present (gnat_label)
- ? gnat_to_gnu_entity (gnat_label, NULL_TREE, false)
- : NULL_TREE);
-
- vec_safe_push (*gnu_stack, gnu_label);
-}
-
/* Return true if the statement list STMT_LIST is empty. */
static bool
@@ -10226,28 +10219,28 @@ post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,
post_error_ne_tree (msg, node, ent, t);
}
-/* Return a label to branch to for the exception type in KIND or NULL_TREE
+/* Return a label to branch to for the exception type in KIND or Empty
if none. */
-tree
+Entity_Id
get_exception_label (char kind)
{
switch (kind)
{
case N_Raise_Constraint_Error:
- return gnu_constraint_error_label_stack->last ();
+ return gnu_constraint_error_label_stack.last ();
case N_Raise_Storage_Error:
- return gnu_storage_error_label_stack->last ();
+ return gnu_storage_error_label_stack.last ();
case N_Raise_Program_Error:
- return gnu_program_error_label_stack->last ();
+ return gnu_program_error_label_stack.last ();
default:
- break;
+ return Empty;
}
- return NULL_TREE;
+ gcc_unreachable ();
}
/* Return the decl for the current elaboration procedure. */
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 6f109c7..dcd4134 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -1787,9 +1787,10 @@ build_call_n_expr (tree fndecl, int n, ...)
MSG gives the exception's identity for the call to Local_Raise, if any. */
static tree
-build_goto_raise (tree label, int msg)
+build_goto_raise (Entity_Id gnat_label, int msg)
{
- tree gnu_result = build1 (GOTO_EXPR, void_type_node, label);
+ tree gnu_label = gnat_to_gnu_entity (gnat_label, NULL_TREE, false);
+ tree gnu_result = build1 (GOTO_EXPR, void_type_node, gnu_label);
Entity_Id local_raise = Get_Local_Raise_Call_Entity ();
/* If Local_Raise is present, build Local_Raise (Exception'Identity). */
@@ -1807,6 +1808,7 @@ build_goto_raise (tree label, int msg)
= build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result);
}
+ TREE_USED (gnu_label) = 1;
return gnu_result;
}
@@ -1859,13 +1861,13 @@ expand_sloc (Node_Id gnat_node, tree *filename, tree *line, tree *col)
tree
build_call_raise (int msg, Node_Id gnat_node, char kind)
{
+ Entity_Id gnat_label = get_exception_label (kind);
tree fndecl = gnat_raise_decls[msg];
- tree label = get_exception_label (kind);
tree filename, line;
/* If this is to be done as a goto, handle that case. */
- if (label)
- return build_goto_raise (label, msg);
+ if (Present (gnat_label))
+ return build_goto_raise (gnat_label, msg);
expand_sloc (gnat_node, &filename, &line, NULL);
@@ -1883,13 +1885,13 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
tree
build_call_raise_column (int msg, Node_Id gnat_node, char kind)
{
+ Entity_Id gnat_label = get_exception_label (kind);
tree fndecl = gnat_raise_decls_ext[msg];
- tree label = get_exception_label (kind);
tree filename, line, col;
/* If this is to be done as a goto, handle that case. */
- if (label)
- return build_goto_raise (label, msg);
+ if (Present (gnat_label))
+ return build_goto_raise (gnat_label, msg);
expand_sloc (gnat_node, &filename, &line, &col);
@@ -1908,13 +1910,13 @@ tree
build_call_raise_range (int msg, Node_Id gnat_node, char kind,
tree index, tree first, tree last)
{
+ Entity_Id gnat_label = get_exception_label (kind);
tree fndecl = gnat_raise_decls_ext[msg];
- tree label = get_exception_label (kind);
tree filename, line, col;
/* If this is to be done as a goto, handle that case. */
- if (label)
- return build_goto_raise (label, msg);
+ if (Present (gnat_label))
+ return build_goto_raise (gnat_label, msg);
expand_sloc (gnat_node, &filename, &line, &col);
generated by cgit v1.1 at 2025-05-28 11:38:57 +0000