From patchwork Tue May 31 16:24:01 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 98058 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 88485B6F77 for ; Wed, 1 Jun 2011 02:24:59 +1000 (EST) Received: (qmail 6353 invoked by alias); 31 May 2011 16:24:52 -0000 Received: (qmail 6156 invoked by uid 22791); 31 May 2011 16:24:48 -0000 X-SWARE-Spam-Status: No, hits=-0.9 required=5.0 tests=AWL, BAYES_00, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, TW_MV, TW_TM, TW_VB X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 31 May 2011 16:24:04 +0000 Received: from [192.168.178.22] (port-92-204-18-93.dynamic.qsc.de [92.204.18.93]) by mx01.qsc.de (Postfix) with ESMTP id E90DC8C7A; Tue, 31 May 2011 18:24:02 +0200 (CEST) Message-ID: <4DE51621.8070707@net-b.de> Date: Tue, 31 May 2011 18:24:01 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.14) Gecko/20110221 SUSE/3.1.8 Thunderbird/3.1.8 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] -fcoarray=single implementation of the atomic subroutines Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch adds the atomic_define and atomic_ref intrinsics. They are currently implemented in form a simple assignment. For -fcoarray=lib they will be replaced by a function call to libcaf_{single,mpi,*}. I was shortly thinking of using something more clever, but I concluded that a simple assignment should be sufficiently atomic (for -fcoarray=single). Build and regtested on x86-64-linux. OK for the trunk? Tobias b/gcc/fortran/check.c | 65 ++++++++++++++ b/gcc/fortran/gfortran.h | 2 b/gcc/fortran/intrinsic.c | 16 +++ b/gcc/fortran/intrinsic.h | 4 b/gcc/fortran/intrinsic.texi | 96 +++++++++++++++++++++ b/gcc/fortran/iresolve.c | 16 +++ b/gcc/fortran/iso-fortran-env.def | 4 b/gcc/fortran/trans-intrinsic.c | 68 ++++++++++++++ b/gcc/fortran/trans.c | 17 ++- b/gcc/fortran/trans.h | 5 - gcc/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 | 27 +++++ gcc/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 | 21 ++++ 12 files changed, 326 insertions(+), 15 deletions(-) 2011-05-31 Tobias Burnus PR fortran/18918 * intrinsic.c (klass): Add CLASS_ATOMIC. (add_subroutines): Add atomic_ref/atomic_define. * intrinsic.texi (ATOMIC_REF, ATOMIC_DEFINE): Document. * intrinsic.h (gfc_check_atomic_def, gfc_check_atomic_ref, gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New prototypes. * gfortran.h (gfc_isym_id): Add GFC_ISYM_ATOMIC_DEF and GFC_ISYM_ATOMIC_REF. * iresolve.c (gfc_resolve_atomic_def, gfc_resolve_atomic_ref): New functions. * check.c (gfc_check_atomic, gfc_check_atomic_def, gfc_check_atomic_ref): New functions. * iso-fortran-env.def (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND): Change kind value. * trans-intrinsic.c (conv_intrinsic_atomic_def, conv_intrinsic_atomic_ref, gfc_conv_intrinsic_subroutine): New functions. (conv_intrinsic_move_alloc) Renamed from gfc_conv_intrinsic_move_alloc - and made static. * trans.h (gfc_conv_intrinsic_move_alloc): Remove. (gfc_conv_intrinsic_subroutine) Add prototype. * trans.c (trans_code): Call gfc_conv_intrinsic_subroutine. 2011-05-31 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray_atomic_1.f90: New. * gfortran.dg/coarray/atomic_1.f90: New. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 70c23e6..0e6b2d8 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -973,6 +973,71 @@ gfc_check_atan2 (gfc_expr *y, gfc_expr *x) } +static gfc_try +gfc_check_atomic (gfc_expr *atom, gfc_expr *value) +{ + if (!(atom->ts.type == BT_INTEGER && atom->ts.kind == gfc_c_int_kind) + && !(atom->ts.type == BT_LOGICAL && atom->ts.kind == gfc_c_int_kind)) + { + gfc_error ("ATOM argument at %L to intrinsic function %s shall be an " + "integer of ATOMIC_INT_KIND or a logical of " + "ATOMIC_LOGICAL_KIND", &atom->where, gfc_current_intrinsic); + return FAILURE; + } + + if (!gfc_expr_attr (atom).codimension) + { + gfc_error ("ATOM argument at %L of the %s intrinsic function shall be a " + "coarray or coindexed", &atom->where, gfc_current_intrinsic); + return FAILURE; + } + + if (atom->ts.type != value->ts.type) + { + gfc_error ("ATOM and VALUE argument of the %s intrinsic function shall " + "have the same type at %L", gfc_current_intrinsic, + &value->where); + return FAILURE; + } + + return SUCCESS; +} + + +gfc_try +gfc_check_atomic_def (gfc_expr *atom, gfc_expr *value) +{ + if (scalar_check (atom, 0) == FAILURE || scalar_check (value, 1) == FAILURE) + return FAILURE; + + if (gfc_check_vardef_context (atom, false, NULL) == FAILURE) + { + gfc_error ("ATOM argument of the %s intrinsic function at %L shall be " + "definable", gfc_current_intrinsic, &atom->where); + return FAILURE; + } + + return gfc_check_atomic (atom, value); +} + + +gfc_try +gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom) +{ + if (scalar_check (value, 0) == FAILURE || scalar_check (atom, 1) == FAILURE) + return FAILURE; + + if (gfc_check_vardef_context (value, false, NULL) == FAILURE) + { + gfc_error ("VALUE argument of the %s intrinsic function at %L shall be " + "definable", gfc_current_intrinsic, &value->where); + return FAILURE; + } + + return gfc_check_atomic (atom, value); +} + + /* BESJN and BESYN functions. */ gfc_try diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 72e412b..b2b2e84 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -306,6 +306,8 @@ enum gfc_isym_id GFC_ISYM_ATAN, GFC_ISYM_ATAN2, GFC_ISYM_ATANH, + GFC_ISYM_ATOMIC_DEF, + GFC_ISYM_ATOMIC_REF, GFC_ISYM_BGE, GFC_ISYM_BGT, GFC_ISYM_BIT_SIZE, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 6151db7..c6d958f 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -51,7 +51,7 @@ sizing; enum klass { CLASS_IMPURE = 0, CLASS_PURE, CLASS_ELEMENTAL, - CLASS_INQUIRY, CLASS_TRANSFORMATIONAL }; + CLASS_INQUIRY, CLASS_TRANSFORMATIONAL, CLASS_ATOMIC }; #define ACTUAL_NO 0 #define ACTUAL_YES 1 @@ -2880,6 +2880,18 @@ add_subroutines (void) make_noreturn(); + add_sym_2s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC, + BT_UNKNOWN, 0, GFC_STD_F2008, + gfc_check_atomic_def, NULL, gfc_resolve_atomic_def, + "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT, + "value", BT_INTEGER, di, REQUIRED, INTENT_IN); + + add_sym_2s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC, + BT_UNKNOWN, 0, GFC_STD_F2008, + gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref, + "value", BT_INTEGER, di, REQUIRED, INTENT_OUT, + "atom", BT_INTEGER, di, REQUIRED, INTENT_IN); + add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time, tm, BT_REAL, dr, REQUIRED, INTENT_OUT); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 88ce008..e64325b 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -39,6 +39,8 @@ gfc_try gfc_check_allocated (gfc_expr *); gfc_try gfc_check_associated (gfc_expr *, gfc_expr *); gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *); gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *); +gfc_try gfc_check_atomic_def (gfc_expr *, gfc_expr *); +gfc_try gfc_check_atomic_ref (gfc_expr *, gfc_expr *); gfc_try gfc_check_besn (gfc_expr *, gfc_expr *); gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *); gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *); @@ -414,6 +416,8 @@ void gfc_resolve_asinh (gfc_expr *, gfc_expr *); void gfc_resolve_atan (gfc_expr *, gfc_expr *); void gfc_resolve_atanh (gfc_expr *, gfc_expr *); void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_atomic_def (gfc_code *); +void gfc_resolve_atomic_ref (gfc_code *); void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *a); void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 2ea4fc5..cb46a77 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -61,6 +61,8 @@ Some basic guidelines for editing this document: * @code{ATAN}: ATAN, Arctangent function * @code{ATAN2}: ATAN2, Arctangent function * @code{ATANH}: ATANH, Inverse hyperbolic tangent function +* @code{ATOMIC_DEFINE}: ATOMIC_DEFINE, Setting a variable atomically +* @code{ATOMIC_REF}: ATOMIC_REF, Obtaining the value of a variable atomically * @code{BESSEL_J0}: BESSEL_J0, Bessel function of the first kind of order 0 * @code{BESSEL_J1}: BESSEL_J1, Bessel function of the first kind of order 1 * @code{BESSEL_JN}: BESSEL_JN, Bessel function of the first kind @@ -1546,6 +1548,100 @@ Inverse function: @ref{TANH} +@node ATOMIC_DEFINE +@section @code{ATOMIC_DEFINE} --- Setting a variable atomically +@fnindex ATOMIC_DEFINE +@cindex Atomic subroutine, define + +@table @asis +@item @emph{Description}: +@code{ATOMIC_DEFINE(ATOM, VALUE)} defines the variable @var{ATOM} with the value +@var{VALUE} atomically. + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Atomic subroutine + +@item @emph{Syntax}: +@code{CALL ATOMIC_DEFINE(ATOM, VALUE)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{ATOM} @tab Scalar coarray or coindexed variable of either integer + type with @code{ATOMIC_INT_KIND} kind or logical type + with @code{ATOMIC_LOGICAL_KIND} kind. +@item @var{VALURE} @tab Scalar and of the same type as @var{ATOM}. If the kind + is different, the value is converted to the kind of + @var{ATOM}. +@end multitable + +@item @emph{Example}: +@smallexample +program atomic + use iso_fortran_env + integer(atomic_int_kind) :: atom[*] + call atomic_define (atom[1], this_image()) +end program atomic +@end smallexample + +@item @emph{See also}: +@ref{ATOMIC_REF}, @ref{ISO_FORTRAN_ENV} +@end table + + + +@node ATOMIC_REF +@section @code{ATOMIC_REF} --- Obtaining the value of a variable atomically +@fnindex ATOMIC_REF +@cindex Atomic subroutine, reference + +@table @asis +@item @emph{Description}: +@code{ATOMIC_DEFINE(ATOM, VALUE)} atomically assigns the value of the +variable @var{ATOM} to @var{VALUE}. + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Atomic subroutine + +@item @emph{Syntax}: +@code{CALL ATOMIC_REF(VALUE, ATOM)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{VALURE} @tab Scalar and of the same type as @var{ATOM}. If the kind + is different, the value is converted to the kind of + @var{ATOM}. +@item @var{ATOM} @tab Scalar coarray or coindexed variable of either integer + type with @code{ATOMIC_INT_KIND} kind or logical type + with @code{ATOMIC_LOGICAL_KIND} kind. +@end multitable + +@item @emph{Example}: +@smallexample +program atomic + use iso_fortran_env + logical(atomic_logical_kind) :: atom[*] + logical :: val + call atomic_ref (atom, .false.) + ! ... + call atomic_ref (atom, val) + if (val) then + print *, "Obtained" + end if +end program atomic +@end smallexample + +@item @emph{See also}: +@ref{ATOMIC_DEFINE}, @ref{ISO_FORTRAN_ENV} +@end table + + + @node BESSEL_J0 @section @code{BESSEL_J0} --- Bessel function of the first kind of order 0 @fnindex BESSEL_J0 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 24c9f76..9d94e3b 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2895,6 +2895,22 @@ create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints) void +gfc_resolve_atomic_def (gfc_code *c) +{ + const char *name = "atomic_define"; + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void +gfc_resolve_atomic_ref (gfc_code *c) +{ + const char *name = "atomic_ref"; + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void gfc_resolve_mvbits (gfc_code *c) { static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN, diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def index 3586f07..a4d4c6a 100644 --- a/gcc/fortran/iso-fortran-env.def +++ b/gcc/fortran/iso-fortran-env.def @@ -38,9 +38,9 @@ along with GCC; see the file COPYING3. If not see -- the standard that supports this type */ NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, "atomic_int_kind", \ - gfc_default_integer_kind, GFC_STD_F2008) + gfc_c_int_kind, GFC_STD_F2008) NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND, "atomic_logical_kind", \ - gfc_default_logical_kind, GFC_STD_F2008) + gfc_c_int_kind, GFC_STD_F2008) NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \ gfc_character_storage_size, GFC_STD_F2003) NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER, \ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3cfaa0d..d6c5ae1 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6952,8 +6952,44 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, } -tree -gfc_conv_intrinsic_move_alloc (gfc_code *code) +static tree +conv_intrinsic_atomic_def (gfc_code *code) +{ + gfc_se atom, value; + stmtblock_t block; + + gfc_init_se (&atom, NULL); + gfc_init_se (&value, NULL); + gfc_conv_expr (&atom, code->ext.actual->expr); + gfc_conv_expr (&value, code->ext.actual->next->expr); + + gfc_init_block (&block); + gfc_add_modify (&block, atom.expr, + fold_convert (TREE_TYPE (atom.expr), value.expr)); + return gfc_finish_block (&block); +} + + +static tree +conv_intrinsic_atomic_ref (gfc_code *code) +{ + gfc_se atom, value; + stmtblock_t block; + + gfc_init_se (&atom, NULL); + gfc_init_se (&value, NULL); + gfc_conv_expr (&value, code->ext.actual->expr); + gfc_conv_expr (&atom, code->ext.actual->next->expr); + + gfc_init_block (&block); + gfc_add_modify (&block, value.expr, + fold_convert (TREE_TYPE (value.expr), atom.expr)); + return gfc_finish_block (&block); +} + + +static tree +conv_intrinsic_move_alloc (gfc_code *code) { if (code->ext.actual->expr->rank == 0) { @@ -7002,4 +7038,32 @@ gfc_conv_intrinsic_move_alloc (gfc_code *code) } +tree +gfc_conv_intrinsic_subroutine (gfc_code *code) +{ + tree res; + + gcc_assert (code->resolved_isym); + + switch (code->resolved_isym->id) + { + case GFC_ISYM_MOVE_ALLOC: + res = conv_intrinsic_move_alloc (code); + + case GFC_ISYM_ATOMIC_DEF: + res = conv_intrinsic_atomic_def (code); + break; + + case GFC_ISYM_ATOMIC_REF: + res = conv_intrinsic_atomic_ref (code); + break; + + default: + res = NULL_TREE; + break; + } + + return res; +} + #include "gt-fortran-trans-intrinsic.h" diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 0ab4637..f2f1352 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1245,15 +1245,20 @@ trans_code (gfc_code * code, tree cond) dependency check, too. */ { bool is_mvbits = false; + + if (code->resolved_isym) + { + res = gfc_conv_intrinsic_subroutine (code); + if (res != NULL_TREE) + break; + } + if (code->resolved_isym && code->resolved_isym->id == GFC_ISYM_MVBITS) is_mvbits = true; - if (code->resolved_isym - && code->resolved_isym->id == GFC_ISYM_MOVE_ALLOC) - res = gfc_conv_intrinsic_move_alloc (code); - else - res = gfc_trans_call (code, is_mvbits, NULL_TREE, - NULL_TREE, false); + + res = gfc_trans_call (code, is_mvbits, NULL_TREE, + NULL_TREE, false); } break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 95cd9fb..e14e41f 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -345,7 +345,8 @@ tree gfc_evaluate_now (tree, stmtblock_t *); /* Find the appropriate variant of a math intrinsic. */ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); -/* Intrinsic function handling. */ +/* Intrinsic procedure handling. */ +tree gfc_conv_intrinsic_subroutine (gfc_code *); void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); /* Is the intrinsic expanded inline. */ @@ -356,8 +357,6 @@ bool gfc_inline_intrinsic_function_p (gfc_expr *); gfc_inline_intrinsic_function_p returns true. */ int gfc_is_intrinsic_libcall (gfc_expr *); -tree gfc_conv_intrinsic_move_alloc (gfc_code *); - /* Used to call ordinary functions/subroutines and procedure pointer components. */ int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, --- /dev/null 2011-05-31 07:23:47.047892583 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 2011-05-31 18:06:21.000000000 +0200 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single -std=f2008" } +! +! PR fortran/18918 +! +! Diagnostic for atomic subroutines +! +use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind +implicit none +integer(atomic_int_kind) :: a(1)[*] +logical(1) :: c[*] +integer(atomic_int_kind) :: b +logical(atomic_logical_kind) :: d, e[*] + +call atomic_define(a, 7_2) ! { dg-error "must be a scalar" } +call atomic_ref(b, b) ! { dg-error "shall be a coarray" } + +call atomic_define(c, 7) ! { dg-error "an integer of ATOMIC_INT_KIND or a logical of ATOMIC_LOGICAL_KIND" } +call atomic_ref(d, a(1)) ! { dg-error "shall have the same type" } +call atomic_ref(.true., e) ! { dg-error "shall be definable" } +end --- /dev/null 2011-05-31 07:23:47.047892583 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 2011-05-31 17:30:32.000000000 +0200 @@ -0,0 +1,27 @@ +! { dg-do run } +! +! PR fortran/18918 +! +! Basic atomic def/ref test +! + +use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind +implicit none +integer(atomic_int_kind) :: a(1)[*] +logical(atomic_logical_kind) :: c[*] +intrinsic :: atomic_define +intrinsic :: atomic_ref +integer(8) :: b +logical(1) :: d + +call atomic_define(a(1), 7_2) +call atomic_ref(b, a(1)) +if (b /= a(1)) call abort() + +call atomic_define(c, .false.) +call atomic_ref(d, c[this_image()]) +if (d .neqv. .false.) call abort() +call atomic_define(c[this_image()], .true.) +call atomic_ref(d, c) +if (d .neqv. .true.) call abort() +end