OSDN Git Service

* gfortran.h (try): Remove macro. Replace try with gfc_try
[pf3gnuchains/gcc-fork.git] / gcc / fortran / scanner.c
index 871739c..8c702ca 100644 (file)
@@ -47,6 +47,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "toplev.h"
 #include "debug.h"
 #include "flags.h"
+#include "cpp.h"
 
 /* Structure for holding module and include file search path.  */
 typedef struct gfc_directorylist
@@ -113,6 +114,12 @@ gfc_wide_tolower (gfc_char_t c)
   return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c);
 }
 
+gfc_char_t
+gfc_wide_toupper (gfc_char_t c)
+{
+  return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((unsigned char) c) : c);
+}
+
 int
 gfc_wide_is_digit (gfc_char_t c)
 {
@@ -143,6 +150,17 @@ gfc_wide_strlen (const gfc_char_t *str)
   return i;
 }
 
+gfc_char_t *
+gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len)
+{
+  size_t i;
+
+  for (i = 0; i < len; i++)
+    b[i] = c;
+
+  return b;
+}
+
 static gfc_char_t *
 wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
 {
@@ -155,25 +173,55 @@ wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
 }
 
 static gfc_char_t *
-wide_strchr (gfc_char_t *s, gfc_char_t c)
+wide_strchr (const gfc_char_t *s, gfc_char_t c)
 {
   do {
     if (*s == c)
       {
-        return (gfc_char_t *) s;
+        return CONST_CAST(gfc_char_t *, s);
       }
   } while (*s++);
   return 0;
 }
 
-static char *
-widechar_to_char (gfc_char_t *s)
+char *
+gfc_widechar_to_char (const gfc_char_t *s, int length)
 {
-  size_t len = gfc_wide_strlen (s), i;
-  char *res = gfc_getmem (len + 1);
+  size_t len, i;
+  char *res;
+
+  if (s == NULL)
+    return NULL;
+
+  /* Passing a negative length is used to indicate that length should be
+     calculated using gfc_wide_strlen().  */
+  len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s));
+  res = XNEWVEC (char, len + 1);
 
   for (i = 0; i < len; i++)
-    res[i] = gfc_wide_fits_in_byte (s[i]) ? (unsigned char) s[i] : '?';
+    {
+      gcc_assert (gfc_wide_fits_in_byte (s[i]));
+      res[i] = (unsigned char) s[i];
+    }
+
+  res[len] = '\0';
+  return res;
+}
+
+gfc_char_t *
+gfc_char_to_widechar (const char *s)
+{
+  size_t len, i;
+  gfc_char_t *res;
+
+  if (s == NULL)
+    return NULL;
+
+  len = strlen (s);
+  res = gfc_get_wide_string (len + 1);
+
+  for (i = 0; i < len; i++)
+    res[i] = (unsigned char) s[i];
 
   res[len] = '\0';
   return res;
@@ -196,8 +244,8 @@ wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
   return 0;
 }
 
-static int
-wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
+int
+gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
 {
   gfc_char_t c1, c2;
 
@@ -271,19 +319,19 @@ add_path_to_list (gfc_directorylist **list, const char *path,
 
   dir = *list;
   if (!dir)
-    dir = *list = gfc_getmem (sizeof (gfc_directorylist));
+    dir = *list = XCNEW (gfc_directorylist);
   else
     {
       while (dir->next)
        dir = dir->next;
 
-      dir->next = gfc_getmem (sizeof (gfc_directorylist));
+      dir->next = XCNEW (gfc_directorylist);
       dir = dir->next;
     }
 
   dir->next = NULL;
   dir->use_for_modules = use_for_modules;
-  dir->path = gfc_getmem (strlen (p) + 2);
+  dir->path = XCNEWVEC (char, strlen (p) + 2);
   strcpy (dir->path, p);
   strcat (dir->path, "/");     /* make '/' last character */
 }
@@ -293,6 +341,7 @@ void
 gfc_add_include_path (const char *path, bool use_for_modules)
 {
   add_path_to_list (&include_dirs, path, use_for_modules);
+  gfc_cpp_add_include_path (xstrdup(path), true);
 }
 
 
@@ -446,9 +495,8 @@ add_file_change (const char *filename, int line)
        file_changes_allocated *= 2;
       else
        file_changes_allocated = 16;
-      file_changes
-       = xrealloc (file_changes,
-                   file_changes_allocated * sizeof (*file_changes));
+      file_changes = XRESIZEVEC (struct gfc_file_change, file_changes,
+                                file_changes_allocated);
     }
   file_changes[file_changes_count].filename = filename;
   file_changes[file_changes_count].lb = NULL;
