Jakub Jelinek - [gomp] Fix gimplify_omp_atomic_pipeline plus some Fortran stuff (original) (raw)

This is the mail archive of the gcc-patches@gcc.gnu.orgmailing list for the GCC project.

• From: Jakub Jelinek
• To: Richard Henderson , Diego Novillo
• Cc: gcc-patches at gcc dot gnu dot org
• Date: Wed, 28 Sep 2005 08:20:35 -0400
• Subject: [gomp] Fix gimplify_omp_atomic_pipeline plus some Fortran stuff
• Reply-to: Jakub Jelinek

Hi!

This patch

1. fixes a comment typo
2. fixes gimplify_omp_atomic_pipeline, as shown with the new atomic-10.c testcase which generated undefined references to __sync_compare_and_swap_4
3. implements Fortran !$omp atomic using OMP_ATOMIC rather than hand-coding it
4. creates OMP_CLAUSE_REDUCTION and OMP_SINGLE Remapping in FE will need more work.

Ok for the generic bits?

2005-09-28 Jakub Jelinek jakub@redhat.com

* tree.def (OMP_SINGLE): Fix a comment typo.
* gimplify.c (gimplify_omp_atomic_pipeline): Fix type of
pointer argument to BUILT_IN_VAL_COMPARE_AND_SWAP_x.

* trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_REDUCTION
clauses.
(gfc_trans_omp_atomic): Build OMP_ATOMIC instead of expanding
sync builtins directly.
(gfc_trans_omp_single): Build OMP_SINGLE statement.

* gcc.dg/gomp/atomic-10.c: New test.

