Mercurial > hg > CbC > CbC_gcc
diff gcc/fortran/module.c @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | 04ced10e8804 |
children | 1830386684a0 |
line wrap: on
line diff
--- a/gcc/fortran/module.c Fri Oct 27 22:46:09 2017 +0900 +++ b/gcc/fortran/module.c Thu Oct 25 07:37:49 2018 +0900 @@ -1,6 +1,6 @@ /* Handle modules, which amounts to loading and saving symbols and their attendant structures. - Copyright (C) 2000-2017 Free Software Foundation, Inc. + Copyright (C) 2000-2018 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -143,7 +143,7 @@ typedef struct pointer_info { BBT_HEADER (pointer_info); - int integer; + HOST_WIDE_INT integer; pointer_t type; /* The first component of each member of the union is the pointer @@ -368,7 +368,7 @@ creating the node if not found. */ static pointer_info * -get_integer (int integer) +get_integer (HOST_WIDE_INT integer) { pointer_info *p, t; int c; @@ -468,7 +468,7 @@ sometime later. Returns the pointer_info structure. */ static pointer_info * -add_fixup (int integer, void *gp) +add_fixup (HOST_WIDE_INT integer, void *gp) { pointer_info *p; fixup_t *f; @@ -1145,7 +1145,7 @@ #define MAX_ATOM_SIZE 100 -static int atom_int; +static HOST_WIDE_INT atom_int; static char *atom_string, atom_name[MAX_ATOM_SIZE]; @@ -1275,7 +1275,7 @@ } -/* Parse a small integer. */ +/* Parse an integer. Should fit in a HOST_WIDE_INT. */ static void parse_integer (int c) @@ -1292,8 +1292,6 @@ } atom_int = 10 * atom_int + c - '0'; - if (atom_int > 99999999) - bad_module ("Integer overflow"); } } @@ -1635,11 +1633,12 @@ static void write_atom (atom_type atom, const void *v) { - char buffer[20]; + char buffer[32]; /* Workaround -Wmaybe-uninitialized false positive during profiledbootstrap by initializing them. */ - int i = 0, len; + int len; + HOST_WIDE_INT i = 0; const char *p; switch (atom) @@ -1658,11 +1657,9 @@ break; case ATOM_INTEGER: - i = *((const int *) v); - if (i < 0) - gfc_internal_error ("write_atom(): Writing negative integer"); - - sprintf (buffer, "%d", i); + i = *((const HOST_WIDE_INT *) v); + + snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i); p = buffer; break; @@ -1770,7 +1767,10 @@ mio_integer (int *ip) { if (iomode == IO_OUTPUT) - write_atom (ATOM_INTEGER, ip); + { + HOST_WIDE_INT hwi = *ip; + write_atom (ATOM_INTEGER, &hwi); + } else { require_atom (ATOM_INTEGER); @@ -1778,6 +1778,18 @@ } } +static void +mio_hwi (HOST_WIDE_INT *hwi) +{ + if (iomode == IO_OUTPUT) + write_atom (ATOM_INTEGER, hwi); + else + { + require_atom (ATOM_INTEGER); + *hwi = atom_int; + } +} + /* Read or write a gfc_intrinsic_op value. */ @@ -1787,7 +1799,7 @@ /* FIXME: Would be nicer to do this via the operators symbolic name. */ if (iomode == IO_OUTPUT) { - int converted = (int) *op; + HOST_WIDE_INT converted = (HOST_WIDE_INT) *op; write_atom (ATOM_INTEGER, &converted); } else @@ -2719,7 +2731,7 @@ { for (i = 0; i < ar->dimen; i++) { - int tmp = (int)ar->dimen_type[i]; + HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i]; write_atom (ATOM_INTEGER, &tmp); } } @@ -2756,7 +2768,8 @@ if (iomode == IO_OUTPUT) { p = get_pointer (*((char **) gp)); - write_atom (ATOM_INTEGER, &p->integer); + HOST_WIDE_INT hwi = p->integer; + write_atom (ATOM_INTEGER, &hwi); } else { @@ -2794,18 +2807,18 @@ mio_component (gfc_component *c, int vtype) { pointer_info *p; - int n; mio_lparen (); if (iomode == IO_OUTPUT) { p = get_pointer (c); - mio_integer (&p->integer); + mio_hwi (&p->integer); } else { - mio_integer (&n); + HOST_WIDE_INT n; + mio_hwi (&n); p = get_integer (n); associate_integer_pointer (p, c); } @@ -2835,6 +2848,8 @@ if (c->attr.proc_pointer) mio_typebound_proc (&c->tb); + c->loc = gfc_current_locus; + mio_rparen (); } @@ -3430,6 +3445,7 @@ static void mio_expr (gfc_expr **ep) { + HOST_WIDE_INT hwi; gfc_expr *e; atom_type t; int flag; @@ -3644,7 +3660,9 @@ break; case BT_CHARACTER: - mio_integer (&e->value.character.length); + hwi = e->value.character.length; + mio_hwi (&hwi); + e->value.character.length = hwi; e->value.character.string = CONST_CAST (gfc_char_t *, mio_allocated_wide_string (e->value.character.string, @@ -4082,6 +4100,9 @@ minit ("UNIFORM", 3), minit ("LINEAR", 4), minit ("ALIGNED", 5), + minit ("LINEAR_REF", 33), + minit ("LINEAR_VAL", 34), + minit ("LINEAR_UVAL", 35), minit (NULL, -1) }; @@ -4124,7 +4145,10 @@ } for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next) { - mio_name (4, omp_declare_simd_clauses); + if (n->u.linear_op == OMP_LINEAR_DEFAULT) + mio_name (4, omp_declare_simd_clauses); + else + mio_name (32 + n->u.linear_op, omp_declare_simd_clauses); mio_symbol_ref (&n->sym); mio_expr (&n->expr); } @@ -4165,11 +4189,20 @@ case 4: case 5: *ptrs[t - 3] = n = gfc_get_omp_namelist (); + finish_namelist: + n->where = gfc_current_locus; ptrs[t - 3] = &n->next; mio_symbol_ref (&n->sym); if (t != 3) mio_expr (&n->expr); break; + case 33: + case 34: + case 35: + *ptrs[1] = n = gfc_get_omp_namelist (); + n->u.linear_op = (enum gfc_omp_linear_op) (t - 32); + t = 4; + goto finish_namelist; } } } @@ -4526,9 +4559,6 @@ /* Decide if we need to load this one or not. */ p = find_use_name_n (name, &i, false); - st = find_symbol (gfc_current_ns->sym_root, - name, module_name, 1); - if (!p || gfc_find_symbol (p, NULL, 0, &sym)) { /* Skip the specific names for these cases. */ @@ -4537,6 +4567,9 @@ continue; } + st = find_symbol (gfc_current_ns->sym_root, + name, module_name, 1); + /* If the symbol exists already and is being USEd without being in an ONLY clause, do not load a new symtree(11.3.2). */ if (!only_flag && st) @@ -4758,7 +4791,7 @@ mio_pool_string (&name); gfc_clear_ts (&ts); mio_typespec (&ts); - if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0) + if (gfc_str_startswith (name, "operator ")) { const char *p = name + sizeof ("operator ") - 1; if (strcmp (p, "+") == 0) @@ -5200,8 +5233,8 @@ /* Exception: Always import vtabs & vtypes. */ if (p == NULL && name[0] == '_' - && (strncmp (name, "__vtab_", 5) == 0 - || strncmp (name, "__vtype_", 6) == 0)) + && (gfc_str_startswith (name, "__vtab_") + || gfc_str_startswith (name, "__vtype_"))) p = name; /* Skip symtree nodes not in an ONLY clause, unless there @@ -5286,8 +5319,8 @@ sym->attr.use_rename = 1; if (name[0] != '_' - || (strncmp (name, "__vtab_", 5) != 0 - && strncmp (name, "__vtype_", 6) != 0)) + || (!gfc_str_startswith (name, "__vtab_") + && !gfc_str_startswith (name, "__vtype_"))) sym->attr.use_only = only_flag; /* Store the symtree pointing to this symbol. */ @@ -5946,7 +5979,7 @@ mio_pool_string (&st->name); mio_integer (&st->ambiguous); - mio_integer (&p->integer); + mio_hwi (&p->integer); } @@ -6132,8 +6165,10 @@ gfc_fatal_error ("Can't open module file %qs for writing at %C: %s", filename_tmp, xstrerror (errno)); + /* Use lbasename to ensure module files are reproducible regardless + of the build path (see the reproducible builds project). */ gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n", - MOD_VERSION, gfc_source_file); + MOD_VERSION, lbasename (gfc_source_file)); /* Write the module itself. */ iomode = IO_OUTPUT;