@@ -585,7 +633,7 @@ gfc_define_undef_line (void)
 
   if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
     {
-      tmp = widechar_to_char (&gfc_current_locus.nextc[8]);
+      tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1);
       (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
                              tmp);
       gfc_free (tmp);
@@ -593,7 +641,7 @@ gfc_define_undef_line (void)
 
   if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
     {
-      tmp = widechar_to_char (&gfc_current_locus.nextc[7]);
+      tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1);
       (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
                             tmp);
       gfc_free (tmp);
@@ -653,7 +701,8 @@ skip_free_comments (void)
                      if (((c = next_char ()) == 'm' || c == 'M')
                          && ((c = next_char ()) == 'p' || c == 'P'))
                        {
-                         if ((c = next_char ()) == ' ' || continue_flag)
+                         if ((c = next_char ()) == ' ' || c == '\t'
+                             || continue_flag)
                            {
                              while (gfc_is_whitespace (c))
                                c = next_char ();
@@ -675,7 +724,7 @@ skip_free_comments (void)
                      next_char ();
                      c = next_char ();
                    }
-                 if (continue_flag || c == ' ')
+                 if (continue_flag || c == ' ' || c == '\t')
                    {
                      gfc_current_locus = old_loc;
                      next_char ();
@@ -771,11 +820,11 @@ skip_fixed_comments (void)
                          c = next_char ();
                          if (c != '\n'
                              && ((openmp_flag && continue_flag)
-                                 || c == ' ' || c == '0'))
+                                 || c == ' ' || c == '\t' || c == '0'))
                            {
-                             c = next_char ();
-                             while (gfc_is_whitespace (c))
+                             do
                                c = next_char ();
+                             while (gfc_is_whitespace (c));
                              if (c != '\n' && c != '!')
                                {
                                  /* Canonicalize to *$omp.  */
@@ -794,6 +843,11 @@ skip_fixed_comments (void)
                      for (col = 3; col < 6; col++, c = next_char ())
                        if (c == ' ')
                          continue;
+                       else if (c == '\t')
+                         {
+                           col = 6;
+                           break;
+                         }
                        else if (c < '0' || c > '9')
                          break;
                        else
@@ -801,7 +855,7 @@ skip_fixed_comments (void)
 
                      if (col == 6 && c != '\n'
                          && ((continue_flag && !digit_seen)
-                             || c == ' ' || c == '0'))
+                             || c == ' ' || c == '\t' || c == '0'))
                        {
                          gfc_current_locus = start;
                          start.nextc[0] = ' ';
@@ -1258,6 +1312,11 @@ gfc_gobble_whitespace (void)
    In fixed mode, we expand a tab that occurs within the statement
    label region to expand to spaces that leave the next character in
    the source region.
+
+   If first_char is not NULL, it's a pointer to a single char value holding
+   the first character of the line, which has already been read by the
+   caller.  This avoids the use of ungetc().
+
    load_line returns whether the line was truncated.
 
    NOTE: The error machinery isn't available at this point, so we can't
@@ -1265,7 +1324,7 @@ gfc_gobble_whitespace (void)
         parts of gfortran.  */
 
 static int
-load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
+load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
 {
   static int linenum = 0, current_line = 1;
   int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
@@ -1294,26 +1353,26 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
       else
        buflen = 132;
 
-      *pbuf = gfc_getmem ((buflen + 1) * sizeof (gfc_char_t));
+      *pbuf = gfc_get_wide_string (buflen + 1);
     }
 
   i = 0;
   buffer = *pbuf;
 
-  preprocessor_flag = 0;
-  c = getc (input);
-  if (c == '#')
-    /* In order to not truncate preprocessor lines, we have to
-       remember that this is one.  */
-    preprocessor_flag = 1;
-  ungetc (c, input);
+  if (first_char)
+    c = *first_char;
+  else
+    c = getc (input);
+
+  /* In order to not truncate preprocessor lines, we have to
+     remember that this is one.  */
+  preprocessor_flag = (c == '#' ? 1 : 0);
 
   for (;;)
     {
-      c = getc (input);
-
       if (c == EOF)
        break;
+
       if (c == '\n')
        {
          /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3.  */
@@ -1330,10 +1389,8 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
          break;
        }
 
-      if (c == '\r')
-       continue;               /* Gobble characters.  */
-      if (c == '\0')
-       continue;
+      if (c == '\r' || c == '\0')
+       goto next_char;                 /* Gobble characters.  */
 
       if (c == '&')
        {
@@ -1358,7 +1415,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
          if (c >= '1' && c <= '9')
            {
              *(buffer-1) = c;
-             continue;
+             goto next_char;
            }
        }
 
@@ -1380,7 +1437,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
              i++;
            }
 
-         continue;
+         goto next_char;
        }
 
       *buffer++ = c;
