re PR fortran/13702 (When preprocessing Fortran files (.F, .F90 and .F95) cpp…

re PR fortran/13702 (When preprocessing Fortran files (.F, .F90 and .F95) cpp should emit line numbers.)

PR fortran/13702
(Port from g95)
* gfortran.h (gfc_linebuf): New typedef.
(linebuf): Remove.
(gfc_file): Revamped, use new gfc_linebuf.
(locus): Revamped, use new types.
(gfc_current_file): Remove.
(gfc_current_form, gfc_source_file): New global variables.
* match.c (gfc_match_space, gfc_match_strings): Use
gfc_current_form to find source form.
* module.c (gfc_dump_module): Use gfc_source_file when printing
module header.
* error.c (show_locus, show_loci) Use new data structures to print
locus.
* scanner.c (first_file, first_duplicated_file, gfc_current_file):
Remove.
(file_head, current_file, gfc_current_form, line_head, line_tail,
gfc_current_locus1, gfc_source_file): New global variables.
(gfc_scanner_init1): Set new global variables.
(gfc_scanner_done1): Free new data structures.
(gfc_current_locus): Return pointer to gfc_current_locus1.
(gfc_set_locus): Set gfc_current_locus1.
(gfc_at_eof): Set new variables.
(gfc_at_bol, gfc_at_eol, gfc_advance_line, gfc_next_char): Adapt
to new locus structure.
(gfc_check_include): Remove.
(skip_free_comments, skip_fixed_comments): Use gfc_current_locus1.
(gfc_skip_comments): Use gfc_current_form, find locus with
gfc_current_locus1.
(gfc_next_char): Use gfc_current_form.
(gfc_peek_char, gfc_gobble_whitespace): Use gfc_current_locus1.
(load_line): Use gfc_current_form. Recognize ^Z as EOF. Fix
comment formatting.
(get_file): New function.
(preprocessor_line, include_line): New functions.
(load_file): Move down, rewrite to match new data structures.
(gfc_new_file): Rewrite to match new data structures.
* parse.c (next_statement): Remove code which is now useless. Use
gfc_source_form and gfc_source_file where appropriate.
* trans-decl.c (gfc_get_label_decl): adapt to new data structures
when determining locus of frontend code.
* trans-io.c (set_error_locus): Same.
* trans.c (gfc_get_backend_locus, gfc_set_backend_locus): Likewise.
* lang-specs.h (@f77-cpp-input, @f95-cpp-input): Remove '-P' from
preprocessor flags.
(all): Add missing initializers.

From-SVN: r81888

gcc/fortran/ChangeLog

 2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
+	PR fortran/13702 
+	(Port from g95)
+	* gfortran.h (gfc_linebuf): New typedef.
+	(linebuf): Remove.
+	(gfc_file): Revamped, use new gfc_linebuf.
+	(locus): Revamped, use new types.
+	(gfc_current_file): Remove.
+	(gfc_current_form, gfc_source_file): New global variables.
+	* match.c (gfc_match_space, gfc_match_strings): Use
+	gfc_current_form to find source form.
+	* module.c (gfc_dump_module): Use gfc_source_file when printing
+	module header.
+	* error.c (show_locus, show_loci) Use new data structures to print
+	locus.
+	* scanner.c (first_file, first_duplicated_file, gfc_current_file):
+	Remove.
+	(file_head, current_file, gfc_current_form, line_head, line_tail,
+	gfc_current_locus1, gfc_source_file): New global variables.
+	(gfc_scanner_init1): Set new global variables.
+	(gfc_scanner_done1): Free new data structures.
+	(gfc_current_locus): Return pointer to gfc_current_locus1.
+	(gfc_set_locus): Set gfc_current_locus1.
+	(gfc_at_eof): Set new variables.
+	(gfc_at_bol, gfc_at_eol, gfc_advance_line, gfc_next_char): Adapt
+	to new locus structure.
+	(gfc_check_include): Remove.
+	(skip_free_comments, skip_fixed_comments): Use gfc_current_locus1.
+	(gfc_skip_comments): Use gfc_current_form, find locus with
+	gfc_current_locus1.
+	(gfc_next_char): Use gfc_current_form.
+	(gfc_peek_char, gfc_gobble_whitespace): Use gfc_current_locus1.
+	(load_line): Use gfc_current_form. Recognize ^Z as EOF. Fix
+	comment formatting.
+	(get_file): New function.
+	(preprocessor_line, include_line): New functions.
+	(load_file): Move down, rewrite to match new data structures.
+	(gfc_new_file): Rewrite to match new data structures.
+	* parse.c (next_statement): Remove code which is now useless. Use
+	gfc_source_form and gfc_source_file where appropriate.
+	* trans-decl.c (gfc_get_label_decl): adapt to new data structures
+	when determining locus of frontend code.
+	* trans-io.c (set_error_locus): Same.
+	* trans.c (gfc_get_backend_locus, gfc_set_backend_locus): Likewise.
+	* lang-specs.h (@f77-cpp-input, @f95-cpp-input): Remove '-P' from
+	preprocessor flags.
+	(all): Add missing initializers.
+
+
+2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
 	* Make-lang.in (trans-common.o): Remove redundant dependency.
 	(data.c): Replace object file name ...
 	(data.o): ... by the correct one.

gcc/fortran/error.c

@@ -118,8 +118,9 @@ error_string (const char *p)
 static void error_printf (const char *, ...) ATTRIBUTE_PRINTF_1;
 
 static void
-show_locus (int offset, locus * l)
+show_locus (int offset, locus * loc)
 {
+  gfc_linebuf *lb;
   gfc_file *f;
   char c, *p;
   int i, m;
@@ -127,20 +128,25 @@ show_locus (int offset, locus * l)
   /* TODO: Either limit the total length and number of included files
      displayed or add buffering of arbitrary number of characters in
      error messages.  */
-  f = l->file;
-  error_printf ("In file %s:%d\n", f->filename, l->lp->start_line + l->line);
 
-  f = f->included_by;
-  while (f != NULL)
+  lb = loc->lb;
+  f = lb->file;
+  error_printf ("In file %s:%d\n", f->filename, lb->linenum);
+
+  for (;;)
     {
-      error_printf ("    Included at %s:%d\n", f->filename,
-		    f->loc.lp->start_line + f->loc.line);
+      i = f->inclusion_line;
+
       f = f->included_by;
+      if (f == NULL) break;
+
+      error_printf ("    Included at %s:%d\n", f->filename, i);
     }
 
   /* Show the line itself, taking care not to print more than what can
      show up on the terminal.  Tabs are converted to spaces.  */
-  p = l->lp->line[l->line] + offset;
+
+  p = lb->line + offset;
   i = strlen (p);
   if (i > terminal_width)
     i = terminal_width - 1;
@@ -190,12 +196,12 @@ show_loci (locus * l1, locus * l2)
       return;
     }
 
-  c1 = l1->nextc - l1->lp->line[l1->line];
+  c1 = l1->nextc - l1->lb->line;
   c2 = 0;
   if (l2 == NULL)
     goto separate;
 
-  c2 = l2->nextc - l2->lp->line[l2->line];
+  c2 = l2->nextc - l2->lb->line;
 
   if (c1 < c2)
     m = c2 - c1;
@@ -203,7 +209,7 @@ show_loci (locus * l1, locus * l2)
     m = c1 - c2;
 
 
-  if (l1->lp != l2->lp || l1->line != l2->line || m > terminal_width - 10)
+  if (l1->lb != l2->lb || m > terminal_width - 10)
     goto separate;
 
   offset = 0;

gcc/fortran/gfortran.h

@@ -413,35 +413,40 @@ typedef struct
 symbol_attribute;
 
 
-typedef struct
+/* The following three structures are used to identify a location in
+   the sources. 
+   
+   gfc_file is used to maintain a tree of the source files and how
+   they include each other
+
+   gfc_linebuf holds a single line of source code and information
+   which file it resides in
+
+   locus point to the sourceline and the character in the source
+   line.  
+*/
+
+typedef struct gfc_file 
 {
-  char *nextc;
-  int line;			/* line within the lp structure */
-  struct linebuf *lp;
-  struct gfc_file *file;
-}
-locus;
+  struct gfc_file *included_by, *next, *up;
+  int inclusion_line, line;
+  char *filename;
+} gfc_file;
 