--- gcc/tree.def.jj 2005-09-28 09:23:35.000000000 +0200 +++ gcc/tree.def 2005-09-28 12:42:20.000000000 +0200 @@ -998,7 +998,7 @@ DEFTREECODE (OMP_SECTION, "omp_section", /* OpenMP - #pragma omp single Operand 0: OMP_SINGLE_CLAUSES: List of clauses. - Operand 0: OMP_SINGLE_BODY: Single section body. */ + Operand 1: OMP_SINGLE_BODY: Single section body. / DEFTREECODE (OMP_SINGLE, "omp_single", tcc_statement, 2) / OpenMP - #pragma omp critical [name] --- gcc/gimplify.c.jj 2005-09-28 10:17:02.000000000 +0200 +++ gcc/gimplify.c 2005-09-28 13:50:08.000000000 +0200 @@ -4879,7 +4879,7 @@ gimplify_omp_atomic_pipeline (tree *expr tree rhs, int index) { tree oldval, oldival, newval, newival, label; - tree type, itype, cmpxchg, args, x; + tree type, itype, cmpxchg, args, x, iaddr; cmpxchg = built_in_decls[BUILT_IN_VAL_COMPARE_AND_SWAP_N + index + 1]; type = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (addr))); @@ -4904,6 +4904,7 @@ gimplify_omp_atomic_pipeline (tree *expr { oldival = oldval; newival = newval; + iaddr = addr; } else { @@ -4913,6 +4914,7 @@ gimplify_omp_atomic_pipeline (tree *expr x = build1 (VIEW_CONVERT_EXPR, itype, oldval); x = build2 (MODIFY_EXPR, void_type_node, oldival, x); gimplify_and_add (x, pre_p); + iaddr = fold_convert (build_pointer_type (itype), addr); } label = create_artificial_label (); @@ -4931,7 +4933,7 @@ gimplify_omp_atomic_pipeline (tree *expr args = tree_cons (NULL, fold_convert (itype, newival), NULL); args = tree_cons (NULL, fold_convert (itype, oldival), args); - args = tree_cons (NULL, addr, args); + args = tree_cons (NULL, iaddr, args); x = build_function_call_expr (cmpxchg, args); if (oldval == oldival) x = fold_convert (type, x); --- gcc/fortran/trans-openmp.c.jj 2005-09-27 13:25:53.000000000 +0200 +++ gcc/fortran/trans-openmp.c 2005-09-28 13:01:22.000000000 +0200 @@ -73,7 +73,55 @@ gfc_trans_omp_clauses (stmtblock_t *bloc if (clause >= OMP_LIST_REDUCTION_FIRST && clause <= OMP_LIST_REDUCTION_LAST) { - /* FIXME: reductions not handled yet. */ + enum tree_code reduction_code; + switch (clause) + { + case OMP_LIST_PLUS: + reduction_code = PLUS_EXPR; + break; + case OMP_LIST_MULT: + reduction_code = MULT_EXPR; + break; + case OMP_LIST_SUB: + reduction_code = MINUS_EXPR; + break; + case OMP_LIST_AND: + reduction_code = TRUTH_ANDIF_EXPR; + break; + case OMP_LIST_OR: + reduction_code = TRUTH_ORIF_EXPR; + break; + case OMP_LIST_EQV: + reduction_code = EQ_EXPR; + break; + case OMP_LIST_NEQV: + reduction_code = NE_EXPR; + break; + case OMP_LIST_MAX: + reduction_code = MAX_EXPR; + break; + case OMP_LIST_MIN: + reduction_code = MIN_EXPR; + break; + case OMP_LIST_IAND: + reduction_code = BIT_AND_EXPR; + break; + case OMP_LIST_IOR: + reduction_code = BIT_IOR_EXPR; + break; + case OMP_LIST_IEOR: + reduction_code = BIT_XOR_EXPR; + break; + default: + gcc_unreachable (); + } + list = gfc_trans_omp_variable_list (n); + if (list != NULL_TREE) + { + list = build1 (OMP_CLAUSE_REDUCTION, NULL_TREE, list); + OMP_CLAUSE_REDUCTION_CODE (list) = reduction_code; + omp_clauses = tree_cons (NULL_TREE, list, omp_clauses); + } continue; } switch (clause) @@ -190,12 +238,9 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_expr *expr2, *e; gfc_symbol *var; stmtblock_t block; - int size; - tree lhsaddr, type, itype, x, oldival, oldval, newival, newval; - tree lhsiaddr, rhsval, label; + tree lhsaddr, type, rhs, x; enum tree_code op = ERROR_MARK; bool var_on_left = false; - enum built_in_function bcode; code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); @@ -329,146 +374,22 @@ gfc_trans_omp_atomic (gfc_code code) expr2 = expr2->value.function.actual->next->expr; } - / When possible, use specialized atomic update functions. / - if (code->expr->ts.type == BT_INTEGER && expr2->ts.type == BT_INTEGER) - { - switch (op) - { - case PLUS_EXPR: - bcode = BUILT_IN_FETCH_AND_ADD_N; - goto maybe_do_fetch_op; - case MINUS_EXPR: - if (var_on_left) - { - bcode = BUILT_IN_FETCH_AND_SUB_N; - goto maybe_do_fetch_op; - } - break; - case BIT_AND_EXPR: - bcode = BUILT_IN_FETCH_AND_AND_N; - goto maybe_do_fetch_op; - case BIT_IOR_EXPR: - bcode = BUILT_IN_FETCH_AND_OR_N; - goto maybe_do_fetch_op; - case BIT_XOR_EXPR: - bcode = BUILT_IN_FETCH_AND_XOR_N; - / FALLTHROUGH / - maybe_do_fetch_op: - switch (code->expr->ts.kind) - { - case 1: - bcode += 1; - goto do_fetch_op; - case 2: - bcode += 2; - goto do_fetch_op; - case 4: - bcode += 3; - goto do_fetch_op; - case 8: - bcode += 4; - / FALLTHROUGH */ - do_fetch_op: - x = gfc_chainon_list (NULL_TREE, lhsaddr); - x = gfc_chainon_list (x, convert (type, rse.expr)); - x = gfc_build_function_call (built_in_decls[bcode], x); - gfc_add_expr_to_block (&block, x); - goto finish; - default: - break; - } - break; - default: - break; - } - }

• /* In these cases, we don't have specialized __sync builtins,

• so we need to implement a compare and swap loop.  */

• itype = NULL;
• size = GET_MODE_PRECISION (TYPE_MODE (type));
• if (code->expr->ts.type != BT_INTEGER && code->expr->ts.type != BT_LOGICAL)
• itype = gfc_type_for_size (size, true);
• oldival = oldval = gfc_create_var (type, "oldval");
• newival = newval = gfc_create_var (type, "newval");
• lhsiaddr = lhsaddr = save_expr (lhsaddr);
• if (itype)
• {

•  oldival = gfc_create_var (itype, "oldival");

•  newival = gfc_create_var (itype, "newival");

•  lhsiaddr = convert (build_pointer_type (itype), lhsaddr);

• }
• if (TREE_CONSTANT (rse.expr))
• rhsval = rse.expr;
• else
• rhsval = gfc_create_var (TREE_TYPE (rse.expr), "rhsval");
• label = gfc_build_label_decl (NULL_TREE);
• TREE_USED (label) = 1;
• gfc_add_modify_expr (&block, oldval, gfc_build_indirect_ref (lhsaddr));
• if (itype)
• gfc_add_modify_expr (&block, oldival,

•       build1 (VIEW_CONVERT_EXPR, itype, oldval));

• if (!TREE_CONSTANT (rse.expr))
• gfc_add_modify_expr (&block, rhsval, rse.expr);
• gfc_add_expr_to_block (&block, build1_v (LABEL_EXPR, label));
• x = convert (TREE_TYPE (rhsval), oldval);

• lhsaddr = save_expr (lhsaddr);

• rhs = gfc_evaluate_now (rse.expr, &block);

• x = convert (TREE_TYPE (rhs), gfc_build_indirect_ref (lhsaddr));

  if (var_on_left)

• x = fold_build2 (op, TREE_TYPE (rhsval), x, rhsval);

• x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);

