diff options
Diffstat (limited to 'gcc/fortran/scanner.c')
| -rw-r--r-- | gcc/fortran/scanner.c | 209 |
1 files changed, 186 insertions, 23 deletions
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 690d6d7..2aadc1c 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -1,5 +1,5 @@ /* Character scanner. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -60,7 +60,8 @@ static gfc_directorylist *include_dirs; static gfc_file *file_head, *current_file; -static int continue_flag, end_flag; +static int continue_flag, end_flag, openmp_flag; +static locus openmp_locus; gfc_source_form gfc_current_form; static gfc_linebuf *line_head, *line_tail; @@ -328,17 +329,17 @@ skip_free_comments (void) { locus start; char c; + int at_bol; for (;;) { + at_bol = gfc_at_bol (); start = gfc_current_locus; if (gfc_at_eof ()) break; do - { - c = next_char (); - } + c = next_char (); while (gfc_is_whitespace (c)); if (c == '\n') @@ -349,6 +350,46 @@ skip_free_comments (void) if (c == '!') { + /* If -fopenmp, we need to handle here 2 things: + 1) don't treat !$omp as comments, but directives + 2) handle OpenMP conditional compilation, where + !$ should be treated as 2 spaces (for initial lines + only if followed by space). */ + if (gfc_option.flag_openmp && at_bol) + { + locus old_loc = gfc_current_locus; + if (next_char () == '$') + { + c = next_char (); + if (c == 'o' || c == 'O') + { + if (((c = next_char ()) == 'm' || c == 'M') + && ((c = next_char ()) == 'p' || c == 'P') + && ((c = next_char ()) == ' ' || continue_flag)) + { + while (gfc_is_whitespace (c)) + c = next_char (); + if (c != '\n' && c != '!') + { + openmp_flag = 1; + openmp_locus = old_loc; + gfc_current_locus = start; + return; + } + } + gfc_current_locus = old_loc; + next_char (); + c = next_char (); + } + if (continue_flag || c == ' ') + { + gfc_current_locus = old_loc; + next_char (); + return; + } + } + gfc_current_locus = old_loc; + } skip_comment_line (); continue; } @@ -356,6 +397,8 @@ skip_free_comments (void) break; } + if (openmp_flag && at_bol) + openmp_flag = 0; gfc_current_locus = start; } @@ -372,6 +415,28 @@ skip_fixed_comments (void) int col; char c; + if (! gfc_at_bol ()) + { + start = gfc_current_locus; + if (! gfc_at_eof ()) + { + do + c = next_char (); + while (gfc_is_whitespace (c)); + + if (c == '\n') + gfc_advance_line (); + else if (c == '!') + skip_comment_line (); + } + + if (! gfc_at_bol ()) + { + gfc_current_locus = start; + return; + } + } + for (;;) { start = gfc_current_locus; @@ -387,6 +452,66 @@ skip_fixed_comments (void) if (c == '!' || c == 'c' || c == 'C' || c == '*') { + /* If -fopenmp, we need to handle here 2 things: + 1) don't treat !$omp|c$omp|*$omp as comments, but directives + 2) handle OpenMP conditional compilation, where + !$|c$|*$ should be treated as 2 spaces if the characters + in columns 3 to 6 are valid fixed form label columns + characters. */ + if (gfc_option.flag_openmp) + { + if (next_char () == '$') + { + c = next_char (); + if (c == 'o' || c == 'O') + { + if (((c = next_char ()) == 'm' || c == 'M') + && ((c = next_char ()) == 'p' || c == 'P')) + { + c = next_char (); + if (c != '\n' + && ((openmp_flag && continue_flag) + || c == ' ' || c == '0')) + { + c = next_char (); + while (gfc_is_whitespace (c)) + c = next_char (); + if (c != '\n' && c != '!') + { + /* Canonicalize to *$omp. */ + *start.nextc = '*'; + openmp_flag = 1; + gfc_current_locus = start; + return; + } + } + } + } + else + { + int digit_seen = 0; + + for (col = 3; col < 6; col++, c = next_char ()) + if (c == ' ') + continue; + else if (c < '0' || c > '9') + break; + else + digit_seen = 1; + + if (col == 6 && c != '\n' + && ((continue_flag && !digit_seen) + || c == ' ' || c == '0')) + { + gfc_current_locus = start; + start.nextc[0] = ' '; + start.nextc[1] = ' '; + continue; + } + } + } + gfc_current_locus = start; + } skip_comment_line (); continue; } @@ -425,18 +550,17 @@ skip_fixed_comments (void) break; } + openmp_flag = 0; gfc_current_locus = start; } -/* Skips the current line if it is a comment. Assumes that we are at - the start of the current line. */ +/* Skips the current line if it is a comment. */ void gfc_skip_comments (void) { - - if (!gfc_at_bol () || gfc_current_form == FORM_FREE) + if (gfc_current_form == FORM_FREE) skip_free_comments (); else skip_fixed_comments (); @@ -454,7 +578,7 @@ int gfc_next_char_literal (int in_string) { locus old_loc; - int i, c; + int i, c, prev_openmp_flag; continue_flag = 0; @@ -465,9 +589,13 @@ restart: if (gfc_current_form == FORM_FREE) { - if (!in_string && c == '!') { + if (openmp_flag + && memcmp (&gfc_current_locus, &openmp_locus, + sizeof (gfc_current_locus)) == 0) + goto done; + /* This line can't be continued */ do { @@ -485,7 +613,7 @@ restart: goto done; /* If the next nonblank character is a ! or \n, we've got a - continuation line. */ + continuation line. */ old_loc = gfc_current_locus; c = next_char (); @@ -493,7 +621,7 @@ restart: c = next_char (); /* Character constants to be continued cannot have commentary - after the '&'. */ + after the '&'. */ if (in_string && c != '\n') { @@ -509,6 +637,7 @@ restart: goto done; } + prev_openmp_flag = openmp_flag; continue_flag = 1; if (c == '!') skip_comment_line (); @@ -516,13 +645,21 @@ restart: gfc_advance_line (); /* We've got a continuation line and need to find where it continues. - First eat any comment lines. */ + First eat any comment lines. */ gfc_skip_comments (); + if (prev_openmp_flag != openmp_flag) + { + gfc_current_locus = old_loc; + openmp_flag = prev_openmp_flag; + c = '&'; + goto done; + } + /* Now that we have a non-comment line, probe ahead for the - first non-whitespace character. If it is another '&', then - reading starts at the next character, otherwise we must back - up to where the whitespace started and resume from there. */ + first non-whitespace character. If it is another '&', then + reading starts at the next character, otherwise we must back + up to where the whitespace started and resume from there. */ old_loc = gfc_current_locus; @@ -530,9 +667,20 @@ restart: while (gfc_is_whitespace (c)) c = next_char (); + if (openmp_flag) + { + for (i = 0; i < 5; i++, c = next_char ()) + { + gcc_assert (TOLOWER (c) == "!$omp"[i]); + if (i == 4) + old_loc = gfc_current_locus; + } + while (gfc_is_whitespace (c)) + c = next_char (); + } + if (c != '&') gfc_current_locus = old_loc; - } else { @@ -553,6 +701,7 @@ restart: if (c != '\n') goto done; + prev_openmp_flag = openmp_flag; continue_flag = 1; old_loc = gfc_current_locus; @@ -560,15 +709,29 @@ restart: gfc_skip_comments (); /* See if this line is a continuation line. */ - for (i = 0; i < 5; i++) + if (openmp_flag != prev_openmp_flag) { - c = next_char (); - if (c != ' ') - goto not_continuation; + openmp_flag = prev_openmp_flag; + goto not_continuation; } + if (!openmp_flag) + for (i = 0; i < 5; i++) + { + c = next_char (); + if (c != ' ') + goto not_continuation; + } + else + for (i = 0; i < 5; i++) + { + c = next_char (); + if (TOLOWER (c) != "*$omp"[i]) + goto not_continuation; + } + c = next_char (); - if (c == '0' || c == ' ') + if (c == '0' || c == ' ' || c == '\n') goto not_continuation; } |