PR 25708 Avoid seeking when parsing strings and when peeking.

2011-12-01  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/25708
	* module.c (parse_string): Read string into resizable array
	instead of parsing twice and seeking.
	(peek_atom): New implementation avoiding seeks.
	(require_atom): Save and set column and line explicitly for error
	handling.

From-SVN: r181879

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 80f8d5b2c8d1202038fe5c740facc6781fdbf215..9c62697d29eb7e7d31069d9e5eabdff6ac0382c2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2011-12-01  Janne Blomqvist  <jb@gcc.gnu.org>
+
+       PR fortran/25708
+       * module.c (parse_string): Read string into resizable array
+       instead of parsing twice and seeking.
+       (peek_atom): New implementation avoiding seeks.
+       (require_atom): Save and set column and line explicitly for error
+       handling.
+
 2011-12-01  Janne Blomqvist  <jb@gcc.gnu.org>
 
        * misc.c (gfc_open_file): Don't call stat.

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 70f8565c1507a55f7118acfc2418d1a3bef3d3bd..f9774d491b86ed75864e4f5c617f3deb039af9e0 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1069,51 +1069,37 @@ module_unget_char (void)
 static void
 parse_string (void)
 {
-  module_locus start;
-  int len, c;
-  char *p;
-
-  get_module_locus (&start);
+  int c;
+  size_t cursz = 30;
+  size_t len = 0;
 
-  len = 0;
+  atom_string = XNEWVEC (char, cursz);
 
-  /* See how long the string is.  */
   for ( ; ; )
     {
       c = module_char ();
-      if (c == EOF)
-       bad_module ("Unexpected end of module in string constant");
 
-      if (c != '\'')
+      if (c == '\'')
        {
-         len++;
-         continue;
+         int c2 = module_char ();
+         if (c2 != '\'')
+           {
+             module_unget_char ();
+             break;
+           }
        }
 
-      c = module_char ();
-      if (c == '\'')
+      if (len >= cursz)
        {
-         len++;
-         continue;
+         cursz *= 2;
+         atom_string = XRESIZEVEC (char, atom_string, cursz);
        }
-
-      break;
+      atom_string[len] = c;
+      len++;
     }
 
-  set_module_locus (&start);
-
-  atom_string = p = XCNEWVEC (char, len + 1);
-
-  for (; len > 0; len--)
-    {
-      c = module_char ();
-      if (c == '\'')
-       module_char ();         /* Guaranteed to be another \'.  */
-      *p++ = c;
-    }
-
-  module_char ();              /* Terminating \'.  */
-  *p = '\0';                   /* C-style string for debug purposes.  */
+  atom_string = XRESIZEVEC (char, atom_string, len + 1);
+  atom_string[len] = '\0';     /* C-style string for debug purposes.  */
 }
 
 
@@ -1279,17 +1265,99 @@ parse_atom (void)
 static atom_type
 peek_atom (void)
 {
-  module_locus m;
-  atom_type a;
+  int c;
+
+  do
+    {
+      c = module_char ();
+    }
+  while (c == ' ' || c == '\r' || c == '\n');
+
+  switch (c)
+    {
+    case '(':
+      module_unget_char ();
+      return ATOM_LPAREN;
 
-  get_module_locus (&m);
+    case ')':
+      module_unget_char ();
+      return ATOM_RPAREN;
 
-  a = parse_atom ();
-  if (a == ATOM_STRING)
-    free (atom_string);
+    case '\'':
+      module_unget_char ();
+      return ATOM_STRING;
+
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+      module_unget_char ();
+      return ATOM_INTEGER;
+
+    case 'a':
+    case 'b':
+    case 'c':
+    case 'd':
+    case 'e':
+    case 'f':
+    case 'g':
+    case 'h':
+    case 'i':
+    case 'j':
+    case 'k':
+    case 'l':
+    case 'm':
+    case 'n':
+    case 'o':
+    case 'p':
+    case 'q':
+    case 'r':
+    case 's':
+    case 't':
+    case 'u':
+    case 'v':
+    case 'w':
+    case 'x':
+    case 'y':
+    case 'z':
+    case 'A':
+    case 'B':
+    case 'C':
+    case 'D':
+    case 'E':
+    case 'F':
+    case 'G':
+    case 'H':
+    case 'I':
+    case 'J':
+    case 'K':
+    case 'L':
+    case 'M':
+    case 'N':
+    case 'O':
+    case 'P':
+    case 'Q':
+    case 'R':
+    case 'S':
+    case 'T':
+    case 'U':
+    case 'V':
+    case 'W':
+    case 'X':
+    case 'Y':
+    case 'Z':
+      module_unget_char ();
+      return ATOM_NAME;
 
-  set_module_locus (&m);
-  return a;
+    default:
+      bad_module ("Bad name");
+    }
 }
 
 
@@ -1299,11 +1367,12 @@ peek_atom (void)
 static void
 require_atom (atom_type type)
 {
-  module_locus m;
   atom_type t;
   const char *p;
+  int column, line;
 
-  get_module_locus (&m);
+  column = module_column;
+  line = module_line;
 
   t = parse_atom ();
   if (t != type)
@@ -1329,7 +1398,8 @@ require_atom (atom_type type)
          gfc_internal_error ("require_atom(): bad atom type required");
        }
 
-      set_module_locus (&m);
+      module_column = column;
+      module_line = line;
       bad_module (p);
     }
 }