OSDN Git Service

2011-08-18 Tobias Burnus <burnus@net-b.de>
[pf3gnuchains/gcc-fork.git] / gcc / fortran / scanner.c
index 4c4a8b4..0c127d4 100644 (file)
@@ -1,6 +1,6 @@
 /* Character scanner.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-   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.
@@ -44,7 +44,7 @@ along with GCC; see the file COPYING3.  If not see
 #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"
@@ -63,9 +63,10 @@ static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
 
 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 locus gcc_attribute_locus;
 
 gfc_source_form gfc_current_form;
 static gfc_linebuf *line_head, *line_tail;
@@ -75,8 +76,6 @@ const char *gfc_source_file;
 static FILE *gfc_src_file;
 static gfc_char_t *gfc_src_preprocessor_lines[2];
 
-extern int pedantic;
-
 static struct gfc_file_change
 {
   const char *filename;
@@ -196,7 +195,7 @@ gfc_widechar_to_char (const gfc_char_t *s, int length)
   /* 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 = gfc_getmem (len + 1);
+  res = XNEWVEC (char, len + 1);
 
   for (i = 0; i < len; i++)
     {
@@ -289,15 +288,15 @@ gfc_scanner_done_1 (void)
   while(line_head != NULL) 
     {
       lb = line_head->next;
-      gfc_free(line_head);
+      free (line_head);
       line_head = lb;
     }
      
   while(file_head != NULL) 
     {
       f = file_head->next;
-      gfc_free(file_head->filename);
-      gfc_free(file_head);
+      free (file_head->filename);
+      free (file_head);
       file_head = f;    
     }
 }
@@ -307,7 +306,7 @@ gfc_scanner_done_1 (void)
 
 static void
 add_path_to_list (gfc_directorylist **list, const char *path,
-                 bool use_for_modules)
+                 bool use_for_modules, bool head)
 {
   gfc_directorylist *dir;
   const char *p;
@@ -317,38 +316,47 @@ add_path_to_list (gfc_directorylist **list, const char *path,
     if (*p++ == '\0')
       return;
 
-  dir = *list;
-  if (!dir)
-    dir = *list = gfc_getmem (sizeof (gfc_directorylist));
+  if (head || *list == NULL)
+    {
+      dir = XCNEW (gfc_directorylist);
+      if (!head)
+        *list = dir;
+    }
   else
     {
+      dir = *list;
       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->next = head ? *list : NULL;
+  if (head)
+    *list = dir;
   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 */
 }
 
 
 void
-gfc_add_include_path (const char *path, bool use_for_modules)
+gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir)
 {
-  add_path_to_list (&include_dirs, path, use_for_modules);
-  gfc_cpp_add_include_path (xstrdup(path), true);
+  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);
+  add_path_to_list (&intrinsic_modules_dirs, path, true, false);
 }
 
 
@@ -363,24 +371,25 @@ gfc_release_include_path (void)
     {
       p = include_dirs;
       include_dirs = include_dirs->next;
-      gfc_free (p->path);
-      gfc_free (p);
+      free (p->path);
+      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);
+      free (p->path);
+      free (p);
     }
 
-  gfc_free (gfc_option.module_dir);
+  free (gfc_option.module_dir);
 }
 
 
 static FILE *
-open_included_file (const char *name, gfc_directorylist *list, bool module)
+open_included_file (const char *name, gfc_directorylist *list,
+                   bool module, bool system)
 {
   char *fullname;
   gfc_directorylist *p;
@@ -397,7 +406,12 @@ open_included_file (const char *name, gfc_directorylist *list, bool module)
 
       f = gfc_open_file (fullname);
       if (f != NULL)
-       return f;
+       {
+         if (gfc_cpp_makedep ())
+           gfc_cpp_add_dep (fullname, system);
+
+         return f;
+       }
     }
 
   return NULL;
@@ -411,28 +425,37 @@ open_included_file (const char *name, gfc_directorylist *list, bool module)
 FILE *
 gfc_open_included_file (const char *name, bool include_cwd, bool module)
 {
-  FILE *f;
-
-  if (IS_ABSOLUTE_PATH (name))
-    return gfc_open_file (name);
+  FILE *f = NULL;
 
-  if (include_cwd)
+  if (IS_ABSOLUTE_PATH (name) || include_cwd)
     {
       f = gfc_open_file (name);
-      if (f != NULL)
-       return f;
+      if (f && gfc_cpp_makedep ())
+       gfc_cpp_add_dep (name, false);
     }
 
-  return open_included_file (name, include_dirs, module);
+  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))
-    return gfc_open_file (name);
+    {
+      f = gfc_open_file (name);
+      if (f && gfc_cpp_makedep ())
+       gfc_cpp_add_dep (name, true);
+    }
 
