2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
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 2, 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 COPYING. If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
23 /* Set of subroutines to (ultimately) return the next character to the
24 various matching subroutines. This file's job is to read files and
25 build up lines that are parsed by the parser. This means that we
26 handle continuation lines and "include" lines.
28 The first thing the scanner does is to load an entire file into
29 memory. We load the entire file into memory for a couple reasons.
30 The first is that we want to be able to deal with nonseekable input
31 (pipes, stdin) and there is a lot of backing up involved during
34 The second is that we want to be able to print the locus of errors,
35 and an error on line 999999 could conflict with something on line
36 one. Given nonseekable input, we've got to store the whole thing.
38 One thing that helps are the column truncation limits that give us
39 an upper bound on the size of individual lines. We don't store the
42 From the scanner's viewpoint, the higher level subroutines ask for
43 new characters and do a lot of jumping backwards. */
50 /* Structure for holding module and include file search path. */
51 typedef struct gfc_directorylist
55 struct gfc_directorylist *next;
59 /* List of include file search directories. */
60 static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
62 static gfc_file *file_head, *current_file;
64 static int continue_flag, end_flag, openmp_flag;
65 static int continue_count, continue_line;
66 static locus openmp_locus;
68 gfc_source_form gfc_current_form;
69 static gfc_linebuf *line_head, *line_tail;
71 locus gfc_current_locus;
72 const char *gfc_source_file;
73 static FILE *gfc_src_file;
74 static char *gfc_src_preprocessor_lines[2];
78 /* Main scanner initialization. */
81 gfc_scanner_init_1 (void)
94 /* Main scanner destructor. */
97 gfc_scanner_done_1 (void)
102 while(line_head != NULL)
104 lb = line_head->next;
109 while(file_head != NULL)
112 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 gfc_free (gfc_option.module_dir);
176 while (include_dirs != NULL)
179 include_dirs = include_dirs->next;
184 gfc_free (gfc_option.module_dir);
185 while (intrinsic_modules_dirs != NULL)
187 p = intrinsic_modules_dirs;
188 intrinsic_modules_dirs = intrinsic_modules_dirs->next;
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)
231 f = gfc_open_file (name);
236 return open_included_file (name, include_dirs, module);
240 gfc_open_intrinsic_module (const char *name)
242 return open_included_file (name, intrinsic_modules_dirs, true);
245 /* Test to see if we're at the end of the main source file. */
255 /* Test to see if we're at the end of the current file. */
264 if (line_head == NULL)
265 return 1; /* Null file */
267 if (gfc_current_locus.lb == NULL)
274 /* Test to see if we're at the beginning of a new line. */
282 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
286 /* Test to see if we're at the end of a line. */
295 return (*gfc_current_locus.nextc == '\0');
299 /* Advance the current line pointer to the next line. */
302 gfc_advance_line (void)
307 if (gfc_current_locus.lb == NULL)
313 gfc_current_locus.lb = gfc_current_locus.lb->next;
315 if (gfc_current_locus.lb != NULL)
316 gfc_current_locus.nextc = gfc_current_locus.lb->line;
319 gfc_current_locus.nextc = NULL;
325 /* Get the next character from the input, advancing gfc_current_file's
326 locus. When we hit the end of the line or the end of the file, we
327 start returning a '\n' in order to complete the current statement.
328 No Fortran line conventions are implemented here.
330 Requiring explicit advances to the next line prevents the parse
331 pointer from being on the wrong line if the current statement ends
339 if (gfc_current_locus.nextc == NULL)
342 c = *gfc_current_locus.nextc++;
345 gfc_current_locus.nextc--; /* Remain on this line. */
352 /* Skip a comment. When we come here the parse pointer is positioned
353 immediately after the comment character. If we ever implement
354 compiler directives withing comments, here is where we parse the
358 skip_comment_line (void)
372 /* Comment lines are null lines, lines containing only blanks or lines
373 on which the first nonblank line is a '!'.
374 Return true if !$ openmp conditional compilation sentinel was
378 skip_free_comments (void)
386 at_bol = gfc_at_bol ();
387 start = gfc_current_locus;
393 while (gfc_is_whitespace (c));
403 /* If -fopenmp, we need to handle here 2 things:
404 1) don't treat !$omp as comments, but directives
405 2) handle OpenMP conditional compilation, where
406 !$ should be treated as 2 spaces (for initial lines
407 only if followed by space). */
408 if (gfc_option.flag_openmp && at_bol)
410 locus old_loc = gfc_current_locus;
411 if (next_char () == '$')
414 if (c == 'o' || c == 'O')
416 if (((c = next_char ()) == 'm' || c == 'M')
417 && ((c = next_char ()) == 'p' || c == 'P')
418 && ((c = next_char ()) == ' ' || continue_flag))
420 while (gfc_is_whitespace (c))
422 if (c != '\n' && c != '!')
425 openmp_locus = old_loc;
426 gfc_current_locus = start;
430 gfc_current_locus = old_loc;
434 if (continue_flag || c == ' ')
436 gfc_current_locus = old_loc;
442 gfc_current_locus = old_loc;
444 skip_comment_line ();
451 if (openmp_flag && at_bol)
453 gfc_current_locus = start;
458 /* Skip comment lines in fixed source mode. We have the same rules as
459 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
460 in column 1, and a '!' cannot be in column 6. Also, we deal with
461 lines with 'd' or 'D' in column 1, if the user requested this. */
464 skip_fixed_comments (void)
472 start = gfc_current_locus;
477 while (gfc_is_whitespace (c));
482 skip_comment_line ();
487 gfc_current_locus = start;
494 start = gfc_current_locus;
505 if (c == '!' || c == 'c' || c == 'C' || c == '*')
507 /* If -fopenmp, we need to handle here 2 things:
508 1) don't treat !$omp|c$omp|*$omp as comments, but directives
509 2) handle OpenMP conditional compilation, where
510 !$|c$|*$ should be treated as 2 spaces if the characters
511 in columns 3 to 6 are valid fixed form label columns
513 if (gfc_option.flag_openmp)
515 if (next_char () == '$')
518 if (c == 'o' || c == 'O')
520 if (((c = next_char ()) == 'm' || c == 'M')
521 && ((c = next_char ()) == 'p' || c == 'P'))
525 && ((openmp_flag && continue_flag)
526 || c == ' ' || c == '0'))
529 while (gfc_is_whitespace (c))
531 if (c != '\n' && c != '!')
533 /* Canonicalize to *$omp. */
536 gfc_current_locus = start;
546 for (col = 3; col < 6; col++, c = next_char ())
549 else if (c < '0' || c > '9')
554 if (col == 6 && c != '\n'
555 && ((continue_flag && !digit_seen)
556 || c == ' ' || c == '0'))
558 gfc_current_locus = start;
559 start.nextc[0] = ' ';
560 start.nextc[1] = ' ';
565 gfc_current_locus = start;
567 skip_comment_line ();
571 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
573 if (gfc_option.flag_d_lines == 0)
575 skip_comment_line ();
579 *start.nextc = c = ' ';
584 while (gfc_is_whitespace (c))
596 if (col != 6 && c == '!')
598 skip_comment_line ();
606 gfc_current_locus = start;
610 /* Skips the current line if it is a comment. */
613 gfc_skip_comments (void)
615 if (gfc_current_form == FORM_FREE)
616 skip_free_comments ();
618 skip_fixed_comments ();
622 /* Get the next character from the input, taking continuation lines
623 and end-of-line comments into account. This implies that comment
624 lines between continued lines must be eaten here. For higher-level
625 subroutines, this flattens continued lines into a single logical
626 line. The in_string flag denotes whether we're inside a character
630 gfc_next_char_literal (int in_string)
633 int i, c, prev_openmp_flag;
645 if (gfc_current_form == FORM_FREE)
647 bool openmp_cond_flag;
649 if (!in_string && c == '!')
652 && memcmp (&gfc_current_locus, &openmp_locus,
653 sizeof (gfc_current_locus)) == 0)
656 /* This line can't be continued */
663 /* Avoid truncation warnings for comment ending lines. */
664 gfc_current_locus.lb->truncated = 0;
672 /* If the next nonblank character is a ! or \n, we've got a
673 continuation line. */
674 old_loc = gfc_current_locus;
677 while (gfc_is_whitespace (c))
680 /* Character constants to be continued cannot have commentary
683 if (in_string && c != '\n')
685 gfc_current_locus = old_loc;
690 if (c != '!' && c != '\n')
692 gfc_current_locus = old_loc;
697 prev_openmp_flag = openmp_flag;
700 skip_comment_line ();
704 /* We've got a continuation line. If we are on the very next line after
705 the last continuation, increment the continuation line count and
706 check whether the limit has been exceeded. */
707 if (gfc_current_locus.lb->linenum == continue_line + 1)
709 if (++continue_count == gfc_option.max_continue_free)
711 if (gfc_notification_std (GFC_STD_GNU)
713 gfc_warning ("Limit of %d continuations exceeded in statement at %C",
714 gfc_option.max_continue_free);
717 continue_line = gfc_current_locus.lb->linenum;
719 /* Now find where it continues. First eat any comment lines. */
720 openmp_cond_flag = skip_free_comments ();
722 if (prev_openmp_flag != openmp_flag)
724 gfc_current_locus = old_loc;
725 openmp_flag = prev_openmp_flag;
730 /* Now that we have a non-comment line, probe ahead for the
731 first non-whitespace character. If it is another '&', then
732 reading starts at the next character, otherwise we must back
733 up to where the whitespace started and resume from there. */
735 old_loc = gfc_current_locus;
738 while (gfc_is_whitespace (c))
743 for (i = 0; i < 5; i++, c = next_char ())
745 gcc_assert (TOLOWER (c) == "!$omp"[i]);
747 old_loc = gfc_current_locus;
749 while (gfc_is_whitespace (c))
757 if (gfc_option.warn_ampersand)
758 gfc_warning_now ("Missing '&' in continued character constant at %C");
759 gfc_current_locus.nextc--;
761 /* Both !$omp and !$ -fopenmp continuation lines have & on the
762 continuation line only optionally. */
763 else if (openmp_flag || openmp_cond_flag)
764 gfc_current_locus.nextc--;
768 gfc_current_locus = old_loc;
775 /* Fixed form continuation. */
776 if (!in_string && c == '!')
778 /* Skip comment at end of line. */
785 /* Avoid truncation warnings for comment ending lines. */
786 gfc_current_locus.lb->truncated = 0;
792 prev_openmp_flag = openmp_flag;
794 old_loc = gfc_current_locus;
797 skip_fixed_comments ();
799 /* See if this line is a continuation line. */
800 if (openmp_flag != prev_openmp_flag)
802 openmp_flag = prev_openmp_flag;
803 goto not_continuation;
807 for (i = 0; i < 5; i++)
811 goto not_continuation;
814 for (i = 0; i < 5; i++)
817 if (TOLOWER (c) != "*$omp"[i])
818 goto not_continuation;
822 if (c == '0' || c == ' ' || c == '\n')
823 goto not_continuation;
825 /* We've got a continuation line. If we are on the very next line after
826 the last continuation, increment the continuation line count and
827 check whether the limit has been exceeded. */
828 if (gfc_current_locus.lb->linenum == continue_line + 1)
830 if (++continue_count == gfc_option.max_continue_fixed)
832 if (gfc_notification_std (GFC_STD_GNU)
834 gfc_warning ("Limit of %d continuations exceeded in statement at %C",
835 gfc_option.max_continue_fixed);
839 if (continue_line < gfc_current_locus.lb->linenum)
840 continue_line = gfc_current_locus.lb->linenum;
843 /* Ready to read first character of continuation line, which might
844 be another continuation line! */
849 gfc_current_locus = old_loc;
859 /* Get the next character of input, folded to lowercase. In fixed
860 form mode, we also ignore spaces. When matcher subroutines are
861 parsing character literals, they have to call
862 gfc_next_char_literal(). */
871 c = gfc_next_char_literal (0);
873 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
885 old_loc = gfc_current_locus;
886 c = gfc_next_char ();
887 gfc_current_locus = old_loc;
893 /* Recover from an error. We try to get past the current statement
894 and get lined up for the next. The next statement follows a '\n'
895 or a ';'. We also assume that we are not within a character
896 constant, and deal with finding a '\'' or '"'. */
899 gfc_error_recovery (void)
908 c = gfc_next_char ();
909 if (c == '\n' || c == ';')
912 if (c != '\'' && c != '"')
941 /* Read ahead until the next character to be read is not whitespace. */
944 gfc_gobble_whitespace (void)
946 static int linenum = 0;
952 old_loc = gfc_current_locus;
953 c = gfc_next_char_literal (0);
954 /* Issue a warning for nonconforming tabs. We keep track of the line
955 number because the Fortran matchers will often back up and the same
956 line will be scanned multiple times. */
957 if (!gfc_option.warn_tabs && c == '\t')
959 #ifdef USE_MAPPED_LOCATION
960 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
962 int cur_linenum = gfc_current_locus.lb->linenum;
964 if (cur_linenum != linenum)
966 linenum = cur_linenum;
967 gfc_warning_now ("Nonconforming tab character at %C");
971 while (gfc_is_whitespace (c));
973 gfc_current_locus = old_loc;
977 /* Load a single line into pbuf.
979 If pbuf points to a NULL pointer, it is allocated.
980 We truncate lines that are too long, unless we're dealing with
981 preprocessor lines or if the option -ffixed-line-length-none is set,
982 in which case we reallocate the buffer to fit the entire line, if
984 In fixed mode, we expand a tab that occurs within the statement
985 label region to expand to spaces that leave the next character in
987 load_line returns whether the line was truncated.
989 NOTE: The error machinery isn't available at this point, so we can't
990 easily report line and column numbers consistent with other
991 parts of gfortran. */
994 load_line (FILE * input, char **pbuf, int *pbuflen)
996 static int linenum = 0, current_line = 1;
997 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
998 int trunc_flag = 0, seen_comment = 0;
999 int seen_printable = 0, seen_ampersand = 0;
1002 /* Determine the maximum allowed line length. */
1003 if (gfc_current_form == FORM_FREE)
1004 maxlen = gfc_option.free_line_length;
1005 else if (gfc_current_form == FORM_FIXED)
1006 maxlen = gfc_option.fixed_line_length;
1012 /* Allocate the line buffer, storing its length into buflen.
1013 Note that if maxlen==0, indicating that arbitrary-length lines
1014 are allowed, the buffer will be reallocated if this length is
1015 insufficient; since 132 characters is the length of a standard
1016 free-form line, we use that as a starting guess. */
1022 *pbuf = gfc_getmem (buflen + 1);
1028 preprocessor_flag = 0;
1031 /* In order to not truncate preprocessor lines, we have to
1032 remember that this is one. */
1033 preprocessor_flag = 1;
1044 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1045 if (gfc_current_form == FORM_FREE
1046 && !seen_printable && seen_ampersand)
1050 ("'&' not allowed by itself in line %d", current_line);
1053 ("'&' not allowed by itself in line %d", current_line);
1059 continue; /* Gobble characters. */
1065 /* Ctrl-Z ends the file. */
1066 while (fgetc (input) != EOF);
1070 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1074 if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand))
1077 if (gfc_current_form == FORM_FREE
1078 && c == '!' && !seen_printable && seen_ampersand)
1082 "'&' not allowed by itself with comment in line %d", current_line);
1085 "'&' not allowed by itself with comment in line %d", current_line);
1089 /* Is this a fixed-form comment? */
1090 if (gfc_current_form == FORM_FIXED && i == 0
1091 && (c == '*' || c == 'c' || c == 'd'))
1094 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
1096 if (!gfc_option.warn_tabs && seen_comment == 0
1097 && current_line != linenum)
1099 linenum = current_line;
1101 "Nonconforming tab character in column 1 of line %d", linenum);
1116 if (maxlen == 0 || preprocessor_flag)
1120 /* Reallocate line buffer to double size to hold the
1122 buflen = buflen * 2;
1123 *pbuf = xrealloc (*pbuf, buflen + 1);
1127 else if (i >= maxlen)
1129 /* Truncate the rest of the line. */
1133 if (c == '\n' || c == EOF)
1139 ungetc ('\n', input);
1143 /* Pad lines to the selected line length in fixed form. */
1144 if (gfc_current_form == FORM_FIXED
1145 && gfc_option.fixed_line_length != 0
1146 && !preprocessor_flag
1149 while (i++ < maxlen)
1161 /* Get a gfc_file structure, initialize it and add it to
1165 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1169 f = gfc_getmem (sizeof (gfc_file));
1171 f->filename = gfc_getmem (strlen (name) + 1);
1172 strcpy (f->filename, name);
1174 f->next = file_head;
1177 f->included_by = current_file;
1178 if (current_file != NULL)
1179 f->inclusion_line = current_file->line;
1181 #ifdef USE_MAPPED_LOCATION
1182 linemap_add (&line_table, reason, false, f->filename, 1);
1188 /* Deal with a line from the C preprocessor. The
1189 initial octothorp has already been seen. */
1192 preprocessor_line (char *c)
1198 int escaped, unescape;
1201 while (*c == ' ' || *c == '\t')
1204 if (*c < '0' || *c > '9')
1209 c = strchr (c, ' ');
1212 /* No file name given. Set new line number. */
1213 current_file->line = line;
1218 while (*c == ' ' || *c == '\t')
1228 /* Make filename end at quote. */
1231 while (*c && ! (! escaped && *c == '"'))
1235 else if (*c == '\\')
1244 /* Preprocessor line has no closing quote. */
1249 /* Undo effects of cpp_quote_string. */
1253 char *d = gfc_getmem (c - filename - unescape);
1269 flag[1] = flag[2] = flag[3] = flag[4] = false;
1273 c = strchr (c, ' ');
1280 if (1 <= i && i <= 4)
1284 /* Interpret flags. */
1286 if (flag[1]) /* Starting new file. */
1288 f = get_file (filename, LC_RENAME);
1289 f->up = current_file;
1293 if (flag[2]) /* Ending current file. */
1295 if (!current_file->up
1296 || strcmp (current_file->up->filename, filename) != 0)
1298 gfc_warning_now ("%s:%d: file %s left but not entered",
1299 current_file->filename, current_file->line,
1302 gfc_free (filename);
1305 current_file = current_file->up;
1308 /* The name of the file can be a temporary file produced by
1309 cpp. Replace the name if it is different. */
1311 if (strcmp (current_file->filename, filename) != 0)
1313 gfc_free (current_file->filename);
1314 current_file->filename = gfc_getmem (strlen (filename) + 1);
1315 strcpy (current_file->filename, filename);
1318 /* Set new line number. */
1319 current_file->line = line;
1321 gfc_free (filename);
1325 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1326 current_file->filename, current_file->line);
1327 current_file->line++;
1331 static try load_file (const char *, bool);
1333 /* include_line()-- Checks a line buffer to see if it is an include
1334 line. If so, we call load_file() recursively to load the included
1335 file. We never return a syntax error because a statement like
1336 "include = 5" is perfectly legal. We return false if no include was
1337 processed or true if we matched an include. */
1340 include_line (char *line)
1342 char quote, *c, *begin, *stop;
1346 if (gfc_option.flag_openmp)
1348 if (gfc_current_form == FORM_FREE)
1350 while (*c == ' ' || *c == '\t')
1352 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1357 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1358 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1363 while (*c == ' ' || *c == '\t')
1366 if (strncasecmp (c, "include", 7))
1370 while (*c == ' ' || *c == '\t')
1373 /* Find filename between quotes. */
1376 if (quote != '"' && quote != '\'')
1381 while (*c != quote && *c != '\0')
1389 while (*c == ' ' || *c == '\t')
1392 if (*c != '\0' && *c != '!')
1395 /* We have an include line at this point. */
1397 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1398 read by anything else. */
1400 load_file (begin, false);
1404 /* Load a file into memory by calling load_line until the file ends. */
1407 load_file (const char *filename, bool initial)
1415 for (f = current_file; f; f = f->up)
1416 if (strcmp (filename, f->filename) == 0)
1418 gfc_error_now ("File '%s' is being included recursively", filename);
1426 input = gfc_src_file;
1427 gfc_src_file = NULL;
1430 input = gfc_open_file (filename);
1433 gfc_error_now ("Can't open file '%s'", filename);
1439 input = gfc_open_included_file (filename, false, false);
1442 gfc_error_now ("Can't open included file '%s'", filename);
1447 /* Load the file. */
1449 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1450 f->up = current_file;
1452 current_file->line = 1;
1456 if (initial && gfc_src_preprocessor_lines[0])
1458 preprocessor_line (gfc_src_preprocessor_lines[0]);
1459 gfc_free (gfc_src_preprocessor_lines[0]);
1460 gfc_src_preprocessor_lines[0] = NULL;
1461 if (gfc_src_preprocessor_lines[1])
1463 preprocessor_line (gfc_src_preprocessor_lines[1]);
1464 gfc_free (gfc_src_preprocessor_lines[1]);
1465 gfc_src_preprocessor_lines[1] = NULL;
1471 int trunc = load_line (input, &line, &line_len);
1473 len = strlen (line);
1474 if (feof (input) && len == 0)
1477 /* There are three things this line can be: a line of Fortran
1478 source, an include line or a C preprocessor directive. */
1482 preprocessor_line (line);
1486 if (include_line (line))
1488 current_file->line++;
1494 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1496 #ifdef USE_MAPPED_LOCATION
1498 = linemap_line_start (&line_table, current_file->line++, 120);
1500 b->linenum = current_file->line++;
1502 b->file = current_file;
1503 b->truncated = trunc;
1504 strcpy (b->line, line);
1506 if (line_head == NULL)
1509 line_tail->next = b;
1514 /* Release the line buffer allocated in load_line. */
1519 current_file = current_file->up;
1520 #ifdef USE_MAPPED_LOCATION
1521 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1527 /* Open a new file and start scanning from that file. Returns SUCCESS
1528 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1529 it tries to determine the source form from the filename, defaulting
1537 result = load_file (gfc_source_file, true);
1539 gfc_current_locus.lb = line_head;
1540 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1542 #if 0 /* Debugging aid. */
1543 for (; line_head; line_head = line_head->next)
1544 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1545 #ifdef USE_MAPPED_LOCATION
1546 LOCATION_LINE (line_head->location),
1559 unescape_filename (const char *ptr)
1561 const char *p = ptr, *s;
1563 int escaped, unescape = 0;
1565 /* Make filename end at quote. */
1567 while (*p && ! (! escaped && *p == '"'))
1571 else if (*p == '\\')
1582 /* Undo effects of cpp_quote_string. */
1584 d = gfc_getmem (p + 1 - ptr - unescape);
1599 /* For preprocessed files, if the first tokens are of the form # NUM.
1600 handle the directives so we know the original file name. */
1603 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1608 gfc_src_file = gfc_open_file (filename);
1609 if (gfc_src_file == NULL)
1612 c = fgetc (gfc_src_file);
1613 ungetc (c, gfc_src_file);
1619 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1621 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1624 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1625 if (filename == NULL)
1628 c = fgetc (gfc_src_file);
1629 ungetc (c, gfc_src_file);
1635 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1637 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1640 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1641 if (dirname == NULL)
1644 len = strlen (dirname);
1645 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1650 dirname[len - 2] = '\0';
1651 set_src_pwd (dirname);
1653 if (! IS_ABSOLUTE_PATH (filename))
1655 char *p = gfc_getmem (len + strlen (filename));
1657 memcpy (p, dirname, len - 2);
1659 strcpy (p + len - 1, filename);
1660 *canon_source_file = p;