This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] Scanner rewrite, fix for PR13702
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>,patch <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 11 May 2004 19:35:51 +0200
- Subject: [gfortran] Scanner rewrite, fix for PR13702
Hi,
this is the rewrite of the scanner and file handling that I ported from
Andy's tree. It brings the following goodies:
1. preprocessing directives are parsed and correctly interpreted
2. enforces that 'include' be on a single line
3. minor simplifications in parse.c
4. Makes gfc_current_locus and gfc_set_locus functions obsolete,
replacing them with accesses to global variables instead. Removing them
is left to a follow-up patch, as it touches many files and I wanted to
keep this patch as much contained in scanner.c as possible.
Compiled and regtested with no new regressions. Together with the
follow-up patch to remove gfc_current_locus() this has also passed
Steve's testsuite without new failures, giving (seemingly) better
diagnosis in several cases. I also had this in my local tree for some
time with no problems.
Changelog below, patch attached.
- Tobi
2004-05-11 Tobias Schlüter <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.
Index: error.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/error.c,v
retrieving revision 1.1.2.2
diff -u -p -r1.1.2.2 error.c
--- error.c 4 Jan 2004 12:59:48 -0000 1.1.2.2
+++ error.c 11 May 2004 15:22:24 -0000
@@ -117,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;
@@ -126,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;
@@ -189,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;
@@ -202,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;
Index: gfortran.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/gfortran.h,v
retrieving revision 1.1.2.12
diff -u -p -r1.1.2.12 gfortran.h
--- gfortran.h 4 Apr 2004 23:27:49 -0000 1.1.2.12
+++ gfortran.h 11 May 2004 15:02:12 -0000
@@ -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 *included_by, *next, *up;
+ int inclusion_line, line;
+ char *filename;
+} gfc_file;
+
+typedef struct gfc_linebuf
+{
+ int linenum;
struct gfc_file *file;
-}
-locus;
+ struct gfc_linebuf *next;
-/* 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. */
-
-/* Chosen so that sizeof(linebuf) = 4096 on most machines */
-#define LINEBUF_SIZE 4080
-
-typedef struct linebuf
-{
- int start_line, lines;
- struct linebuf *next;
- char *line[1];
- char buf[LINEBUF_SIZE];
-}
-linebuf;
+ char line[];
+} gfc_linebuf;
+
+typedef struct
+{
+ 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 +1304,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;
Index: lang-specs.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/lang-specs.h,v
retrieving revision 1.1.2.4
diff -u -p -r1.1.2.4 lang-specs.h
--- lang-specs.h 17 Jan 2004 19:33:46 -0000 1.1.2.4
+++ lang-specs.h 11 May 2004 15:02:33 -0000
@@ -1,35 +1,35 @@
/* Contribution to the specs for the GNU Compiler Collection
from GNU Fortran 95 compiler.
- Copyright (C) 2002,2004 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
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},
Index: match.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/match.c,v
retrieving revision 1.1.2.8
diff -u -p -r1.1.2.8 match.c
--- match.c 11 Jan 2004 15:21:50 -0000 1.1.2.8
+++ match.c 11 May 2004 15:02:33 -0000
@@ -76,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 ();
@@ -336,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;
Index: module.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/module.c,v
retrieving revision 1.1.2.3
diff -u -p -r1.1.2.3 module.c
--- module.c 10 Aug 2003 00:33:50 -0000 1.1.2.3
+++ module.c 11 May 2004 15:02:35 -0000
@@ -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 d
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;
Index: parse.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/parse.c,v
retrieving revision 1.1.2.4
diff -u -p -r1.1.2.4 parse.c
--- parse.c 1 Jan 2004 12:09:12 -0000 1.1.2.4
+++ parse.c 11 May 2004 15:02:39 -0000
@@ -474,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;
@@ -491,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;
}
@@ -1259,7 +1260,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;
Index: scanner.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/scanner.c,v
retrieving revision 1.1.2.2
diff -u -p -r1.1.2.2 scanner.c
--- scanner.c 2 Aug 2003 00:26:48 -0000 1.1.2.2
+++ scanner.c 11 May 2004 15:02:53 -0000
@@ -60,21 +60,26 @@ gfc_directorylist;
/* List of include file search directories. */
static gfc_directorylist *include_dirs;
-static gfc_file *first_file, *first_duplicated_file;
-static int continue_flag, end_flag;
+static gfc_file *file_head, *current_file;
-gfc_file *gfc_current_file;
+static int continue_flag, end_flag;
+gfc_source_form gfc_current_form;
+static gfc_linebuf *line_head, *line_tail;
+
+locus gfc_current_locus1;
+char *gfc_source_file;
+
/* Main scanner initialization. */
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)
+ while(line_head != NULL)
{
-
- 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)
- {
- lp2 = lp->next;
- gfc_free (lp);
- }
- }
-
- fp2 = fp->next;
- gfc_free (fp);
+ lb = line_head->next;
+ gfc_free(line_head);
+ line_head = lb;
+ }
+
+ while(file_head != NULL)
+ {
+ f = file_head->next;
+ gfc_free(file_head->filename);
+ gfc_free(file_head);
+ file_head = f;
}
- for (fp = first_duplicated_file; fp; fp = fp2)
- {
- fp2 = fp->next;
- gfc_free (fp);
- }
}
@@ -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)
- return;
-
- if (++locp->line >= lp->lines)
+ if (gfc_current_locus1.lb == NULL)
{
- locp->lp = lp = lp->next;
- if (lp == NULL)
- return; /* End of this file */
+ end_flag = 1;
+ return;
+ }
- locp->line = 0;
- }
+ gfc_current_locus1.lb = gfc_current_locus1.lb->next;
- locp->nextc = lp->line[locp->line];
+ if (gfc_current_locus1.lb != NULL)
+ gfc_current_locus1.nextc = gfc_current_locus1.lb->line;
+ else
+ {
+ gfc_current_locus1.nextc = NULL;
+ end_flag = 1;
+ }
}
@@ -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 ())
- return '\n';
-
- if (gfc_current_file->included_by == NULL)
- end_flag = 1;
-
- return '\n';
- }
-
- locp = &gfc_current_file->loc;
- if (locp->nextc == NULL)
+
+ if (gfc_current_locus1.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
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
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
}
-/* 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;
+ }
- fp->start = lp = gfc_getmem (sizeof (linebuf));
+ line = atoi (c);
- linenum = 1;
- lp->lines = 0;
- lp->start_line = 1;
- lp->next = NULL;
+ c = strchr (c, ' ') + 2; /* Skip space and quote. */
+ filename = c;
- linep = (char *) (lp + 1);
+ c = strchr (c, '"'); /* Make filename end at quote. */
+ *c++ = '\0';
+
+ /* Get flags. */
+
+ flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
- /* Load the file. */
for (;;)
{
- load_line (input, fp->form, line, fp->filename, linenum);
- linenum++;
+ c = strchr (c, ' ');
+ if (c == NULL)
+ break;
- len = strlen (line);
+ 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, 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;
+ gfc_source_file = gfc_getmem (strlen (filename) + 1);
+ strcpy (gfc_source_file, filename);
}
-
- 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;
- }
-
- /* 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;
-
- fp->loc.line = 0;
- fp->loc.lp = fp->start;
- fp->loc.nextc = fp->start->line[0];
- fp->loc.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);
- return SUCCESS;
+ exit (0);
+#endif
+
+ return result;
}
Index: trans-decl.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/trans-decl.c,v
retrieving revision 1.1.2.37
diff -u -p -r1.1.2.37 trans-decl.c
--- trans-decl.c 24 Apr 2004 12:19:27 -0000 1.1.2.37
+++ trans-decl.c 11 May 2004 15:03:16 -0000
@@ -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;
Index: trans-io.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/trans-io.c,v
retrieving revision 1.1.2.11
diff -u -p -r1.1.2.11 trans-io.c
--- trans-io.c 24 Apr 2004 14:28:36 -0000 1.1.2.11
+++ trans-io.c 11 May 2004 15:03:32 -0000
@@ -500,13 +500,13 @@ set_error_locus (stmtblock_t * block, lo
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));
}
Index: trans.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/trans.c,v
retrieving revision 1.1.2.12
diff -u -p -r1.1.2.12 trans.c
--- trans.c 16 Feb 2004 12:36:08 -0000 1.1.2.12
+++ trans.c 11 May 2004 15:03:36 -0000
@@ -414,8 +414,9 @@ gfc_add_block_to_block (stmtblock_t * bl
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;
}