A new field 'previous' is added to the 'gfc_change_set' structure so that it can
be used as a stack.
New procedures are added to use the new partial undoing feature, namely:
gfc_new_checkpoint, gfc_drop_last_checkpoint and gfc_restore_last_checkpoint.
They will be used in the next patch.
2013-02-15 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/54730
* gfortran.h (struct gfc_change_set): New field 'previous'.
(gfc_new_checkpoint, gfc_drop_last_checkpoint,
gfc_restore_last_checkpoint):
New prototypes.
* symbol.c (change_set_var): Update initialization.
(single_undo_checkpoint_p, gfc_new_checkpoint, free_change_set_data,
pop_change_set, gfc_drop_last_checkpiont,
enforce_single_undo_checkpoint):
New functions.
(save_symbol_data): Handle multiple change sets. Make sure old_symbol
field's
previous value is not overwritten. Clear gfc_new field.
(restore_old_symbol): Restore previous old_symbol field.
(gfc_restore_last_checkpoint): New function, using body renamed from
gfc_undo_symbols. Restore the previous change set as current one.
(gfc_undo_symbols): New body.
(gfc_commit_symbols, gfc_commit_symbol, gfc_enforce_clean_symbol_state):
Call enforce_single_undo_checkpoint.
(gfc_symbol_done_2): Free change set data.
diff --git a/gfortran.h b/gfortran.h
index 31b0d42..7a18c6c 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -1281,6 +1281,7 @@ struct gfc_change_set
{
vec<gfc_symbol *> syms;
vec<gfc_typebound_proc *> tbps;
+ gfc_change_set *previous;
};
@@ -2641,6 +2642,9 @@ int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
int gfc_get_ha_symbol (const char *, gfc_symbol **);
int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
+void gfc_new_checkpoint (gfc_change_set &);
+void gfc_drop_last_checkpoint (void);
+void gfc_restore_last_checkpoint (void);
void gfc_undo_symbols (void);
void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol *);
diff --git a/symbol.c b/symbol.c
index e4dbb41..f040431 100644
--- a/symbol.c
+++ b/symbol.c
@@ -99,7 +99,7 @@ gfc_gsymbol *gfc_gsym_root = NULL;
gfc_dt_list *gfc_derived_types;
-static gfc_change_set change_set_var = { vNULL, vNULL };
+static gfc_change_set change_set_var = { vNULL, vNULL, NULL };
static gfc_change_set *changes = &change_set_var;
@@ -2697,17 +2697,49 @@ gfc_find_symbol (const char *name, gfc_namespace *ns, int parent_flag,
}
+/* Tells whether there is only one set of changes in the stack. */
+
+static bool
+single_undo_checkpoint_p (void)
+{
+ if (changes == &change_set_var)
+ {
+ gcc_assert (changes->previous == NULL);
+ return true;
+ }
+ else
+ {
+ gcc_assert (changes->previous != NULL);
+ return false;
+ }
+}
+
/* Save symbol with the information necessary to back it out. */
static void
save_symbol_data (gfc_symbol *sym)
{
+ gfc_symbol *s;
+ unsigned i;
- if (sym->gfc_new || sym->old_symbol != NULL)
+ if (!single_undo_checkpoint_p ())
+ {
+ /* If there is more than one change set, look for the symbol in the
+ current one. If it is found there, we can reuse it. */
+ FOR_EACH_VEC_ELT (changes->syms, i, s)
+ if (s == sym)
+ {
+ gcc_assert (sym->gfc_new || sym->old_symbol != NULL);
+ return;
+ }
+ }
+ else if (sym->gfc_new || sym->old_symbol != NULL)
return;
- sym->old_symbol = XCNEW (gfc_symbol);
- *(sym->old_symbol) = *sym;
+ s = XCNEW (gfc_symbol);
+ *s = *sym;
+ sym->old_symbol = s;
+ sym->gfc_new = 0;
changes->syms.safe_push (sym);
}
@@ -2878,6 +2910,22 @@ find_common_symtree (gfc_symtree *st, gfc_common_head *head)
}
+/* Clear the given storage, and make it the current change set for registering
+ changed symbols. Its contents are freed after a call to
+ gfc_restore_last_checkpoint or gfc_drop_last_checkpoint, but it is up to the
+ caller to free the storage itself. It is usually a local variable, so there
+ is nothing to do anyway. */
+
+void
+gfc_new_checkpoint (gfc_change_set &chg_syms)
+{
+ chg_syms.syms = vNULL;
+ chg_syms.tbps = vNULL;
+ chg_syms.previous = changes;
+ changes = &chg_syms;
+}
+
+
/* Restore previous state of symbol. Just copy simple stuff. */
static void
@@ -2932,17 +2980,88 @@ restore_old_symbol (gfc_symbol *p)
p->formal = old->formal;
}
- free (p->old_symbol);
- p->old_symbol = NULL;
+ p->old_symbol = old->old_symbol;
+ free (old);
+}
+
+
+/* Frees the internal data of a gfc_change_set structure. Doesn't free the
+ structure itself. */
+
+static void
+free_change_set_data (gfc_change_set &cs)
+{
+ cs.syms.release ();
+ cs.tbps.release ();
+}
+
+
+/* Given a change set pointer, free its target's contents and update it with
+ the address of the previous change set. Note that only the contents are
+ freed, not the target itself (the contents' container). It is not a problem
+ as the latter will be a local variable usually. */
+
+static void
+pop_change_set (gfc_change_set *&cs)
+{
+ free_change_set_data (*cs);
+ cs = cs->previous;
+}
+
+
+static void free_old_symbol (gfc_symbol *sym);
+
+
+/* Merges the current change set into the previous one. The changes themselves
+ are left untouched; only one checkpoint is forgotten. */
+
+void
+gfc_drop_last_checkpoint (void)
+{
+ gfc_symbol *s, *t;
+ unsigned i, j;
+
+ FOR_EACH_VEC_ELT (changes->syms, i, s)
+ {
+ /* No need to loop in this case. */
+ if (s->old_symbol == NULL)
+ continue;
+
+ /* Remove the duplicate symbols. */
+ FOR_EACH_VEC_ELT (changes->previous->syms, j, t)
+ if (t == s)
+ {
+ changes->previous->syms.unordered_remove (j);
+
+ /* S->OLD_SYMBOL is the backup symbol for S as it was at the
+ last checkpoint. We drop that checkpoint, so S->OLD_SYMBOL
+ shall contain from now on the backup symbol for S as it was
+ at the checkpoint before. */
+ if (s->old_symbol->gfc_new)
+ {
+ gcc_assert (s->old_symbol->old_symbol == NULL);
+ s->gfc_new = s->old_symbol->gfc_new;
+ free_old_symbol (s);
+ }
+ else
+ restore_old_symbol (s->old_symbol);
+ break;
+ }
+ }
+
+ changes->previous->syms.safe_splice (changes->syms);
+ changes->previous->tbps.safe_splice (changes->tbps);
+
+ pop_change_set (changes);
}
-/* Undoes all the changes made to symbols in the current statement.
+/* Undoes all the changes made to symbols since the previous checkpoint.
This subroutine is made simpler due to the fact that attributes are
never removed once added. */
void
-gfc_undo_symbols (void)
+gfc_restore_last_checkpoint (void)
{
gfc_symbol *p;
unsigned i;
@@ -3010,6 +3129,30 @@ gfc_undo_symbols (void)
changes->syms.truncate (0);
changes->tbps.truncate (0);
+
+ if (!single_undo_checkpoint_p ())
+ pop_change_set (changes);
+}
+
+
+/* Makes sure that there is only one set of changes; in other words we haven't
+ forgotten to pair a call to gfc_new_checkpoint with a call to either
+ gfc_drop_last_checkpoint or gfc_restore_last_checkpoint. */
+
+static void
+enforce_single_undo_checkpoint (void)
+{
+ gcc_checking_assert (single_undo_checkpoint_p ());
+}
+
+
+/* Undoes all the changes made to symbols in the current statement. */
+
+void
+gfc_undo_symbols (void)
+{
+ enforce_single_undo_checkpoint ();
+ gfc_restore_last_checkpoint ();
}
@@ -3050,6 +3193,8 @@ gfc_commit_symbols (void)
gfc_typebound_proc *tbp;
unsigned i;
+ enforce_single_undo_checkpoint ();
+
FOR_EACH_VEC_ELT (changes->syms, i, p)
{
p->mark = 0;
@@ -3073,6 +3218,8 @@ gfc_commit_symbol (gfc_symbol *sym)
gfc_symbol *p;
unsigned i;
+ enforce_single_undo_checkpoint ();
+
FOR_EACH_VEC_ELT (changes->syms, i, p)
if (p == sym)
{
@@ -3356,10 +3503,12 @@ gfc_symbol_init_2 (void)
void
gfc_symbol_done_2 (void)
{
-
gfc_free_namespace (gfc_current_ns);
gfc_current_ns = NULL;
gfc_free_dt_list ();
+
+ enforce_single_undo_checkpoint ();
+ free_change_set_data (*changes);
}
@@ -3524,6 +3673,7 @@ gfc_save_all (gfc_namespace *ns)
void
gfc_enforce_clean_symbol_state(void)
{
+ enforce_single_undo_checkpoint ();
gcc_assert (changes->syms.is_empty ());
}
