Mercurial > hg > CbC > CbC_gcc

comparison gcc/fortran/parse.c @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
1 /* Main parser. 1 /* Main parser.
2 Copyright (C) 2000-2017 Free Software Foundation, Inc. 2 Copyright (C) 2000-2018 Free Software Foundation, Inc.
3 Contributed by Andy Vaught 3 Contributed by Andy Vaught
4 4
5 This file is part of GCC. 5 This file is part of GCC.
6 6
7 GCC is free software; you can redistribute it and/or modify it under 7 GCC is free software; you can redistribute it and/or modify it under
130 do { \ 130 do { \
131 if (match_word (keyword, subr, &old_locus) == MATCH_YES) \ 131 if (match_word (keyword, subr, &old_locus) == MATCH_YES) \
132 return st; \ 132 return st; \
133 else \ 133 else \
134 undo_new_statement (); \ 134 undo_new_statement (); \
135 } while (0); 135 } while (0)
136 136
137 137
138 /* This is a specialist version of decode_statement that is used 138 /* This is a specialist version of decode_statement that is used
139 for the specification statements in a function, whose 139 for the specification statements in a function, whose
140 characteristics are deferred into the specification statements. 140 characteristics are deferred into the specification statements.
449 match (NULL, gfc_match_bind_c_stmt, ST_ATTR_DECL); 449 match (NULL, gfc_match_bind_c_stmt, ST_ATTR_DECL);
450 break; 450 break;
451 451
452 case 'c': 452 case 'c':
453 match ("call", gfc_match_call, ST_CALL); 453 match ("call", gfc_match_call, ST_CALL);
454 match ("change team", gfc_match_change_team, ST_CHANGE_TEAM);
454 match ("close", gfc_match_close, ST_CLOSE); 455 match ("close", gfc_match_close, ST_CLOSE);
455 match ("continue", gfc_match_continue, ST_CONTINUE); 456 match ("continue", gfc_match_continue, ST_CONTINUE);
456 match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL); 457 match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
457 match ("cycle", gfc_match_cycle, ST_CYCLE); 458 match ("cycle", gfc_match_cycle, ST_CYCLE);
458 match ("case", gfc_match_case, ST_CASE); 459 match ("case", gfc_match_case, ST_CASE);
468 match ("dimension", gfc_match_dimension, ST_ATTR_DECL); 469 match ("dimension", gfc_match_dimension, ST_ATTR_DECL);
469 break; 470 break;
470 471
471 case 'e': 472 case 'e':
472 match ("end file", gfc_match_endfile, ST_END_FILE); 473 match ("end file", gfc_match_endfile, ST_END_FILE);
474 match ("end team", gfc_match_end_team, ST_END_TEAM);
473 match ("exit", gfc_match_exit, ST_EXIT); 475 match ("exit", gfc_match_exit, ST_EXIT);
474 match ("else", gfc_match_else, ST_ELSE); 476 match ("else", gfc_match_else, ST_ELSE);
475 match ("else where", gfc_match_elsewhere, ST_ELSEWHERE); 477 match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
476 match ("else if", gfc_match_elseif, ST_ELSEIF); 478 match ("else if", gfc_match_elseif, ST_ELSEIF);
477 match ("error stop", gfc_match_error_stop, ST_ERROR_STOP); 479 match ("error stop", gfc_match_error_stop, ST_ERROR_STOP);
489 491
490 case 'f': 492 case 'f':
491 match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE); 493 match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE);
492 match ("final", gfc_match_final_decl, ST_FINAL); 494 match ("final", gfc_match_final_decl, ST_FINAL);
493 match ("flush", gfc_match_flush, ST_FLUSH); 495 match ("flush", gfc_match_flush, ST_FLUSH);
496 match ("form team", gfc_match_form_team, ST_FORM_TEAM);
494 match ("format", gfc_match_format, ST_FORMAT); 497 match ("format", gfc_match_format, ST_FORMAT);
495 break; 498 break;
496 499
497 case 'g': 500 case 'g':
498 match ("generic", gfc_match_generic, ST_GENERIC); 501 match ("generic", gfc_match_generic, ST_GENERIC);
556 match ("static", gfc_match_static, ST_ATTR_DECL); 559 match ("static", gfc_match_static, ST_ATTR_DECL);
557 match ("submodule", gfc_match_submodule, ST_SUBMODULE); 560 match ("submodule", gfc_match_submodule, ST_SUBMODULE);
558 match ("sync all", gfc_match_sync_all, ST_SYNC_ALL); 561 match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
559 match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES); 562 match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
560 match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY); 563 match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
564 match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM);
561 break; 565 break;
562 566
563 case 't': 567 case 't':
564 match ("target", gfc_match_target, ST_ATTR_DECL); 568 match ("target", gfc_match_target, ST_ATTR_DECL);
565 match ("type", gfc_match_derived_decl, ST_DERIVED_DECL); 569 match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
604 else if (match_word (keyword, subr, &old_locus) \ 608 else if (match_word (keyword, subr, &old_locus) \
605 == MATCH_YES) \ 609 == MATCH_YES) \
606 return st; \ 610 return st; \
607 else \ 611 else \
608 undo_new_statement (); \ 612 undo_new_statement (); \
609 } while (0); 613 } while (0)
610 614
611 static gfc_statement 615 static gfc_statement
612 decode_oacc_directive (void) 616 decode_oacc_directive (void)
613 { 617 {
614 locus old_locus; 618 locus old_locus;
617 621
618 gfc_enforce_clean_symbol_state (); 622 gfc_enforce_clean_symbol_state ();
619 623
620 gfc_clear_error (); /* Clear any pending errors. */ 624 gfc_clear_error (); /* Clear any pending errors. */
621 gfc_clear_warning (); /* Clear any pending warnings. */ 625 gfc_clear_warning (); /* Clear any pending warnings. */
626
627 gfc_matching_function = false;
622 628
623 if (gfc_pure (NULL)) 629 if (gfc_pure (NULL))
624 { 630 {
625 gfc_error_now ("OpenACC directives at %C may not appear in PURE " 631 gfc_error_now ("OpenACC directives at %C may not appear in PURE "
626 "procedures"); 632 "procedures");
726 ret = st; \ 732 ret = st; \
727 goto finish; \ 733 goto finish; \
728 } \ 734 } \
729 else \ 735 else \
730 undo_new_statement (); \ 736 undo_new_statement (); \
731 } while (0); 737 } while (0)
732 738
733 /* Like match, but don't match anything if not -fopenmp 739 /* Like match, but don't match anything if not -fopenmp
734 and if spec_only, goto do_spec_only without actually matching. */ 740 and if spec_only, goto do_spec_only without actually matching. */
735 #define matcho(keyword, subr, st) \ 741 #define matcho(keyword, subr, st) \
736 do { \ 742 do { \
744 ret = st; \ 750 ret = st; \
745 goto finish; \ 751 goto finish; \
746 } \ 752 } \
747 else \ 753 else \
748 undo_new_statement (); \ 754 undo_new_statement (); \
749 } while (0); 755 } while (0)
750 756
751 /* Like match, but set a flag simd_matched if keyword matched. */ 757 /* Like match, but set a flag simd_matched if keyword matched. */
752 #define matchds(keyword, subr, st) \ 758 #define matchds(keyword, subr, st) \
753 do { \ 759 do { \
754 if (match_word_omp_simd (keyword, subr, &old_locus, \ 760 if (match_word_omp_simd (keyword, subr, &old_locus, \
757 ret = st; \ 763 ret = st; \
758 goto finish; \ 764 goto finish; \
759 } \ 765 } \
760 else \ 766 else \
761 undo_new_statement (); \ 767 undo_new_statement (); \
762 } while (0); 768 } while (0)
763 769
764 /* Like match, but don't match anything if not -fopenmp. */ 770 /* Like match, but don't match anything if not -fopenmp. */
765 #define matchdo(keyword, subr, st) \ 771 #define matchdo(keyword, subr, st) \
766 do { \ 772 do { \
767 if (!flag_openmp) \ 773 if (!flag_openmp) \
772 ret = st; \ 778 ret = st; \
773 goto finish; \ 779 goto finish; \
774 } \ 780 } \
775 else \ 781 else \
776 undo_new_statement (); \ 782 undo_new_statement (); \
777 } while (0); 783 } while (0)
778 784
779 static gfc_statement 785 static gfc_statement
780 decode_omp_directive (void) 786 decode_omp_directive (void)
781 { 787 {
782 locus old_locus; 788 locus old_locus;
788 794
789 gfc_enforce_clean_symbol_state (); 795 gfc_enforce_clean_symbol_state ();
790 796
791 gfc_clear_error (); /* Clear any pending errors. */ 797 gfc_clear_error (); /* Clear any pending errors. */
792 gfc_clear_warning (); /* Clear any pending warnings. */ 798 gfc_clear_warning (); /* Clear any pending warnings. */
799
800 gfc_matching_function = false;
793 801
794 if (gfc_current_state () == COMP_FUNCTION 802 if (gfc_current_state () == COMP_FUNCTION
795 && gfc_current_block ()->result->ts.kind == -1) 803 && gfc_current_block ()->result->ts.kind == -1)
796 spec_only = true; 804 spec_only = true;
797 805
1061 gfc_clear_error (); /* Clear any pending errors. */ 1069 gfc_clear_error (); /* Clear any pending errors. */
1062 gfc_clear_warning (); /* Clear any pending warnings. */ 1070 gfc_clear_warning (); /* Clear any pending warnings. */
1063 old_locus = gfc_current_locus; 1071 old_locus = gfc_current_locus;
1064 1072
1065 match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL); 1073 match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
1074 match ("unroll", gfc_match_gcc_unroll, ST_NONE);
1066 1075
1067 /* All else has failed, so give up. See if any of the matchers has 1076 /* All else has failed, so give up. See if any of the matchers has
1068 stored an error message of some sort. */ 1077 stored an error message of some sort. */
1069 1078
1070 if (!gfc_error_check ()) 1079 if (!gfc_error_check ())
1500 case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ 1509 case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
1501 case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ 1510 case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
1502 case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ 1511 case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
1503 case ST_ERROR_STOP: case ST_SYNC_ALL: \ 1512 case ST_ERROR_STOP: case ST_SYNC_ALL: \
1504 case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ 1513 case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
1514 case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
1515 case ST_END_TEAM: case ST_SYNC_TEAM: \
1505 case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \ 1516 case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
1506 case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ 1517 case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
1507 case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA 1518 case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
1508 1519
1509 /* Statements that mark other executable statements. */ 1520 /* Statements that mark other executable statements. */
1831 p = "EVENT WAIT"; 1842 p = "EVENT WAIT";
1832 break; 1843 break;
1833 case ST_FAIL_IMAGE: 1844 case ST_FAIL_IMAGE:
1834 p = "FAIL IMAGE"; 1845 p = "FAIL IMAGE";
1835 break; 1846 break;
1847 case ST_CHANGE_TEAM:
1848 p = "CHANGE TEAM";
1849 break;
1850 case ST_END_TEAM:
1851 p = "END TEAM";
1852 break;
1853 case ST_FORM_TEAM:
1854 p = "FORM TEAM";
1855 break;
1856 case ST_SYNC_TEAM:
1857 p = "SYNC TEAM";
1858 break;
1836 case ST_END_ASSOCIATE: 1859 case ST_END_ASSOCIATE:
1837 p = "END ASSOCIATE"; 1860 p = "END ASSOCIATE";
1838 break; 1861 break;
1839 case ST_END_BLOCK: 1862 case ST_END_BLOCK:
1840 p = "END BLOCK"; 1863 p = "END BLOCK";
2735 2758
2736 gfc_current_ns->code = (p && p->previous) ? p->head : NULL; 2759 gfc_current_ns->code = (p && p->previous) ? p->head : NULL;
2737 gfc_done_2 (); 2760 gfc_done_2 ();
2738 2761
2739 longjmp (eof_buf, 1); 2762 longjmp (eof_buf, 1);
2763
2764 /* Avoids build error on systems where longjmp is not declared noreturn. */
2765 gcc_unreachable ();
2740 } 2766 }
2741 2767
2742 2768
2743 /* Parse the CONTAINS section of a derived type definition. */ 2769 /* Parse the CONTAINS section of a derived type definition. */
2744 2770
3694 case ST_DERIVED_DECL: 3720 case ST_DERIVED_DECL:
3695 case ST_END_BLOCK_DATA: 3721 case ST_END_BLOCK_DATA:
3696 case ST_EQUIVALENCE: 3722 case ST_EQUIVALENCE:
3697 case ST_IMPLICIT: 3723 case ST_IMPLICIT:
3698 case ST_IMPLICIT_NONE: 3724 case ST_IMPLICIT_NONE:
3725 case ST_OMP_THREADPRIVATE:
3699 case ST_PARAMETER: 3726 case ST_PARAMETER:
3700 case ST_STRUCTURE_DECL: 3727 case ST_STRUCTURE_DECL:
3701 case ST_TYPE: 3728 case ST_TYPE:
3702 case ST_USE: 3729 case ST_USE:
3703 break; 3730 break;
4629 4656
4630 do_op = new_st.op; 4657 do_op = new_st.op;
4631 s.ext.end_do_label = new_st.label1; 4658 s.ext.end_do_label = new_st.label1;
4632 4659
4633 if (new_st.ext.iterator != NULL) 4660 if (new_st.ext.iterator != NULL)
4634 stree = new_st.ext.iterator->var->symtree; 4661 {
4662 stree = new_st.ext.iterator->var->symtree;
4663 if (directive_unroll != -1)
4664 {
4665 new_st.ext.iterator->unroll = directive_unroll;
4666 directive_unroll = -1;
4667 }
4668 }
4635 else 4669 else
4636 stree = NULL; 4670 stree = NULL;
4637 4671
4638 accept_statement (ST_DO); 4672 accept_statement (ST_DO);
4639 4673
5387 5421
5388 default: 5422 default:
5389 return st; 5423 return st;
5390 } 5424 }
5391 5425
5426 if (directive_unroll != -1)
5427 gfc_error ("%<GCC unroll%> directive does not commence a loop at %C");
5428
5392 st = next_statement (); 5429 st = next_statement ();
5393 } 5430 }
5394 } 5431 }
5395 5432
5396 5433
6012 6049
6013 /* Resolve all the program units. */ 6050 /* Resolve all the program units. */
6014 static void 6051 static void
6015 resolve_all_program_units (gfc_namespace *gfc_global_ns_list) 6052 resolve_all_program_units (gfc_namespace *gfc_global_ns_list)
6016 { 6053 {
6017 gfc_free_dt_list (); 6054 gfc_derived_types = NULL;
6018 gfc_current_ns = gfc_global_ns_list; 6055 gfc_current_ns = gfc_global_ns_list;
6019 for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) 6056 for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
6020 { 6057 {
6021 if (gfc_current_ns->proc_name 6058 if (gfc_current_ns->proc_name
6022 && gfc_current_ns->proc_name->attr.flavor == FL_MODULE) 6059 && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)