Commit dd355a42 by Mikael Morin

Make-lang.in (F95_PARSER_OBJS): Add dependency to vec.h.

fortran/
	* Make-lang.in (F95_PARSER_OBJS): Add dependency to vec.h.
	* gfortran.h: Include vec.h.
	(gfc_undo_change_set): New struct.
	* symbol.c (tentative_tbp): Remove struct.
	(changed_syms, tentative_tbp_list): Remove variables.
	(default_undo_chgset_var, latest_undo_chgset): New variables.
	(save_symbol_data, gfc_get_sym_tree, gfc_undo_symbols,
	gfc_commit_symbols, gfc_commit_symbol,
	gfc_enforce_clean_symbol_state, gfc_get_typebound_proc):
	Use latest_undo_chgset instead of changed_syms and tentative_tbp_list.

From-SVN: r196411
parent 0f0d56d8
2013-03-03 Mikael Morin <mikael@gcc.gnu.org>
* Make-lang.in (F95_PARSER_OBJS): Add dependency to vec.h
* gfortran.h: Include vec.h
(gfc_undo_change_set): New struct.
* symbol.c (tentative_tbp): Remove struct.
(changed_syms, tentative_tbp_list): Remove variables.
(default_undo_chgset_var, latest_undo_chgset): New variables.
(save_symbol_data, gfc_get_sym_tree, gfc_undo_symbols,
gfc_commit_symbols, gfc_commit_symbol,
gfc_enforce_clean_symbol_state, gfc_get_typebound_proc):
Use latest_undo_chgset instead of changed_syms and tentative_tbp_list.
2013-03-01 Tobias Burnus <burnus@net-b.de> 2013-03-01 Tobias Burnus <burnus@net-b.de>
PR fortran/56491 PR fortran/56491
......
...@@ -327,7 +327,7 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/libgfortran.h \ ...@@ -327,7 +327,7 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/libgfortran.h \
fortran/intrinsic.h fortran/match.h fortran/constructor.h \ fortran/intrinsic.h fortran/match.h fortran/constructor.h \
fortran/parse.h fortran/arith.h fortran/target-memory.h \ fortran/parse.h fortran/arith.h fortran/target-memory.h \
$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.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) \ $(FLAGS_H) $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) \
fortran/iso-c-binding.def fortran/iso-fortran-env.def fortran/iso-c-binding.def fortran/iso-fortran-env.def
fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h
......
...@@ -39,6 +39,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -39,6 +39,7 @@ along with GCC; see the file COPYING3. If not see
#include "intl.h" #include "intl.h"
#include "input.h" #include "input.h"
#include "splay-tree.h" #include "splay-tree.h"
#include "vec.h"
/* Major control parameters. */ /* Major control parameters. */
...@@ -1275,6 +1276,14 @@ typedef struct gfc_symbol ...@@ -1275,6 +1276,14 @@ typedef struct gfc_symbol
} }
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. */ /* This structure is used to keep track of symbols in common blocks. */
typedef struct gfc_common_head typedef struct gfc_common_head
{ {
......
...@@ -97,21 +97,10 @@ gfc_namespace *gfc_global_ns_list; ...@@ -97,21 +97,10 @@ gfc_namespace *gfc_global_ns_list;
gfc_gsymbol *gfc_gsym_root = NULL; gfc_gsymbol *gfc_gsym_root = NULL;
static gfc_symbol *changed_syms = NULL;
gfc_dt_list *gfc_derived_types; gfc_dt_list *gfc_derived_types;
static gfc_undo_change_set default_undo_chgset_var = { vNULL, vNULL };
/* List of tentative typebound-procedures. */ static gfc_undo_change_set *latest_undo_chgset = &default_undo_chgset_var;
typedef struct tentative_tbp
{
gfc_typebound_proc *proc;
struct tentative_tbp *next;
}
tentative_tbp;
static tentative_tbp *tentative_tbp_list = NULL;
/*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/ /*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
...@@ -2303,7 +2292,7 @@ done: ...@@ -2303,7 +2292,7 @@ done:
undo changes made to a symbol table if the current interpretation undo changes made to a symbol table if the current interpretation
of a statement is found to be incorrect. Whenever a symbol is 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 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 symbols are kept in a vector so that we can commit or
undo the changes at a later time. undo the changes at a later time.
A symtree may point to a symbol node outside of its namespace. In A symtree may point to a symbol node outside of its namespace. In
...@@ -2721,8 +2710,7 @@ save_symbol_data (gfc_symbol *sym) ...@@ -2721,8 +2710,7 @@ save_symbol_data (gfc_symbol *sym)
sym->old_symbol = XCNEW (gfc_symbol); sym->old_symbol = XCNEW (gfc_symbol);
*(sym->old_symbol) = *sym; *(sym->old_symbol) = *sym;
sym->tlink = changed_syms; latest_undo_chgset->syms.safe_push (sym);
changed_syms = sym;
} }
...@@ -2758,10 +2746,9 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result, ...@@ -2758,10 +2746,9 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
/* Add to the list of tentative symbols. */ /* Add to the list of tentative symbols. */
p->old_symbol = NULL; p->old_symbol = NULL;
p->tlink = changed_syms;
p->mark = 1; p->mark = 1;
p->gfc_new = 1; p->gfc_new = 1;
changed_syms = p; latest_undo_chgset->syms.safe_push (p);
st = gfc_new_symtree (&ns->sym_root, name); st = gfc_new_symtree (&ns->sym_root, name);
st->n.sym = p; st->n.sym = p;
...@@ -2899,13 +2886,11 @@ find_common_symtree (gfc_symtree *st, gfc_common_head *head) ...@@ -2899,13 +2886,11 @@ find_common_symtree (gfc_symtree *st, gfc_common_head *head)
void void
gfc_undo_symbols (void) gfc_undo_symbols (void)
{ {
gfc_symbol *p, *q, *old; gfc_symbol *p, *old;
tentative_tbp *tbp, *tbq; 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) if (p->gfc_new)
{ {
/* Symbol was new. */ /* Symbol was new. */
...@@ -3012,18 +2997,10 @@ gfc_undo_symbols (void) ...@@ -3012,18 +2997,10 @@ gfc_undo_symbols (void)
free (p->old_symbol); free (p->old_symbol);
p->old_symbol = NULL; p->old_symbol = NULL;
p->tlink = NULL;
} }
changed_syms = NULL; latest_undo_chgset->syms.truncate (0);
latest_undo_chgset->tbps.truncate (0);
for (tbp = tentative_tbp_list; tbp; tbp = tbq)
{
tbq = tbp->next;
/* Procedure is already marked `error' by default. */
free (tbp);
}
tentative_tbp_list = NULL;
} }
...@@ -3060,26 +3037,21 @@ free_old_symbol (gfc_symbol *sym) ...@@ -3060,26 +3037,21 @@ free_old_symbol (gfc_symbol *sym)
void void
gfc_commit_symbols (void) gfc_commit_symbols (void)
{ {
gfc_symbol *p, *q; gfc_symbol *p;
tentative_tbp *tbp, *tbq; 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->mark = 0;
p->gfc_new = 0; p->gfc_new = 0;
free_old_symbol (p); free_old_symbol (p);
} }
changed_syms = NULL; latest_undo_chgset->syms.truncate (0);
for (tbp = tentative_tbp_list; tbp; tbp = tbq) FOR_EACH_VEC_ELT (latest_undo_chgset->tbps, i, tbp)
{ tbp->error = 0;
tbq = tbp->next; latest_undo_chgset->tbps.truncate (0);
tbp->proc->error = 0;
free (tbp);
}
tentative_tbp_list = NULL;
} }
...@@ -3090,20 +3062,15 @@ void ...@@ -3090,20 +3062,15 @@ void
gfc_commit_symbol (gfc_symbol *sym) gfc_commit_symbol (gfc_symbol *sym)
{ {
gfc_symbol *p; gfc_symbol *p;
unsigned i;
if (changed_syms == sym) FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
changed_syms = sym->tlink; if (p == sym)
else {
{ latest_undo_chgset->syms.unordered_remove (i);
for (p = changed_syms; p; p = p->tlink) break;
if (p->tlink == sym) }
{
p->tlink = sym->tlink;
break;
}
}
sym->tlink = NULL;
sym->mark = 0; sym->mark = 0;
sym->gfc_new = 0; sym->gfc_new = 0;
...@@ -3548,7 +3515,7 @@ gfc_save_all (gfc_namespace *ns) ...@@ -3548,7 +3515,7 @@ gfc_save_all (gfc_namespace *ns)
void void
gfc_enforce_clean_symbol_state(void) gfc_enforce_clean_symbol_state(void)
{ {
gcc_assert (changed_syms == NULL); gcc_assert (latest_undo_chgset->syms.is_empty ());
} }
...@@ -4709,17 +4676,13 @@ gfc_typebound_proc* ...@@ -4709,17 +4676,13 @@ gfc_typebound_proc*
gfc_get_typebound_proc (gfc_typebound_proc *tb0) gfc_get_typebound_proc (gfc_typebound_proc *tb0)
{ {
gfc_typebound_proc *result; gfc_typebound_proc *result;
tentative_tbp *list_node;
result = XCNEW (gfc_typebound_proc); result = XCNEW (gfc_typebound_proc);
if (tb0) if (tb0)
*result = *tb0; *result = *tb0;
result->error = 1; result->error = 1;
list_node = XCNEW (tentative_tbp); latest_undo_chgset->tbps.safe_push (result);
list_node->next = tentative_tbp_list;
list_node->proc = result;
tentative_tbp_list = list_node;
return result; return result;
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment