Skip to content

R
riscv-gcc-1
Commit 195a95c4 by Tobias Burnus Committed by Tobias Burnus
Options

re PR fortran/38282 (Bit intrinsics: ILEN and IBCHNG) 

2010-09-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38282
        * intrinsic.c (add_functions): Support IALL, IANY, IPARITY.
        (check_specific): Special case for those intrinsics.
        * gfortran.h (gfc_isym_id): Add new intrinsics
        * intrinsic.h (gfc_check_transf_bit_intrins,
        gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity,
        gfc_resolve_iall, gfc_resolve_iany, gfc_resolve_iparity):
        New prototypes.
        * iresolve.c (gfc_resolve_iall, gfc_resolve_iany,
        gfc_resolve_iparity, resolve_transformational): New functions.
        (gfc_resolve_product, gfc_resolve_sum,
        gfc_resolve_parity): Use resolve_transformational.
        * check.c (gfc_check_transf_bit_intrins): New function.
        * simplify.c (gfc_simplify_iall, gfc_simplify_iany,
        gfc_simplify_iparity, do_bit_any, do_bit_ior,
        do_bit_xor, simplify_transformation): New functions.
        (gfc_simplify_all, gfc_simplify_any, gfc_simplify_parity,
        gfc_simplify_sum, gfc_simplify_product): Use simplify_transformation.
        * trans-intrinsic.c (gfc_conv_intrinsic_arith,
        gfc_conv_intrinsic_function, gfc_is_intrinsic_libcall):
        Handle IALL, IANY and IPARITY intrinsics.       
        * intrinsic.texi (IMAGE_INDEX): Move up to fix alphabetic
        order.
        (IALL, IANY, IPARITY): Document new intrinsics.

2010-09-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38282
        * gfortran.dg/iall_iany_iparity_1.f90: New.
        * gfortran.dg/iall_iany_iparity_2.f90: New.

2010-09-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/38282
        * gfortran.map: Add new iany, iall and iparity intrinsics.
        * Makefile.am: Ditto.
        * m4/iany.m4: New.
        * m4/iall.m4: New.
        * m4/iparity.m4: New.
        * Makefile.in: Regenerate.
        * generated/iall_i1.c: Generate.
        * generated/iall_i2.c: Generate.
        * generated/iall_i4.c: Generate.
        * generated/iall_i8.c: Generate.
        * generated/iall_i16.c: Generate.
        * generated/iany_i1.c: Generate.
        * generated/iany_i2.c: Generate.
        * generated/iany_i4.c: Generate.
        * generated/iany_i8.c: Generate.
        * generated/iany_i16.c: Generate.
        * generated/iparity_i1.c: Generate.
        * generated/iparity_i2.c: Generate.
        * generated/iparity_i4.c: Generate.
        * generated/iparity_i8.c: Generate.
        * generated/iparity_i16.c: Generate.

