#include "system.h"
#include "flags.h"
#include "gfortran.h"
+#include "obstack.h"
+#include "bitmap.h"
#include "arith.h" /* For gfc_compare_expr(). */
#include "dependency.h"
}
seq_type;
-/* Stack to push the current if we descend into a block during
- resolution. See resolve_branch() and resolve_code(). */
+/* Stack to keep track of the nesting of blocks as we move through the
+ code. See resolve_branch() and resolve_code(). */
typedef struct code_stack
{
- struct gfc_code *head, *current;
+ struct gfc_code *head, *current, *tail;
struct code_stack *prev;
+
+ /* This bitmap keeps track of the targets valid for a branch from
+ inside this block. */
+ bitmap reachable_labels;
}
code_stack;
/* The id of the last entry seen. */
static int current_entry_id;
+/* We use bitmaps to determine if a branch target is valid. */
+static bitmap_obstack labels_obstack;
+
int
gfc_is_formal_arg (void)
{
/*********** Toplevel code resolution subroutines ***********/
+/* Find the set of labels that are reachable from this block. We also
+ record the last statement in each block so that we don't have to do
+ a linear search to find the END DO statements of the blocks. */
+
+static void
+reachable_labels (gfc_code *block)
+{
+ gfc_code *c;
+
+ if (!block)
+ return;
+
+ cs_base->reachable_labels = bitmap_obstack_alloc (&labels_obstack);
+
+ /* Collect labels in this block. */
+ for (c = block; c; c = c->next)
+ {
+ if (c->here)
+ bitmap_set_bit (cs_base->reachable_labels, c->here->value);
+
+ if (!c->next && cs_base->prev)
+ cs_base->prev->tail = c;
+ }
+
+ /* Merge with labels from parent block. */
+ if (cs_base->prev)
+ {
+ gcc_assert (cs_base->prev->reachable_labels);
+ bitmap_ior_into (cs_base->reachable_labels,
+ cs_base->prev->reachable_labels);
+ }
+}
+
/* Given a branch to a label and a namespace, if the branch is conforming.
- The code node described where the branch is located. */
+ The code node describes where the branch is located. */
static void
resolve_branch (gfc_st_label *label, gfc_code *code)
{
- gfc_code *block, *found;
code_stack *stack;
- gfc_st_label *lp;
if (label == NULL)
return;
- lp = label;
/* Step one: is this a valid branching target? */
- if (lp->defined == ST_LABEL_UNKNOWN)
+ if (label->defined == ST_LABEL_UNKNOWN)
{
- gfc_error ("Label %d referenced at %L is never defined", lp->value,
- &lp->where);
+ gfc_error ("Label %d referenced at %L is never defined", label->value,
+ &label->where);
return;
}
- if (lp->defined != ST_LABEL_TARGET)
+ if (label->defined != ST_LABEL_TARGET)
{
gfc_error ("Statement at %L is not a valid branch target statement "
- "for the branch statement at %L", &lp->where, &code->loc);
+ "for the branch statement at %L", &label->where, &code->loc);
return;
}
return;
}
- /* Step three: Try to find the label in the parse tree. To do this,
- we traverse the tree block-by-block: first the block that
- contains this GOTO, then the block that it is nested in, etc. We
- can ignore other blocks because branching into another block is
- not allowed. */
-
- found = NULL;
-
- for (stack = cs_base; stack; stack = stack->prev)
- {
- for (block = stack->head; block; block = block->next)
- {
- if (block->here == label)
- {
- found = block;
- break;
- }
- }
-
- if (found)
- break;
- }
+ /* Step three: See if the label is in the same block as the
+ branching statement. The hard work has been done by setting up
+ the bitmap reachable_labels. */
- if (found == NULL)
+ if (!bitmap_bit_p (cs_base->reachable_labels, label->value))
{
/* The label is not in an enclosing block, so illegal. This was
- allowed in Fortran 66, so we allow it as extension. We also
- forego further checks if we run into this. */
+ allowed in Fortran 66, so we allow it as extension. No
+ further checks are necessary in this case. */
gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block "
- "as the GOTO statement at %L", &lp->where, &code->loc);
+ "as the GOTO statement at %L", &label->where,
+ &code->loc);
return;
}
/* Step four: Make sure that the branching target is legal if
- the statement is an END {SELECT,DO,IF}. */
+ the statement is an END {SELECT,IF}. */
- if (found->op == EXEC_NOP)
- {
- for (stack = cs_base; stack; stack = stack->prev)
- if (stack->current->next == found)
- break;
+ for (stack = cs_base; stack; stack = stack->prev)
+ if (stack->current->next && stack->current->next->here == label)
+ break;
- if (stack == NULL)
- gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps to END "
- "of construct at %L", &code->loc, &found->loc);
+ if (stack && stack->current->next->op == EXEC_NOP)
+ {
+ gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps to "
+ "END of construct at %L", &code->loc,
+ &stack->current->next->loc);
+ return; /* We know this is not an END DO. */
}
+
+ /* Step five: Make sure that we're not jumping to the end of a DO
+ loop from within the loop. */
+
+ for (stack = cs_base; stack; stack = stack->prev)
+ if ((stack->current->op == EXEC_DO
+ || stack->current->op == EXEC_DO_WHILE)
+ && stack->tail->here == label && stack->tail->op == EXEC_NOP)
+ {
+ gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: GOTO at %L jumps "
+ "to END of construct at %L", &code->loc,
+ &stack->tail->loc);
+ return;
+
+ }
}
frame.head = code;
cs_base = &frame;
+ reachable_labels (code);
+
for (; code; code = code->next)
{
frame.current = code;
cs_base = NULL;
/* Set to an out of range value. */
current_entry_id = -1;
+
+ bitmap_obstack_initialize (&labels_obstack);
resolve_code (ns->code, ns);
+ bitmap_obstack_release (&labels_obstack);
}
projects / platform / upstream / gcc.git / commitdiff