-/* The linebuf structure deserves some explanation.  This is the
-   primary structure for holding lines.  A source file is stored in a
-   singly linked list of these structures.  Each structure holds an
-   integer number of lines.  The line[] member is actually an array of
-   pointers that point to the NULL-terminated lines.  This list grows
-   upwards, and the actual lines are stored at the top of the
-   structure and grow downward.  Each structure is packed with as many
-   lines as it can hold, then another linebuf is allocated.  */
+typedef struct gfc_linebuf 
+{
+  int linenum;
+  struct gfc_file *file;
+  struct gfc_linebuf *next;
 
-/* Chosen so that sizeof(linebuf) = 4096 on most machines */
-#define LINEBUF_SIZE 4080
+  char line[];
+} gfc_linebuf;
   
-typedef struct linebuf
+typedef struct 
 {
-  int start_line, lines;
-  struct linebuf *next;
-  char *line[1];
-  char buf[LINEBUF_SIZE];
-}
-linebuf;
+  char *nextc;
+  gfc_linebuf *lb;
+} locus;
 
 
 #include <limits.h>
@@ -451,17 +456,6 @@ linebuf;
 #endif
 
 
-typedef struct gfc_file
-{
-  char filename[PATH_MAX + 1];
-  gfc_source_form form;
-  struct gfc_file *included_by, *next;
-  locus loc;
-  struct linebuf *start;
-}
-gfc_file;
-
-
 extern int gfc_suppress_error;
 
 