From-SVN: r163898
parent 1c53d72b
Showing with 739 additions and 200 deletions
gcc/fortran/ChangeLog
2010-09-06 Tobias Burnus <burnus@net-b.de>
PR fortran/38282
* intrinsic.c (add_functions): Support IALL, IANY, IPARITY.
(check_specific): Special case for those intrinsics.
* gfortran.h (gfc_isym_id): Add new intrinsics
* intrinsic.h (gfc_check_transf_bit_intrins,
gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity,
gfc_resolve_iall, gfc_resolve_iany, gfc_resolve_iparity):
New prototypes.
* iresolve.c (gfc_resolve_iall, gfc_resolve_iany,
gfc_resolve_iparity, resolve_transformational): New functions.
(gfc_resolve_product, gfc_resolve_sum,
gfc_resolve_parity): Use resolve_transformational.
* check.c (gfc_check_transf_bit_intrins): New function.
* simplify.c (gfc_simplify_iall, gfc_simplify_iany,
gfc_simplify_iparity, do_bit_any, do_bit_ior,
do_bit_xor, simplify_transformation): New functions.
(gfc_simplify_all, gfc_simplify_any, gfc_simplify_parity,
gfc_simplify_sum, gfc_simplify_product): Use simplify_transformation.
* trans-intrinsic.c (gfc_conv_intrinsic_arith,
gfc_conv_intrinsic_function, gfc_is_intrinsic_libcall):
Handle IALL, IANY and IPARITY intrinsics.
* intrinsic.texi (IMAGE_INDEX): Move up to fix alphabetic
order.
(IALL, IANY, IPARITY): Document new intrinsics.
2010-09-05 Tobias Burnus <burnus@net-b.de>
PR fortran/45186
......
gcc/fortran/check.c
......@@ -2353,6 +2353,26 @@ gfc_check_product_sum (gfc_actual_arglist *ap)
}
/* For IANY, IALL and IPARITY. */
gfc_try
gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
{
if (ap->expr->ts.type != BT_INTEGER)
{
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &ap->expr->where);
return FAILURE;
}
if (array_check (ap->expr, 0) == FAILURE)
return FAILURE;
return check_reduction (ap);
}
gfc_try
gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
{
......
gcc/fortran/gfortran.h
......@@ -397,7 +397,9 @@ enum gfc_isym_id
GFC_ISYM_HUGE,
GFC_ISYM_HYPOT,
GFC_ISYM_IACHAR,
GFC_ISYM_IALL,
GFC_ISYM_IAND,
GFC_ISYM_IANY,
GFC_ISYM_IARGC,
GFC_ISYM_IBCLR,
GFC_ISYM_IBITS,
......@@ -412,6 +414,7 @@ enum gfc_isym_id
GFC_ISYM_INT2,
GFC_ISYM_INT8,
GFC_ISYM_IOR,
GFC_ISYM_IPARITY,
GFC_ISYM_IRAND,
GFC_ISYM_ISATTY,
GFC_ISYM_IS_IOSTAT_END,
......
gcc/fortran/intrinsic.c
......@@ -1777,6 +1777,20 @@ add_functions (void)
make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
add_sym_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL);
make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL);
make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
di, GFC_STD_GNU, NULL, NULL, NULL);
......@@ -1885,6 +1899,13 @@ add_functions (void)
make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL);
make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
/* The following function is for G77 compatibility. */
add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
......@@ -3737,6 +3758,9 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
/* Same here. The difference to the previous case is that we allow a
general numeric type. */
t = gfc_check_product_sum (*ap);
else if (specific->check.f3red == gfc_check_transf_bit_intrins)
/* Same as for PRODUCT and SUM, but different checks. */
t = gfc_check_transf_bit_intrins (*ap);
else
{
if (specific->check.f1 == NULL)
......
gcc/fortran/intrinsic.h
......@@ -144,6 +144,7 @@ gfc_try gfc_check_stat (gfc_expr *, gfc_expr *);
gfc_try gfc_check_storage_size (gfc_expr *, gfc_expr *);
gfc_try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_try gfc_check_symlnk (gfc_expr *, gfc_expr *);
gfc_try gfc_check_transf_bit_intrins (gfc_actual_arglist *);
gfc_try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_try gfc_check_transpose (gfc_expr *);
gfc_try gfc_check_trim (gfc_expr *);
......@@ -260,7 +261,9 @@ gfc_expr *gfc_simplify_gamma (gfc_expr *);
gfc_expr *gfc_simplify_huge (gfc_expr *);
gfc_expr *gfc_simplify_hypot (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iall (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iand (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iany (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_ibset (gfc_expr *, gfc_expr *);
......@@ -275,6 +278,7 @@ gfc_expr *gfc_simplify_long (gfc_expr *);
gfc_expr *gfc_simplify_ifix (gfc_expr *);
gfc_expr *gfc_simplify_idint (gfc_expr *);
gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_iparity (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_is_iostat_end (gfc_expr *);
gfc_expr *gfc_simplify_is_iostat_eor (gfc_expr *);
gfc_expr *gfc_simplify_isnan (gfc_expr *);
......@@ -441,12 +445,15 @@ void gfc_resolve_ierrno (gfc_expr *);
void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ichar (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_iachar (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_iall (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_iany (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_int2 (gfc_expr *, gfc_expr *);
void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
void gfc_resolve_long (gfc_expr *, gfc_expr *);
void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_iparity (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_isatty (gfc_expr *, gfc_expr *);
void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *);
......
gcc/fortran/intrinsic.texi
......@@ -139,7 +139,9 @@ Some basic guidelines for editing this document:
* @code{HUGE}: HUGE, Largest number of a kind
* @code{HYPOT}: HYPOT, Euclidian distance function
* @code{IACHAR}: IACHAR, Code in @acronym{ASCII} collating sequence
* @code{IALL}: IALL, Bitwise AND of array elements
* @code{IAND}: IAND, Bitwise logical and
* @code{IANY}: IANY, Bitwise OR of array elements
* @code{IARGC}: IARGC, Get the number of command line arguments
* @code{IBCLR}: IBCLR, Clear bit
* @code{IBITS}: IBITS, Bit extraction
......@@ -148,13 +150,14 @@ Some basic guidelines for editing this document:
* @code{IDATE}: IDATE, Current local time (day/month/year)
* @code{IEOR}: IEOR, Bitwise logical exclusive or
* @code{IERRNO}: IERRNO, Function to get the last system error number
* @code{IMAGE_INDEX}: IMAGE_INDEX, Cosubscript to image index convertion
* @code{INDEX}: INDEX intrinsic, Position of a substring within a string
* @code{INT}: INT, Convert to integer type
* @code{INT2}: INT2, Convert to 16-bit integer type
* @code{INT8}: INT8, Convert to 64-bit integer type
* @code{IOR}: IOR, Bitwise logical or
* @code{IPARITY}: IPARITY, Bitwise XOR of array elements
* @code{IRAND}: IRAND, Integer pseudo-random number
* @code{IMAGE_INDEX}: IMAGE_INDEX, Cosubscript to image index convertion
* @code{IS_IOSTAT_END}: IS_IOSTAT_END, Test for end-of-file value
* @code{IS_IOSTAT_EOR}: IS_IOSTAT_EOR, Test for end-of-record value
* @code{ISATTY}: ISATTY, Whether a unit is a terminal device
......@@ -5580,6 +5583,66 @@ and formatted string representations.
@node IALL
@section @code{IALL} --- Bitwise AND of array elements
@fnindex IALL
@cindex array, AND
@cindex bits, AND of array elements
@table @asis
@item @emph{Description}:
Reduces with bitwise AND the elements of @var{ARRAY} along dimension @var{DIM}
if the corresponding element in @var{MASK} is @code{TRUE}.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Transformational function
@item @emph{Syntax}:
@multitable @columnfractions .80
@item @code{RESULT = IALL(ARRAY[, MASK])}
@item @code{RESULT = IALL(ARRAY, DIM[, MASK])}
@end multitable
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}
@item @var{DIM} @tab (Optional) shall be a scalar of type
@code{INTEGER} with a value in the range from 1 to n, where n
equals the rank of @var{ARRAY}.
@item @var{MASK} @tab (Optional) shall be of type @code{LOGICAL}
and either be a scalar or an array of the same shape as @var{ARRAY}.
@end multitable
@item @emph{Return value}:
The result is of the same type as @var{ARRAY}.
If @var{DIM} is absent, a scalar with the bitwise ALL of all elements in
@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals
the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with
dimension @var{DIM} dropped is returned.
@item @emph{Example}:
@smallexample
PROGRAM test_iall
INTEGER(1) :: a(2)
a(1) = b'00100100'
a(1) = b'01101010'
! prints 00100000
PRINT '(b8.8)', IALL(a)
END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{IANY}, @ref{IPARITY}, @ref{IAND}
@end table
@node IAND
@section @code{IAND} --- Bitwise logical and
@fnindex IAND
......@@ -5628,6 +5691,66 @@ END PROGRAM
@node IANY
@section @code{IANY} --- Bitwise XOR of array elements
@fnindex IANY
@cindex array, OR
@cindex bits, OR of array elements
@table @asis
@item @emph{Description}:
Reduces with bitwise OR (inclusive or) the elements of @var{ARRAY} along
dimension @var{DIM} if the corresponding element in @var{MASK} is @code{TRUE}.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Transformational function
@item @emph{Syntax}:
@multitable @columnfractions .80
@item @code{RESULT = IANY(ARRAY[, MASK])}
@item @code{RESULT = IANY(ARRAY, DIM[, MASK])}
@end multitable
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}
@item @var{DIM} @tab (Optional) shall be a scalar of type
@code{INTEGER} with a value in the range from 1 to n, where n
equals the rank of @var{ARRAY}.
@item @var{MASK} @tab (Optional) shall be of type @code{LOGICAL}
and either be a scalar or an array of the same shape as @var{ARRAY}.
@end multitable
@item @emph{Return value}:
The result is of the same type as @var{ARRAY}.
If @var{DIM} is absent, a scalar with the bitwise OR of all elements in
@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals
the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with
dimension @var{DIM} dropped is returned.
@item @emph{Example}:
@smallexample
PROGRAM test_iany
INTEGER(1) :: a(2)
a(1) = b'00100100'
a(1) = b'01101010'
! prints 01111011
PRINT '(b8.8)', IANY(a)
END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{IPARITY}, @ref{IALL}, @ref{IOR}
@end table
@node IARGC
@section @code{IARGC} --- Get the number of command line arguments
@fnindex IARGC
......@@ -5977,6 +6100,50 @@ kind.
@node IMAGE_INDEX
@section @code{IMAGE_INDEX} --- Function that converts a cosubscript to an image index
@fnindex IMAGE_INDEX
@cindex coarray, IMAGE_INDEX
@cindex images, cosubscript to image index conversion
@table @asis
@item @emph{Description}:
Returns the image index belonging to a cosubscript.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Inquiry function.
@item @emph{Syntax}:
@code{RESULT = IMAGE_INDEX(COARRAY, SUB)}
@item @emph{Arguments}: None.
@multitable @columnfractions .15 .70
@item @var{COARRAY} @tab Coarray of any type.
@item @var{SUB} @tab default integer rank-1 array of a size equal to
the corank of @var{COARRAY}.
@end multitable
@item @emph{Return value}:
Scalar default integer with the value of the image index which corresponds
to the cosubscripts. For invalid cosubscripts the result is zero.
@item @emph{Example}:
@smallexample
INTEGER :: array[2,-1:4,8,*]
! Writes 28 (or 0 if there are fewer than 28 images)
WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
@end smallexample
@item @emph{See also}:
@ref{THIS_IMAGE}, @ref{NUM_IMAGES}
@end table
@node INDEX intrinsic
@section @code{INDEX} --- Position of a substring within a string
@fnindex INDEX
......@@ -6204,6 +6371,67 @@ the larger argument.)
@node IPARITY
@section @code{IPARITY} --- Bitwise XOR of array elements
@fnindex IPARITY
@cindex array, parity
@cindex array, XOR
@cindex bits, XOR of array elements
@table @asis
@item @emph{Description}:
Reduces with bitwise XOR (exclusive or) the elements of @var{ARRAY} along
dimension @var{DIM} if the corresponding element in @var{MASK} is @code{TRUE}.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Transformational function
@item @emph{Syntax}:
@multitable @columnfractions .80
@item @code{RESULT = IPARITY(ARRAY[, MASK])}
@item @code{RESULT = IPARITY(ARRAY, DIM[, MASK])}
@end multitable
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}
@item @var{DIM} @tab (Optional) shall be a scalar of type
@code{INTEGER} with a value in the range from 1 to n, where n
equals the rank of @var{ARRAY}.
@item @var{MASK} @tab (Optional) shall be of type @code{LOGICAL}
and either be a scalar or an array of the same shape as @var{ARRAY}.
@end multitable
@item @emph{Return value}:
The result is of the same type as @var{ARRAY}.
If @var{DIM} is absent, a scalar with the bitwise XOR of all elements in
@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals
the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with
dimension @var{DIM} dropped is returned.
@item @emph{Example}:
@smallexample
PROGRAM test_iparity
INTEGER(1) :: a(2)
a(1) = b'00100100'
a(1) = b'01101010'
! prints 10111011
PRINT '(b8.8)', IPARITY(a)
END PROGRAM
@end smallexample
@item @emph{See also}:
@ref{IANY}, @ref{IALL}, @ref{IEOR}, @ref{PARITY}
@end table
@node IRAND
@section @code{IRAND} --- Integer pseudo-random number
@fnindex IRAND
......@@ -6255,50 +6483,6 @@ end program test_irand
@node IMAGE_INDEX
@section @code{IMAGE_INDEX} --- Function that converts a cosubscript to an image index
@fnindex IMAGE_INDEX
@cindex coarray, IMAGE_INDEX
@cindex images, cosubscript to image index conversion
@table @asis
@item @emph{Description}:
Returns the image index belonging to a cosubscript.
@item @emph{Standard}:
Fortran 2008 and later
@item @emph{Class}:
Inquiry function.
@item @emph{Syntax}:
@code{RESULT = IMAGE_INDEX(COARRAY, SUB)}
@item @emph{Arguments}: None.
@multitable @columnfractions .15 .70
@item @var{COARRAY} @tab Coarray of any type.
@item @var{SUB} @tab default integer rank-1 array of a size equal to
the corank of @var{COARRAY}.
@end multitable
@item @emph{Return value}:
Scalar default integer with the value of the image index which corresponds
to the cosubscripts. For invalid cosubscripts the result is zero.
@item @emph{Example}:
@smallexample
INTEGER :: array[2,-1:4,8,*]
! Writes 28 (or 0 if there are fewer than 28 images)
WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
@end smallexample
@item @emph{See also}:
@ref{THIS_IMAGE}, @ref{NUM_IMAGES}
@end table
@node IS_IOSTAT_END
@section @code{IS_IOSTAT_END} --- Test for end-of-file value
@fnindex IS_IOSTAT_END
......
gcc/fortran/iresolve.c
......@@ -141,6 +141,40 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
f->value.function.name = xstrdup (name);
}
static void
resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
gfc_expr *dim, gfc_expr *mask)
{
const char *prefix;
f->ts = array->ts;
if (mask)
{
if (mask->rank == 0)
prefix = "s";
else
prefix = "m";
resolve_mask_arg (mask);
}
else
prefix = "";
if (dim != NULL)
{
f->rank = array->rank - 1;
f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
gfc_resolve_dim_arg (dim);
}
f->value.function.name
= gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
gfc_type_letter (array->ts.type), array->ts.kind);
}
/********************** Resolution functions **********************/
......@@ -1044,6 +1078,13 @@ gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
void
gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
resolve_transformational ("iall", f, array, dim, mask);
}
void
gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
{
/* If the kind of i and j are different, then g77 cross-promoted the
......@@ -1063,6 +1104,13 @@ gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
void
gfc_resolve_iany (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
resolve_transformational ("iany", f, array, dim, mask);
}
void
gfc_resolve_ibclr (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
{
f->ts = i->ts;
......@@ -1239,6 +1287,13 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a)
void
gfc_resolve_iparity (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
resolve_transformational ("iparity", f, array, dim, mask);
}
void
gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
{
gfc_typespec ts;
......@@ -1827,17 +1882,7 @@ gfc_resolve_nint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
void
gfc_resolve_norm2 (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
{
f->ts = array->ts;
if (dim != NULL)
{
f->rank = array->rank - 1;
f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
gfc_resolve_dim_arg (dim);
}
f->value.function.name
= gfc_get_string (PREFIX ("norm2_r%d"), array->ts.kind);
resolve_transformational ("norm2", f, array, dim, NULL);
}
......@@ -1908,19 +1953,7 @@ gfc_resolve_pack (gfc_expr *f, gfc_expr *array, gfc_expr *mask,
void
gfc_resolve_parity (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
{
f->ts = array->ts;
if (dim != NULL)
{
f->rank = array->rank - 1;
f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
gfc_resolve_dim_arg (dim);
}
resolve_mask_arg (array);
f->value.function.name
= gfc_get_string (PREFIX ("parity_l%d"), array->ts.kind);
resolve_transformational ("parity", f, array, dim, NULL);
}
......@@ -1928,32 +1961,7 @@ void
gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *mask)
{
const char *name;
f->ts = array->ts;
if (dim != NULL)
{
f->rank = array->rank - 1;
f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
gfc_resolve_dim_arg (dim);
}
if (mask)
{
if (mask->rank == 0)
name = "sproduct";
else
name = "mproduct";
resolve_mask_arg (mask);
}
else
name = "product";
f->value.function.name
= gfc_get_string (PREFIX ("%s_%c%d"), name,
gfc_type_letter (array->ts.type), array->ts.kind);
resolve_transformational ("product", f, array, dim, mask);
}
......@@ -2412,32 +2420,7 @@ gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
void
gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
const char *name;
f->ts = array->ts;
if (mask)
{
if (mask->rank == 0)
name = "ssum";
else
name = "msum";
resolve_mask_arg (mask);
}
else
name = "sum";
if (dim != NULL)
{
f->rank = array->rank - 1;
f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
gfc_resolve_dim_arg (dim);
}
f->value.function.name
= gfc_get_string (PREFIX ("%s_%c%d"), name,
gfc_type_letter (array->ts.type), array->ts.kind);
resolve_transformational ("sum", f, array, dim, mask);
}
......
gcc/fortran/simplify.c
......@@ -620,6 +620,30 @@ simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *d
}
static gfc_expr *
simplify_transformation (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
int init_val, transformational_op op)
{
gfc_expr *result;
if (!is_constant_array_expr (array)
|| !gfc_is_constant_expr (dim))
return NULL;
if (mask
&& !is_constant_array_expr (mask)
&& mask->expr_type != EXPR_CONSTANT)
return NULL;
result = transformational_result (array, dim, array->ts.type,
array->ts.kind, &array->where);
init_result_expr (result, init_val, NULL);
return !dim || array->rank == 1 ?
simplify_transformation_to_scalar (result, array, mask, op) :
simplify_transformation_to_array (result, array, dim, mask, op, NULL);
}
/********************** Simplification functions *****************************/
......@@ -888,19 +912,7 @@ gfc_simplify_aint (gfc_expr *e, gfc_expr *k)
gfc_expr *
gfc_simplify_all (gfc_expr *mask, gfc_expr *dim)
{
gfc_expr *result;
if (!is_constant_array_expr (mask)
|| !gfc_is_constant_expr (dim))
return NULL;
result = transformational_result (mask, dim, mask->ts.type,
mask->ts.kind, &mask->where);
init_result_expr (result, true, NULL);
return !dim || mask->rank == 1 ?
simplify_transformation_to_scalar (result, mask, NULL, gfc_and) :
simplify_transformation_to_array (result, mask, dim, NULL, gfc_and, NULL);
return simplify_transformation (mask, dim, NULL, true, gfc_and);
}
......@@ -974,19 +986,7 @@ gfc_simplify_and (gfc_expr *x, gfc_expr *y)
gfc_expr *
gfc_simplify_any (gfc_expr *mask, gfc_expr *dim)
{
gfc_expr *result;
if (!is_constant_array_expr (mask)
|| !gfc_is_constant_expr (dim))
return NULL;
result = transformational_result (mask, dim, mask->ts.type,
mask->ts.kind, &mask->where);
init_result_expr (result, false, NULL);
return !dim || mask->rank == 1 ?
simplify_transformation_to_scalar (result, mask, NULL, gfc_or) :
simplify_transformation_to_array (result, mask, dim, NULL, gfc_or, NULL);
return simplify_transformation (mask, dim, NULL, false, gfc_or);
}
......@@ -2231,6 +2231,44 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
}
static gfc_expr *
do_bit_and (gfc_expr *result, gfc_expr *e)
{
gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
gcc_assert (result->ts.type == BT_INTEGER
&& result->expr_type == EXPR_CONSTANT);
mpz_and (result->value.integer, result->value.integer, e->value.integer);
return result;
}
gfc_expr *
gfc_simplify_iall (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
return simplify_transformation (array, dim, mask, -1, do_bit_and);
}
static gfc_expr *
do_bit_ior (gfc_expr *result, gfc_expr *e)
{
gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
gcc_assert (result->ts.type == BT_INTEGER
&& result->expr_type == EXPR_CONSTANT);
mpz_ior (result->value.integer, result->value.integer, e->value.integer);
return result;
}
gfc_expr *
gfc_simplify_iany (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
return simplify_transformation (array, dim, mask, 0, do_bit_ior);
}
gfc_expr *
gfc_simplify_iand (gfc_expr *x, gfc_expr *y)
{
......@@ -2683,6 +2721,26 @@ gfc_simplify_ior (gfc_expr *x, gfc_expr *y)
}
static gfc_expr *
do_bit_xor (gfc_expr *result, gfc_expr *e)
{
gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
gcc_assert (result->ts.type == BT_INTEGER
&& result->expr_type == EXPR_CONSTANT);
mpz_xor (result->value.integer, result->value.integer, e->value.integer);
return result;
}
gfc_expr *
gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
return simplify_transformation (array, dim, mask, 0, do_bit_xor);
}
gfc_expr *
gfc_simplify_is_iostat_end (gfc_expr *x)
{
......@@ -4277,18 +4335,7 @@ do_xor (gfc_expr *result, gfc_expr *e)
gfc_expr *
gfc_simplify_parity (gfc_expr *e, gfc_expr *dim)
{
gfc_expr *result;
if (!is_constant_array_expr (e)
|| (dim != NULL && !gfc_is_constant_expr (dim)))
return NULL;
result = transformational_result (e, dim, e->ts.type, e->ts.kind, &e->where);
init_result_expr (result, 0, NULL);
return (!dim || e->rank == 1)
? simplify_transformation_to_scalar (result, e, NULL, do_xor)
: simplify_transformation_to_array (result, e, dim, NULL, do_xor, NULL);
return simplify_transformation (e, dim, NULL, 0, do_xor);
}
......@@ -4345,24 +4392,7 @@ gfc_simplify_precision (gfc_expr *e)
gfc_expr *
gfc_simplify_product (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
gfc_expr *result;
if (!is_constant_array_expr (array)
|| !gfc_is_constant_expr (dim))
return NULL;
if (mask
&& !is_constant_array_expr (mask)
&& mask->expr_type != EXPR_CONSTANT)
return NULL;
result = transformational_result (array, dim, array->ts.type,
array->ts.kind, &array->where);
init_result_expr (result, 1, NULL);
return !dim || array->rank == 1 ?
simplify_transformation_to_scalar (result, array, mask, gfc_multiply) :
simplify_transformation_to_array (result, array, dim, mask, gfc_multiply, NULL);
return simplify_transformation (array, dim, mask, 1, gfc_multiply);
}
......@@ -5508,24 +5538,7 @@ gfc_simplify_sqrt (gfc_expr *e)
gfc_expr *
gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
gfc_expr *result;
if (!is_constant_array_expr (array)
|| !gfc_is_constant_expr (dim))
return NULL;
if (mask
&& !is_constant_array_expr (mask)
&& mask->expr_type != EXPR_CONSTANT)
return NULL;
result = transformational_result (array, dim, array->ts.type,
array->ts.kind, &array->where);
init_result_expr (result, 0, NULL);
return !dim || array->rank == 1 ?
simplify_transformation_to_scalar (result, array, mask, gfc_add) :
simplify_transformation_to_array (result, array, dim, mask, gfc_add, NULL);
return simplify_transformation (array, dim, mask, 0, gfc_add);
}
......
gcc/fortran/trans-intrinsic.c
......@@ -2004,11 +2004,14 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
gfc_build_const (type, integer_one_node));
tmp = gfc_build_const (type, integer_zero_node);
}
else if (op == PLUS_EXPR)
else if (op == PLUS_EXPR || op == BIT_IOR_EXPR || op == BIT_XOR_EXPR)
tmp = gfc_build_const (type, integer_zero_node);
else if (op == NE_EXPR)
/* PARITY. */
tmp = convert (type, boolean_false_node);
else if (op == BIT_AND_EXPR)
tmp = gfc_build_const (type, fold_build1_loc (input_location, NEGATE_EXPR,
type, integer_one_node));
else
tmp = gfc_build_const (type, integer_one_node);
......@@ -5530,10 +5533,18 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_fraction (se, expr);
break;
case GFC_ISYM_IALL:
gfc_conv_intrinsic_arith (se, expr, BIT_AND_EXPR, false);
break;
case GFC_ISYM_IAND:
gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR);
break;
case GFC_ISYM_IANY:
gfc_conv_intrinsic_arith (se, expr, BIT_IOR_EXPR, false);
break;
case GFC_ISYM_IBCLR:
gfc_conv_intrinsic_singlebitop (se, expr, 0);
break;
......@@ -5576,6 +5587,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR);
break;
case GFC_ISYM_IPARITY:
gfc_conv_intrinsic_arith (se, expr, BIT_XOR_EXPR, false);
break;
case GFC_ISYM_IS_IOSTAT_END:
gfc_conv_has_intvalue (se, expr, LIBERROR_END);
break;
......@@ -5919,6 +5934,9 @@ gfc_is_intrinsic_libcall (gfc_expr * expr)
case GFC_ISYM_ANY:
case GFC_ISYM_COUNT:
case GFC_ISYM_JN2:
case GFC_ISYM_IANY:
case GFC_ISYM_IALL:
case GFC_ISYM_IPARITY:
case GFC_ISYM_MATMUL:
case GFC_ISYM_MAXLOC:
case GFC_ISYM_MAXVAL:
......
gcc/testsuite/ChangeLog
2010-09-06 Tobias Burnus <burnus@net-b.de>
PR fortran/38282
* gfortran.dg/iall_iany_iparity_1.f90: New.
* gfortran.dg/iall_iany_iparity_2.f90: New.
2010-09-06 Jason Merrill <jason@redhat.com>
* g++.dg/cpp0x/initlist42.C: New.
......
gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90 0 → 100644
! { dg-do run }
!
! PR fortran/38282
!
implicit none
integer :: a(2,1)
a(1,1) = 35
a(2,1) = -74
if (iand(a(1,1),a(2,1)) /= iall(a)) call abort ()
if (iand(a(1,1),a(2,1)) /= iall(array=[35, -74])) call abort ()
if (any (iand(a(1,1),a(2,1)) /= iall(a,dim=1))) call abort ()
if (iand(a(1,1),a(2,1)) /= iall(dim=1,mask=[.true.,.true.],array=[35, -74])) call abort ()
if (ior(a(1,1),a(2,1)) /= iany(a)) call abort ()
if (ior(a(1,1),a(2,1)) /= iany(array=[35, -74])) call abort ()
if (any (ior(a(1,1),a(2,1)) /= iany(a,dim=1))) call abort ()
if (ior(a(1,1),a(2,1)) /= iany(dim=1,mask=[.true.,.true.],array=[35, -74])) call abort ()
if (ieor(a(1,1),a(2,1)) /= iparity(a)) call abort ()
if (ieor(a(1,1),a(2,1)) /= iparity(array=[35, -74])) call abort ()
if (any (ieor(a(1,1),a(2,1)) /= iparity(a,dim=1))) call abort ()
if (ieor(a(1,1),a(2,1)) /= iparity(dim=1,mask=[.true.,.true.],array=[35, -74])) call abort ()
end
gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! PR fortran/38282
!
implicit none
integer :: a(2,1)
a(1,1) = 35
a(2,1) = -74
if (iand(a(1,1),a(2,1)) /= iall(a)) stop 1 ! { dg-error " .iall. at .1. has no IMPLICIT type" }
if (ior(a(1,1),a(2,1)) /= iany(a)) stop 1 ! { dg-error " .iany. at .1. has no IMPLICIT type" }
if (ieor(a(1,1),a(2,1)) /= iparity(a)) stop 1 ! { dg-error " .iparity. at .1. has no IMPLICIT type" }
end
libgfortran/ChangeLog
2010-09-06 Tobias Burnus <burnus@net-b.de>
PR fortran/38282
* gfortran.map: Add new iany, iall and iparity intrinsics.
* Makefile.am: Ditto.
* m4/iany.m4: New.
* m4/iall.m4: New.
* m4/iparity.m4: New.
* Makefile.in: Regenerate.
* generated/iall_i1.c: Generate.
* generated/iall_i2.c: Generate.
* generated/iall_i4.c: Generate.
* generated/iall_i8.c: Generate.
* generated/iall_i16.c: Generate.
* generated/iany_i1.c: Generate.
* generated/iany_i2.c: Generate.
* generated/iany_i4.c: Generate.
* generated/iany_i8.c: Generate.
* generated/iany_i16.c: Generate.
* generated/iparity_i1.c: Generate.
* generated/iparity_i2.c: Generate.
* generated/iparity_i4.c: Generate.
* generated/iparity_i8.c: Generate.
* generated/iparity_i16.c: Generate.
2010-09-05 Tobias Burnus <burnus@net-b.de>
* m4/bessel.m4: Fix printf warning by casting to (long int).
......
libgfortran/Makefile.am
......@@ -189,6 +189,27 @@ $(srcdir)/generated/count_4_l.c \
$(srcdir)/generated/count_8_l.c \
$(srcdir)/generated/count_16_l.c
i_iall_c= \
$(srcdir)/generated/iall_i1.c \
$(srcdir)/generated/iall_i2.c \
$(srcdir)/generated/iall_i4.c \
$(srcdir)/generated/iall_i8.c \
$(srcdir)/generated/iall_i16.c
i_iany_c= \
$(srcdir)/generated/iany_i1.c \
$(srcdir)/generated/iany_i2.c \
$(srcdir)/generated/iany_i4.c \
$(srcdir)/generated/iany_i8.c \
$(srcdir)/generated/iany_i16.c
i_iparity_c= \
$(srcdir)/generated/iparity_i1.c \
$(srcdir)/generated/iparity_i2.c \
$(srcdir)/generated/iparity_i4.c \
$(srcdir)/generated/iparity_i8.c \
$(srcdir)/generated/iparity_i16.c
i_maxloc0_c= \
$(srcdir)/generated/maxloc0_4_i1.c \
$(srcdir)/generated/maxloc0_8_i1.c \
......@@ -603,11 +624,13 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \
m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \
m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4
m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \
m4/iall.m4 m4/iany.m4 m4/iparity.m4
gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
$(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_norm2_c) $(i_parity_c) \
$(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_iall_c) $(i_iany_c) \
$(i_iparity_c) $(i_norm2_c) $(i_parity_c) \
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
......@@ -850,6 +873,15 @@ $(i_any_c): m4/any.m4 $(I_M4_DEPS2)
$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
$(i_iall_c): m4/iall.m4 $(I_M4_DEPS)
$(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@
$(i_iany_c): m4/iany.m4 $(I_M4_DEPS)
$(M4) -Dfile=$@ -I$(srcdir)/m4 iany.m4 > $@
$(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS)
$(M4) -Dfile=$@ -I$(srcdir)/m4 iparity.m4 > $@
$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
......
libgfortran/gfortran.map
......@@ -1107,8 +1107,6 @@ GFORTRAN_1.3 {
GFORTRAN_1.4 {
global:
_gfortran_error_stop_numeric;
_gfortran_selected_real_kind2008;
_gfortran_bessel_jn_r4;
_gfortran_bessel_jn_r8;
_gfortran_bessel_jn_r10;
......@@ -1117,6 +1115,22 @@ GFORTRAN_1.4 {
_gfortran_bessel_yn_r8;
_gfortran_bessel_yn_r10;
_gfortran_bessel_yn_r16;
_gfortran_error_stop_numeric;
_gfortran_iall_i1;
_gfortran_iall_i2;
_gfortran_iall_i4;
_gfortran_iall_i8;
_gfortran_iall_i16;
_gfortran_iany_i1;
_gfortran_iany_i2;
_gfortran_iany_i4;
_gfortran_iany_i8;
_gfortran_iany_i16;
_gfortran_iparity_i1;
_gfortran_iparity_i2;
_gfortran_iparity_i4;
_gfortran_iparity_i8;
_gfortran_iparity_i16;
_gfortran_norm2_r4;
_gfortran_norm2_r8;
_gfortran_norm2_r10;
......@@ -1126,6 +1140,7 @@ GFORTRAN_1.4 {
_gfortran_parity_l4;
_gfortran_parity_l8;
_gfortran_parity_l16;
_gfortran_selected_real_kind2008;
} GFORTRAN_1.3;
F2C_1.0 {
......
libgfortran/m4/iall.m4 0 → 100644
`/* Implementation of the IALL intrinsic
Copyright 2010 Free Software Foundation, Inc.
Contributed by Tobias Burnus <burnus@net-b.de>
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>'
include(iparm.m4)dnl
include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = ('rtype_name`) -1;',
` result &= *src;')
MASKED_ARRAY_FUNCTION(0,
` result = 0;',
` if (*msrc)
result &= *src;')
SCALAR_ARRAY_FUNCTION(0)
#endif
libgfortran/m4/iany.m4 0 → 100644
`/* Implementation of the IANY intrinsic
Copyright 2010 Free Software Foundation, Inc.
Contributed by Tobias Burnus <burnus@net-b.de>
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>'
include(iparm.m4)dnl
include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = 0;',
` result |= *src;')
MASKED_ARRAY_FUNCTION(0,
` result = 0;',
` if (*msrc)
result |= *src;')
SCALAR_ARRAY_FUNCTION(0)
#endif
libgfortran/m4/iparity.m4 0 → 100644
`/* Implementation of the IPARITY intrinsic
Copyright 2010 Free Software Foundation, Inc.
Contributed by Tobias Burnus <burnus@net-b.de>
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>'
include(iparm.m4)dnl
include(ifunction.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = 0;',
` result ^= *src;')
MASKED_ARRAY_FUNCTION(0,
` result = 0;',
` if (*msrc)
result ^= *src;')
SCALAR_ARRAY_FUNCTION(0)
#endif
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment