OSDN Git Service

2010-12-11 Jerry DeLisle <jvdelisle@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / gcc / fortran / scanner.c
index 92ee366..c226bae 100644 (file)
@@ -1,13 +1,13 @@
 /* Character scanner.
 /* Character scanner.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
-   Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
 
 GCC is free software; you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free
    Contributed by Andy Vaught
 
 This file is part of GCC.
 
 GCC is free software; you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -16,9 +16,8 @@ FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 for more details.
 
 You should have received a copy of the GNU General Public License
 for more details.
 
 You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING.  If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA.  */
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
 
 /* Set of subroutines to (ultimately) return the next character to the
    various matching subroutines.  This file's job is to read files and
 
 /* Set of subroutines to (ultimately) return the next character to the
    various matching subroutines.  This file's job is to read files and
@@ -45,24 +44,29 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "config.h"
 #include "system.h"
 #include "gfortran.h"
 #include "config.h"
 #include "system.h"
 #include "gfortran.h"
-#include "toplev.h"
+#include "toplev.h"    /* For set_src_pwd.  */
+#include "debug.h"
+#include "flags.h"
+#include "cpp.h"
 
 /* Structure for holding module and include file search path.  */
 typedef struct gfc_directorylist
 {
   char *path;
 
 /* Structure for holding module and include file search path.  */
 typedef struct gfc_directorylist
 {
   char *path;
+  bool use_for_modules;
   struct gfc_directorylist *next;
 }
 gfc_directorylist;
 
 /* List of include file search directories.  */
   struct gfc_directorylist *next;
 }
 gfc_directorylist;
 
 /* List of include file search directories.  */
-static gfc_directorylist *include_dirs;
+static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
 
 static gfc_file *file_head, *current_file;
 
 
 static gfc_file *file_head, *current_file;
 
-static int continue_flag, end_flag, openmp_flag;
+static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
 static int continue_count, continue_line;
 static locus openmp_locus;
 static int continue_count, continue_line;
 static locus openmp_locus;
+static locus gcc_attribute_locus;
 
 gfc_source_form gfc_current_form;
 static gfc_linebuf *line_head, *line_tail;
 
 gfc_source_form gfc_current_form;
 static gfc_linebuf *line_head, *line_tail;
@@ -70,9 +74,192 @@ static gfc_linebuf *line_head, *line_tail;
 locus gfc_current_locus;
 const char *gfc_source_file;
 static FILE *gfc_src_file;
 locus gfc_current_locus;
 const char *gfc_source_file;
 static FILE *gfc_src_file;
-static char *gfc_src_preprocessor_lines[2];
+static gfc_char_t *gfc_src_preprocessor_lines[2];
+
+static struct gfc_file_change
+{
+  const char *filename;
+  gfc_linebuf *lb;
+  int line;
+} *file_changes;
+size_t file_changes_cur, file_changes_count;
+size_t file_changes_allocated;
+
+
+/* Functions dealing with our wide characters (gfc_char_t) and
+   sequences of such characters.  */
+
+int
+gfc_wide_fits_in_byte (gfc_char_t c)
+{
+  return (c <= UCHAR_MAX);
+}
+
+static inline int
+wide_is_ascii (gfc_char_t c)
+{
+  return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
+}
+
+int
+gfc_wide_is_printable (gfc_char_t c)
+{
+  return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c));
+}
+
+gfc_char_t
+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)
+{
+  return (c >= '0' && c <= '9');
+}
+
+static inline int
+wide_atoi (gfc_char_t *c)
+{
+#define MAX_DIGITS 20
+  char buf[MAX_DIGITS+1];
+  int i = 0;
+
+  while (gfc_wide_is_digit(*c) && i < MAX_DIGITS)
+    buf[i++] = *c++;
+  buf[i] = '\0';
+  return atoi (buf);
+}
+
+size_t
+gfc_wide_strlen (const gfc_char_t *str)
+{
+  size_t i;
+
+  for (i = 0; str[i]; i++)
+    ;
+
+  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)
+{
+  gfc_char_t *d;
+
+  for (d = dest; (*d = *src) != '\0'; ++src, ++d)
+    ;
+
+  return dest;
+}
+
+static gfc_char_t *
+wide_strchr (const gfc_char_t *s, gfc_char_t c)
+{
+  do {
+    if (*s == c)
+      {
+        return CONST_CAST(gfc_char_t *, s);
+      }
+  } while (*s++);
+  return 0;
+}
+
+char *
+gfc_widechar_to_char (const gfc_char_t *s, int length)
+{
+  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++)
+    {
+      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;
+}
+
+static int
+wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+  gfc_char_t c1, c2;
+
+  while (n-- > 0)
+    {
+      c1 = *s1++;
+      c2 = *s2++;
+      if (c1 != c2)
+       return (c1 > c2 ? 1 : -1);
+      if (c1 == '\0')
+       return 0;
+    }
+  return 0;
+}
+
+int
+gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+  gfc_char_t c1, c2;
+
+  while (n-- > 0)
+    {
+      c1 = gfc_wide_tolower (*s1++);
+      c2 = TOLOWER (*s2++);
+      if (c1 != c2)
+       return (c1 > c2 ? 1 : -1);
+      if (c1 == '\0')
+       return 0;
+    }
+  return 0;
+}
 
 
-extern int pedantic;
 
 /* Main scanner initialization.  */
 
 
 /* Main scanner initialization.  */
 
@@ -112,44 +299,67 @@ gfc_scanner_done_1 (void)
       gfc_free(file_head);
       file_head = f;    
     }
       gfc_free(file_head);
       file_head = f;    
     }
-
 }
 
 
 /* Adds path to the list pointed to by list.  */
 
 }
 
 
 /* Adds path to the list pointed to by list.  */
 
-void
-gfc_add_include_path (const char *path)
+static void
+add_path_to_list (gfc_directorylist **list, const char *path,
+                 bool use_for_modules, bool head)
 {
   gfc_directorylist *dir;
   const char *p;
 
   p = path;
 {
   gfc_directorylist *dir;
   const char *p;
 
   p = path;
-  while (*p == ' ' || *p == '\t')  /* someone might do 'gfortran "-I include"' */
+  while (*p == ' ' || *p == '\t')  /* someone might do "-I include" */
     if (*p++ == '\0')
       return;
 
     if (*p++ == '\0')
       return;
 
-  dir = include_dirs;
-  if (!dir)
+  if (head || *list == NULL)
     {
     {
-      dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
+      dir = XCNEW (gfc_directorylist);
+      if (!head)
+        *list = dir;
     }
   else
     {
     }
   else
     {
+      dir = *list;
       while (dir->next)
        dir = dir->next;
 
       while (dir->next)
        dir = dir->next;
 
-      dir->next = gfc_getmem (sizeof (gfc_directorylist));
+      dir->next = XCNEW (gfc_directorylist);
       dir = dir->next;
     }
 
       dir = dir->next;
     }
 
-  dir->next = NULL;
-  dir->path = gfc_getmem (strlen (p) + 2);
+  dir->next = head ? *list : NULL;
+  if (head)
+    *list = dir;
+  dir->use_for_modules = use_for_modules;
+  dir->path = XCNEWVEC (char, strlen (p) + 2);
   strcpy (dir->path, p);
   strcat (dir->path, "/");     /* make '/' last character */
 }
 
 
   strcpy (dir->path, p);
   strcat (dir->path, "/");     /* make '/' last character */
 }
 
 