-  return open_included_file (name, intrinsic_modules_dirs, true);
+  if (!f)
+    f = open_included_file (name, intrinsic_modules_dirs, true, true);
+
+  return f;
 }
 
 
@@ -495,9 +518,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;
@@ -605,7 +627,7 @@ next_char (void)
 
 /* 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
@@ -637,7 +659,7 @@ gfc_define_undef_line (void)
       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);
+      free (tmp);
     }
 
   if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
@@ -645,7 +667,7 @@ gfc_define_undef_line (void)
       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);
+      free (tmp);
     }
 
   /* Skip the rest of the line.  */
@@ -655,6 +677,34 @@ gfc_define_undef_line (void)
 }
 
 
+/* 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
@@ -686,12 +736,16 @@ skip_free_comments (void)
 
       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 (gfc_option.flag_openmp && at_bol)
+         if (gfc_option.gfc_flag_openmp && at_bol)
            {
              locus old_loc = gfc_current_locus;
              if (next_char () == '$')
@@ -702,7 +756,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 ();
@@ -724,7 +779,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 ();
@@ -743,6 +798,8 @@ skip_free_comments (void)
 
   if (openmp_flag && at_bol)
     openmp_flag = 0;
+
+  gcc_attribute_flag = 0;
   gfc_current_locus = start;
   return false;
 }
@@ -797,6 +854,13 @@ skip_fixed_comments (void)
 
       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
@@ -807,7 +871,7 @@ skip_fixed_comments (void)
              && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
            continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
 
-         if (gfc_option.flag_openmp)
+         if (gfc_option.gfc_flag_openmp)
            {
              if (next_char () == '$')
                {
@@ -820,11 +884,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.  */
@@ -843,6 +907,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
@@ -850,7 +919,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] = ' ';
@@ -903,6 +972,7 @@ skip_fixed_comments (void)
     }
 
   openmp_flag = 0;
+  gcc_attribute_flag = 0;
   gfc_current_locus = start;
 }
 
@@ -927,7 +997,7 @@ gfc_skip_comments (void)
    context or not.  */
 
 gfc_char_t
-gfc_next_char_literal (int in_string)
+gfc_next_char_literal (gfc_instring in_string)
 {
   locus old_loc;
   int i, prev_openmp_flag;
@@ -949,6 +1019,11 @@ restart:
 
       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)
@@ -967,6 +1042,17 @@ restart:
          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;
 
@@ -1060,10 +1146,10 @@ restart:
        {
          if (in_string)
            {
-             if (gfc_option.warn_ampersand)
-               gfc_warning_now ("Missing '&' in continued character "
-                                "constant at %C");
              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.  */
@@ -1077,7 +1163,7 @@ restart:
            }
        }
     }
-  else
+  else /* Fixed form.  */
     {
       /* Fixed form continuation.  */
       if (!in_string && c == '!')
@@ -1096,6 +1182,14 @@ restart:
       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;
@@ -1176,7 +1270,7 @@ gfc_next_char (void)
 
   do
     {
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
     }
   while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
 
@@ -1277,7 +1371,7 @@ gfc_gobble_whitespace (void)
   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.  */
@@ -1307,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.
+
+   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
@@ -1314,12 +1413,12 @@ 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;
   int trunc_flag = 0, seen_comment = 0;
-  int seen_printable = 0, seen_ampersand = 0;
+  int seen_printable = 0, seen_ampersand = 0, quoted = ' ';
   gfc_char_t *buffer;
   bool found_tab = false;
 
@@ -1349,20 +1448,20 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
   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.  */
@@ -1379,15 +1478,16 @@ 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 == '&')
        {
          if (seen_ampersand)
-           seen_ampersand = 0;
+           {
+             seen_ampersand = 0;
+             seen_printable = 1;
+           }
          else
            seen_ampersand = 1;
        }
@@ -1400,6 +1500,18 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
          && (c == '*' || c == 'c' || c == 'd'))
        seen_comment = 1;
 
+      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)
        {
@@ -1407,7 +1519,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
          if (c >= '1' && c <= '9')
            {
              *(buffer-1) = c;
-             continue;
+             goto next_char;
            }
        }
 
@@ -1429,7 +1541,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen)
              i++;
            }
 
-         continue;
+         goto next_char;
        }
 
       *buffer++ = c;
