2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
3 Free Software Foundation, Inc.
4 Contributed by Andy Vaught
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
22 /* Set of subroutines to (ultimately) return the next character to the
23 various matching subroutines. This file's job is to read files and
24 build up lines that are parsed by the parser. This means that we
25 handle continuation lines and "include" lines.
27 The first thing the scanner does is to load an entire file into
28 memory. We load the entire file into memory for a couple reasons.
29 The first is that we want to be able to deal with nonseekable input
30 (pipes, stdin) and there is a lot of backing up involved during
33 The second is that we want to be able to print the locus of errors,
34 and an error on line 999999 could conflict with something on line
35 one. Given nonseekable input, we've got to store the whole thing.
37 One thing that helps are the column truncation limits that give us
38 an upper bound on the size of individual lines. We don't store the
41 From the scanner's viewpoint, the higher level subroutines ask for
42 new characters and do a lot of jumping backwards. */
51 /* Structure for holding module and include file search path. */
52 typedef struct gfc_directorylist
56 struct gfc_directorylist *next;
60 /* List of include file search directories. */
61 static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
63 static gfc_file *file_head, *current_file;
65 static int continue_flag, end_flag, openmp_flag;
66 static int continue_count, continue_line;
67 static locus openmp_locus;
69 gfc_source_form gfc_current_form;
70 static gfc_linebuf *line_head, *line_tail;
72 locus gfc_current_locus;
73 const char *gfc_source_file;
74 static FILE *gfc_src_file;
75 static char *gfc_src_preprocessor_lines[2];
79 /* Main scanner initialization. */
82 gfc_scanner_init_1 (void)
95 /* Main scanner destructor. */
98 gfc_scanner_done_1 (void)
103 while(line_head != NULL)
105 lb = line_head->next;
110 while(file_head != NULL)
113 gfc_free(file_head->filename);
120 /* Adds path to the list pointed to by list. */
123 add_path_to_list (gfc_directorylist **list, const char *path,
124 bool use_for_modules)
126 gfc_directorylist *dir;
130 while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
136 dir = *list = gfc_getmem (sizeof (gfc_directorylist));
142 dir->next = gfc_getmem (sizeof (gfc_directorylist));
147 dir->use_for_modules = use_for_modules;
148 dir->path = gfc_getmem (strlen (p) + 2);
149 strcpy (dir->path, p);
150 strcat (dir->path, "/"); /* make '/' last character */
155 gfc_add_include_path (const char *path, bool use_for_modules)
157 add_path_to_list (&include_dirs, path, use_for_modules);
162 gfc_add_intrinsic_modules_path (const char *path)
164 add_path_to_list (&intrinsic_modules_dirs, path, true);
168 /* Release resources allocated for options. */
171 gfc_release_include_path (void)
173 gfc_directorylist *p;
175 while (include_dirs != NULL)
178 include_dirs = include_dirs->next;
183 while (intrinsic_modules_dirs != NULL)
185 p = intrinsic_modules_dirs;
186 intrinsic_modules_dirs = intrinsic_modules_dirs->next;
191 gfc_free (gfc_option.module_dir);
196 open_included_file (const char *name, gfc_directorylist *list, bool module)
199 gfc_directorylist *p;
202 for (p = list; p; p = p->next)
204 if (module && !p->use_for_modules)
207 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
208 strcpy (fullname, p->path);
209 strcat (fullname, name);
211 f = gfc_open_file (fullname);
220 /* Opens file for reading, searching through the include directories
221 given if necessary. If the include_cwd argument is true, we try
222 to open the file in the current directory first. */
225 gfc_open_included_file (const char *name, bool include_cwd, bool module)
229 if (IS_ABSOLUTE_PATH (name))
230 return gfc_open_file (name);
234 f = gfc_open_file (name);
239 return open_included_file (name, include_dirs, module);
243 gfc_open_intrinsic_module (const char *name)
245 if (IS_ABSOLUTE_PATH (name))
246 return gfc_open_file (name);
248 return open_included_file (name, intrinsic_modules_dirs, true);
252 /* Test to see if we're at the end of the main source file. */
261 /* Test to see if we're at the end of the current file. */
269 if (line_head == NULL)
270 return 1; /* Null file */
272 if (gfc_current_locus.lb == NULL)
279 /* Test to see if we're at the beginning of a new line. */
287 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
291 /* Test to see if we're at the end of a line. */
299 return (*gfc_current_locus.nextc == '\0');
303 /* Advance the current line pointer to the next line. */
306 gfc_advance_line (void)
311 if (gfc_current_locus.lb == NULL)
317 if (gfc_current_locus.lb->next
318 && gfc_current_locus.lb->next->file != gfc_current_locus.lb->file)
320 if (gfc_current_locus.lb->next->file
321 && !gfc_current_locus.lb->next->dbg_emitted
322 && gfc_current_locus.lb->file->up == gfc_current_locus.lb->next->file)
324 /* We exit from an included file. */
325 (*debug_hooks->end_source_file)
326 (gfc_linebuf_linenum (gfc_current_locus.lb->next));
327 gfc_current_locus.lb->next->dbg_emitted = true;
329 else if (gfc_current_locus.lb->next->file != gfc_current_locus.lb->file
330 && !gfc_current_locus.lb->next->dbg_emitted)
332 /* We enter into a new file. */
333 (*debug_hooks->start_source_file)
334 (gfc_linebuf_linenum (gfc_current_locus.lb),
335 gfc_current_locus.lb->next->file->filename);
336 gfc_current_locus.lb->next->dbg_emitted = true;
340 gfc_current_locus.lb = gfc_current_locus.lb->next;
342 if (gfc_current_locus.lb != NULL)
343 gfc_current_locus.nextc = gfc_current_locus.lb->line;
346 gfc_current_locus.nextc = NULL;
352 /* Get the next character from the input, advancing gfc_current_file's
353 locus. When we hit the end of the line or the end of the file, we
354 start returning a '\n' in order to complete the current statement.
355 No Fortran line conventions are implemented here.
357 Requiring explicit advances to the next line prevents the parse
358 pointer from being on the wrong line if the current statement ends
366 if (gfc_current_locus.nextc == NULL)
369 c = (unsigned char) *gfc_current_locus.nextc++;
372 gfc_current_locus.nextc--; /* Remain on this line. */
380 /* Skip a comment. When we come here the parse pointer is positioned
381 immediately after the comment character. If we ever implement
382 compiler directives withing comments, here is where we parse the
386 skip_comment_line (void)
401 gfc_define_undef_line (void)
403 /* All lines beginning with '#' are either #define or #undef. */
404 if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_char () != '#')
407 if (strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
408 (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
409 &(gfc_current_locus.nextc[8]));
411 if (strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
412 (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
413 &(gfc_current_locus.nextc[7]));
415 /* Skip the rest of the line. */
416 skip_comment_line ();
422 /* Comment lines are null lines, lines containing only blanks or lines
423 on which the first nonblank line is a '!'.
424 Return true if !$ openmp conditional compilation sentinel was
428 skip_free_comments (void)
436 at_bol = gfc_at_bol ();
437 start = gfc_current_locus;
443 while (gfc_is_whitespace (c));
453 /* If -fopenmp, we need to handle here 2 things:
454 1) don't treat !$omp as comments, but directives
455 2) handle OpenMP conditional compilation, where
456 !$ should be treated as 2 spaces (for initial lines
457 only if followed by space). */
458 if (gfc_option.flag_openmp && at_bol)
460 locus old_loc = gfc_current_locus;
461 if (next_char () == '$')
464 if (c == 'o' || c == 'O')
466 if (((c = next_char ()) == 'm' || c == 'M')
467 && ((c = next_char ()) == 'p' || c == 'P'))
469 if ((c = next_char ()) == ' ' || continue_flag)
471 while (gfc_is_whitespace (c))
473 if (c != '\n' && c != '!')
476 openmp_locus = old_loc;
477 gfc_current_locus = start;
482 gfc_warning_now ("!$OMP at %C starts a commented "
483 "line as it neither is followed "
484 "by a space nor is a "
485 "continuation line");
487 gfc_current_locus = old_loc;
491 if (continue_flag || c == ' ')
493 gfc_current_locus = old_loc;
499 gfc_current_locus = old_loc;
501 skip_comment_line ();
508 if (openmp_flag && at_bol)
510 gfc_current_locus = start;
515 /* Skip comment lines in fixed source mode. We have the same rules as
516 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
517 in column 1, and a '!' cannot be in column 6. Also, we deal with
518 lines with 'd' or 'D' in column 1, if the user requested this. */
521 skip_fixed_comments (void)
529 start = gfc_current_locus;
534 while (gfc_is_whitespace (c));
539 skip_comment_line ();
544 gfc_current_locus = start;
551 start = gfc_current_locus;
562 if (c == '!' || c == 'c' || c == 'C' || c == '*')
564 /* If -fopenmp, we need to handle here 2 things:
565 1) don't treat !$omp|c$omp|*$omp as comments, but directives
566 2) handle OpenMP conditional compilation, where
567 !$|c$|*$ should be treated as 2 spaces if the characters
568 in columns 3 to 6 are valid fixed form label columns
570 if (gfc_option.flag_openmp)
572 if (next_char () == '$')
575 if (c == 'o' || c == 'O')
577 if (((c = next_char ()) == 'm' || c == 'M')
578 && ((c = next_char ()) == 'p' || c == 'P'))
582 && ((openmp_flag && continue_flag)
583 || c == ' ' || c == '0'))
586 while (gfc_is_whitespace (c))
588 if (c != '\n' && c != '!')
590 /* Canonicalize to *$omp. */
593 gfc_current_locus = start;
603 for (col = 3; col < 6; col++, c = next_char ())
606 else if (c < '0' || c > '9')
611 if (col == 6 && c != '\n'
612 && ((continue_flag && !digit_seen)
613 || c == ' ' || c == '0'))
615 gfc_current_locus = start;
616 start.nextc[0] = ' ';
617 start.nextc[1] = ' ';
622 gfc_current_locus = start;
624 skip_comment_line ();
628 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
630 if (gfc_option.flag_d_lines == 0)
632 skip_comment_line ();
636 *start.nextc = c = ' ';
641 while (gfc_is_whitespace (c))
653 if (col != 6 && c == '!')
655 skip_comment_line ();
663 gfc_current_locus = start;
667 /* Skips the current line if it is a comment. */
670 gfc_skip_comments (void)
672 if (gfc_current_form == FORM_FREE)
673 skip_free_comments ();
675 skip_fixed_comments ();
679 /* Get the next character from the input, taking continuation lines
680 and end-of-line comments into account. This implies that comment
681 lines between continued lines must be eaten here. For higher-level
682 subroutines, this flattens continued lines into a single logical
683 line. The in_string flag denotes whether we're inside a character
687 gfc_next_char_literal (int in_string)
690 int i, c, prev_openmp_flag;
702 if (gfc_current_form == FORM_FREE)
704 bool openmp_cond_flag;
706 if (!in_string && c == '!')
709 && memcmp (&gfc_current_locus, &openmp_locus,
710 sizeof (gfc_current_locus)) == 0)
713 /* This line can't be continued */
720 /* Avoid truncation warnings for comment ending lines. */
721 gfc_current_locus.lb->truncated = 0;
729 /* If the next nonblank character is a ! or \n, we've got a
730 continuation line. */
731 old_loc = gfc_current_locus;
734 while (gfc_is_whitespace (c))
737 /* Character constants to be continued cannot have commentary
740 if (in_string && c != '\n')
742 gfc_current_locus = old_loc;
747 if (c != '!' && c != '\n')
749 gfc_current_locus = old_loc;
754 prev_openmp_flag = openmp_flag;
757 skip_comment_line ();
762 goto not_continuation;
764 /* We've got a continuation line. If we are on the very next line after
765 the last continuation, increment the continuation line count and
766 check whether the limit has been exceeded. */
767 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
769 if (++continue_count == gfc_option.max_continue_free)
771 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
772 gfc_warning ("Limit of %d continuations exceeded in "
773 "statement at %C", gfc_option.max_continue_free);
776 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
778 /* Now find where it continues. First eat any comment lines. */
779 openmp_cond_flag = skip_free_comments ();
781 if (prev_openmp_flag != openmp_flag)
783 gfc_current_locus = old_loc;
784 openmp_flag = prev_openmp_flag;
789 /* Now that we have a non-comment line, probe ahead for the
790 first non-whitespace character. If it is another '&', then
791 reading starts at the next character, otherwise we must back
792 up to where the whitespace started and resume from there. */
794 old_loc = gfc_current_locus;
797 while (gfc_is_whitespace (c))
802 for (i = 0; i < 5; i++, c = next_char ())
804 gcc_assert (TOLOWER (c) == "!$omp"[i]);
806 old_loc = gfc_current_locus;
808 while (gfc_is_whitespace (c))
816 if (gfc_option.warn_ampersand)
817 gfc_warning_now ("Missing '&' in continued character "
819 gfc_current_locus.nextc--;
821 /* Both !$omp and !$ -fopenmp continuation lines have & on the
822 continuation line only optionally. */
823 else if (openmp_flag || openmp_cond_flag)
824 gfc_current_locus.nextc--;
828 gfc_current_locus = old_loc;
835 /* Fixed form continuation. */
836 if (!in_string && c == '!')
838 /* Skip comment at end of line. */
845 /* Avoid truncation warnings for comment ending lines. */
846 gfc_current_locus.lb->truncated = 0;
852 prev_openmp_flag = openmp_flag;
854 old_loc = gfc_current_locus;
857 skip_fixed_comments ();
859 /* See if this line is a continuation line. */
860 if (openmp_flag != prev_openmp_flag)
862 openmp_flag = prev_openmp_flag;
863 goto not_continuation;
867 for (i = 0; i < 5; i++)
871 goto not_continuation;
874 for (i = 0; i < 5; i++)
877 if (TOLOWER (c) != "*$omp"[i])
878 goto not_continuation;
882 if (c == '0' || c == ' ' || c == '\n')
883 goto not_continuation;
885 /* We've got a continuation line. If we are on the very next line after
886 the last continuation, increment the continuation line count and
887 check whether the limit has been exceeded. */
888 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
890 if (++continue_count == gfc_option.max_continue_fixed)
892 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
893 gfc_warning ("Limit of %d continuations exceeded in "
895 gfc_option.max_continue_fixed);
899 if (continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
900 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
903 /* Ready to read first character of continuation line, which might
904 be another continuation line! */
909 gfc_current_locus = old_loc;
919 /* Get the next character of input, folded to lowercase. In fixed
920 form mode, we also ignore spaces. When matcher subroutines are
921 parsing character literals, they have to call
922 gfc_next_char_literal(). */
931 c = gfc_next_char_literal (0);
933 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
945 old_loc = gfc_current_locus;
946 c = gfc_next_char ();
947 gfc_current_locus = old_loc;
953 /* Recover from an error. We try to get past the current statement
954 and get lined up for the next. The next statement follows a '\n'
955 or a ';'. We also assume that we are not within a character
956 constant, and deal with finding a '\'' or '"'. */
959 gfc_error_recovery (void)
968 c = gfc_next_char ();
969 if (c == '\n' || c == ';')
972 if (c != '\'' && c != '"')
1001 /* Read ahead until the next character to be read is not whitespace. */
1004 gfc_gobble_whitespace (void)
1006 static int linenum = 0;
1012 old_loc = gfc_current_locus;
1013 c = gfc_next_char_literal (0);
1014 /* Issue a warning for nonconforming tabs. We keep track of the line
1015 number because the Fortran matchers will often back up and the same
1016 line will be scanned multiple times. */
1017 if (!gfc_option.warn_tabs && c == '\t')
1019 #ifdef USE_MAPPED_LOCATION
1020 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
1022 int cur_linenum = gfc_current_locus.lb->linenum;
1024 if (cur_linenum != linenum)
1026 linenum = cur_linenum;
1027 gfc_warning_now ("Nonconforming tab character at %C");
1031 while (gfc_is_whitespace (c));
1033 gfc_current_locus = old_loc;
1037 /* Load a single line into pbuf.
1039 If pbuf points to a NULL pointer, it is allocated.
1040 We truncate lines that are too long, unless we're dealing with
1041 preprocessor lines or if the option -ffixed-line-length-none is set,
1042 in which case we reallocate the buffer to fit the entire line, if
1044 In fixed mode, we expand a tab that occurs within the statement
1045 label region to expand to spaces that leave the next character in
1047 load_line returns whether the line was truncated.
1049 NOTE: The error machinery isn't available at this point, so we can't
1050 easily report line and column numbers consistent with other
1051 parts of gfortran. */
1054 load_line (FILE *input, char **pbuf, int *pbuflen)
1056 static int linenum = 0, current_line = 1;
1057 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
1058 int trunc_flag = 0, seen_comment = 0;
1059 int seen_printable = 0, seen_ampersand = 0;
1062 /* Determine the maximum allowed line length. */
1063 if (gfc_current_form == FORM_FREE)
1064 maxlen = gfc_option.free_line_length;
1065 else if (gfc_current_form == FORM_FIXED)
1066 maxlen = gfc_option.fixed_line_length;
1072 /* Allocate the line buffer, storing its length into buflen.
1073 Note that if maxlen==0, indicating that arbitrary-length lines
1074 are allowed, the buffer will be reallocated if this length is
1075 insufficient; since 132 characters is the length of a standard
1076 free-form line, we use that as a starting guess. */
1082 *pbuf = gfc_getmem (buflen + 1);
1088 preprocessor_flag = 0;
1091 /* In order to not truncate preprocessor lines, we have to
1092 remember that this is one. */
1093 preprocessor_flag = 1;
1104 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1105 if (gfc_current_form == FORM_FREE
1106 && !seen_printable && seen_ampersand)
1109 gfc_error_now ("'&' not allowed by itself in line %d",
1112 gfc_warning_now ("'&' not allowed by itself in line %d",
1119 continue; /* Gobble characters. */
1131 if ((c != '&' && c != '!') || (c == '!' && !seen_ampersand))
1134 /* Is this a fixed-form comment? */
1135 if (gfc_current_form == FORM_FIXED && i == 0
1136 && (c == '*' || c == 'c' || c == 'd'))
1139 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
1141 if (!gfc_option.warn_tabs && seen_comment == 0
1142 && current_line != linenum)
1144 linenum = current_line;
1145 gfc_warning_now ("Nonconforming tab character in column 1 "
1146 "of line %d", linenum);
1161 if (maxlen == 0 || preprocessor_flag)
1165 /* Reallocate line buffer to double size to hold the
1167 buflen = buflen * 2;
1168 *pbuf = xrealloc (*pbuf, buflen + 1);
1169 buffer = (*pbuf) + i;
1172 else if (i >= maxlen)
1174 /* Truncate the rest of the line. */
1178 if (c == '\n' || c == EOF)
1184 ungetc ('\n', input);
1188 /* Pad lines to the selected line length in fixed form. */
1189 if (gfc_current_form == FORM_FIXED
1190 && gfc_option.fixed_line_length != 0
1191 && !preprocessor_flag
1194 while (i++ < maxlen)
1206 /* Get a gfc_file structure, initialize it and add it to
1210 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1214 f = gfc_getmem (sizeof (gfc_file));
1216 f->filename = gfc_getmem (strlen (name) + 1);
1217 strcpy (f->filename, name);
1219 f->next = file_head;
1222 f->included_by = current_file;
1223 if (current_file != NULL)
1224 f->inclusion_line = current_file->line;
1226 #ifdef USE_MAPPED_LOCATION
1227 linemap_add (line_table, reason, false, f->filename, 1);
1233 /* Deal with a line from the C preprocessor. The
1234 initial octothorp has already been seen. */
1237 preprocessor_line (char *c)
1243 int escaped, unescape;
1246 while (*c == ' ' || *c == '\t')
1249 if (*c < '0' || *c > '9')
1254 c = strchr (c, ' ');
1257 /* No file name given. Set new line number. */
1258 current_file->line = line;
1263 while (*c == ' ' || *c == '\t')
1273 /* Make filename end at quote. */
1276 while (*c && ! (!escaped && *c == '"'))
1280 else if (*c == '\\')
1289 /* Preprocessor line has no closing quote. */
1294 /* Undo effects of cpp_quote_string. */
1298 char *d = gfc_getmem (c - filename - unescape);
1314 flag[1] = flag[2] = flag[3] = flag[4] = false;
1318 c = strchr (c, ' ');
1325 if (1 <= i && i <= 4)
1329 /* Interpret flags. */
1331 if (flag[1]) /* Starting new file. */
1333 f = get_file (filename, LC_RENAME);
1334 f->up = current_file;
1338 if (flag[2]) /* Ending current file. */
1340 if (!current_file->up
1341 || strcmp (current_file->up->filename, filename) != 0)
1343 gfc_warning_now ("%s:%d: file %s left but not entered",
1344 current_file->filename, current_file->line,
1347 gfc_free (filename);
1351 current_file = current_file->up;
1352 #ifdef USE_MAPPED_LOCATION
1353 linemap_add (line_table, LC_RENAME, false, current_file->filename,
1354 current_file->line);
1358 /* The name of the file can be a temporary file produced by
1359 cpp. Replace the name if it is different. */
1361 if (strcmp (current_file->filename, filename) != 0)
1363 gfc_free (current_file->filename);
1364 current_file->filename = gfc_getmem (strlen (filename) + 1);
1365 strcpy (current_file->filename, filename);
1368 /* Set new line number. */
1369 current_file->line = line;
1371 gfc_free (filename);
1375 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1376 current_file->filename, current_file->line);
1377 current_file->line++;
1381 static try load_file (const char *, bool);
1383 /* include_line()-- Checks a line buffer to see if it is an include
1384 line. If so, we call load_file() recursively to load the included
1385 file. We never return a syntax error because a statement like
1386 "include = 5" is perfectly legal. We return false if no include was
1387 processed or true if we matched an include. */
1390 include_line (char *line)
1392 char quote, *c, *begin, *stop;
1396 if (gfc_option.flag_openmp)
1398 if (gfc_current_form == FORM_FREE)
1400 while (*c == ' ' || *c == '\t')
1402 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1407 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1408 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1413 while (*c == ' ' || *c == '\t')
1416 if (strncasecmp (c, "include", 7))
1420 while (*c == ' ' || *c == '\t')
1423 /* Find filename between quotes. */
1426 if (quote != '"' && quote != '\'')
1431 while (*c != quote && *c != '\0')
1439 while (*c == ' ' || *c == '\t')
1442 if (*c != '\0' && *c != '!')
1445 /* We have an include line at this point. */
1447 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1448 read by anything else. */
1450 load_file (begin, false);
1455 /* Load a file into memory by calling load_line until the file ends. */
1458 load_file (const char *filename, bool initial)
1467 for (f = current_file; f; f = f->up)
1468 if (strcmp (filename, f->filename) == 0)
1470 gfc_error_now ("File '%s' is being included recursively", filename);
1478 input = gfc_src_file;
1479 gfc_src_file = NULL;
1482 input = gfc_open_file (filename);
1485 gfc_error_now ("Can't open file '%s'", filename);
1491 input = gfc_open_included_file (filename, false, false);
1494 gfc_error_now ("Can't open included file '%s'", filename);
1499 /* Load the file. */
1501 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1502 f->up = current_file;
1504 current_file->line = 1;
1509 if (initial && gfc_src_preprocessor_lines[0])
1511 preprocessor_line (gfc_src_preprocessor_lines[0]);
1512 gfc_free (gfc_src_preprocessor_lines[0]);
1513 gfc_src_preprocessor_lines[0] = NULL;
1514 if (gfc_src_preprocessor_lines[1])
1516 preprocessor_line (gfc_src_preprocessor_lines[1]);
1517 gfc_free (gfc_src_preprocessor_lines[1]);
1518 gfc_src_preprocessor_lines[1] = NULL;
1524 int trunc = load_line (input, &line, &line_len);
1526 len = strlen (line);
1527 if (feof (input) && len == 0)
1530 /* If this is the first line of the file, it can contain a byte
1531 order mark (BOM), which we will ignore:
1532 FF FE is UTF-16 little endian,
1533 FE FF is UTF-16 big endian,
1534 EF BB BF is UTF-8. */
1536 && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE')
1537 || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF')
1538 || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB'
1539 && line[2] == '\xBF')))
1541 int n = line[1] == '\xBB' ? 3 : 2;
1542 char * new = gfc_getmem (line_len);
1544 strcpy (new, line + n);
1550 /* There are three things this line can be: a line of Fortran
1551 source, an include line or a C preprocessor directive. */
1555 /* When -g3 is specified, it's possible that we emit #define
1556 and #undef lines, which we need to pass to the middle-end
1557 so that it can emit correct debug info. */
1558 if (debug_info_level == DINFO_LEVEL_VERBOSE
1559 && (strncmp (line, "#define ", 8) == 0
1560 || strncmp (line, "#undef ", 7) == 0))
1564 preprocessor_line (line);
1569 /* Preprocessed files have preprocessor lines added before the byte
1570 order mark, so first_line is not about the first line of the file
1571 but the first line that's not a preprocessor line. */
1574 if (include_line (line))
1576 current_file->line++;
1582 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1584 #ifdef USE_MAPPED_LOCATION
1586 = linemap_line_start (line_table, current_file->line++, 120);
1588 b->linenum = current_file->line++;
1590 b->file = current_file;
1591 b->truncated = trunc;
1592 strcpy (b->line, line);
1594 if (line_head == NULL)
1597 line_tail->next = b;
1602 /* Release the line buffer allocated in load_line. */
1607 current_file = current_file->up;
1608 #ifdef USE_MAPPED_LOCATION
1609 linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
1615 /* Open a new file and start scanning from that file. Returns SUCCESS
1616 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1617 it tries to determine the source form from the filename, defaulting
1625 result = load_file (gfc_source_file, true);
1627 gfc_current_locus.lb = line_head;
1628 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1630 #if 0 /* Debugging aid. */
1631 for (; line_head; line_head = line_head->next)
1632 gfc_status ("%s:%3d %s\n",
1633 #ifdef USE_MAPPED_LOCATION
1634 LOCATION_FILE (line_head->location),
1635 LOCATION_LINE (line_head->location),
1637 line_head->file->filename,
1649 unescape_filename (const char *ptr)
1651 const char *p = ptr, *s;
1653 int escaped, unescape = 0;
1655 /* Make filename end at quote. */
1657 while (*p && ! (! escaped && *p == '"'))
1661 else if (*p == '\\')
1672 /* Undo effects of cpp_quote_string. */
1674 d = gfc_getmem (p + 1 - ptr - unescape);
1689 /* For preprocessed files, if the first tokens are of the form # NUM.
1690 handle the directives so we know the original file name. */
1693 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1698 gfc_src_file = gfc_open_file (filename);
1699 if (gfc_src_file == NULL)
1702 c = getc (gfc_src_file);
1703 ungetc (c, gfc_src_file);
1709 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1711 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1714 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1715 if (filename == NULL)
1718 c = getc (gfc_src_file);
1719 ungetc (c, gfc_src_file);
1725 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1727 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1730 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1731 if (dirname == NULL)
1734 len = strlen (dirname);
1735 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1740 dirname[len - 2] = '\0';
1741 set_src_pwd (dirname);
1743 if (! IS_ABSOLUTE_PATH (filename))
1745 char *p = gfc_getmem (len + strlen (filename));
1747 memcpy (p, dirname, len - 2);
1749 strcpy (p + len - 1, filename);
1750 *canon_source_file = p;