+void
+gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir)
+{
+  add_path_to_list (&include_dirs, path, use_for_modules, file_dir);
+
+  /* For '#include "..."' these directories are automatically searched.  */
+  if (!file_dir)
+    gfc_cpp_add_include_path (xstrdup(path), true);
+}
+
+
+void
+gfc_add_intrinsic_modules_path (const char *path)
+{
+  add_path_to_list (&intrinsic_modules_dirs, path, true, false);
+}
+
+
 /* Release resources allocated for options.  */
 
 void
 /* Release resources allocated for options.  */
 
 void
@@ -157,7 +367,6 @@ gfc_release_include_path (void)
 {
   gfc_directorylist *p;
 
 {
   gfc_directorylist *p;
 
-  gfc_free (gfc_option.module_dir);
   while (include_dirs != NULL)
     {
       p = include_dirs;
   while (include_dirs != NULL)
     {
       p = include_dirs;
@@ -165,46 +374,96 @@ gfc_release_include_path (void)
       gfc_free (p->path);
       gfc_free (p);
     }
       gfc_free (p->path);
       gfc_free (p);
     }
+
+  while (intrinsic_modules_dirs != NULL)
+    {
+      p = intrinsic_modules_dirs;
+      intrinsic_modules_dirs = intrinsic_modules_dirs->next;
+      gfc_free (p->path);
+      gfc_free (p);
+    }
+
+  gfc_free (gfc_option.module_dir);
 }
 
 }
 
-/* Opens file for reading, searching through the include directories
-   given if necessary.  If the include_cwd argument is true, we try
-   to open the file in the current directory first.  */
 
 
-FILE *
-gfc_open_included_file (const char *name, const bool include_cwd)
+static FILE *
+open_included_file (const char *name, gfc_directorylist *list,
+                   bool module, bool system)
 {
   char *fullname;
   gfc_directorylist *p;
   FILE *f;
 
 {
   char *fullname;
   gfc_directorylist *p;
   FILE *f;
 
-  if (include_cwd)
+  for (p = list; p; p = p->next)
     {
     {
-      f = gfc_open_file (name);
-      if (f != NULL)
-       return f;
-    }
+      if (module && !p->use_for_modules)
+       continue;
 
 
-  for (p = include_dirs; p; p = p->next)
-    {
       fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
       strcpy (fullname, p->path);
       strcat (fullname, name);
 
       f = gfc_open_file (fullname);
       if (f != NULL)
       fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
       strcpy (fullname, p->path);
       strcat (fullname, name);
 
       f = gfc_open_file (fullname);
       if (f != NULL)
-       return f;
+       {
+         if (gfc_cpp_makedep ())
+           gfc_cpp_add_dep (fullname, system);
+
+         return f;
+       }
     }
 
   return NULL;
 }
 
     }
 
   return NULL;
 }
 
+
+/* Opens file for reading, searching through the include directories
+   given if necessary.  If the include_cwd argument is true, we try
+   to open the file in the current directory first.  */
+
+FILE *
+gfc_open_included_file (const char *name, bool include_cwd, bool module)
+{
+  FILE *f = NULL;
+
+  if (IS_ABSOLUTE_PATH (name) || include_cwd)
+    {
+      f = gfc_open_file (name);
+      if (f && gfc_cpp_makedep ())
+       gfc_cpp_add_dep (name, false);
+    }
+
+  if (!f)
+    f = open_included_file (name, include_dirs, module, false);
+
+  return f;
+}
+
+FILE *
+gfc_open_intrinsic_module (const char *name)
+{
+  FILE *f = NULL;
+
+  if (IS_ABSOLUTE_PATH (name))
+    {
+      f = gfc_open_file (name);
+      if (f && gfc_cpp_makedep ())
+       gfc_cpp_add_dep (name, true);
+    }
+
+  if (!f)
+    f = open_included_file (name, intrinsic_modules_dirs, true, true);
+
+  return f;
+}
+
+
 /* Test to see if we're at the end of the main source file.  */
 
 int
 gfc_at_end (void)
 {
 /* Test to see if we're at the end of the main source file.  */
 
 int
 gfc_at_end (void)
 {
-
   return end_flag;
 }
 
   return end_flag;
 }
 