@@ -1442,24 +1554,48 @@ 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;
            }
        }
       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 (;;)
            {
              c = getc (input);
+             if (c == '\r' || c == ' ')
+               continue;
+
              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.  */
@@ -1488,10 +1624,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;
@@ -1619,14 +1754,14 @@ preprocessor_line (gfc_char_t *c)
   if (flag[2]) /* Ending current file.  */
     {
       if (!current_file->up
-         || strcmp (current_file->up->filename, filename) != 0)
+         || filename_cmp (current_file->up->filename, filename) != 0)
        {
          gfc_warning_now ("%s:%d: file %s left but not entered",
                           current_file->filename, current_file->line,
                           filename);
          if (unescape)
-           gfc_free (wide_filename);
-         gfc_free (filename);
+           free (wide_filename);
+         free (filename);
          return;
        }
 
@@ -1639,18 +1774,19 @@ preprocessor_line (gfc_char_t *c)
   /* The name of the file can be a temporary file produced by
      cpp. Replace the name if it is different.  */
 
-  if (strcmp (current_file->filename, filename) != 0)
+  if (filename_cmp (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)
-    gfc_free (wide_filename);
-  gfc_free (filename);
+    free (wide_filename);
+  free (filename);
   return;
 
  bad_cpp_line:
@@ -1660,7 +1796,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
@@ -1676,7 +1812,7 @@ include_line (gfc_char_t *line)
 
   c = line;
 
-  if (gfc_option.flag_openmp)
+  if (gfc_option.gfc_flag_openmp)
     {
       if (gfc_current_form == FORM_FREE)
        {
@@ -1731,16 +1867,18 @@ include_line (gfc_char_t *line)
                   read by anything else.  */
 
   filename = gfc_widechar_to_char (begin, -1);
-  load_file (filename, false);
-  gfc_free (filename);
+  if (load_file (filename, NULL, false) == FAILURE)
+    exit (FATAL_EXIT_CODE);
+
+  free (filename);
   return true;
 }
 
 
 /* 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;
@@ -1748,11 +1886,16 @@ 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)
+    if (filename_cmp (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;
       }
 
@@ -1764,7 +1907,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);
@@ -1773,10 +1916,11 @@ 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);
+         fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n",
+                  current_file->filename, current_file->line, filename);
          return FAILURE;
        }
     }
@@ -1795,19 +1939,19 @@ load_file (const char *filename, bool initial)
   if (initial && gfc_src_preprocessor_lines[0])
     {
       preprocessor_line (gfc_src_preprocessor_lines[0]);
-      gfc_free (gfc_src_preprocessor_lines[0]);
+      free (gfc_src_preprocessor_lines[0]);
       gfc_src_preprocessor_lines[0] = NULL;
       if (gfc_src_preprocessor_lines[1])
        {
          preprocessor_line (gfc_src_preprocessor_lines[1]);
-         gfc_free (gfc_src_preprocessor_lines[1]);
+         free (gfc_src_preprocessor_lines[1]);
          gfc_src_preprocessor_lines[1] = NULL;
        }
     }
 
   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)
@@ -1828,11 +1972,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_get_wide_string (line_len);
+         gfc_char_t *new_char = gfc_get_wide_string (line_len);
 
-         wide_strcpy (new, &line[n]);
-         gfc_free (line);
-         line = new;
+         wide_strcpy (new_char, &line[n]);
+         free (line);
+         line = new_char;
          len -= n;
        }
 
@@ -1868,8 +2012,8 @@ load_file (const char *filename, bool initial)
 
       /* Add line.  */
 
-      b = gfc_getmem (gfc_linebuf_header_size
-                     + (len + 1) * sizeof (gfc_char_t));
+      b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size
+                   + (len + 1) * sizeof (gfc_char_t));
 
       b->location
        = linemap_line_start (line_table, current_file->line++, 120);
@@ -1889,7 +2033,7 @@ load_file (const char *filename, bool initial)
     }
 
   /* Release the line buffer allocated in load_line.  */
-  gfc_free (line);
+  free (line);
 
   fclose (input);
 
@@ -1902,23 +2046,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;
 
   if (gfc_cpp_enabled ())
     {
       result = gfc_cpp_preprocess (gfc_source_file);
       if (!gfc_cpp_preprocess_only ())
-        result = load_file (gfc_cpp_temporary_file (), true);
+        result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true);
     }
   else
-    result = load_file (gfc_source_file, true);
+    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;
@@ -1928,7 +2072,7 @@ gfc_new_file (void)
     printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
            LOCATION_LINE (line_head->location), line_head->line);
 
-  exit (0);
+  exit (SUCCESS_EXIT_CODE);
 #endif
 
   return result;
@@ -1960,7 +2104,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)
@@ -1989,45 +2133,43 @@ 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 = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1);
   filename = unescape_filename (tmp);
-  gfc_free (tmp);
+  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 = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1);
   dirname = unescape_filename (tmp);
-  gfc_free (tmp);
+  free (tmp);
   if (dirname == NULL)
     return filename;
 
   len = strlen (dirname);
   if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
     {
-      gfc_free (dirname);
+      free (dirname);
       return filename;
     }
   dirname[len - 2] = '\0';
@@ -2035,7 +2177,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] = '/';
@@ -2043,6 +2185,6 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
       *canon_source_file = p;
     }
 
-  gfc_free (dirname);
+  free (dirname);
   return filename;
 }