Le 22/02/2013 16:23, Tobias Burnus a écrit :
Regarding the naming, can you use a bit more speaking names? For
instance – without claiming that the naming choice is best:
"undo_changes" instead of "changes", "emtpy_undo_change_set_var" instead
of "change_set_var", "gfc_new_undo_checkpoint" instead of
"gfc_new_checkpoint". It can be also something different, but it should
imply what they a good for.
I'll change:
gfc_change_set -> gfc_undo_change_set
change_set_var -> default_undo_chgset_var
changes -> latest_undo_chgset
gfc_new_checkpoint -> gfc_new_undo_checkpoint
gfc_drop_last_checkpoint -> gfc_drop_last_undo_checkpoint
gfc_restore_last_checkpoint -> gfc_restore_last_undo_checkpoint
free_change_set_data -> free_undo_change_set_data
pop_change_set -> pop_undo_change_set
I attach the corresponding patches.
Will test and commit tomorrow.
Mikael
diff --git a/Make-lang.in b/Make-lang.in
index 3584dd8..8c9e7ea 100644
--- a/Make-lang.in
+++ b/Make-lang.in
@@ -327,7 +327,7 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/libgfortran.h \
fortran/intrinsic.h fortran/match.h fortran/constructor.h \
fortran/parse.h fortran/arith.h fortran/target-memory.h \
$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \
- dumpfile.h $(TREE_H) dumpfile.h $(GGC_H) \
+ dumpfile.h $(TREE_H) dumpfile.h $(GGC_H) $(VEC_H) \
$(FLAGS_H) $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) \
fortran/iso-c-binding.def fortran/iso-fortran-env.def
fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h
diff --git a/gfortran.h b/gfortran.h
index 44d5c91..d6176db 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -39,6 +39,7 @@ along with GCC; see the file COPYING3. If not see
#include "intl.h"
#include "input.h"
#include "splay-tree.h"
+#include "vec.h"
/* Major control parameters. */
@@ -1275,6 +1276,14 @@ typedef struct gfc_symbol
}
gfc_symbol;
+
+struct gfc_undo_change_set
+{
+ vec<gfc_symbol *> syms;
+ vec<gfc_typebound_proc *> tbps;
+};
+
+
/* This structure is used to keep track of symbols in common blocks. */
typedef struct gfc_common_head
{
diff --git a/symbol.c b/symbol.c
index acfebc5..ec721bf 100644
--- a/symbol.c
+++ b/symbol.c
@@ -97,21 +97,10 @@ gfc_namespace *gfc_global_ns_list;
gfc_gsymbol *gfc_gsym_root = NULL;
-static gfc_symbol *changed_syms = NULL;
-
gfc_dt_list *gfc_derived_types;
-
-/* List of tentative typebound-procedures. */
-
-typedef struct tentative_tbp
-{
- gfc_typebound_proc *proc;
- struct tentative_tbp *next;
-}
-tentative_tbp;
-
-static tentative_tbp *tentative_tbp_list = NULL;
+static gfc_undo_change_set default_undo_chgset_var = { vNULL, vNULL };
+static gfc_undo_change_set *latest_undo_chgset = &default_undo_chgset_var;
/*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
@@ -2301,9 +2290,9 @@ done:
Given the tricky nature of the Fortran grammar, we must be able to
undo changes made to a symbol table if the current interpretation
of a statement is found to be incorrect. Whenever a symbol is
- looked up, we make a copy of it and link to it. All of these
- symbols are kept in a singly linked list so that we can commit or
- undo the changes at a later time.
+ looked up, we make a copy of it and link to it. All of these symbols
+ are kept in a vector so that we can commit or undo the changes
+ at a later time.
A symtree may point to a symbol node outside of its namespace. In
this case, that symbol has been used as a host associated variable
@@ -2720,8 +2709,7 @@ save_symbol_data (gfc_symbol *sym)
sym->old_symbol = XCNEW (gfc_symbol);
*(sym->old_symbol) = *sym;
- sym->tlink = changed_syms;
- changed_syms = sym;
+ latest_undo_chgset->syms.safe_push (sym);
}
@@ -2757,10 +2745,9 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
/* Add to the list of tentative symbols. */
p->old_symbol = NULL;
- p->tlink = changed_syms;
p->mark = 1;
p->gfc_new = 1;
- changed_syms = p;
+ latest_undo_chgset->syms.safe_push (p);
st = gfc_new_symtree (&ns->sym_root, name);
st->n.sym = p;
@@ -2898,13 +2885,11 @@ find_common_symtree (gfc_symtree *st, gfc_common_head *head)
void
gfc_undo_symbols (void)
{
- gfc_symbol *p, *q, *old;
- tentative_tbp *tbp, *tbq;
+ gfc_symbol *p, *old;
+ unsigned i;
- for (p = changed_syms; p; p = q)
+ FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
- q = p->tlink;
-
if (p->gfc_new)
{
/* Symbol was new. */
@@ -3011,18 +2996,10 @@ gfc_undo_symbols (void)
free (p->old_symbol);
p->old_symbol = NULL;
- p->tlink = NULL;
}
- changed_syms = NULL;
-
- for (tbp = tentative_tbp_list; tbp; tbp = tbq)
- {
- tbq = tbp->next;
- /* Procedure is already marked `error' by default. */
- free (tbp);
- }
- tentative_tbp_list = NULL;
+ latest_undo_chgset->syms.truncate (0);
+ latest_undo_chgset->tbps.truncate (0);
}
@@ -3059,26 +3036,21 @@ free_old_symbol (gfc_symbol *sym)
void
gfc_commit_symbols (void)
{
- gfc_symbol *p, *q;
- tentative_tbp *tbp, *tbq;
+ gfc_symbol *p;
+ gfc_typebound_proc *tbp;
+ unsigned i;
- for (p = changed_syms; p; p = q)
+ FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
- q = p->tlink;
- p->tlink = NULL;
p->mark = 0;
p->gfc_new = 0;
free_old_symbol (p);
}
- changed_syms = NULL;
+ latest_undo_chgset->syms.truncate (0);
- for (tbp = tentative_tbp_list; tbp; tbp = tbq)
- {
- tbq = tbp->next;
- tbp->proc->error = 0;
- free (tbp);
- }
- tentative_tbp_list = NULL;
+ FOR_EACH_VEC_ELT (latest_undo_chgset->tbps, i, tbp)
+ tbp->error = 0;
+ latest_undo_chgset->tbps.truncate (0);
}
@@ -3089,20 +3061,15 @@ void
gfc_commit_symbol (gfc_symbol *sym)
{
gfc_symbol *p;
+ unsigned i;
- if (changed_syms == sym)
- changed_syms = sym->tlink;
- else
- {
- for (p = changed_syms; p; p = p->tlink)
- if (p->tlink == sym)
- {
- p->tlink = sym->tlink;
- break;
- }
- }
+ FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
+ if (p == sym)
+ {
+ latest_undo_chgset->syms.unordered_remove (i);
+ break;
+ }
- sym->tlink = NULL;
sym->mark = 0;
sym->gfc_new = 0;
@@ -3547,7 +3514,7 @@ gfc_save_all (gfc_namespace *ns)
void
gfc_enforce_clean_symbol_state(void)
{
- gcc_assert (changed_syms == NULL);
+ gcc_assert (latest_undo_chgset->syms.is_empty ());
}
@@ -4708,17 +4675,13 @@ gfc_typebound_proc*
gfc_get_typebound_proc (gfc_typebound_proc *tb0)
{
gfc_typebound_proc *result;
- tentative_tbp *list_node;
result = XCNEW (gfc_typebound_proc);
if (tb0)
*result = *tb0;
result->error = 1;
- list_node = XCNEW (tentative_tbp);
- list_node->next = tentative_tbp_list;
- list_node->proc = result;
- tentative_tbp_list = list_node;
+ latest_undo_chgset->tbps.safe_push (result);
return result;
}
diff --git a/symbol.c b/symbol.c
index ec721bf..301e6e4 100644
--- a/symbol.c
+++ b/symbol.c
@@ -2878,6 +2878,64 @@ find_common_symtree (gfc_symtree *st, gfc_common_head *head)
}
+/* Restore previous state of symbol. Just copy simple stuff. */
+
+static void
+restore_old_symbol (gfc_symbol *p)
+{
+ gfc_symbol *old;
+
+ p->mark = 0;
+ old = p->old_symbol;
+
+ p->ts.type = old->ts.type;
+ p->ts.kind = old->ts.kind;
+
+ p->attr = old->attr;
+
+ if (p->value != old->value)
+ {
+ gfc_free_expr (old->value);
+ p->value = NULL;
+ }
+
+ if (p->as != old->as)
+ {
+ if (p->as)
+ gfc_free_array_spec (p->as);
+ p->as = old->as;
+ }
+
+ p->generic = old->generic;
+ p->component_access = old->component_access;
+
+ if (p->namelist != NULL && old->namelist == NULL)
+ {
+ gfc_free_namelist (p->namelist);
+ p->namelist = NULL;
+ }
+ else
+ {
+ if (p->namelist_tail != old->namelist_tail)
+ {
+ gfc_free_namelist (old->namelist_tail->next);
+ old->namelist_tail->next = NULL;
+ }
+ }
+
+ p->namelist_tail = old->namelist_tail;
+
+ if (p->formal != old->formal)
+ {
+ gfc_free_formal_arglist (p->formal);
+ p->formal = old->formal;
+ }
+
+ free (p->old_symbol);
+ p->old_symbol = NULL;
+}
+
+
/* Undoes all the changes made to symbols in the current statement.
This subroutine is made simpler due to the fact that attributes are
never removed once added. */
@@ -2885,7 +2943,7 @@ find_common_symtree (gfc_symtree *st, gfc_common_head *head)
void
gfc_undo_symbols (void)
{
- gfc_symbol *p, *old;
+ gfc_symbol *p;
unsigned i;
FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
@@ -2944,58 +3002,9 @@ gfc_undo_symbols (void)
gfc_delete_symtree (&p->ns->sym_root, p->name);
gfc_release_symbol (p);
- continue;
- }
-
- /* Restore previous state of symbol. Just copy simple stuff. */
- p->mark = 0;
- old = p->old_symbol;
-
- p->ts.type = old->ts.type;
- p->ts.kind = old->ts.kind;
-
- p->attr = old->attr;
-
- if (p->value != old->value)
- {
- gfc_free_expr (old->value);
- p->value = NULL;
- }
-
- if (p->as != old->as)
- {
- if (p->as)
- gfc_free_array_spec (p->as);
- p->as = old->as;
- }
-
- p->generic = old->generic;
- p->component_access = old->component_access;
-
- if (p->namelist != NULL && old->namelist == NULL)
- {
- gfc_free_namelist (p->namelist);
- p->namelist = NULL;
}
else
- {
- if (p->namelist_tail != old->namelist_tail)
- {
- gfc_free_namelist (old->namelist_tail->next);
- old->namelist_tail->next = NULL;
- }
- }
-
- p->namelist_tail = old->namelist_tail;
-
- if (p->formal != old->formal)
- {
- gfc_free_formal_arglist (p->formal);
- p->formal = old->formal;
- }
-
- free (p->old_symbol);
- p->old_symbol = NULL;
+ restore_old_symbol (p);
}
latest_undo_chgset->syms.truncate (0);
diff --git a/symbol.c b/symbol.c
index 301e6e4..b94a44a 100644
--- a/symbol.c
+++ b/symbol.c
@@ -2895,7 +2895,8 @@ restore_old_symbol (gfc_symbol *p)
if (p->value != old->value)
{
- gfc_free_expr (old->value);
+ gcc_checking_assert (old->value == NULL);
+ gfc_free_expr (p->value);
p->value = NULL;
}
diff --git a/gfortran.h b/gfortran.h
index d6176db..18bbf79 100644
--- a/gfortran.h
+++ b/gfortran.h
@@ -1281,6 +1281,7 @@ struct gfc_undo_change_set
{
vec<gfc_symbol *> syms;
vec<gfc_typebound_proc *> tbps;
+ gfc_undo_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_undo_checkpoint (gfc_undo_change_set &);
+void gfc_drop_last_undo_checkpoint (void);
+void gfc_restore_last_undo_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 b94a44a..fea24a8 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_undo_change_set default_undo_chgset_var = { vNULL, vNULL };
+static gfc_undo_change_set default_undo_chgset_var = { vNULL, vNULL, NULL };
static gfc_undo_change_set *latest_undo_chgset = &default_undo_chgset_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 (latest_undo_chgset == &default_undo_chgset_var)
+ {
+ gcc_assert (latest_undo_chgset->previous == NULL);
+ return true;
+ }
+ else
+ {
+ gcc_assert (latest_undo_chgset->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 (latest_undo_chgset->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;
latest_undo_chgset->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_undo_checkpoint or gfc_drop_last_undo_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_undo_checkpoint (gfc_undo_change_set &chg_syms)
+{
+ chg_syms.syms = vNULL;
+ chg_syms.tbps = vNULL;
+ chg_syms.previous = latest_undo_chgset;
+ latest_undo_chgset = &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_undo_change_set structure. Doesn't free the
+ structure itself. */
+
+static void
+free_undo_change_set_data (gfc_undo_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_undo_change_set (gfc_undo_change_set *&cs)
+{
+ free_undo_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_undo_checkpoint (void)
+{
+ gfc_symbol *s, *t;
+ unsigned i, j;
+
+ FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, s)
+ {
+ /* No need to loop in this case. */
+ if (s->old_symbol == NULL)
+ continue;
+
+ /* Remove the duplicate symbols. */
+ FOR_EACH_VEC_ELT (latest_undo_chgset->previous->syms, j, t)
+ if (t == s)
+ {
+ latest_undo_chgset->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;
+ }
+ }
+
+ latest_undo_chgset->previous->syms.safe_splice (latest_undo_chgset->syms);
+ latest_undo_chgset->previous->tbps.safe_splice (latest_undo_chgset->tbps);
+
+ pop_undo_change_set (latest_undo_chgset);
}
-/* 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_undo_checkpoint (void)
{
gfc_symbol *p;
unsigned i;
@@ -3010,6 +3129,30 @@ gfc_undo_symbols (void)
latest_undo_chgset->syms.truncate (0);
latest_undo_chgset->tbps.truncate (0);
+
+ if (!single_undo_checkpoint_p ())
+ pop_undo_change_set (latest_undo_chgset);
+}
+
+
+/* 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_undo_checkpoint or gfc_restore_last_undo_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_undo_checkpoint ();
}
@@ -3050,6 +3193,8 @@ gfc_commit_symbols (void)
gfc_typebound_proc *tbp;
unsigned i;
+ enforce_single_undo_checkpoint ();
+
FOR_EACH_VEC_ELT (latest_undo_chgset->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 (latest_undo_chgset->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_undo_change_set_data (*latest_undo_chgset);
}
@@ -3524,6 +3673,7 @@ gfc_save_all (gfc_namespace *ns)
void
gfc_enforce_clean_symbol_state(void)
{
+ enforce_single_undo_checkpoint ();
gcc_assert (latest_undo_chgset->syms.is_empty ());
}
diff --git a/array.c b/array.c
index 6787c05..6ee292c 100644
--- a/array.c
+++ b/array.c
@@ -1046,6 +1046,7 @@ match
gfc_match_array_constructor (gfc_expr **result)
{
gfc_constructor_base head, new_cons;
+ gfc_undo_change_set changed_syms;
gfc_expr *expr;
gfc_typespec ts;
locus where;
@@ -1074,6 +1075,7 @@ gfc_match_array_constructor (gfc_expr **result)
/* Try to match an optional "type-spec ::" */
gfc_clear_ts (&ts);
+ gfc_new_undo_checkpoint (changed_syms);
if (gfc_match_decl_type_spec (&ts, 0) == MATCH_YES)
{
seen_ts = (gfc_match (" ::") == MATCH_YES);
@@ -1082,19 +1084,28 @@ gfc_match_array_constructor (gfc_expr **result)
{
if (gfc_notify_std (GFC_STD_F2003, "Array constructor "
"including type specification at %C") == FAILURE)
- goto cleanup;
+ {
+ gfc_restore_last_undo_checkpoint ();
+ goto cleanup;
+ }
if (ts.deferred)
{
gfc_error ("Type-spec at %L cannot contain a deferred "
"type parameter", &where);
+ gfc_restore_last_undo_checkpoint ();
goto cleanup;
}
}
}
- if (! seen_ts)
- gfc_current_locus = where;
+ if (seen_ts)
+ gfc_drop_last_undo_checkpoint ();
+ else
+ {
+ gfc_restore_last_undo_checkpoint ();
+ gfc_current_locus = where;
+ }
if (gfc_match (end_delim) == MATCH_YES)
{