else - x = fold_build2 (op, TREE_TYPE (rhsval), rhsval, x); + x = fold_build2 (op, TREE_TYPE (rhs), rhs, x); - if (TREE_CODE (TREE_TYPE (rhsval)) == COMPLEX_TYPE + if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE && TREE_CODE (type) != COMPLEX_TYPE) - x = build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhsval)), x);

• gfc_add_modify_expr (&block, newval, convert (type, x));

• x = build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (rhs)), x);

• if (itype)
• gfc_add_modify_expr (&block, newival,

•       build1 (VIEW_CONVERT_EXPR, itype, newval));

• bcode = BUILT_IN_VAL_COMPARE_AND_SWAP_N;
• switch (size)
• {
• case 8:

•  bcode += 1;

•  break;

• case 16:

•  bcode += 2;

•  break;

• case 32:

•  bcode += 3;

•  break;

• case 64:

•  bcode += 4;

•  break;

• default:

•  gcc_unreachable ();

• }
• x = gfc_chainon_list (NULL_TREE, lhsiaddr);
• x = gfc_chainon_list (x, oldival);
• x = gfc_chainon_list (x, newival);
• x = gfc_build_function_call (built_in_decls[bcode], x);
• gfc_add_modify_expr (&block, oldival, convert (TREE_TYPE (oldival), x));
• if (itype)
• gfc_add_modify_expr (&block, oldval,

•       build1 (VIEW_CONVERT_EXPR, type, oldival));

• x = build2 (NE_EXPR, boolean_type_node, oldival, newival);
• x = build3_v (COND_EXPR, x, build1_v (GOTO_EXPR, label),

•   build_empty_stmt ());

• x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); gfc_add_expr_to_block (&block, x);

-finish: gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre);

@@ -809,8 +730,11 @@ gfc_trans_omp_sections (gfc_code *code, static tree gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses) {

• gfc_trans_omp_clauses (NULL, clauses);
• return gfc_trans_code (code->block->next);

• tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses);
• tree stmt = gfc_trans_code (code->block->next);
• if (omp_not_yet)
• stmt = build2_v (OMP_SINGLE, omp_clauses, stmt);
• return stmt; }

