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;