Mercurial > hg > CbC > CbC_gcc

comparison gcc/fortran/trans-openmp.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 /* OpenMP directive translation -- generate GCC trees from gfc_code. 1 /* OpenMP directive translation -- generate GCC trees from gfc_code.
2 Copyright (C) 2005-2017 Free Software Foundation, Inc. 2 Copyright (C) 2005-2018 Free Software Foundation, Inc.
3 Contributed by Jakub Jelinek <jakub@redhat.com> 3 Contributed by Jakub Jelinek <jakub@redhat.com>
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
411 tem = NULL_TREE; 411 tem = NULL_TREE;
412 if (tem) 412 if (tem)
413 { 413 {
414 tem = fold_convert (pvoid_type_node, tem); 414 tem = fold_convert (pvoid_type_node, tem);
415 tem = fold_build2_loc (input_location, NE_EXPR, 415 tem = fold_build2_loc (input_location, NE_EXPR,
416 boolean_type_node, tem, 416 logical_type_node, tem,
417 null_pointer_node); 417 null_pointer_node);
418 then_b = build3_loc (input_location, COND_EXPR, void_type_node, 418 then_b = build3_loc (input_location, COND_EXPR, void_type_node,
419 tem, then_b, 419 tem, then_b,
420 build_empty_stmt (input_location)); 420 build_empty_stmt (input_location));
421 } 421 }
538 538
539 tree tem = fold_convert (pvoid_type_node, 539 tree tem = fold_convert (pvoid_type_node,
540 GFC_DESCRIPTOR_TYPE_P (type) 540 GFC_DESCRIPTOR_TYPE_P (type)
541 ? gfc_conv_descriptor_data_get (outer) : outer); 541 ? gfc_conv_descriptor_data_get (outer) : outer);
542 tem = unshare_expr (tem); 542 tem = unshare_expr (tem);
543 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, 543 cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
544 tem, null_pointer_node); 544 tem, null_pointer_node);
545 gfc_add_expr_to_block (&block, 545 gfc_add_expr_to_block (&block,
546 build3_loc (input_location, COND_EXPR, 546 build3_loc (input_location, COND_EXPR,
547 void_type_node, cond, then_b, 547 void_type_node, cond, then_b,
548 else_b)); 548 else_b));
644 else 644 else
645 gfc_add_modify (&cond_block, unshare_expr (dest), 645 gfc_add_modify (&cond_block, unshare_expr (dest),
646 build_zero_cst (TREE_TYPE (dest))); 646 build_zero_cst (TREE_TYPE (dest)));
647 else_b = gfc_finish_block (&cond_block); 647 else_b = gfc_finish_block (&cond_block);
648 648
649 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, 649 cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
650 unshare_expr (srcptr), null_pointer_node); 650 unshare_expr (srcptr), null_pointer_node);
651 gfc_add_expr_to_block (&block, 651 gfc_add_expr_to_block (&block,
652 build3_loc (input_location, COND_EXPR, 652 build3_loc (input_location, COND_EXPR,
653 void_type_node, cond, then_b, else_b)); 653 void_type_node, cond, then_b, else_b));
654 654
697 WALK_ALLOC_COMPS_DTOR); 697 WALK_ALLOC_COMPS_DTOR);
698 tree tem = fold_convert (pvoid_type_node, 698 tree tem = fold_convert (pvoid_type_node,
699 GFC_DESCRIPTOR_TYPE_P (type) 699 GFC_DESCRIPTOR_TYPE_P (type)
700 ? gfc_conv_descriptor_data_get (dest) : dest); 700 ? gfc_conv_descriptor_data_get (dest) : dest);
701 tem = unshare_expr (tem); 701 tem = unshare_expr (tem);
702 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, 702 cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
703 tem, null_pointer_node); 703 tem, null_pointer_node);
704 tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, 704 tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
705 then_b, build_empty_stmt (input_location)); 705 then_b, build_empty_stmt (input_location));
706 gfc_add_expr_to_block (&block, tem); 706 gfc_add_expr_to_block (&block, tem);
707 } 707 }
737 ? gfc_conv_descriptor_data_get (dest) : dest; 737 ? gfc_conv_descriptor_data_get (dest) : dest;
738 destptr = unshare_expr (destptr); 738 destptr = unshare_expr (destptr);
739 destptr = fold_convert (pvoid_type_node, destptr); 739 destptr = fold_convert (pvoid_type_node, destptr);
740 gfc_add_modify (&cond_block, ptr, destptr); 740 gfc_add_modify (&cond_block, ptr, destptr);
741 741
742 nonalloc = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, 742 nonalloc = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
743 destptr, null_pointer_node); 743 destptr, null_pointer_node);
744 cond = nonalloc; 744 cond = nonalloc;
745 if (GFC_DESCRIPTOR_TYPE_P (type)) 745 if (GFC_DESCRIPTOR_TYPE_P (type))
746 { 746 {
747 int i; 747 int i;
753 gfc_array_index_type, tem, 753 gfc_array_index_type, tem,
754 gfc_conv_descriptor_lbound_get (src, rank)); 754 gfc_conv_descriptor_lbound_get (src, rank));
755 tem = fold_build2_loc (input_location, PLUS_EXPR, 755 tem = fold_build2_loc (input_location, PLUS_EXPR,
756 gfc_array_index_type, tem, 756 gfc_array_index_type, tem,
757 gfc_conv_descriptor_lbound_get (dest, rank)); 757 gfc_conv_descriptor_lbound_get (dest, rank));
758 tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, 758 tem = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
759 tem, gfc_conv_descriptor_ubound_get (dest, 759 tem, gfc_conv_descriptor_ubound_get (dest,
760 rank)); 760 rank));
761 cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, 761 cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
762 boolean_type_node, cond, tem); 762 logical_type_node, cond, tem);
763 } 763 }
764 } 764 }
765 765
766 gfc_init_block (&cond_block2); 766 gfc_init_block (&cond_block2);
767 767
833 gfc_add_modify (&cond_block, unshare_expr (dest), 833 gfc_add_modify (&cond_block, unshare_expr (dest),
834 build_zero_cst (TREE_TYPE (dest))); 834 build_zero_cst (TREE_TYPE (dest)));
835 } 835 }
836 else_b = gfc_finish_block (&cond_block); 836 else_b = gfc_finish_block (&cond_block);
837 837
838 cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, 838 cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
839 unshare_expr (srcptr), null_pointer_node); 839 unshare_expr (srcptr), null_pointer_node);
840 gfc_add_expr_to_block (&block, 840 gfc_add_expr_to_block (&block,
841 build3_loc (input_location, COND_EXPR, 841 build3_loc (input_location, COND_EXPR,
842 void_type_node, cond, 842 void_type_node, cond,
843 then_b, else_b)); 843 then_b, else_b));
1026 1026
1027 tem = fold_convert (pvoid_type_node, 1027 tem = fold_convert (pvoid_type_node,
1028 GFC_DESCRIPTOR_TYPE_P (type) 1028 GFC_DESCRIPTOR_TYPE_P (type)
1029 ? gfc_conv_descriptor_data_get (decl) : decl); 1029 ? gfc_conv_descriptor_data_get (decl) : decl);
1030 tem = unshare_expr (tem); 1030 tem = unshare_expr (tem);
1031 tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, 1031 tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
1032 tem, null_pointer_node); 1032 tem, null_pointer_node);
1033 tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, 1033 tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
1034 then_b, build_empty_stmt (input_location)); 1034 then_b, build_empty_stmt (input_location));
1035 } 1035 }
1036 return tem; 1036 return tem;
1127 gfc_add_modify (&cond_block, size, zero); 1127 gfc_add_modify (&cond_block, size, zero);
1128 else_b = gfc_finish_block (&cond_block); 1128 else_b = gfc_finish_block (&cond_block);
1129 tem = gfc_conv_descriptor_data_get (decl); 1129 tem = gfc_conv_descriptor_data_get (decl);
1130 tem = fold_convert (pvoid_type_node, tem); 1130 tem = fold_convert (pvoid_type_node, tem);
1131 cond = fold_build2_loc (input_location, NE_EXPR, 1131 cond = fold_build2_loc (input_location, NE_EXPR,
1132 boolean_type_node, tem, null_pointer_node); 1132 logical_type_node, tem, null_pointer_node);
1133 gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, 1133 gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
1134 void_type_node, cond, 1134 void_type_node, cond,
1135 then_b, else_b)); 1135 then_b, else_b));
1136 } 1136 }
1137 else 1137 else
1621 intrinsic_sym.name = iname; 1621 intrinsic_sym.name = iname;
1622 intrinsic_sym.ts = sym->ts; 1622 intrinsic_sym.ts = sym->ts;
1623 intrinsic_sym.attr.referenced = 1; 1623 intrinsic_sym.attr.referenced = 1;
1624 intrinsic_sym.attr.intrinsic = 1; 1624 intrinsic_sym.attr.intrinsic = 1;
1625 intrinsic_sym.attr.function = 1; 1625 intrinsic_sym.attr.function = 1;
1626 intrinsic_sym.attr.implicit_type = 1;
1626 intrinsic_sym.result = &intrinsic_sym; 1627 intrinsic_sym.result = &intrinsic_sym;
1627 intrinsic_sym.declared_at = where; 1628 intrinsic_sym.declared_at = where;
1628 1629
1629 symtree4 = gfc_new_symtree (&root4, iname); 1630 symtree4 = gfc_new_symtree (&root4, iname);
1630 symtree4->n.sym = &intrinsic_sym; 1631 symtree4->n.sym = &intrinsic_sym;
1946 OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1; 1947 OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1;
1947 OMP_CLAUSE_LINEAR_STEP (node) = last_step; 1948 OMP_CLAUSE_LINEAR_STEP (node) = last_step;
1948 } 1949 }
1949 else 1950 else
1950 { 1951 {
1951 tree type = gfc_typenode_for_spec (&n->sym->ts); 1952 if (kind == OMP_CLAUSE_LINEAR_REF)
1952 OMP_CLAUSE_LINEAR_STEP (node) 1953 {
1953 = fold_convert (type, last_step); 1954 tree type;
1955 if (n->sym->attr.flavor == FL_PROCEDURE)
1956 {
1957 type = gfc_get_function_type (n->sym);
1958 type = build_pointer_type (type);
1959 }
1960 else
1961 type = gfc_sym_type (n->sym);
1962 if (POINTER_TYPE_P (type))
1963 type = TREE_TYPE (type);
1964 /* Otherwise to be determined what exactly
1965 should be done. */
1966 tree t = fold_convert (sizetype, last_step);
1967 t = size_binop (MULT_EXPR, t,
1968 TYPE_SIZE_UNIT (type));
1969 OMP_CLAUSE_LINEAR_STEP (node) = t;
1970 }
1971 else
1972 {
1973 tree type
1974 = gfc_typenode_for_spec (&n->sym->ts);
1975 OMP_CLAUSE_LINEAR_STEP (node)
1976 = fold_convert (type, last_step);
1977 }
1954 } 1978 }
1955 if (n->sym->attr.dimension || n->sym->attr.allocatable) 1979 if (n->sym->attr.dimension || n->sym->attr.allocatable)
1956 OMP_CLAUSE_LINEAR_ARRAY (node) = 1; 1980 OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
1957 omp_clauses = gfc_trans_add_clause (node, omp_clauses); 1981 omp_clauses = gfc_trans_add_clause (node, omp_clauses);
1958 } 1982 }
2153 gfc_add_modify (&cond_block, size, zero); 2177 gfc_add_modify (&cond_block, size, zero);
2154 else_b = gfc_finish_block (&cond_block); 2178 else_b = gfc_finish_block (&cond_block);
2155 tem = gfc_conv_descriptor_data_get (decl); 2179 tem = gfc_conv_descriptor_data_get (decl);
2156 tem = fold_convert (pvoid_type_node, tem); 2180 tem = fold_convert (pvoid_type_node, tem);
2157 cond = fold_build2_loc (input_location, NE_EXPR, 2181 cond = fold_build2_loc (input_location, NE_EXPR,
2158 boolean_type_node, 2182 logical_type_node,
2159 tem, null_pointer_node); 2183 tem, null_pointer_node);
2160 gfc_add_expr_to_block (block, 2184 gfc_add_expr_to_block (block,
2161 build3_loc (input_location, 2185 build3_loc (input_location,
2162 COND_EXPR, 2186 COND_EXPR,
2163 void_type_node, 2187 void_type_node,
2869 if (clauses->par_auto) 2893 if (clauses->par_auto)
2870 { 2894 {
2871 c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO); 2895 c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO);
2872 omp_clauses = gfc_trans_add_clause (c, omp_clauses); 2896 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2873 } 2897 }
2898 if (clauses->if_present)
2899 {
2900 c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF_PRESENT);
2901 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2902 }
2903 if (clauses->finalize)
2904 {
2905 c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINALIZE);
2906 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2907 }
2874 if (clauses->independent) 2908 if (clauses->independent)
2875 { 2909 {
2876 c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT); 2910 c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT);
2877 omp_clauses = gfc_trans_add_clause (c, omp_clauses); 2911 omp_clauses = gfc_trans_add_clause (c, omp_clauses);
2878 } 2912 }
3597 { 3631 {
3598 TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from); 3632 TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
3599 /* The condition should not be folded. */ 3633 /* The condition should not be folded. */
3600 TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0 3634 TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
3601 ? LE_EXPR : GE_EXPR, 3635 ? LE_EXPR : GE_EXPR,
3602 boolean_type_node, dovar, to); 3636 logical_type_node, dovar, to);
3603 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR, 3637 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
3604 type, dovar, step); 3638 type, dovar, step);
3605 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, 3639 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
3606 MODIFY_EXPR, 3640 MODIFY_EXPR,
3607 type, dovar, 3641 type, dovar,
3624 count = gfc_create_var (type, "count"); 3658 count = gfc_create_var (type, "count");
3625 TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count, 3659 TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
3626 build_int_cst (type, 0)); 3660 build_int_cst (type, 0));
3627 /* The condition should not be folded. */ 3661 /* The condition should not be folded. */
3628 TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR, 3662 TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
3629 boolean_type_node, 3663 logical_type_node,
3630 count, tmp); 3664 count, tmp);
3631 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR, 3665 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
3632 type, count, 3666 type, count,
3633 build_int_cst (type, 1)); 3667 build_int_cst (type, 1));
3634 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, 3668 TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,