@@ -1393,7 +1450,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
              /* Reallocate line buffer to double size to hold the
                overlong line.  */
              buflen = buflen * 2;
-             *pbuf = xrealloc (*pbuf, (buflen + 1) * sizeof (gfc_char_t));
+             *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1));
              buffer = (*pbuf) + i;
            }
        }
@@ -1409,8 +1466,12 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
              trunc_flag = 1;
            }
 
-         ungetc ('\n', input);
+         c = '\n';
+         continue;
        }
+
+next_char:
+      c = getc (input);
     }
 
   /* Pad lines to the selected line length in fixed form.  */
@@ -1439,10 +1500,9 @@ get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
 {
   gfc_file *f;
 
-  f = gfc_getmem (sizeof (gfc_file));
+  f = XCNEW (gfc_file);
 
-  f->filename = gfc_getmem (strlen (name) + 1);
-  strcpy (f->filename, name);
+  f->filename = xstrdup (name);
 
   f->next = file_head;
   file_head = f;
@@ -1523,7 +1583,7 @@ preprocessor_line (gfc_char_t *c)
   if (unescape)
     {
       gfc_char_t *s = wide_filename;
-      gfc_char_t *d = gfc_getmem (c - wide_filename - unescape);
+      gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape);
 
       wide_filename = d;
       while (*s)
@@ -1556,7 +1616,7 @@ preprocessor_line (gfc_char_t *c)
 
   /* Convert the filename in wide characters into a filename in narrow
      characters.  */
-  filename = widechar_to_char (wide_filename);
+  filename = gfc_widechar_to_char (wide_filename, -1);
 
   /* Interpret flags.  */
 
@@ -1592,9 +1652,10 @@ preprocessor_line (gfc_char_t *c)
 
   if (strcmp (current_file->filename, filename) != 0)
     {
-      gfc_free (current_file->filename);
-      current_file->filename = gfc_getmem (strlen (filename) + 1);
-      strcpy (current_file->filename, filename);
+       /* FIXME: we leak the old filename because a pointer to it may be stored
+          in the linemap.  Alternative could be using GC or updating linemap to
+          point to the new name, but there is no API for that currently. */
+      current_file->filename = xstrdup (filename);
     }
 
   /* Set new line number.  */
@@ -1611,7 +1672,7 @@ preprocessor_line (gfc_char_t *c)
 }
 
 
-static try load_file (const char *, bool);
+static gfc_try load_file (const char *, const char *, bool);
 
 /* include_line()-- Checks a line buffer to see if it is an include
    line.  If so, we call load_file() recursively to load the included
@@ -1647,7 +1708,7 @@ include_line (gfc_char_t *line)
   while (*c == ' ' || *c == '\t')
     c++;
 
-  if (wide_strncasecmp (c, "include", 7))
+  if (gfc_wide_strncasecmp (c, "include", 7))
     return false;
 
   c += 7;
@@ -1681,8 +1742,8 @@ include_line (gfc_char_t *line)
   *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
                   read by anything else.  */
 
-  filename = widechar_to_char (begin);
-  load_file (filename, false);
+  filename = gfc_widechar_to_char (begin, -1);
+  load_file (filename, NULL, false);
   gfc_free (filename);
   return true;
 }
@@ -1690,8 +1751,8 @@ include_line (gfc_char_t *line)
 
 /* Load a file into memory by calling load_line until the file ends.  */
 
-static try
-load_file (const char *filename, bool initial)
+static gfc_try
+load_file (const char *realfilename, const char *displayedname, bool initial)
 {
   gfc_char_t *line;
   gfc_linebuf *b;
@@ -1699,6 +1760,9 @@ load_file (const char *filename, bool initial)
   FILE *input;
   int len, line_len;
   bool first_line;
+  const char *filename;
+
+  filename = displayedname ? displayedname : realfilename;
 
   for (f = current_file; f; f = f->up)
     if (strcmp (filename, f->filename) == 0)
@@ -1715,7 +1779,7 @@ load_file (const char *filename, bool initial)
          gfc_src_file = NULL;
        }
       else