static tree --- gcc/testsuite/gcc.dg/gomp/atomic-10.c.jj 2005-09-28 13:57:32.000000000 +0200 +++ gcc/testsuite/gcc.dg/gomp/atomic-10.c 2005-09-28 14:10:50.000000000 +0200 @@ -0,0 +1,140 @@ +/* { dg-do run } / +/ { dg-options "-O2 -fopenmp" } */ + +extern void abort (void); +int x1, x2, x3, x4, x5; +volatile int y6 = 9, y2, y3, y4, y5; +volatile unsigned char z1, z2, z3, z4, z5; +float a1, a2, a3, a4; + +void +f1 (void) +{

• #pragma omp atomic
• x1++;
• #pragma omp atomic
• x2--;
• #pragma omp atomic
• ++x3;
• #pragma omp atomic
• --x4;
• #pragma omp atomic
• x5 += 1;
• #pragma omp atomic
• x1 -= y6;
• #pragma omp atomic
• x2 |= 1;
• #pragma omp atomic
• x3 &= 1;
• #pragma omp atomic
• x4 ^= 1;
• #pragma omp atomic
• x5 *= 3;
• #pragma omp atomic
• x1 /= 3;
• #pragma omp atomic
• x2 /= 3;
• #pragma omp atomic
• x3 <<= 3;
• #pragma omp atomic
• x4 >>= 3;

+} + +void +f2 (void) +{

• #pragma omp atomic
• y6++;
• #pragma omp atomic
• y2--;
• #pragma omp atomic
• ++y3;
• #pragma omp atomic
• --y4;
• #pragma omp atomic
• y5 += 1;
• #pragma omp atomic
• y6 -= x1;
• #pragma omp atomic
• y2 |= 1;
• #pragma omp atomic
• y3 &= 1;
• #pragma omp atomic
• y4 ^= 1;
• #pragma omp atomic
• y5 *= 3;
• #pragma omp atomic
• y6 /= 3;
• #pragma omp atomic
• y2 /= 3;
• #pragma omp atomic
• y3 <<= 3;
• #pragma omp atomic
• y4 >>= 3;

+} + +void +f3 (void) +{

• #pragma omp atomic
• z1++;
• #pragma omp atomic
• z2--;
• #pragma omp atomic
• ++z3;
• #pragma omp atomic
• --z4;
• #pragma omp atomic
• z5 += 1;
• #pragma omp atomic
• z1 |= 1;
• #pragma omp atomic
• z2 &= 1;
• #pragma omp atomic
• z3 ^= 1;
• #pragma omp atomic
• z4 *= 3;
• #pragma omp atomic
• z5 /= 3;
• #pragma omp atomic
• z1 /= 3;
• #pragma omp atomic
• z2 <<= 3;
• #pragma omp atomic
• z3 >>= 3;

+} + +void +f4 (void) +{

• #pragma omp atomic
• a1 += 8.0;
• #pragma omp atomic
• a2 *= 3.5;
• #pragma omp atomic
• a3 -= a1 + a2;
• #pragma omp atomic
• a4 /= 2.0;

+} + +int +main (void) +{

• f1 ();

• if (x1 != -2 || x2 != 0 || x3 != 8 || x4 != -1 || x5 != 3)

• abort ();

• f2 ();

• if (y6 != 4 || y2 != 0 || y3 != 8 || y4 != -1 || y5 != 3)

• abort ();

• f3 ();

• if (z1 != 0 || z2 != 8 || z3 != 0 || z4 != 253 || z5 != 0)

• abort ();

• a1 = 7;

• a2 = 10;

• a3 = 11;

• a4 = 13;

• f4 ();

• if (a1 != 15.0 || a2 != 35.0 || a3 != -39.0 || a4 != 6.5)

• abort ();

• return 0; +}

  Jakub

• Follow-Ups:
  • Re: [gomp] Fix gimplify_omp_atomic_pipeline plus some Fortran stuff
    * From: Diego Novillo
  • Re: [gomp] Fix gimplify_omp_atomic_pipeline plus some Fortran stuff
    * From: Richard Henderson