@@ -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
@@ -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_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
{
@@ -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_change_set change_set_var = { vNULL, vNULL };
+static gfc_change_set *changes = &change_set_var;
/*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
@@ -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;
+ changes->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;
+ changes->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 (changes->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;
+ changes->syms.truncate (0);
+ changes->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 (changes->syms, i, p)
{
- q = p->tlink;
- p->tlink = NULL;
p->mark = 0;
p->gfc_new = 0;
free_old_symbol (p);
}
- changed_syms = NULL;
+ changes->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 (changes->tbps, i, tbp)
+ tbp->error = 0;
+ changes->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 (changes->syms, i, p)
+ if (p == sym)
+ {
+ changes->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 (changes->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;
+ changes->tbps.safe_push (result);
return result;
}