diff options
Diffstat (limited to 'gcc/fortran/parse.c')
| -rw-r--r-- | gcc/fortran/parse.c | 477 |
1 files changed, 448 insertions, 29 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 1c8294e..fd7d4eb 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -585,6 +585,93 @@ decode_statement (void) } while (0); static gfc_statement +decode_oacc_directive (void) +{ + locus old_locus; + char c; + + gfc_enforce_clean_symbol_state (); + + gfc_clear_error (); /* Clear any pending errors. */ + gfc_clear_warning (); /* Clear any pending warnings. */ + + if (gfc_pure (NULL)) + { + gfc_error_now ("OpenACC directives at %C may not appear in PURE " + "procedures"); + gfc_error_recovery (); + return ST_NONE; + } + + gfc_unset_implicit_pure (NULL); + + old_locus = gfc_current_locus; + + /* General OpenACC directive matching: Instead of testing every possible + statement, we eliminate most possibilities by peeking at the + first character. */ + + c = gfc_peek_ascii_char (); + + switch (c) + { + case 'c': + match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE); + break; + case 'd': + match ("data", gfc_match_oacc_data, ST_OACC_DATA); + match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE); + break; + case 'e': + match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA); + match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA); + match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP); + match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS); + match ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP); + match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP); + match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL); + match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA); + match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA); + break; + case 'h': + match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA); + break; + case 'p': + match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP); + match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL); + break; + case 'k': + match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP); + match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS); + break; + case 'l': + match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); + break; + case 'r': + match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); + break; + case 'u': + match ("update", gfc_match_oacc_update, ST_OACC_UPDATE); + break; + case 'w': + match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT); + break; + } + + /* Directive not found or stored an error message. + Check and give up. */ + + if (gfc_error_check () == 0) + gfc_error_now ("Unclassifiable OpenACC directive at %C"); + + reject_statement (); + + gfc_error_recovery (); + + return ST_NONE; +} + +static gfc_statement decode_omp_directive (void) { locus old_locus; @@ -811,6 +898,23 @@ decode_gcc_attribute (void) #undef match +/* Assert next length characters to be equal to token in free form. */ + +static void +verify_token_free (const char* token, int length, bool last_was_use_stmt) +{ + int i; + char c; + + c = gfc_next_ascii_char (); + for (i = 0; i < length; i++, c = gfc_next_ascii_char ()) + gcc_assert (c == token[i]); + + gcc_assert (gfc_is_whitespace(c)); + gfc_gobble_whitespace (); + if (last_was_use_stmt) + use_modules (); +} /* Get the next statement in free form source. */ @@ -880,7 +984,7 @@ next_free (void) else if (c == '!') { /* Comments have already been skipped by the time we get here, - except for GCC attributes and OpenMP directives. */ + except for GCC attributes and OpenMP/OpenACC directives. */ gfc_next_ascii_char (); /* Eat up the exclamation sign. */ c = gfc_peek_ascii_char (); @@ -897,21 +1001,39 @@ next_free (void) return decode_gcc_attribute (); } - else if (c == '$' && (flag_openmp || flag_openmp_simd)) + else if (c == '$') { - int i; - - c = gfc_next_ascii_char (); - for (i = 0; i < 4; i++, c = gfc_next_ascii_char ()) - gcc_assert (c == "$omp"[i]); + /* Since both OpenMP and OpenACC directives starts with + !$ character sequence, we must check all flags combinations */ + if ((flag_openmp || flag_openmp_simd) + && !flag_openacc) + { + verify_token_free ("$omp", 4, last_was_use_stmt); + return decode_omp_directive (); + } + else if ((flag_openmp || flag_openmp_simd) + && flag_openacc) + { + gfc_next_ascii_char (); /* Eat up dollar character */ + c = gfc_peek_ascii_char (); - gcc_assert (c == ' ' || c == '\t'); - gfc_gobble_whitespace (); - if (last_was_use_stmt) - use_modules (); - return decode_omp_directive (); + if (c == 'o') + { + verify_token_free ("omp", 3, last_was_use_stmt); + return decode_omp_directive (); + } + else if (c == 'a') + { + verify_token_free ("acc", 3, last_was_use_stmt); + return decode_oacc_directive (); + } + } + else if (flag_openacc) + { + verify_token_free ("$acc", 4, last_was_use_stmt); + return decode_oacc_directive (); + } } - gcc_unreachable (); } @@ -927,6 +1049,28 @@ next_free (void) return decode_statement (); } +/* Assert next length characters to be equal to token in fixed form. */ + +static bool +verify_token_fixed (const char *token, int length, bool last_was_use_stmt) +{ + int i; + char c = gfc_next_char_literal (NONSTRING); + + for (i = 0; i < length; i++, c = gfc_next_char_literal (NONSTRING)) + gcc_assert ((char) gfc_wide_tolower (c) == token[i]); + + if (c != ' ' && c != '0') + { + gfc_buffer_error (false); + gfc_error ("Bad continuation line at %C"); + return false; + } + if (last_was_use_stmt) + use_modules (); + + return true; +} /* Get the next statement in fixed-form source. */ @@ -986,21 +1130,38 @@ next_fixed (void) return decode_gcc_attribute (); } - else if (c == '$' - && (flag_openmp || flag_openmp_simd)) + else if (c == '$') { - for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING)) - gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]); - - if (c != ' ' && c != '0') + if ((flag_openmp || flag_openmp_simd) + && !flag_openacc) { - gfc_buffer_error (false); - gfc_error ("Bad continuation line at %C"); - return ST_NONE; + if (!verify_token_fixed ("omp", 3, last_was_use_stmt)) + return ST_NONE; + return decode_omp_directive (); + } + else if ((flag_openmp || flag_openmp_simd) + && flag_openacc) + { + c = gfc_next_char_literal(NONSTRING); + if (c == 'o' || c == 'O') + { + if (!verify_token_fixed ("mp", 2, last_was_use_stmt)) + return ST_NONE; + return decode_omp_directive (); + } + else if (c == 'a' || c == 'A') + { + if (!verify_token_fixed ("cc", 2, last_was_use_stmt)) + return ST_NONE; + return decode_oacc_directive (); + } + } + else if (flag_openacc) + { + if (!verify_token_fixed ("acc", 3, last_was_use_stmt)) + return ST_NONE; + return decode_oacc_directive (); } - if (last_was_use_stmt) - use_modules (); - return decode_omp_directive (); } /* FALLTHROUGH */ @@ -1161,7 +1322,9 @@ next_statement (void) case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \ - case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK + case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ + case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ + case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA /* Statements that mark other executable statements. */ @@ -1186,7 +1349,9 @@ next_statement (void) case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE: \ case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO: \ case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: \ - case ST_CRITICAL + case ST_CRITICAL: \ + case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ + case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP /* Declaration statements */ @@ -1194,7 +1359,7 @@ next_statement (void) case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \ case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \ - case ST_OMP_DECLARE_TARGET + case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -1214,6 +1379,8 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym) p->sym = sym; p->head = p->tail = NULL; p->do_variable = NULL; + if (p->state != COMP_DO && p->state != COMP_DO_CONCURRENT) + p->ext.oacc_declare_clauses = NULL; /* If this the state of a construct like BLOCK, DO or IF, the corresponding construct statement was accepted right before pushing the state. Thus, @@ -1679,6 +1846,69 @@ gfc_ascii_statement (gfc_statement st) case ST_END_ENUM: p = "END ENUM"; break; + case ST_OACC_PARALLEL_LOOP: + p = "!$ACC PARALLEL LOOP"; + break; + case ST_OACC_END_PARALLEL_LOOP: + p = "!$ACC END PARALLEL LOOP"; + break; + case ST_OACC_PARALLEL: + p = "!$ACC PARALLEL"; + break; + case ST_OACC_END_PARALLEL: + p = "!$ACC END PARALLEL"; + break; + case ST_OACC_KERNELS: + p = "!$ACC KERNELS"; + break; + case ST_OACC_END_KERNELS: + p = "!$ACC END KERNELS"; + break; + case ST_OACC_KERNELS_LOOP: + p = "!$ACC KERNELS LOOP"; + break; + case ST_OACC_END_KERNELS_LOOP: + p = "!$ACC END KERNELS LOOP"; + break; + case ST_OACC_DATA: + p = "!$ACC DATA"; + break; + case ST_OACC_END_DATA: + p = "!$ACC END DATA"; + break; + case ST_OACC_HOST_DATA: + p = "!$ACC HOST_DATA"; + break; + case ST_OACC_END_HOST_DATA: + p = "!$ACC END HOST_DATA"; + break; + case ST_OACC_LOOP: + p = "!$ACC LOOP"; + break; + case ST_OACC_END_LOOP: + p = "!$ACC END LOOP"; + break; + case ST_OACC_DECLARE: + p = "!$ACC DECLARE"; + break; + case ST_OACC_UPDATE: + p = "!$ACC UPDATE"; + break; + case ST_OACC_WAIT: + p = "!$ACC WAIT"; + break; + case ST_OACC_CACHE: + p = "!$ACC CACHE"; + break; + case ST_OACC_ENTER_DATA: + p = "!$ACC ENTER DATA"; + break; + case ST_OACC_EXIT_DATA: + p = "!$ACC EXIT DATA"; + break; + case ST_OACC_ROUTINE: + p = "!$ACC ROUTINE"; + break; case ST_OMP_ATOMIC: p = "!$OMP ATOMIC"; break; @@ -2180,6 +2410,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) case ST_PUBLIC: case ST_PRIVATE: case ST_DERIVED_DECL: + case ST_OACC_DECLARE: case_decl: if (p->state >= ORDER_EXEC) goto order; @@ -3081,6 +3312,19 @@ declSt: st = next_statement (); goto loop; + case ST_OACC_DECLARE: + if (!verify_st_order(&ss, st, false)) + { + reject_statement (); + st = next_statement (); + goto loop; + } + if (gfc_state_stack->ext.oacc_declare_clauses == NULL) + gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses; + accept_statement (st); + st = next_statement (); + goto loop; + default: break; } @@ -3571,9 +3815,15 @@ static void parse_critical_block (void) { gfc_code *top, *d; - gfc_state_data s; + gfc_state_data s, *sd; gfc_statement st; + for (sd = gfc_state_stack; sd; sd = sd->previous) + if (sd->state == COMP_OMP_STRUCTURED_BLOCK) + gfc_error_now (is_oacc (sd) + ? "CRITICAL block inside of OpenACC region at %C" + : "CRITICAL block inside of OpenMP region at %C"); + s.ext.end_do_label = new_st.label1; accept_statement (ST_CRITICAL); @@ -3988,6 +4238,128 @@ parse_omp_atomic (void) } +/* Parse the statements of an OpenACC structured block. */ + +static void +parse_oacc_structured_block (gfc_statement acc_st) +{ + gfc_statement st, acc_end_st; + gfc_code *cp, *np; + gfc_state_data s, *sd; + + for (sd = gfc_state_stack; sd; sd = sd->previous) + if (sd->state == COMP_CRITICAL) + gfc_error_now ("OpenACC directive inside of CRITICAL block at %C"); + + accept_statement (acc_st); + + cp = gfc_state_stack->tail; + push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL); + np = new_level (cp); + np->op = cp->op; + np->block = NULL; + switch (acc_st) + { + case ST_OACC_PARALLEL: + acc_end_st = ST_OACC_END_PARALLEL; + break; + case ST_OACC_KERNELS: + acc_end_st = ST_OACC_END_KERNELS; + break; + case ST_OACC_DATA: + acc_end_st = ST_OACC_END_DATA; + break; + case ST_OACC_HOST_DATA: + acc_end_st = ST_OACC_END_HOST_DATA; + break; + default: + gcc_unreachable (); + } + + do + { + st = parse_executable (ST_NONE); + if (st == ST_NONE) + unexpected_eof (); + else if (st != acc_end_st) + gfc_error ("Expecting %s at %C", gfc_ascii_statement (acc_end_st)); + reject_statement (); + } + while (st != acc_end_st); + + gcc_assert (new_st.op == EXEC_NOP); + + gfc_clear_new_st (); + gfc_commit_symbols (); + gfc_warning_check (); + pop_state (); +} + +/* Parse the statements of OpenACC loop/parallel loop/kernels loop. */ + +static gfc_statement +parse_oacc_loop (gfc_statement acc_st) +{ + gfc_statement st; + gfc_code *cp, *np; + gfc_state_data s, *sd; + + for (sd = gfc_state_stack; sd; sd = sd->previous) + if (sd->state == COMP_CRITICAL) + gfc_error_now ("OpenACC directive inside of CRITICAL block at %C"); + + accept_statement (acc_st); + + cp = gfc_state_stack->tail; + push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL); + np = new_level (cp); + np->op = cp->op; + np->block = NULL; + + for (;;) + { + st = next_statement (); + if (st == ST_NONE) + unexpected_eof (); + else if (st == ST_DO) + break; + else + { + gfc_error ("Expected DO loop at %C"); + reject_statement (); + } + } + + parse_do_block (); + if (gfc_statement_label != NULL + && gfc_state_stack->previous != NULL + && gfc_state_stack->previous->state == COMP_DO + && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label) + { + pop_state (); + return ST_IMPLIED_ENDDO; + } + + check_do_closure (); + pop_state (); + + st = next_statement (); + if (st == ST_OACC_END_LOOP) + gfc_warning ("Redundant !$ACC END LOOP at %C"); + if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) || + (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) || + (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP)) + { + gcc_assert (new_st.op == EXEC_NOP); + gfc_clear_new_st (); + gfc_commit_symbols (); + gfc_warning_check (); + st = next_statement (); + } + return st; +} + + /* Parse the statements of an OpenMP structured block. */ static void @@ -4307,6 +4679,21 @@ parse_executable (gfc_statement st) parse_forall_block (); break; + case ST_OACC_PARALLEL_LOOP: + case ST_OACC_KERNELS_LOOP: + case ST_OACC_LOOP: + st = parse_oacc_loop (st); + if (st == ST_IMPLIED_ENDDO) + return st; + continue; + + case ST_OACC_PARALLEL: + case ST_OACC_KERNELS: + case ST_OACC_DATA: + case ST_OACC_HOST_DATA: + parse_oacc_structured_block (st); + break; + case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: @@ -4637,6 +5024,13 @@ contains: done: gfc_current_ns->code = gfc_state_stack->head; + if (gfc_state_stack->state == COMP_PROGRAM + || gfc_state_stack->state == COMP_MODULE + || gfc_state_stack->state == COMP_SUBROUTINE + || gfc_state_stack->state == COMP_FUNCTION + || gfc_state_stack->state == COMP_BLOCK) + gfc_current_ns->oacc_declare_clauses + = gfc_state_stack->ext.oacc_declare_clauses; } @@ -5155,3 +5549,28 @@ duplicate_main: gfc_done_2 (); return true; } + +/* Return true if this state data represents an OpenACC region. */ +bool +is_oacc (gfc_state_data *sd) +{ + switch (sd->construct->op) + { + case EXEC_OACC_PARALLEL_LOOP: + case EXEC_OACC_PARALLEL: + case EXEC_OACC_KERNELS_LOOP: + case EXEC_OACC_KERNELS: + case EXEC_OACC_DATA: + case EXEC_OACC_HOST_DATA: + case EXEC_OACC_LOOP: + case EXEC_OACC_UPDATE: + case EXEC_OACC_WAIT: + case EXEC_OACC_CACHE: + case EXEC_OACC_ENTER_DATA: + case EXEC_OACC_EXIT_DATA: + return true; + + default: + return false; + } +} |