@@ -214,7 +473,6 @@ gfc_at_end (void)
 int
 gfc_at_eof (void)
 {
 int
 gfc_at_eof (void)
 {
-
   if (gfc_at_end ())
     return 1;
 
   if (gfc_at_end ())
     return 1;
 
@@ -245,13 +503,66 @@ gfc_at_bol (void)
 int
 gfc_at_eol (void)
 {
 int
 gfc_at_eol (void)
 {
-
   if (gfc_at_eof ())
     return 1;
 
   return (*gfc_current_locus.nextc == '\0');
 }
 
   if (gfc_at_eof ())
     return 1;
 
   return (*gfc_current_locus.nextc == '\0');
 }
 
+static void
+add_file_change (const char *filename, int line)
+{
+  if (file_changes_count == file_changes_allocated)
+    {
+      if (file_changes_allocated)
+       file_changes_allocated *= 2;
+      else
+       file_changes_allocated = 16;
+      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;
+  file_changes[file_changes_count++].line = line;
+}
+
+static void
+report_file_change (gfc_linebuf *lb)
+{
+  size_t c = file_changes_cur;
+  while (c < file_changes_count
+        && file_changes[c].lb == lb)
+    {
+      if (file_changes[c].filename)
+       (*debug_hooks->start_source_file) (file_changes[c].line,
+                                          file_changes[c].filename);
+      else
+       (*debug_hooks->end_source_file) (file_changes[c].line);
+      ++c;
+    }
+  file_changes_cur = c;
+}
+
+void
+gfc_start_source_files (void)
+{
+  /* If the debugger wants the name of the main source file,
+     we give it.  */
+  if (debug_hooks->start_end_main_source_file)
+    (*debug_hooks->start_source_file) (0, gfc_source_file);
+
+  file_changes_cur = 0;
+  report_file_change (gfc_current_locus.lb);
+}
+
+void
+gfc_end_source_files (void)
+{
+  report_file_change (NULL);
+
+  if (debug_hooks->start_end_main_source_file)
+    (*debug_hooks->end_source_file) (0);
+}
 
 /* Advance the current line pointer to the next line.  */
 
 
 /* Advance the current line pointer to the next line.  */
 
@@ -267,9 +578,16 @@ gfc_advance_line (void)
       return;
     } 
 
       return;
     } 
 
+  if (gfc_current_locus.lb->next
+      && !gfc_current_locus.lb->next->dbg_emitted)
+    {
+      report_file_change (gfc_current_locus.lb->next);
+      gfc_current_locus.lb->next->dbg_emitted = true;
+    }
+
   gfc_current_locus.lb = gfc_current_locus.lb->next;
 
   gfc_current_locus.lb = gfc_current_locus.lb->next;
 
-  if (gfc_current_locus.lb != NULL)         
+  if (gfc_current_locus.lb != NULL)     
     gfc_current_locus.nextc = gfc_current_locus.lb->line;
   else 
     {
     gfc_current_locus.nextc = gfc_current_locus.lb->line;
   else 
     {
@@ -288,10 +606,10 @@ gfc_advance_line (void)
    pointer from being on the wrong line if the current statement ends
    prematurely.  */
 
    pointer from being on the wrong line if the current statement ends
    prematurely.  */
 
-static int
+static gfc_char_t
 next_char (void)
 {
 next_char (void)
 {
-  int c;
+  gfc_char_t c;
   
   if (gfc_current_locus.nextc == NULL)
     return '\n';
   
   if (gfc_current_locus.nextc == NULL)
     return '\n';
@@ -306,15 +624,16 @@ next_char (void)
   return c;
 }
 
   return c;
 }
 
+
 /* Skip a comment.  When we come here the parse pointer is positioned
    immediately after the comment character.  If we ever implement
 /* Skip a comment.  When we come here the parse pointer is positioned
    immediately after the comment character.  If we ever implement
-   compiler directives withing comments, here is where we parse the
+   compiler directives within comments, here is where we parse the
    directive.  */
 
 static void
 skip_comment_line (void)
 {
    directive.  */
 
 static void
 skip_comment_line (void)
 {
-  char c;
+  gfc_char_t c;
 
   do
     {
 
   do
     {
@@ -326,6 +645,66 @@ skip_comment_line (void)
 }
 
 
 }
 
 
+int
+gfc_define_undef_line (void)
+{
+  char *tmp;
+
+  /* All lines beginning with '#' are either #define or #undef.  */
+  if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
+    return 0;
+
+  if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
+    {
+      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);
+    }
+
+  if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
+    {
+      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);
+    }
+
+  /* Skip the rest of the line.  */
+  skip_comment_line ();
+
+  return 1;
+}
+
+
+/* Return true if GCC$ was matched.  */
+static bool
+skip_gcc_attribute (locus start)
+{
+  bool r = false;
+  char c;
+  locus old_loc = gfc_current_locus;
+
+  if ((c = next_char ()) == 'g' || c == 'G')
+    if ((c = next_char ()) == 'c' || c == 'C')
+      if ((c = next_char ()) == 'c' || c == 'C')
+       if ((c = next_char ()) == '$')
+         r = true;
+
+  if (r == false)
+    gfc_current_locus = old_loc;
+  else
+   {
+      gcc_attribute_flag = 1;
+      gcc_attribute_locus = old_loc;
+      gfc_current_locus = start;
+   }
+
+  return r;
+}
+
+
+
 /* Comment lines are null lines, lines containing only blanks or lines
    on which the first nonblank line is a '!'.
    Return true if !$ openmp conditional compilation sentinel was
 /* Comment lines are null lines, lines containing only blanks or lines
    on which the first nonblank line is a '!'.
    Return true if !$ openmp conditional compilation sentinel was
@@ -335,7 +714,7 @@ static bool
 skip_free_comments (void)
 {
   locus start;
 skip_free_comments (void)
 {
   locus start;
-  char c;
+  gfc_char_t c;
   int at_bol;
 
   for (;;)
   int at_bol;
 
   for (;;)
@@ -357,12 +736,16 @@ skip_free_comments (void)
 
       if (c == '!')
        {
 
       if (c == '!')
        {
+         /* Keep the !GCC$ line.  */
+                 if (at_bol && skip_gcc_attribute (start))
+           return false;
+
          /* If -fopenmp, we need to handle here 2 things:
             1) don't treat !$omp as comments, but directives
             2) handle OpenMP conditional compilation, where
                !$ should be treated as 2 spaces (for initial lines
                only if followed by space).  */
          /* If -fopenmp, we need to handle here 2 things:
             1) don't treat !$omp as comments, but directives
             2) handle OpenMP conditional compilation, where
                !$ should be treated as 2 spaces (for initial lines
                only if followed by space).  */
-         if (gfc_option.flag_openmp && at_bol)
+         if (gfc_option.gfc_flag_openmp && at_bol)
            {
              locus old_loc = gfc_current_locus;
              if (next_char () == '$')
            {
              locus old_loc = gfc_current_locus;
              if (next_char () == '$')
@@ -371,24 +754,32 @@ skip_free_comments (void)
                  if (c == 'o' || c == 'O')
                    {
                      if (((c = next_char ()) == 'm' || c == 'M')
                  if (c == 'o' || c == 'O')
                    {
                      if (((c = next_char ()) == 'm' || c == 'M')
-                         && ((c = next_char ()) == 'p' || c == 'P')
-                         && ((c = next_char ()) == ' ' || continue_flag))
+                         && ((c = next_char ()) == 'p' || c == 'P'))
                        {
                        {
-                         while (gfc_is_whitespace (c))
-                           c = next_char ();
-                         if (c != '\n' && c != '!')
+                         if ((c = next_char ()) == ' ' || c == '\t'
+                             || continue_flag)
                            {
                            {
-                             openmp_flag = 1;
-                             openmp_locus = old_loc;
-                             gfc_current_locus = start;
-                             return false;
+                             while (gfc_is_whitespace (c))
+                               c = next_char ();
+                             if (c != '\n' && c != '!')
+                               {
+                                 openmp_flag = 1;
+                                 openmp_locus = old_loc;
+                                 gfc_current_locus = start;
+                                 return false;
+                               }
                            }
                            }
+                         else
+                           gfc_warning_now ("!$OMP at %C starts a commented "
+                                            "line as it neither is followed "
+                                            "by a space nor is a "
+                                            "continuation line");
                        }
                      gfc_current_locus = old_loc;
                      next_char ();
                      c = next_char ();
                    }
                        }
                      gfc_current_locus = old_loc;
                      next_char ();
                      c = next_char ();
                    }
-                 if (continue_flag || c == ' ')
+                 if (continue_flag || c == ' ' || c == '\t')
                    {
                      gfc_current_locus = old_loc;
                      next_char ();
                    {
                      gfc_current_locus = old_loc;
                      next_char ();
@@ -407,6 +798,8 @@ skip_free_comments (void)
 
   if (openmp_flag && at_bol)
     openmp_flag = 0;
 
   if (openmp_flag && at_bol)
     openmp_flag = 0;
+
+  gcc_attribute_flag = 0;
   gfc_current_locus = start;
   return false;
 }
   gfc_current_locus = start;
   return false;
 }
@@ -422,7 +815,7 @@ skip_fixed_comments (void)
 {
   locus start;
   int col;
 {
   locus start;
   int col;
-  char c;
+  gfc_char_t c;
 
   if (! gfc_at_bol ())
     {
 
   if (! gfc_at_bol ())
     {
@@ -461,13 +854,24 @@ skip_fixed_comments (void)
 
       if (c == '!' || c == 'c' || c == 'C' || c == '*')
        {
 
       if (c == '!' || c == 'c' || c == 'C' || c == '*')
        {
+         if (skip_gcc_attribute (start))
+           {
+             /* Canonicalize to *$omp.  */
+             *start.nextc = '*';
+             return;
+           }
+
          /* If -fopenmp, we need to handle here 2 things:
             1) don't treat !$omp|c$omp|*$omp as comments, but directives
             2) handle OpenMP conditional compilation, where
                !$|c$|*$ should be treated as 2 spaces if the characters
                in columns 3 to 6 are valid fixed form label columns
                characters.  */
          /* If -fopenmp, we need to handle here 2 things:
             1) don't treat !$omp|c$omp|*$omp as comments, but directives
             2) handle OpenMP conditional compilation, where
                !$|c$|*$ should be treated as 2 spaces if the characters
                in columns 3 to 6 are valid fixed form label columns
                characters.  */
-         if (gfc_option.flag_openmp)
+         if (gfc_current_locus.lb != NULL
+             && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+           continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
+         if (gfc_option.gfc_flag_openmp)
            {
              if (next_char () == '$')
                {
            {
              if (next_char () == '$')
                {
@@ -480,11 +884,11 @@ skip_fixed_comments (void)
                          c = next_char ();
                          if (c != '\n'
                              && ((openmp_flag && continue_flag)
                          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 ();
                                c = next_char ();
+                             while (gfc_is_whitespace (c));
                              if (c != '\n' && c != '!')
                                {
                                  /* Canonicalize to *$omp.  */
                              if (c != '\n' && c != '!')
                                {
                                  /* Canonicalize to *$omp.  */
@@ -503,6 +907,11 @@ skip_fixed_comments (void)
                      for (col = 3; col < 6; col++, c = next_char ())
                        if (c == ' ')
                          continue;
                      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
                        else if (c < '0' || c > '9')
                          break;
                        else
@@ -510,7 +919,7 @@ skip_fixed_comments (void)
 
                      if (col == 6 && c != '\n'
                          && ((continue_flag && !digit_seen)
 
                      if (col == 6 && c != '\n'
                          && ((continue_flag && !digit_seen)
-                             || c == ' ' || c == '0'))
+                             || c == ' ' || c == '\t' || c == '0'))
                        {
                          gfc_current_locus = start;
                          start.nextc[0] = ' ';
                        {
                          gfc_current_locus = start;
                          start.nextc[0] = ' ';
@@ -552,6 +961,9 @@ skip_fixed_comments (void)
 
       if (col != 6 && c == '!')
        {
 
       if (col != 6 && c == '!')
        {
+         if (gfc_current_locus.lb != NULL
+             && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+           continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
          skip_comment_line ();
          continue;
        }
          skip_comment_line ();
          continue;
        }
@@ -560,6 +972,7 @@ skip_fixed_comments (void)
     }
 
   openmp_flag = 0;
     }
 
   openmp_flag = 0;
+  gcc_attribute_flag = 0;
   gfc_current_locus = start;
 }
 
   gfc_current_locus = start;
 }
 
@@ -583,11 +996,12 @@ gfc_skip_comments (void)
    line.  The in_string flag denotes whether we're inside a character
    context or not.  */
 
    line.  The in_string flag denotes whether we're inside a character
    context or not.  */
 
-int
-gfc_next_char_literal (int in_string)
+gfc_char_t
+gfc_next_char_literal (gfc_instring in_string)
 {
   locus old_loc;
 {
   locus old_loc;
-  int i, c, prev_openmp_flag;
+  int i, prev_openmp_flag;
+  gfc_char_t c;
 
   continue_flag = 0;
 
 
   continue_flag = 0;
 
@@ -605,6 +1019,11 @@ restart:
 
       if (!in_string && c == '!')
        {
 
       if (!in_string && c == '!')
        {
+         if (gcc_attribute_flag
+             && memcmp (&gfc_current_locus, &gcc_attribute_locus,
+                sizeof (gfc_current_locus)) == 0)
+           goto done;
+
          if (openmp_flag
              && memcmp (&gfc_current_locus, &openmp_locus,
                 sizeof (gfc_current_locus)) == 0)
          if (openmp_flag
              && memcmp (&gfc_current_locus, &openmp_locus,
                 sizeof (gfc_current_locus)) == 0)
@@ -623,6 +1042,17 @@ restart:
          goto done;
        }
 
          goto done;
        }
 
+      /* Check to see if the continuation line was truncated.  */
+      if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL
+         && gfc_current_locus.lb->truncated)
+       {
+         int maxlen = gfc_option.free_line_length;
+         gfc_current_locus.lb->truncated = 0;
+         gfc_current_locus.nextc += maxlen;
+         gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+         gfc_current_locus.nextc -= maxlen;
+       }
+
       if (c != '&')
        goto done;
 
       if (c != '&')
        goto done;
 
@@ -657,25 +1087,30 @@ restart:
        skip_comment_line ();
       else
        gfc_advance_line ();
        skip_comment_line ();
       else
        gfc_advance_line ();
+      
+      if (gfc_at_eof())
+       goto not_continuation;
 
       /* We've got a continuation line.  If we are on the very next line after
         the last continuation, increment the continuation line count and
         check whether the limit has been exceeded.  */
 
       /* We've got a continuation line.  If we are on the very next line after
         the last continuation, increment the continuation line count and
         check whether the limit has been exceeded.  */
-      if (gfc_current_locus.lb->linenum == continue_line + 1)
+      if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
        {
          if (++continue_count == gfc_option.max_continue_free)
            {
        {
          if (++continue_count == gfc_option.max_continue_free)
            {
-             if (gfc_notification_std (GFC_STD_GNU)
-                 || pedantic)
-               gfc_warning ("Limit of %d continuations exceeded in statement at %C",
-                             gfc_option.max_continue_free);
+             if (gfc_notification_std (GFC_STD_GNU) || pedantic)
+               gfc_warning ("Limit of %d continuations exceeded in "
+                            "statement at %C", gfc_option.max_continue_free);
            }
        }
            }
        }
-      continue_line = gfc_current_locus.lb->linenum;
 
       /* Now find where it continues. First eat any comment lines.  */
       openmp_cond_flag = skip_free_comments ();
 
 
       /* Now find where it continues. First eat any comment lines.  */
       openmp_cond_flag = skip_free_comments ();
 
+      if (gfc_current_locus.lb != NULL
+         && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+       continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
       if (prev_openmp_flag != openmp_flag)
        {
          gfc_current_locus = old_loc;
       if (prev_openmp_flag != openmp_flag)
        {
          gfc_current_locus = old_loc;
@@ -699,7 +1134,7 @@ restart:
        {
          for (i = 0; i < 5; i++, c = next_char ())
            {
        {
          for (i = 0; i < 5; i++, c = next_char ())
            {
-             gcc_assert (TOLOWER (c) == "!$omp"[i]);
+             gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]);
              if (i == 4)
                old_loc = gfc_current_locus;
            }
              if (i == 4)
                old_loc = gfc_current_locus;
            }
@@ -711,9 +1146,10 @@ restart:
        {
          if (in_string)
            {
        {
          if (in_string)
            {
-             if (gfc_option.warn_ampersand)
-               gfc_warning_now ("Missing '&' in continued character constant at %C");
              gfc_current_locus.nextc--;
              gfc_current_locus.nextc--;
+             if (gfc_option.warn_ampersand && in_string == INSTRING_WARN)
+               gfc_warning ("Missing '&' in continued character "
+                            "constant at %C");
            }
          /* Both !$omp and !$ -fopenmp continuation lines have & on the
             continuation line only optionally.  */
            }
          /* Both !$omp and !$ -fopenmp continuation lines have & on the
             continuation line only optionally.  */
@@ -727,7 +1163,7 @@ restart:
            }
        }
     }
            }
        }
     }
-  else
+  else /* Fixed form.  */
     {
       /* Fixed form continuation.  */
       if (!in_string && c == '!')
     {
       /* Fixed form continuation.  */
       if (!in_string && c == '!')
@@ -746,6 +1182,14 @@ restart:
       if (c != '\n')
        goto done;
 
       if (c != '\n')
        goto done;
 
+      /* Check to see if the continuation line was truncated.  */
+      if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL
+         && gfc_current_locus.lb->truncated)
+       {
+         gfc_current_locus.lb->truncated = 0;
+         gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+       }
+
       prev_openmp_flag = openmp_flag;
       continue_flag = 1;
       old_loc = gfc_current_locus;
       prev_openmp_flag = openmp_flag;
       continue_flag = 1;
       old_loc = gfc_current_locus;
@@ -771,7 +1215,7 @@ restart:
        for (i = 0; i < 5; i++)
          {
            c = next_char ();
        for (i = 0; i < 5; i++)
          {
            c = next_char ();
-           if (TOLOWER (c) != "*$omp"[i])
+           if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
              goto not_continuation;
          }
 
              goto not_continuation;
          }
 
@@ -782,19 +1226,20 @@ restart:
       /* We've got a continuation line.  If we are on the very next line after
         the last continuation, increment the continuation line count and
         check whether the limit has been exceeded.  */
       /* We've got a continuation line.  If we are on the very next line after
         the last continuation, increment the continuation line count and
         check whether the limit has been exceeded.  */
-      if (gfc_current_locus.lb->linenum == continue_line + 1)
+      if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
        {
          if (++continue_count == gfc_option.max_continue_fixed)
            {
        {
          if (++continue_count == gfc_option.max_continue_fixed)
            {
-             if (gfc_notification_std (GFC_STD_GNU)
-                 || pedantic)
-               gfc_warning ("Limit of %d continuations exceeded in statement at %C",
-                             gfc_option.max_continue_fixed);
+             if (gfc_notification_std (GFC_STD_GNU) || pedantic)
+               gfc_warning ("Limit of %d continuations exceeded in "
+                            "statement at %C",
+                            gfc_option.max_continue_fixed);
            }
        }
 
            }
        }
 
-      if (continue_line < gfc_current_locus.lb->linenum)
-       continue_line = gfc_current_locus.lb->linenum;
+      if (gfc_current_locus.lb != NULL
+         && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+       continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
     }
 
   /* Ready to read first character of continuation line, which might
     }
 
   /* Ready to read first character of continuation line, which might
@@ -818,26 +1263,35 @@ done:
    parsing character literals, they have to call
    gfc_next_char_literal().  */
 
    parsing character literals, they have to call
    gfc_next_char_literal().  */
 
-int
+gfc_char_t
 gfc_next_char (void)
 {
 gfc_next_char (void)
 {
-  int c;
+  gfc_char_t c;
 
   do
     {
 
   do
     {
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
     }
   while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
 
     }
   while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
 
-  return TOLOWER (c);
+  return gfc_wide_tolower (c);
 }
 
 }
 
+char
+gfc_next_ascii_char (void)
+{
+  gfc_char_t c = gfc_next_char ();
 
 
-int
+  return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+                                   : (unsigned char) UCHAR_MAX);
+}
+
+
+gfc_char_t
 gfc_peek_char (void)
 {
   locus old_loc;
 gfc_peek_char (void)
 {
   locus old_loc;
-  int c;
+  gfc_char_t c;
 
   old_loc = gfc_current_locus;
   c = gfc_next_char ();
 
   old_loc = gfc_current_locus;
   c = gfc_next_char ();
@@ -847,6 +1301,16 @@ gfc_peek_char (void)
 }
 
 
 }
 
 
+char
+gfc_peek_ascii_char (void)
+{
+  gfc_char_t c = gfc_peek_char ();
+
+  return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+                                   : (unsigned char) UCHAR_MAX);
+}
+
+
 /* Recover from an error.  We try to get past the current statement
    and get lined up for the next.  The next statement follows a '\n'
    or a ';'.  We also assume that we are not within a character
 /* Recover from an error.  We try to get past the current statement
    and get lined up for the next.  The next statement follows a '\n'
    or a ';'.  We also assume that we are not within a character
@@ -855,7 +1319,7 @@ gfc_peek_char (void)
 void
 gfc_error_recovery (void)
 {
 void
 gfc_error_recovery (void)
 {
-  char c, delim;
+  gfc_char_t c, delim;
 
   if (gfc_at_eof ())
     return;
 
   if (gfc_at_eof ())
     return;
@@ -902,22 +1366,18 @@ gfc_gobble_whitespace (void)
 {
   static int linenum = 0;
   locus old_loc;
 {
   static int linenum = 0;
   locus old_loc;
-  int c;
+  gfc_char_t c;
 
   do
     {
       old_loc = gfc_current_locus;
 
   do
     {
       old_loc = gfc_current_locus;
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
       /* Issue a warning for nonconforming tabs.  We keep track of the line
         number because the Fortran matchers will often back up and the same
         line will be scanned multiple times.  */
       if (!gfc_option.warn_tabs && c == '\t')
        {
       /* Issue a warning for nonconforming tabs.  We keep track of the line
         number because the Fortran matchers will often back up and the same
         line will be scanned multiple times.  */
       if (!gfc_option.warn_tabs && c == '\t')
        {
-#ifdef USE_MAPPED_LOCATION
          int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
          int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
-#else
-         int cur_linenum = gfc_current_locus.lb->linenum;
-#endif
          if (cur_linenum != linenum)
            {
              linenum = cur_linenum;
          if (cur_linenum != linenum)
            {
              linenum = cur_linenum;
@@ -941,6 +1401,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.
    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
    load_line returns whether the line was truncated.
 
    NOTE: The error machinery isn't available at this point, so we can't
@@ -948,13 +1413,14 @@ gfc_gobble_whitespace (void)
         parts of gfortran.  */
 
 static int
         parts of gfortran.  */
 
 static int
-load_line (FILE * input, char **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;
   int trunc_flag = 0, seen_comment = 0;
 {
   static int linenum = 0, current_line = 1;
   int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
   int trunc_flag = 0, seen_comment = 0;
-  int seen_printable = 0, seen_ampersand = 0;
-  char *buffer;
+  int seen_printable = 0, seen_ampersand = 0, quoted = ' ';
+  gfc_char_t *buffer;
+  bool found_tab = false;
 
   /* Determine the maximum allowed line length.  */
   if (gfc_current_form == FORM_FREE)
 
   /* Determine the maximum allowed line length.  */
   if (gfc_current_form == FORM_FREE)
@@ -976,95 +1442,106 @@ load_line (FILE * input, char **pbuf, int *pbuflen)
       else
        buflen = 132;
 
       else
        buflen = 132;
 
-      *pbuf = gfc_getmem (buflen + 1);
+      *pbuf = gfc_get_wide_string (buflen + 1);
     }
 
   i = 0;
   buffer = *pbuf;
 
     }
 
   i = 0;
   buffer = *pbuf;
 
-  preprocessor_flag = 0;
-  c = fgetc (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 (;;)
     {
 
   for (;;)
     {
-      c = fgetc (input);
-
       if (c == EOF)
        break;
       if (c == EOF)
        break;
+
       if (c == '\n')
        {
          /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3.  */
          if (gfc_current_form == FORM_FREE 
       if (c == '\n')
        {
          /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3.  */
          if (gfc_current_form == FORM_FREE 
-               && !seen_printable && seen_ampersand)
+             && !seen_printable && seen_ampersand)
            {
              if (pedantic)
            {
              if (pedantic)
-               gfc_error_now
-                 ("'&' not allowed by itself in line %d", current_line);
+               gfc_error_now ("'&' not allowed by itself in line %d",
+                              current_line);
              else
              else
-               gfc_warning_now
-                 ("'&' not allowed by itself in line %d", current_line);
+               gfc_warning_now ("'&' not allowed by itself in line %d",
+                                current_line);
            }
          break;
        }
 
            }
          break;
        }
 
-      if (c == '\r')
-       continue;               /* Gobble characters.  */
-      if (c == '\0')
-       continue;
-
-      if (c == '\032')
-       {
-         /* Ctrl-Z ends the file.  */
-         while (fgetc (input) != EOF);
-         break;
-       }
+      if (c == '\r' || c == '\0')
+       goto next_char;                 /* Gobble characters.  */
 
 
-      /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3.  */
       if (c == '&')
       if (c == '&')
-       seen_ampersand = 1;
-
-      if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand))
-       seen_printable = 1;
-      
-      if (gfc_current_form == FORM_FREE 
-           && c == '!' && !seen_printable && seen_ampersand)
        {
        {
-         if (pedantic)
-           gfc_error_now (
-             "'&' not allowed by itself with comment in line %d", current_line);
+         if (seen_ampersand)
+           {
+             seen_ampersand = 0;
+             seen_printable = 1;
+           }
          else
          else
-           gfc_warning_now (
-             "'&' not allowed by itself with comment in line %d", current_line);
-         seen_printable = 1;
+           seen_ampersand = 1;
        }
 
        }
 
+      if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
+       seen_printable = 1;
+
       /* Is this a fixed-form comment?  */
       if (gfc_current_form == FORM_FIXED && i == 0
          && (c == '*' || c == 'c' || c == 'd'))
        seen_comment = 1;
 
       /* Is this a fixed-form comment?  */
       if (gfc_current_form == FORM_FIXED && i == 0
          && (c == '*' || c == 'c' || c == 'd'))
        seen_comment = 1;
 
-      if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
+      if (quoted == ' ')
+       {
+         if (c == '\'' || c == '"')
+           quoted = c;
+       }
+      else if (c == quoted)
+       quoted = ' ';
+
+      /* Is this a free-form comment?  */
+      if (c == '!' && quoted == ' ')
+        seen_comment = 1;
+
+      /* Vendor extension: "<tab>1" marks a continuation line.  */
+      if (found_tab)
+       {
+         found_tab = false;
+         if (c >= '1' && c <= '9')
+           {
+             *(buffer-1) = c;
+             goto next_char;
+           }
+       }
+
+      if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
        {
        {
+         found_tab = true;
+
          if (!gfc_option.warn_tabs && seen_comment == 0
              && current_line != linenum)
            {
              linenum = current_line;
          if (!gfc_option.warn_tabs && seen_comment == 0
              && current_line != linenum)
            {
              linenum = current_line;
-             gfc_warning_now (
-               "Nonconforming tab character in column 1 of line %d", linenum);
+             gfc_warning_now ("Nonconforming tab character in column %d "
+                              "of line %d", i+1, linenum);
            }
 
            }
 
-         while (i <= 6)
+         while (i < 6)
            {
              *buffer++ = ' ';
              i++;
            }
 
            {
              *buffer++ = ' ';
              i++;
            }
 
-         continue;
+         goto next_char;
        }
 
       *buffer++ = c;
        }
 
       *buffer++ = c;
@@ -1077,24 +1554,48 @@ load_line (FILE * input, char **pbuf, int *pbuflen)
              /* Reallocate line buffer to double size to hold the
                overlong line.  */
              buflen = buflen * 2;
              /* Reallocate line buffer to double size to hold the
                overlong line.  */
              buflen = buflen * 2;
-             *pbuf = xrealloc (*pbuf, buflen + 1);
-             buffer = (*pbuf)+i;
+             *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1));
+             buffer = (*pbuf) + i;
            }
        }
       else if (i >= maxlen)
        {
            }
        }
       else if (i >= maxlen)
        {
+         bool trunc_warn = true;
+
+         /* Enhancement, if the very next non-space character is an ampersand
+            or comment that we would otherwise warn about, don't mark as
+            truncated.  */
+
          /* Truncate the rest of the line.  */
          for (;;)
            {
          /* Truncate the rest of the line.  */
          for (;;)
            {
-             c = fgetc (input);
+             c = getc (input);
+             if (c == '\r' || c == ' ')
+               continue;
+
              if (c == '\n' || c == EOF)
                break;
 
              if (c == '\n' || c == EOF)
                break;
 
-             trunc_flag = 1;
+             if (!trunc_warn && c != '!')
+               trunc_warn = true;
+
+             if (trunc_warn && ((gfc_current_form == FORM_FIXED && c == '&')
+                 || c == '!'))
+               trunc_warn = false;
+
+             if (c == '!')
+               seen_comment = 1;
+
+             if (trunc_warn && !seen_comment)
+               trunc_flag = 1;
            }
 
            }
 
-         ungetc ('\n', input);
+         c = '\n';
+         continue;
        }
        }
+
+next_char:
+      c = getc (input);
     }
 
   /* Pad lines to the selected line length in fixed form.  */
     }
 
   /* Pad lines to the selected line length in fixed form.  */
@@ -1123,36 +1624,35 @@ get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
 {
   gfc_file *f;
 
 {
   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;
 
 
   f->next = file_head;
   file_head = f;
 
-  f->included_by = current_file;
+  f->up = current_file;
   if (current_file != NULL)
     f->inclusion_line = current_file->line;
 
   if (current_file != NULL)
     f->inclusion_line = current_file->line;
 
-#ifdef USE_MAPPED_LOCATION
-  linemap_add (&line_table, reason, false, f->filename, 1);
-#endif
+  linemap_add (line_table, reason, false, f->filename, 1);
 
   return f;
 }
 
 
   return f;
 }
 
+
 /* Deal with a line from the C preprocessor. The
    initial octothorp has already been seen.  */
 
 static void
 /* Deal with a line from the C preprocessor. The
    initial octothorp has already been seen.  */
 
 static void
-preprocessor_line (char *c)
+preprocessor_line (gfc_char_t *c)
 {
   bool flag[5];
   int i, line;
 {
   bool flag[5];
   int i, line;
-  char *filename;
+  gfc_char_t *wide_filename;
   gfc_file *f;
   int escaped, unescape;
   gfc_file *f;
   int escaped, unescape;
+  char *filename;
 
   c++;
   while (*c == ' ' || *c == '\t')
 
   c++;
   while (*c == ' ' || *c == '\t')
@@ -1161,9 +1661,9 @@ preprocessor_line (char *c)
   if (*c < '0' || *c > '9')
     goto bad_cpp_line;
 
   if (*c < '0' || *c > '9')
     goto bad_cpp_line;
 
-  line = atoi (c);
+  line = wide_atoi (c);
 
 
-  c = strchr (c, ' ');
+  c = wide_strchr (c, ' ');
   if (c == NULL)
     {
       /* No file name given.  Set new line number.  */
   if (c == NULL)
     {
       /* No file name given.  Set new line number.  */
@@ -1180,15 +1680,15 @@ preprocessor_line (char *c)
     goto bad_cpp_line;
   ++c;
 
     goto bad_cpp_line;
   ++c;
 
-  filename = c;
+  wide_filename = c;
 
   /* Make filename end at quote.  */
   unescape = 0;
   escaped = false;
 
   /* Make filename end at quote.  */
   unescape = 0;
   escaped = false;
-  while (*c && ! (! escaped && *c == '"'))
+  while (*c && ! (!escaped && *c == '"'))
     {
       if (escaped)
     {
       if (escaped)
-        escaped = false;
+       escaped = false;
       else if (*c == '\\')
        {
          escaped = true;
       else if (*c == '\\')
        {
          escaped = true;
@@ -1206,10 +1706,10 @@ preprocessor_line (char *c)
   /* Undo effects of cpp_quote_string.  */
   if (unescape)
     {
   /* Undo effects of cpp_quote_string.  */
   if (unescape)
     {
-      char *s = filename;
-      char *d = gfc_getmem (c - filename - unescape);
+      gfc_char_t *s = wide_filename;
+      gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape);
 
 
-      filename = d;
+      wide_filename = d;
       while (*s)
        {
          if (*s == '\\')
       while (*s)
        {
          if (*s == '\\')
@@ -1227,23 +1727,27 @@ preprocessor_line (char *c)
 
   for (;;)
     {
 
   for (;;)
     {
-      c = strchr (c, ' ');
+      c = wide_strchr (c, ' ');
       if (c == NULL)
        break;
 
       c++;
       if (c == NULL)
        break;
 
       c++;
-      i = atoi (c);
+      i = wide_atoi (c);
 
       if (1 <= i && i <= 4)
        flag[i] = true;
     }
 
 
       if (1 <= i && i <= 4)
        flag[i] = true;
     }
 
+  /* Convert the filename in wide characters into a filename in narrow
+     characters.  */
+  filename = gfc_widechar_to_char (wide_filename, -1);
+
   /* Interpret flags.  */
 
   if (flag[1]) /* Starting new file.  */
     {
       f = get_file (filename, LC_RENAME);
   /* Interpret flags.  */
 
   if (flag[1]) /* Starting new file.  */
     {
       f = get_file (filename, LC_RENAME);
-      f->up = current_file;
+      add_file_change (f->filename, f->inclusion_line);
       current_file = f;
     }
 
       current_file = f;
     }
 
@@ -1256,10 +1760,15 @@ preprocessor_line (char *c)
                           current_file->filename, current_file->line,
                           filename);
          if (unescape)
                           current_file->filename, current_file->line,
                           filename);
          if (unescape)
-           gfc_free (filename);
+           gfc_free (wide_filename);
+         gfc_free (filename);
          return;
        }
          return;
        }
+
+      add_file_change (NULL, line);
       current_file = current_file->up;
       current_file = current_file->up;
+      linemap_add (line_table, LC_RENAME, false, current_file->filename,
+                  current_file->line);
     }
 
   /* The name of the file can be a temporary file produced by
     }
 
   /* The name of the file can be a temporary file produced by
@@ -1267,15 +1776,17 @@ preprocessor_line (char *c)
 
   if (strcmp (current_file->filename, filename) != 0)
     {
 
   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.  */
   current_file->line = line;
   if (unescape)
     }
 
   /* Set new line number.  */
   current_file->line = line;
   if (unescape)
-    gfc_free (filename);
+    gfc_free (wide_filename);
+  gfc_free (filename);
   return;
 
  bad_cpp_line:
   return;
 
  bad_cpp_line:
@@ -1285,7 +1796,7 @@ preprocessor_line (char *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
 
 /* 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
@@ -1294,13 +1805,14 @@ static try load_file (const char *, bool);
    processed or true if we matched an include.  */
 
 static bool
    processed or true if we matched an include.  */
 
 static bool
-include_line (char *line)
+include_line (gfc_char_t *line)
 {
 {
-  char quote, *c, *begin, *stop;
+  gfc_char_t quote, *c, *begin, *stop;
+  char *filename;
 
   c = line;
 
 
   c = line;
 
-  if (gfc_option.flag_openmp)
+  if (gfc_option.gfc_flag_openmp)
     {
       if (gfc_current_form == FORM_FREE)
        {
     {
       if (gfc_current_form == FORM_FREE)
        {
@@ -1320,8 +1832,8 @@ include_line (char *line)
   while (*c == ' ' || *c == '\t')
     c++;
 
   while (*c == ' ' || *c == '\t')
     c++;
 
-  if (strncasecmp (c, "include", 7))
-      return false;
+  if (gfc_wide_strncasecmp (c, "include", 7))
+    return false;
 
   c += 7;
   while (*c == ' ' || *c == '\t')
 
   c += 7;
   while (*c == ' ' || *c == '\t')
@@ -1354,25 +1866,36 @@ include_line (char *line)
   *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
                   read by anything else.  */
 
   *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
                   read by anything else.  */
 
-  load_file (begin, false);
+  filename = gfc_widechar_to_char (begin, -1);
+  if (load_file (filename, NULL, false) == FAILURE)
+    exit (1);
+
+  gfc_free (filename);
   return true;
 }
 
   return true;
 }
 
+
 /* Load a file into memory by calling load_line until the file ends.  */
 
 /* 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)
 {
 {
-  char *line;
+  gfc_char_t *line;
   gfc_linebuf *b;
   gfc_file *f;
   FILE *input;
   int len, line_len;
   gfc_linebuf *b;
   gfc_file *f;
   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)
       {
 
   for (f = current_file; f; f = f->up)
     if (strcmp (filename, f->filename) == 0)
       {
-       gfc_error_now ("File '%s' is being included recursively", filename);
+       fprintf (stderr, "%s:%d: Error: File '%s' is being included "
+                "recursively\n", current_file->filename, current_file->line,
+                filename);
        return FAILURE;
       }
 
        return FAILURE;
       }
 
@@ -1384,7 +1907,7 @@ load_file (const char *filename, bool initial)
          gfc_src_file = NULL;
        }
       else
          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);
       if (input == NULL)
        {
          gfc_error_now ("Can't open file '%s'", filename);
@@ -1393,10 +1916,11 @@ load_file (const char *filename, bool initial)
     }
   else
     {
     }
   else
     {
-      input = gfc_open_included_file (filename, false);
+      input = gfc_open_included_file (realfilename, false, false);
       if (input == NULL)
        {
       if (input == NULL)
        {
-         gfc_error_now ("Can't open included file '%s'", filename);
+         fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n",
+                  current_file->filename, current_file->line, filename);
          return FAILURE;
        }
     }
          return FAILURE;
        }
     }
@@ -1404,11 +1928,13 @@ load_file (const char *filename, bool initial)
   /* Load the file.  */
 
   f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
   /* Load the file.  */
 
   f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
-  f->up = current_file;
+  if (!initial)
+    add_file_change (f->filename, f->inclusion_line);
   current_file = f;
   current_file->line = 1;
   line = NULL;
   line_len = 0;
   current_file = f;
   current_file->line = 1;
   line = NULL;
   line_len = 0;
+  first_line = true;
 
   if (initial && gfc_src_preprocessor_lines[0])
     {
 
   if (initial && gfc_src_preprocessor_lines[0])
     {
@@ -1425,21 +1951,59 @@ load_file (const char *filename, bool initial)
 
   for (;;)
     {
 
   for (;;)
     {
-      int trunc = load_line (input, &line, &line_len);
+      int trunc = load_line (input, &line, &line_len, NULL);
 
 
-      len = strlen (line);
+      len = gfc_wide_strlen (line);
       if (feof (input) && len == 0)
        break;
 
       if (feof (input) && len == 0)
        break;
 
+      /* If this is the first line of the file, it can contain a byte
+        order mark (BOM), which we will ignore:
+          FF FE is UTF-16 little endian,
+          FE FF is UTF-16 big endian,
+          EF BB BF is UTF-8.  */
+      if (first_line
+         && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
+                            && line[1] == (unsigned char) '\xFE')
+             || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
+                               && line[1] == (unsigned char) '\xFF')
+             || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
+                               && line[1] == (unsigned char) '\xBB'
+                               && line[2] == (unsigned char) '\xBF')))
+       {
+         int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
+         gfc_char_t *new_char = gfc_get_wide_string (line_len);
+
+         wide_strcpy (new_char, &line[n]);
+         gfc_free (line);
+         line = new_char;
+         len -= n;
+       }
+
       /* There are three things this line can be: a line of Fortran
         source, an include line or a C preprocessor directive.  */
 
       if (line[0] == '#')
        {
       /* There are three things this line can be: a line of Fortran
         source, an include line or a C preprocessor directive.  */
 
       if (line[0] == '#')
        {
-         preprocessor_line (line);
-         continue;
+         /* When -g3 is specified, it's possible that we emit #define
+            and #undef lines, which we need to pass to the middle-end
+            so that it can emit correct debug info.  */
+         if (debug_info_level == DINFO_LEVEL_VERBOSE
+             && (wide_strncmp (line, "#define ", 8) == 0
+                 || wide_strncmp (line, "#undef ", 7) == 0))
+           ;
+         else
+           {
+             preprocessor_line (line);
+             continue;
+           }
        }
 
        }
 
+      /* Preprocessed files have preprocessor lines added before the byte
+         order mark, so first_line is not about the first line of the file
+        but the first line that's not a preprocessor line.  */
+      first_line = false;
+
       if (include_line (line))
        {
          current_file->line++;
       if (include_line (line))
        {
          current_file->line++;
@@ -1448,17 +2012,14 @@ load_file (const char *filename, bool initial)
 
       /* Add line.  */
 
 
       /* Add line.  */
 
-      b = gfc_getmem (gfc_linebuf_header_size + len + 1);
+      b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size
+                                     + (len + 1) * sizeof (gfc_char_t));
 
 
-#ifdef USE_MAPPED_LOCATION
       b->location
       b->location
-       = linemap_line_start (&line_table, current_file->line++, 120);
-#else
-      b->linenum = current_file->line++;
-#endif
+       = linemap_line_start (line_table, current_file->line++, 120);
       b->file = current_file;
       b->truncated = trunc;
       b->file = current_file;
       b->truncated = trunc;
-      strcpy (b->line, line);
+      wide_strcpy (b->line, line);
 
       if (line_head == NULL)
        line_head = b;
 
       if (line_head == NULL)
        line_head = b;
@@ -1466,6 +2027,9 @@ load_file (const char *filename, bool initial)
        line_tail->next = b;
 
       line_tail = b;
        line_tail->next = b;
 
       line_tail = b;
+
+      while (file_changes_cur < file_changes_count)
+       file_changes[file_changes_cur++].lb = b;
     }
 
   /* Release the line buffer allocated in load_line.  */
     }
 
   /* Release the line buffer allocated in load_line.  */
@@ -1473,38 +2037,40 @@ load_file (const char *filename, bool initial)
 
   fclose (input);
 
 
   fclose (input);
 
+  if (!initial)
+    add_file_change (NULL, current_file->inclusion_line + 1);
   current_file = current_file->up;
   current_file = current_file->up;
-#ifdef USE_MAPPED_LOCATION
-  linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
-#endif
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
   return SUCCESS;
 }
 
 
 /* Open a new file and start scanning from that file. Returns SUCCESS
   return SUCCESS;
 }
 
 
 /* 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.  */
 
    it tries to determine the source form from the filename, defaulting
    to free form.  */
 
-try
+gfc_try
 gfc_new_file (void)
 {
 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;
 
 #if 0 /* Debugging aid.  */
   for (; line_head; line_head = line_head->next)
 
   gfc_current_locus.lb = line_head;
   gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
 
 #if 0 /* Debugging aid.  */
   for (; line_head; line_head = line_head->next)
-    gfc_status ("%s:%3d %s\n", line_head->file->filename, 
-#ifdef USE_MAPPED_LOCATION
-               LOCATION_LINE (line_head->location),
-#else
-               line_head->linenum,
-#endif
-               line_head->line);
+    printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
+           LOCATION_LINE (line_head->location), line_head->line);
 
   exit (0);
 #endif
 
   exit (0);
 #endif
@@ -1533,12 +2099,12 @@ unescape_filename (const char *ptr)
       ++p;
     }
 
       ++p;
     }
 
-  if (! *p || p[1])
+  if (!*p || p[1])
     return NULL;
 
   /* Undo effects of cpp_quote_string.  */
   s = ptr;
     return NULL;
 
   /* 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)
   ret = d;
 
   while (s != p)
@@ -1560,41 +2126,43 @@ const char *
 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
 {
   int c, len;
 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
 {
   int c, len;
-  char *dirname;
+  char *dirname, *tmp;
 
   gfc_src_file = gfc_open_file (filename);
   if (gfc_src_file == NULL)
     return NULL;
 
 
   gfc_src_file = gfc_open_file (filename);
   if (gfc_src_file == NULL)
     return NULL;
 
-  c = fgetc (gfc_src_file);
-  ungetc (c, gfc_src_file);
+  c = getc (gfc_src_file);
 
   if (c != '#')
     return NULL;
 
   len = 0;
 
   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 (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
+  if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
     return NULL;
 
     return NULL;
 
-  filename = unescape_filename (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;
 
   if (filename == NULL)
     return NULL;
 
-  c = fgetc (gfc_src_file);
-  ungetc (c, gfc_src_file);
+  c = getc (gfc_src_file);
 
   if (c != '#')
     return filename;
 
   len = 0;
 
   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 (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
+  if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
     return filename;
 
     return filename;
 
-  dirname = unescape_filename (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)
     return filename;
 
   if (dirname == NULL)
     return filename;
 
@@ -1609,7 +2177,7 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
 
   if (! IS_ABSOLUTE_PATH (filename))
     {
 
   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] = '/';
 
       memcpy (p, dirname, len - 2);
       p[len - 2] = '/';