-       input = gfc_open_file (filename);
+       input = gfc_open_file (realfilename);
       if (input == NULL)
        {
          gfc_error_now ("Can't open file '%s'", filename);
@@ -1724,7 +1788,7 @@ load_file (const char *filename, bool initial)
     }
   else
     {
-      input = gfc_open_included_file (filename, false, false);
+      input = gfc_open_included_file (realfilename, false, false);
       if (input == NULL)
        {
          gfc_error_now ("Can't open included file '%s'", filename);
@@ -1758,7 +1822,7 @@ load_file (const char *filename, bool initial)
 
   for (;;)
     {
-      int trunc = load_line (input, &line, &line_len);
+      int trunc = load_line (input, &line, &line_len, NULL);
 
       len = gfc_wide_strlen (line);
       if (feof (input) && len == 0)
@@ -1779,11 +1843,11 @@ load_file (const char *filename, bool initial)
                                && line[2] == (unsigned char) '\xBF')))
        {
          int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
-         gfc_char_t *new = gfc_getmem (line_len * sizeof (gfc_char_t));
+         gfc_char_t *new_char = gfc_get_wide_string (line_len);
 
-         wide_strcpy (new, &line[n]);
+         wide_strcpy (new_char, &line[n]);
          gfc_free (line);
-         line = new;
+         line = new_char;
          len -= n;
        }
 
@@ -1819,8 +1883,8 @@ load_file (const char *filename, bool initial)
 
       /* Add line.  */
 
-      b = gfc_getmem (gfc_linebuf_header_size
-                     + (len + 1) * sizeof (gfc_char_t));
+      b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size
+                                     + (len + 1) * sizeof (gfc_char_t));
 
       b->location
        = linemap_line_start (line_table, current_file->line++, 120);
@@ -1853,16 +1917,23 @@ load_file (const char *filename, bool initial)
 
 
 /* Open a new file and start scanning from that file. Returns SUCCESS
-   if everything went OK, FAILURE otherwise.  If form == FORM_UKNOWN
+   if everything went OK, FAILURE otherwise.  If form == FORM_UNKNOWN
    it tries to determine the source form from the filename, defaulting
    to free form.  */
 
-try
+gfc_try
 gfc_new_file (void)
 {
-  try result;
+  gfc_try result;
 
-  result = load_file (gfc_source_file, true);
+  if (gfc_cpp_enabled ())
+    {
+      result = gfc_cpp_preprocess (gfc_source_file);
+      if (!gfc_cpp_preprocess_only ())
+        result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true);
+    }
+  else
+    result = load_file (gfc_source_file, NULL, true);
 
   gfc_current_locus.lb = line_head;
   gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
@@ -1904,7 +1975,7 @@ unescape_filename (const char *ptr)
 
   /* Undo effects of cpp_quote_string.  */
   s = ptr;
-  d = gfc_getmem (p + 1 - ptr - unescape);
+  d = XCNEWVEC (char, p + 1 - ptr - unescape);
   ret = d;
 
   while (s != p)
@@ -1933,36 +2004,34 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
     return NULL;
 
   c = getc (gfc_src_file);
-  ungetc (c, gfc_src_file);
 
   if (c != '#')
     return NULL;
 
   len = 0;
-  load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
+  load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c);
 
   if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
     return NULL;
 
-  tmp = widechar_to_char (&gfc_src_preprocessor_lines[0][5]);
+  tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1);
   filename = unescape_filename (tmp);
   gfc_free (tmp);
   if (filename == NULL)
     return NULL;
 
   c = getc (gfc_src_file);
-  ungetc (c, gfc_src_file);
 
   if (c != '#')
     return filename;
 
   len = 0;
-  load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
+  load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c);
 
   if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
     return filename;
 
-  tmp = widechar_to_char (&gfc_src_preprocessor_lines[1][5]);
+  tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1);
   dirname = unescape_filename (tmp);
   gfc_free (tmp);
   if (dirname == NULL)
@@ -1979,7 +2048,7 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
 
   if (! IS_ABSOLUTE_PATH (filename))
     {
-      char *p = gfc_getmem (len + strlen (filename));
+      char *p = XCNEWVEC (char, len + strlen (filename));
 
       memcpy (p, dirname, len - 2);
       p[len - 2] = '/';