@@ -1308,7 +1302,9 @@ void gfc_error_recovery (void);
 void gfc_gobble_whitespace (void);
 try gfc_new_file (const char *, gfc_source_form);
 
-extern gfc_file *gfc_current_file;
+extern gfc_source_form gfc_current_form;
+extern char *gfc_source_file;
+/* extern locus gfc_current_locus; */
 
 /* misc.c */
 void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;

gcc/fortran/lang-specs.h

@@ -7,29 +7,29 @@ This file is licensed under the GPL.  */
 /* This is the contribution to the `default_compilers' array in gcc.c
    for the f95 language.  */
 
-{".F",   "@f77-cpp-input", 0},
-{".fpp", "@f77-cpp-input", 0},
-{".FPP", "@f77-cpp-input", 0},
+{".F",   "@f77-cpp-input", 0, 0, 0},
+{".fpp", "@f77-cpp-input", 0, 0, 0},
+{".FPP", "@f77-cpp-input", 0, 0, 0},
 {"@f77-cpp-input",
-  "cc1 -P -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
+  "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
       %{E|M|MM:%(cpp_debug_options)}\
       %{!M:%{!MM:%{!E: -o %|.f |\n\
     f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\
-      %{!fsyntax-only:%(invoke_as)}}}}", 0},
-{".F90", "@f95-cpp-input", 0},
-{".F95", "@f95-cpp-input", 0},
+      %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
+{".F90", "@f95-cpp-input", 0, 0, 0},
+{".F95", "@f95-cpp-input", 0, 0, 0},
 {"@f95-cpp-input",
-  "cc1 -P -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
+  "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
       %{E|M|MM:%(cpp_debug_options)}\
       %{!M:%{!MM:%{!E: -o %|.f95 |\n\
     f951 %|.f95 %(cc1_options) %{J*} %{I*}\
-      %{!fsyntax-only:%(invoke_as)}}}}", 0},
-{".f90", "@f95", 0},
-{".f95", "@f95", 0},
+      %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
+{".f90", "@f95", 0, 0, 0},
+{".f95", "@f95", 0, 0, 0},
 {"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\
-         %{!fsyntax-only:%(invoke_as)}}", 0},
-{".f",   "@f77", 0},
-{".for", "@f77", 0},
-{".FOR", "@f77", 0},
+         %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
+{".f",   "@f77", 0, 0, 0},
+{".for", "@f77", 0, 0, 0},
+{".FOR", "@f77", 0, 0, 0},
 {"@f77", "%{!E:f951 %i %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\
-         %{!fsyntax-only:%(invoke_as)}}", 0},
+         %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},

gcc/fortran/match.c

@@ -77,7 +77,7 @@ gfc_match_space (void)
   locus old_loc;
   int c;
 
-  if (gfc_current_file->form == FORM_FIXED)
+  if (gfc_current_form == FORM_FIXED)
     return MATCH_YES;
 
   old_loc = *gfc_current_locus ();
@@ -337,7 +337,7 @@ gfc_match_strings (mstring * a)
 	  if (*p->mp == ' ')
 	    {
 	      /* Space matches 1+ whitespace(s).  */
-	      if ((gfc_current_file->form == FORM_FREE)
+	      if ((gfc_current_form == FORM_FREE)
 		  && gfc_is_whitespace (c))
 		continue;
 

gcc/fortran/module.c

@@ -3338,7 +3338,6 @@ void
 gfc_dump_module (const char *name, int dump_flag)
 {
   char filename[PATH_MAX], *p;
-  gfc_file *g;
   time_t now;
 
   filename[0] = '\0';
@@ -3359,17 +3358,13 @@ gfc_dump_module (const char *name, int dump_flag)
     gfc_fatal_error ("Can't open module file '%s' for writing: %s",
 		     filename, strerror (errno));
 
-  /* Find the top level filename.  */
-  g = gfc_current_file;
-  while (g->next)
-    g = g->next;
-
   now = time (NULL);
   p = ctime (&now);
 
   *strchr (p, '\n') = '\0';
 
-  fprintf (module_fp, "GFORTRAN module created from %s on %s\n", g->filename, p);
+  fprintf (module_fp, "GFORTRAN module created from %s on %s\n", 
+	   gfc_source_file, p);
   fputs ("If you edit this, you'll get what you deserve.\n\n", module_fp);
 
   iomode = IO_OUTPUT;

gcc/fortran/parse.c

@@ -483,16 +483,6 @@ next_statement (void)
 
       gfc_skip_comments ();
 
-      if (gfc_at_bol () && gfc_check_include ())
-	continue;
-
-      if (gfc_at_eof () && gfc_current_file->included_by != NULL)
-	{
-	  gfc_current_file = gfc_current_file->included_by;
-	  gfc_advance_line ();
-	  continue;
-	}
-
       if (gfc_at_end ())
 	{
 	  st = ST_NONE;
@@ -500,7 +490,8 @@ next_statement (void)
 	}
 
       st =
-	(gfc_current_file->form == FORM_FIXED) ? next_fixed () : next_free ();
+	(gfc_current_form == FORM_FIXED) ? next_fixed () : next_free ();
+
       if (st != ST_NONE)
 	break;
     }
@@ -1268,7 +1259,7 @@ unexpected_eof (void)
 {
   gfc_state_data *p;
 
-  gfc_error ("Unexpected end of file in '%s'", gfc_current_file->filename);
+  gfc_error ("Unexpected end of file in '%s'", gfc_source_file);
 
   /* Memory cleanup.  Move to "second to last".  */
   for (p = gfc_state_stack; p && p->previous && p->previous->previous;

gcc/fortran/scanner.c

@@ -60,10 +60,15 @@ gfc_directorylist;
 /* List of include file search directories.  */
 static gfc_directorylist *include_dirs;
 
-static gfc_file *first_file, *first_duplicated_file;
+static gfc_file *file_head, *current_file;
+
 static int continue_flag, end_flag;
 
-gfc_file *gfc_current_file;
+gfc_source_form gfc_current_form;
+static gfc_linebuf *line_head, *line_tail;
+       
+locus gfc_current_locus1;
+char *gfc_source_file;
       
 
 /* Main scanner initialization.  */
@@ -71,10 +76,10 @@ gfc_file *gfc_current_file;
 void
 gfc_scanner_init_1 (void)
 {
+  file_head = NULL;
+  line_head = NULL;
+  line_tail = NULL;
 
-  gfc_current_file = NULL;
-  first_file = NULL;
-  first_duplicated_file = NULL;
   end_flag = 0;
 }
 
@@ -84,36 +89,24 @@ gfc_scanner_init_1 (void)
 void
 gfc_scanner_done_1 (void)
 {
+  gfc_linebuf *lb;
+  gfc_file *f;
 
-  linebuf *lp, *lp2;
-  gfc_file *fp, *fp2;
-
-  for (fp = first_file; fp; fp = fp2)
-    {
-
-      if (fp->start != NULL)
-	{
-	  /* Free linebuf blocks */
-	  for (fp2 = fp->next; fp2; fp2 = fp2->next)
-	    if (fp->start == fp2->start)
-	      fp2->start = NULL;
-
-	  for (lp = fp->start; lp; lp = lp2)
+  while(line_head != NULL) 
     {
-	      lp2 = lp->next;
-	      gfc_free (lp);
-	    }
-	}
-
-      fp2 = fp->next;
-      gfc_free (fp);
+      lb = line_head->next;
+      gfc_free(line_head);
+      line_head = lb;
     }
      
-  for (fp = first_duplicated_file; fp; fp = fp2)
+  while(file_head != NULL) 
     {
-      fp2 = fp->next;
-      gfc_free (fp);
+      f = file_head->next;
+      gfc_free(file_head->filename);
+      gfc_free(file_head);
+      file_head = f;    
     }
+
 }
 
 
@@ -168,7 +161,6 @@ gfc_release_include_path (void)
     }
 }
 
-
 /* Opens file for reading, searching through the include directories
    given if necessary.  */
 
@@ -206,19 +198,18 @@ locus *
 gfc_current_locus (void)
 {
 
-  if (gfc_current_file == NULL)
-    return NULL;
-  return &gfc_current_file->loc;
+  return &gfc_current_locus1;
 }
 
 
+
 /* Let a caller move the current read pointer (backwards).  */
 
 void
 gfc_set_locus (locus * lp)
 {
 
-  gfc_current_file->loc = *lp;
+  gfc_current_locus1 = *lp;
 }
 
 
@@ -241,10 +232,10 @@ gfc_at_eof (void)
   if (gfc_at_end ())
     return 1;
 
-  if (gfc_current_file->start->lines == 0)
+  if (line_head == NULL)
     return 1;			/* Null file */
 
-  if (gfc_current_file->loc.lp == NULL)
+  if (gfc_current_locus1.lb == NULL)
     return 1;
 
   return 0;
@@ -256,14 +247,10 @@ gfc_at_eof (void)
 int
 gfc_at_bol (void)
 {
-  int i;
-
   if (gfc_at_eof ())
     return 1;
 
-  i = gfc_current_file->loc.line;
-
-  return gfc_current_file->loc.nextc == gfc_current_file->loc.lp->line[i];
+  return (gfc_current_locus1.nextc == gfc_current_locus1.lb->line);
 }
 
 
@@ -276,7 +263,7 @@ gfc_at_eol (void)
   if (gfc_at_eof ())
     return 1;
 
-  return *gfc_current_file->loc.nextc == '\0';
+  return (*gfc_current_locus1.nextc == '\0');
 }
 
 
@@ -285,27 +272,24 @@ gfc_at_eol (void)
 void
 gfc_advance_line (void)
 {
-  locus *locp;
-  linebuf *lp;
-
   if (gfc_at_end ())
     return;
 
-  locp = &gfc_current_file->loc;
-  lp = locp->lp;
-  if (lp == NULL)
+  if (gfc_current_locus1.lb == NULL) 
+    {
+      end_flag = 1;
       return;
+    } 
 
-  if (++locp->line >= lp->lines)
-    {
-      locp->lp = lp = lp->next;
-      if (lp == NULL)
-	return;	  /* End of this file */
+  gfc_current_locus1.lb = gfc_current_locus1.lb->next;
 
-      locp->line = 0;
+  if (gfc_current_locus1.lb != NULL)         
+    gfc_current_locus1.nextc = gfc_current_locus1.lb->line;
+  else 
+    {
+      gfc_current_locus1.nextc = NULL;
+      end_flag = 1;
     }       
-
-  locp->nextc = lp->line[locp->line];
 }
 
 
@@ -321,104 +305,21 @@ gfc_advance_line (void)
 static int
 next_char (void)
 {
-  locus *locp;
   int c;
   
-  /* End the current include level, but not if we're in the middle
-     of processing a continuation. */
-  if (gfc_at_eof ())
-    {
-      if (continue_flag != 0 || gfc_at_end ())
+  if (gfc_current_locus1.nextc == NULL)
     return '\n';
 
-      if (gfc_current_file->included_by == NULL)
-	end_flag = 1;
-
-      return '\n';
-    }
-
-  locp = &gfc_current_file->loc;
-  if (locp->nextc == NULL)
-    return '\n';
-
-  c = *locp->nextc++;
+  c = *gfc_current_locus1.nextc++;
   if (c == '\0')
     {
-      locp->nextc--;	/* Stay stuck on this line */
+      gfc_current_locus1.nextc--; /* Remain on this line.  */
       c = '\n';
     }
 
   return c;
 }
 
-
-/* Checks the current line buffer to see if it is an include line.  If
-   so, we load the new file and prepare to read from it.  Include
-   lines happen at a lower level than regular parsing because the
-   string-matching subroutine is far simpler than the normal one.
-
-   We never return a syntax error because a statement like "include = 5"
-   is perfectly legal.  We return zero if no include was processed or
-   nonzero if we matched an include.  */
-
-int
-gfc_check_include (void)
-{
-  char c, quote, path[PATH_MAX + 1];
-  const char *include;
-  locus start;
-  int i;
-
-  include = "include";
-
-  start = *gfc_current_locus ();
-  gfc_gobble_whitespace ();
-
-  /* Match the 'include' */
-  while (*include != '\0')
-    if (*include++ != gfc_next_char ())
-      goto no_include;
-
-  gfc_gobble_whitespace ();
-
-  quote = next_char ();
-  if (quote != '"' && quote != '\'')
-    goto no_include;
-
-  /* Copy the filename */
-  for (i = 0;;)
-    {
-      c = next_char ();
-      if (c == '\n')
-	goto no_include;	/* No close quote */
-      if (c == quote)
-	break;
-
-  /* This shouldn't happen-- PATH_MAX should be way longer than the
-     max line length.  */
-
-      if (i >= PATH_MAX)
-	gfc_internal_error ("Pathname of include file is too long at %C");
-
-      path[i++] = c;
-    }
-
-  path[i] = '\0';
-  if (i == 0)
-    goto no_include;	/* No filename! */
-
-  /* At this point, we've got a filename to be included.  The rest
-     of the include line is ignored */
-
-  gfc_new_file (path, gfc_current_file->form);
-  return 1;
-
-no_include:
-  gfc_set_locus (&start);
-  return 0;
-}
-
-
 /* 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
@@ -450,7 +351,7 @@ skip_free_comments (void)
 
   for (;;)
     {
-      start = *gfc_current_locus ();
+      start = gfc_current_locus1;
       if (gfc_at_eof ())
 	break;
 
@@ -492,7 +393,7 @@ skip_fixed_comments (void)
 
   for (;;)
     {
-      start = *gfc_current_locus ();
+      start = gfc_current_locus1;
       if (gfc_at_eof ())
 	break;
 
@@ -543,7 +444,7 @@ void
 gfc_skip_comments (void)
 {
 
-  if (!gfc_at_bol () || gfc_current_file->form == FORM_FREE)
+  if (!gfc_at_bol () || gfc_current_form == FORM_FREE)
     skip_free_comments ();
   else
     skip_fixed_comments ();
@@ -570,7 +471,7 @@ restart:
   if (gfc_at_end ())
     return c;
 
-  if (gfc_current_file->form == FORM_FREE)
+  if (gfc_current_form == FORM_FREE)
     {
 
       if (!in_string && c == '!')
@@ -590,7 +491,7 @@ restart:
 
       /* If the next nonblank character is a ! or \n, we've got a
          continuation line. */
-      old_loc = gfc_current_file->loc;
+      old_loc = gfc_current_locus1;
 
       c = next_char ();
       while (gfc_is_whitespace (c))
@@ -701,7 +602,7 @@ gfc_next_char (void)
     {
       c = gfc_next_char_literal (0);
     }
-  while (gfc_current_file->form == FORM_FIXED && gfc_is_whitespace (c));
+  while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
 
   return TOLOWER (c);
 }
@@ -713,7 +614,7 @@ gfc_peek_char (void)
   locus old_loc;
   int c;
 
-  old_loc = *gfc_current_locus ();
+  old_loc = gfc_current_locus1;
   c = gfc_next_char ();
   gfc_set_locus (&old_loc);
 
@@ -783,7 +684,7 @@ gfc_gobble_whitespace (void)
 
   do
     {
-      old_loc = *gfc_current_locus ();
+      old_loc = gfc_current_locus1;
       c = gfc_next_char_literal (0);
     }
   while (gfc_is_whitespace (c));
@@ -798,12 +699,13 @@ gfc_gobble_whitespace (void)
    character in the source region.  */
 
 static void
-load_line (FILE * input, gfc_source_form form, char *buffer,
-	   char *filename, int linenum)
+load_line (FILE * input, char *buffer, char *filename, int linenum)
 {
   int c, maxlen, i, trunc_flag;
 
-  maxlen = (form == FORM_FREE) ? 132 : gfc_option.fixed_line_length;
+  maxlen = (gfc_current_form == FORM_FREE) 
+    ? 132 
+    : gfc_option.fixed_line_length;
 
   i = 0;
 
@@ -817,12 +719,19 @@ load_line (FILE * input, gfc_source_form form, char *buffer,
 	break;
 
       if (c == '\r')
-	continue;		/* Gobble characters */
+	continue;		/* Gobble characters.  */
       if (c == '\0')
 	continue;
 
-      if (form == FORM_FIXED && c == '\t' && i <= 6)
-	{			/* Tab expandsion */
+      if (c == '\032')
+	{
+	  /* Ctrl-Z ends the file.  */
+	  while (fgetc (input) != EOF);
+	  break;
+	}
+
+      if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
+	{			/* Tab expandsion.  */
 	  while (i <= 6)
 	    {
 	      *buffer++ = ' ';
@@ -836,7 +745,7 @@ load_line (FILE * input, gfc_source_form form, char *buffer,
       i++;
 
       if (i >= maxlen)
-	{			/* Truncate the rest of the line */
+	{			/* Truncate the rest of the line.  */
 	  trunc_flag = 1;
 
 	  for (;;)
@@ -863,51 +772,247 @@ load_line (FILE * input, gfc_source_form form, char *buffer,
 }
 
 
-/* Load a file into memory by calling load_line until the file ends.  */
+/* Get a gfc_file structure, initialize it and add it to
+   the file stack.  */
+
+static gfc_file *
+get_file (char *name)
+{
+  gfc_file *f;
+
+  f = gfc_getmem (sizeof (gfc_file));
+
+  f->filename = gfc_getmem (strlen (name) + 1);
+  strcpy (f->filename, name);
+
+  f->next = file_head;
+  file_head = f;
+
+  f->included_by = current_file;
+  if (current_file != NULL)
+    f->inclusion_line = current_file->line;
+
+  return f;
+}
+
+/* Deal with a line from the C preprocessor. The
+   initial octothorp has already been seen.  */
 
 static void
-load_file (FILE * input, gfc_file * fp)
+preprocessor_line (char *c)
 {
-  char *linep, line[GFC_MAX_LINE + 1];
-  int len, linenum;
-  linebuf *lp;
+  bool flag[5];
+  int i, line;
+  char *filename;
+  gfc_file *f;
+
+  c++;
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  if (*c < '0' || *c > '9')
+    {
+      gfc_warning_now ("%s:%d Unknown preprocessor directive", 
+		       current_file->filename, current_file->line);
+      current_file->line++;
+      return;
+    }
+
+  line = atoi (c);
 
-  fp->start = lp = gfc_getmem (sizeof (linebuf));
+  c = strchr (c, ' ') + 2; /* Skip space and quote.  */
+  filename = c;
 
-  linenum = 1;
-  lp->lines = 0;
-  lp->start_line = 1;
-  lp->next = NULL;
+  c = strchr (c, '"'); /* Make filename end at quote.  */
+  *c++ = '\0';
 
-  linep = (char *) (lp + 1);
+  /* Get flags.  */
+  
+  flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
+
+  for (;;)
+    {
+      c = strchr (c, ' ');
+      if (c == NULL)
+	break;
+
+      c++;
+      i = atoi (c);
+
+      if (1 <= i && i <= 4)
+	flag[i] = true;
+    }
+     
+  /* Interpret flags.  */
+  
+  if (flag[1] || flag[3]) /* Starting new file.  */
+    {
+      f = get_file (filename);
+      f->up = current_file;
+      current_file = f;
+    }
+  
+  if (flag[2]) /* Ending current file.  */
+    {
+      current_file = current_file->up;
+    }
+  
+  current_file->line = line;
+  
+  /* 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)
+    {
+      gfc_free (current_file->filename);
+      current_file->filename = gfc_getmem (strlen (filename) + 1);
+      strcpy (current_file->filename, filename);
+    }
+}
+
+
+static try load_file (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
+   file.  We never return a syntax error because a statement like
+   "include = 5" is perfectly legal.  We return false if no include was
+   processed or true if we matched an include.  */
+
+static bool
+include_line (char *line)
+{
+  char quote, *c, *begin, *stop;
+  
+  c = line;
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  if (strncasecmp (c, "include", 7))
+      return false;
+
+  c += 7;
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  /* Find filename between quotes.  */
+  
+  quote = *c++;
+  if (quote != '"' && quote != '\'')
+    return false;
+
+  begin = c;
+
+  while (*c != quote && *c != '\0')
+    c++;
+
+  if (*c == '\0')
+    return false;
+
+  stop = c++;
+  
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  if (*c != '\0' && *c != '!')
+    return false;
+
+  /* We have an include line at this point. */
+
+  *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
+		   read by anything else.  */
+
+  load_file (begin, false);
+  return true;
+}
+
+/* Load a file into memory by calling load_line until the file ends.  */
+
+static try
+load_file (char *filename, bool initial)
+{
+  char line[GFC_MAX_LINE+1];
+  gfc_linebuf *b;
+  gfc_file *f;
+  FILE *input;
+  int len;
+
+  for (f = current_file; f; f = f->up)
+    if (strcmp (filename, f->filename) == 0)
+      {
+	gfc_error_now ("File '%s' is being included recursively", filename);
+	return FAILURE;
+      }
+
+  if (initial)
+    {
+      input = gfc_open_file (filename);
+      if (input == NULL)
+	{
+	  gfc_error_now ("Can't open file '%s'", filename);
+	  return FAILURE;
+	}
+    }
+  else
+    {
+      input = gfc_open_included_file (filename);
+      if (input == NULL)
+	{
+	  gfc_error_now ("Can't open included file '%s'", filename);
+	  return FAILURE;
+	}
+    }
 
   /* Load the file.  */
+
+  f = get_file (filename);
+  f->up = current_file;
+  current_file = f;
+  current_file->line = 1;
+
   for (;;) 
     {
-      load_line (input, fp->form, line, fp->filename, linenum);
-      linenum++;
+      load_line (input, line, filename, current_file->line);
 
       len = strlen (line);
-
       if (feof (input) && len == 0)
 	break;
 
-      /* See if we need another linebuf.  */
-      if (((char *) &lp->line[lp->lines + 2]) > linep - len - 1)
-	{
-	  lp->next = gfc_getmem (sizeof (linebuf));
+      /* There are three things this line can be: a line of Fortran
+	 source, an include line or a C preprocessor directive.  */
 
-	  lp->next->start_line = lp->start_line + lp->lines;
-	  lp = lp->next;
-	  lp->lines = 0;
+      if (line[0] == '#')
+	{
+	  preprocessor_line (line);
+	  continue;
+	}
 
-	  linep = (char *) (lp + 1);
+      if (include_line (line))
+	{
+	  current_file->line++;
+	  continue;
 	}
 
-      linep = linep - len - 1;
-      lp->line[lp->lines++] = linep;
-      strcpy (linep, line);
+      /* Add line.  */
+
+      b = gfc_getmem (sizeof (gfc_linebuf) + len + 1);
+
+      b->linenum = current_file->line++;
+      b->file = current_file;
+      strcpy (b->line, line);
+
+      if (line_head == NULL)
+	line_head = b;
+      else
+	line_tail->next = b;
+
+      line_tail = b;
     }
+
+  fclose (input);
+
+  current_file = current_file->up;
+  return SUCCESS;
 }
 
 
@@ -982,92 +1087,52 @@ form_from_filename (const char *filename)
 }
 
 
-/* Open a new file and start scanning from that file.  Every new file
-   gets a gfc_file node, even if it is a duplicate file.  Returns SUCCESS
-   if everything went OK, FAILURE otherwise.  */
+/* Open a new file and start scanning from that file. Returns SUCCESS
+   if everything went OK, FAILURE otherwise.  If form == FORM_UKNOWN
+   it tries to determine the source form from the filename, defaulting
+   to free form.  */
 
 try
 gfc_new_file (const char *filename, gfc_source_form form)
 {
-  gfc_file *fp, *fp2;
-  FILE *input;
-  int len;
+  try result;
 
-  len = strlen (filename);
-  if (len > PATH_MAX)
+  if (filename != NULL)
     {
-      gfc_error_now ("Filename '%s' is too long- ignoring it", filename);
-      return FAILURE;
-    }
-
-  fp = gfc_getmem (sizeof (gfc_file));
-
-  /* Make sure this file isn't being included recursively.  */
-  for (fp2 = gfc_current_file; fp2; fp2 = fp2->included_by)
-    if (strcmp (filename, fp2->filename) == 0)
-      {
-	gfc_error_now ("Recursive inclusion of file '%s' at %C- ignoring it",
-		       filename);
-	gfc_free (fp);
-	return FAILURE;
+      gfc_source_file = gfc_getmem (strlen (filename) + 1);
+      strcpy (gfc_source_file, filename);
     }
-
-  /* See if the file has already been included.  */
-  for (fp2 = first_file; fp2; fp2 = fp2->next)
-    if (strcmp (filename, fp2->filename) == 0)
-      {
-	*fp = *fp2;
-	fp->next = first_duplicated_file;
-	first_duplicated_file = fp;
-	goto init_fp;
-      }
-
-  strcpy (fp->filename, filename);
-
-  if (gfc_current_file == NULL)
-    input = gfc_open_file (filename);
   else
-    input = gfc_open_included_file (filename);
-
-  if (input == NULL)
-    {
-      if (gfc_current_file == NULL)
-	gfc_error_now ("Can't open file '%s'", filename);
-      else
-	gfc_error_now ("Can't open file '%s' included at %C", filename);
-
-      gfc_free (fp);
-      return FAILURE;
-    }
+    gfc_source_file = NULL;
 
   /* Decide which form the file will be read in as.  */
+
   if (form != FORM_UNKNOWN)
-    fp->form = form;
+    gfc_current_form = form;
   else
     {
-      fp->form = form_from_filename (filename);
+      gfc_current_form = form_from_filename (filename);
 
-      if (fp->form == FORM_UNKNOWN)
+      if (gfc_current_form == FORM_UNKNOWN)
 	{
-	  fp->form = FORM_FREE;
-	  gfc_warning_now ("Reading file %s as free form", filename);
+	  gfc_current_form = FORM_FREE;
+	  gfc_warning_now ("Reading file '%s' as free form.", 
+			   (filename[0] == '\0') ? "<stdin>" : filename); 
 	}
     }
 
-  fp->next = first_file;
-  first_file = fp;
+  result = load_file (gfc_source_file, true);
 
-  load_file (input, fp);
-  fclose (input);
+  gfc_current_locus1.lb = line_head;
+  gfc_current_locus1.nextc = (line_head == NULL) ? NULL : line_head->line;
 
-init_fp:
-  fp->included_by = gfc_current_file;
-  gfc_current_file = fp;
+#if 0 /* Debugging aid.  */
+  for (; line_head; line_head = line_head->next)
+    gfc_status ("%s:%3d %s\n", line_head->file->filename, 
+		line_head->linenum, line_head->line);
 
-  fp->loc.line = 0;
-  fp->loc.lp = fp->start;
-  fp->loc.nextc = fp->start->line[0];
-  fp->loc.file = fp;
+  exit (0);
+#endif
 
-  return SUCCESS;
+  return result;
 }

gcc/fortran/trans-decl.c

@@ -244,8 +244,8 @@ gfc_get_label_decl (gfc_st_label * lp)
       /* Tell the debugger where the label came from.  */
       if (lp->value <= MAX_LABEL_VALUE)	/* An internal label */
 	{
-	  DECL_SOURCE_LINE (label_decl) = lp->where.line;
-	  DECL_SOURCE_FILE (label_decl) = lp->where.file->filename;
+	  DECL_SOURCE_LINE (label_decl) = lp->where.lb->linenum;
+	  DECL_SOURCE_FILE (label_decl) = lp->where.lb->file->filename;
 	}
       else
 	DECL_ARTIFICIAL (label_decl) = 1;

gcc/fortran/trans-io.c

@@ -500,13 +500,13 @@ set_error_locus (stmtblock_t * block, locus * where)
   tree tmp;
   int line;
 
-  f = where->file;
+  f = where->lb->file;
   tmp = gfc_build_string_const (strlen (f->filename) + 1, f->filename);
 
   tmp = gfc_build_addr_expr (pchar_type_node, tmp);
   gfc_add_modify_expr (block, locus_file, tmp);
 
-  line = where->lp->start_line + where->line;
+  line = where->lb->linenum;
   gfc_add_modify_expr (block, locus_line, build_int_2 (line, 0));
 }
 

gcc/fortran/trans.c

@@ -414,8 +414,9 @@ gfc_add_block_to_block (stmtblock_t * block, stmtblock_t * append)
 void
 gfc_get_backend_locus (locus * loc)
 {
-  loc->line = input_line - 1;
-  loc->file = gfc_current_backend_file;
+  loc->lb = gfc_getmem (sizeof (gfc_linebuf));    
+  loc->lb->linenum = input_line - 1;
+  loc->lb->file = gfc_current_backend_file;
 }
 
 
@@ -424,9 +425,9 @@ gfc_get_backend_locus (locus * loc)
 void
 gfc_set_backend_locus (locus * loc)
 {
-  input_line = loc->line + 1;
-  gfc_current_backend_file = loc->file;
-  input_filename = loc->file->filename;
+  input_line = loc->lb->linenum;
+  gfc_current_backend_file = loc->lb->file;
+  input_filename = loc->lb->file->filename;
 }