diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 50 | ||||
| -rw-r--r-- | gcc/fortran/error.c | 28 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 70 | ||||
| -rw-r--r-- | gcc/fortran/lang-specs.h | 32 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 9 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 15 | ||||
| -rw-r--r-- | gcc/fortran/scanner.c | 571 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans-io.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans.c | 11 |
11 files changed, 451 insertions, 347 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 586ddb61104..a1542b5db3e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,55 @@ 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. diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 260733c8af4..b7b0fdb1bf6 100644 --- a/gcc/fortran/error.c +++ b/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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 627eb8df96b..498e63b6c9b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -413,35 +413,40 @@ typedef struct symbol_attribute; -typedef struct -{ - char *nextc; - int line; /* line within the lp structure */ - struct linebuf *lp; - struct gfc_file *file; -} -locus; +/* 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 -/* 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. */ + gfc_linebuf holds a single line of source code and information + which file it resides in -/* Chosen so that sizeof(linebuf) = 4096 on most machines */ -#define LINEBUF_SIZE 4080 + locus point to the sourceline and the character in the source + line. +*/ -typedef struct linebuf +typedef struct gfc_file { - int start_line, lines; - struct linebuf *next; - char *line[1]; - char buf[LINEBUF_SIZE]; -} -linebuf; + 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; + 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; diff --git a/gcc/fortran/lang-specs.h b/gcc/fortran/lang-specs.h index f1828e2ad19..b18483f5c23 100644 --- a/gcc/fortran/lang-specs.h +++ b/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}, diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index c13e0579585..dc8dc3e7333 100644 --- a/gcc/fortran/match.c +++ b/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; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 566e3f330c7..1143705a1d9 100644 --- a/gcc/fortran/module.c +++ b/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; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index beec9d622ba..dea613bce77 100644 --- a/gcc/fortran/parse.c +++ b/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; diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 34959ab92fe..a16c2749ce8 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -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; } - - 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) - 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; - 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; +#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; } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b345ed99c8e..e4f564cbf67 100644 --- a/gcc/fortran/trans-decl.c +++ b/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; diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 24f403d90b3..c0570fc8575 100644 --- a/gcc/fortran/trans-io.c +++ b/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)); } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 39a63415539..267391c1c38 100644 --- a/gcc/fortran/trans.c +++ b/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; } |
