diff options
Diffstat (limited to 'gcc/fortran/parse.c')
| -rw-r--r-- | gcc/fortran/parse.c | 100 |
1 files changed, 94 insertions, 6 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 2679e92..7d935c3 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -291,9 +291,9 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - /* Check for the IF, DO, SELECT, WHERE, FORALL and BLOCK statements, which - might begin with a block label. The match functions for these - statements are unusual in that their keyword is not seen before + /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, and BLOCK + statements, which might begin with a block label. The match functions for + these statements are unusual in that their keyword is not seen before the matcher is called. */ if (gfc_match_if (&st) == MATCH_YES) @@ -311,8 +311,9 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - match (NULL, gfc_match_block, ST_BLOCK); match (NULL, gfc_match_do, ST_DO); + match (NULL, gfc_match_block, ST_BLOCK); + match (NULL, gfc_match_critical, ST_CRITICAL); match (NULL, gfc_match_select, ST_SELECT_CASE); match (NULL, gfc_match_select_type, ST_SELECT_TYPE); @@ -362,6 +363,7 @@ decode_statement (void) match ("else", gfc_match_else, ST_ELSE); match ("else where", gfc_match_elsewhere, ST_ELSEWHERE); match ("else if", gfc_match_elseif, ST_ELSEIF); + match ("error stop", gfc_match_error_stop, ST_ERROR_STOP); match ("enum , bind ( c )", gfc_match_enum, ST_ENUM); if (gfc_match_end (&st) == MATCH_YES) @@ -432,6 +434,9 @@ decode_statement (void) match ("sequence", gfc_match_eos, ST_SEQUENCE); match ("stop", gfc_match_stop, ST_STOP); match ("save", gfc_match_save, ST_ATTR_DECL); + match ("sync all", gfc_match_sync_all, ST_SYNC_ALL); + match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES); + match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY); break; case 't': @@ -936,7 +941,8 @@ next_statement (void) case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ - case ST_OMP_BARRIER: case ST_OMP_TASKWAIT + case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_ERROR_STOP: \ + case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY /* Statements that mark other executable statements. */ @@ -948,7 +954,7 @@ next_statement (void) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ - case ST_OMP_TASK + case ST_OMP_TASK: case ST_CRITICAL /* Declaration statements */ @@ -1082,6 +1088,7 @@ check_statement_label (gfc_statement st) case ST_ENDDO: case ST_ENDIF: case ST_END_SELECT: + case ST_END_CRITICAL: case_executable: case_exec_markers: type = ST_LABEL_TARGET; @@ -1176,6 +1183,9 @@ gfc_ascii_statement (gfc_statement st) case ST_CONTAINS: p = "CONTAINS"; break; + case ST_CRITICAL: + p = "CRITICAL"; + break; case ST_CYCLE: p = "CYCLE"; break; @@ -1209,6 +1219,9 @@ gfc_ascii_statement (gfc_statement st) case ST_END_BLOCK_DATA: p = "END BLOCK DATA"; break; + case ST_END_CRITICAL: + p = "END CRITICAL"; + break; case ST_ENDDO: p = "END DO"; break; @@ -1251,6 +1264,9 @@ gfc_ascii_statement (gfc_statement st) case ST_EQUIVALENCE: p = "EQUIVALENCE"; break; + case ST_ERROR_STOP: + p = "ERROR STOP"; + break; case ST_EXIT: p = "EXIT"; break; @@ -1339,6 +1355,15 @@ gfc_ascii_statement (gfc_statement st) case ST_STOP: p = "STOP"; break; + case ST_SYNC_ALL: + p = "SYNC ALL"; + break; + case ST_SYNC_IMAGES: + p = "SYNC IMAGES"; + break; + case ST_SYNC_MEMORY: + p = "SYNC MEMORY"; + break; case ST_SUBROUTINE: p = "SUBROUTINE"; break; @@ -1555,6 +1580,7 @@ accept_statement (gfc_statement st) case ST_ENDIF: case ST_END_SELECT: + case ST_END_CRITICAL: if (gfc_statement_label != NULL) { new_st.op = EXEC_END_BLOCK; @@ -3047,6 +3073,61 @@ check_do_closure (void) static void parse_progunit (gfc_statement); +/* Parse a CRITICAL block. */ + +static void +parse_critical_block (void) +{ + gfc_code *top, *d; + gfc_state_data s; + gfc_statement st; + + s.ext.end_do_label = new_st.label1; + + accept_statement (ST_CRITICAL); + top = gfc_state_stack->tail; + + push_state (&s, COMP_CRITICAL, gfc_new_block); + + d = add_statement (); + d->op = EXEC_CRITICAL; + top->block = d; + + do + { + st = parse_executable (ST_NONE); + + switch (st) + { + case ST_NONE: + unexpected_eof (); + break; + + case ST_END_CRITICAL: + if (s.ext.end_do_label != NULL + && s.ext.end_do_label != gfc_statement_label) + gfc_error_now ("Statement label in END CRITICAL at %C does not " + "match CRITIAL label"); + + if (gfc_statement_label != NULL) + { + new_st.op = EXEC_NOP; + add_statement (); + } + break; + + default: + unexpected_statement (st); + break; + } + } + while (st != ST_END_CRITICAL); + + pop_state (); + accept_statement (st); +} + + /* Set up the local namespace for a BLOCK construct. */ gfc_namespace* @@ -3472,9 +3553,12 @@ parse_executable (gfc_statement st) case ST_CYCLE: case ST_PAUSE: case ST_STOP: + case ST_ERROR_STOP: case ST_END_SUBROUTINE: case ST_DO: + case ST_CRITICAL: + case ST_BLOCK: case ST_FORALL: case ST_WHERE: case ST_SELECT_CASE: @@ -3522,6 +3606,10 @@ parse_executable (gfc_statement st) return ST_IMPLIED_ENDDO; break; + case ST_CRITICAL: + parse_critical_block (); + break; + case ST_WHERE_BLOCK: parse_where_block (); break; |