mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-20 19:01:12 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

Browse Source 
2011-05-31  Tobias Burnus  <burnus@net-b.de>

        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.
        (gfc_atomic_int_kind, gfc_atomic_logical_kind): New global vars.
        * 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.

From-SVN: r174510
This commit is contained in:
Tobias Burnus 2011-05-31 22:04:09 +02:00 committed by Tobias Burnus
parent ead7c399bc
commit da661a58be
15 changed files with 370 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/fortran/ChangeLog
View File

@ -1,3 +1,32 @@
2011-05-31 Tobias Burnus <burnus@net-b.de>
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.
(gfc_atomic_int_kind, gfc_atomic_logical_kind): New global vars.
* 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.
* trans-types (gfc_atomic_int_kind, gfc_atomic_logical_kind): New
global vars.
(gfc_init_kinds): Set them.
2011-05-31 Tobias Burnus <burnus@net-b.de>
PR fortran/18918

66
gcc/fortran/check.c
View File

@ -973,6 +973,72 @@ 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_atomic_int_kind)
&& !(atom->ts.type == BT_LOGICAL
&& atom->ts.kind == gfc_atomic_logical_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

4
gcc/fortran/gfortran.h
View File

@ -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,
@ -2464,6 +2466,8 @@ extern int gfc_default_character_kind;
extern int gfc_default_logical_kind;
extern int gfc_default_complex_kind;
extern int gfc_c_int_kind;
extern int gfc_atomic_int_kind;
extern int gfc_atomic_logical_kind;
extern int gfc_intio_kind;
extern int gfc_charlen_int_kind;
extern int gfc_numeric_storage_size;

14
gcc/fortran/intrinsic.c
View File

@ -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);

4
gcc/fortran/intrinsic.h
View File

@ -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 *);

96
gcc/fortran/intrinsic.texi
View File

@ -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

16
gcc/fortran/iresolve.c
View File

@ -2894,6 +2894,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)
{

4
gcc/fortran/iso-fortran-env.def
View File

@ -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_atomic_int_kind, GFC_STD_F2008)
NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND, "atomic_logical_kind", \
gfc_default_logical_kind, GFC_STD_F2008)
gfc_atomic_logical_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, \

69
gcc/fortran/trans-intrinsic.c
View File

@ -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,33 @@ 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);
break;
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"

6
gcc/fortran/trans-types.c
View File

@ -118,6 +118,8 @@ int gfc_default_character_kind;
int gfc_default_logical_kind;
int gfc_default_complex_kind;
int gfc_c_int_kind;
int gfc_atomic_int_kind;
int gfc_atomic_logical_kind;
/* The kind size used for record offsets. If the target system supports
kind=8, this will be set to 8, otherwise it is set to 4. */
@ -578,6 +580,10 @@ gfc_init_kinds (void)
/* Pick a kind the same size as the C "int" type. */
gfc_c_int_kind = INT_TYPE_SIZE / 8;
/* Choose atomic kinds to match C's int. */
gfc_atomic_int_kind = gfc_c_int_kind;
gfc_atomic_logical_kind = gfc_c_int_kind;
/* initialize the C interoperable kinds */
init_c_interop_kinds();
}

17
gcc/fortran/trans.c
View File

@ -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;

5
gcc/fortran/trans.h
View File

@ -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 *,

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2011-05-31 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_atomic_1.f90: New.
* gfortran.dg/coarray/atomic_1.f90: New.
2011-05-31 Jakub Jelinek <jakub@redhat.com>
* gcc.dg/guality/bswaptest.c: New test.

27
gcc/testsuite/gfortran.dg/coarray/atomic_1.f90 Normal file
View File

@ -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

21
gcc/testsuite/gfortran.dg/coarray_atomic_1.f90 Normal file
View File

@ -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