OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Tobias Schlüter 2004-05-15 19:31:32 +02:00 committed by Tobias Schlüter
parent 39ae2b013a
commit d4fa05b90d
11 changed files with 455 additions and 351 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
gcc/fortran/ChangeLog
View File

@ -1,3 +1,53 @@
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.

28
gcc/fortran/error.c
View File

@ -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;

74
gcc/fortran/gfortran.h
View File

@ -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
{
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;
struct gfc_linebuf *next;
char line[];
} gfc_linebuf;
typedef struct
{
char *nextc;
int line; /* line within the lp structure */
struct linebuf *lp;
struct gfc_file *file;
}
locus;
/* 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;
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;

32
gcc/fortran/lang-specs.h
View File

@ -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},

4
gcc/fortran/match.c
View File

@ -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;

9
gcc/fortran/module.c
View File

@ -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;

15
gcc/fortran/parse.c
View File

@ -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;

575
gcc/fortran/scanner.c
View File

@ -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 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. */
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 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;
fp->start = lp = gfc_getmem (sizeof (linebuf));
c++;
while (*c == ' ' || *c == '\t')
c++;
linenum = 1;
lp->lines = 0;
lp->start_line = 1;
lp->next = NULL;
if (*c < '0' || *c > '9')
{
gfc_warning_now ("%s:%d Unknown preprocessor directive",
current_file->filename, current_file->line);
current_file->line++;
return;
}
linep = (char *) (lp + 1);
line = atoi (c);
c = strchr (c, ' ') + 2; /* Skip space and quote. */
filename = c;
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;
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)
/* There are three things this line can be: a line of Fortran
source, an include line or a C preprocessor directive. */
if (line[0] == '#')
{
lp->next = gfc_getmem (sizeof (linebuf));
lp->next->start_line = lp->start_line + lp->lines;
lp = lp->next;
lp->lines = 0;
linep = (char *) (lp + 1);
preprocessor_line (line);
continue;
}
linep = linep - len - 1;
lp->line[lp->lines++] = linep;
strcpy (linep, line);
if (include_line (line))
{
current_file->line++;
continue;
}
/* 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;
#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;
}

4
gcc/fortran/trans-decl.c
View File

@ -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;

4
gcc/fortran/trans-io.c
View File

@ -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));
}

11
gcc/fortran/trans.c
View File

@ -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;
}