OSDN Git Service

2010-09-06 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 6 Sep 2010 05:55:10 +0000 (05:55 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 6 Sep 2010 05:55:10 +0000 (05:55 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@163898 138bc75d-0d04-0410-961f-82ee72b054a4

34 files changed:
gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/fortran/gfortran.h
gcc/fortran/intrinsic.c
gcc/fortran/intrinsic.h
gcc/fortran/intrinsic.texi
gcc/fortran/iresolve.c
gcc/fortran/simplify.c
gcc/fortran/trans-intrinsic.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/generated/iall_i1.c [new file with mode: 0644]
libgfortran/generated/iall_i16.c [new file with mode: 0644]
libgfortran/generated/iall_i2.c [new file with mode: 0644]
libgfortran/generated/iall_i4.c [new file with mode: 0644]
libgfortran/generated/iall_i8.c [new file with mode: 0644]
libgfortran/generated/iany_i1.c [new file with mode: 0644]
libgfortran/generated/iany_i16.c [new file with mode: 0644]
libgfortran/generated/iany_i2.c [new file with mode: 0644]
libgfortran/generated/iany_i4.c [new file with mode: 0644]
libgfortran/generated/iany_i8.c [new file with mode: 0644]
libgfortran/generated/iparity_i1.c [new file with mode: 0644]
libgfortran/generated/iparity_i16.c [new file with mode: 0644]
libgfortran/generated/iparity_i2.c [new file with mode: 0644]
libgfortran/generated/iparity_i4.c [new file with mode: 0644]
libgfortran/generated/iparity_i8.c [new file with mode: 0644]
libgfortran/gfortran.map
libgfortran/m4/iall.m4 [new file with mode: 0644]
libgfortran/m4/iany.m4 [new file with mode: 0644]
libgfortran/m4/iparity.m4 [new file with mode: 0644]

index 0d8a590..e661b44 100644 (file)
@@ -1,3 +1,30 @@
+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
index 0ff6b6e..308895d 100644 (file)
@@ -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)
 {
index 3c15521..06ef0c5 100644 (file)
@@ -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,
index 8176035..f36484a 100644 (file)
@@ -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)
index b06c65b..178dbf7 100644 (file)
@@ -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 *);
index e78bb0d..bea3b36 100644 (file)
@@ -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
index 66df99e..9aab499 100644 (file)
@@ -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);
 }
 
 
index 8649597..248df6c 100644 (file)
@@ -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);
 }
 
 
index 38b7ecc..c49908b 100644 (file)
@@ -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:
index da06cd3..ac57935 100644 (file)
@@ -1,3 +1,9 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90 b/gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90
new file mode 100644 (file)
index 0000000..35b4e16
--- /dev/null
@@ -0,0 +1,26 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90 b/gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90
new file mode 100644 (file)
index 0000000..4872ddf
--- /dev/null
@@ -0,0 +1,18 @@
+! { 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
index 4c5ffd8..e21064e 100644 (file)
@@ -1,3 +1,28 @@
+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).
index b8dd9f8..2952f99 100644 (file)
@@ -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 > $@
 
index fa30519..e6be1c1 100644 (file)
@@ -144,43 +144,49 @@ am__objects_12 = sum_i1.lo sum_i2.lo sum_i4.lo sum_i8.lo sum_i16.lo \
        sum_r4.lo sum_r8.lo sum_r10.lo sum_r16.lo sum_c4.lo sum_c8.lo \
        sum_c10.lo sum_c16.lo
 am__objects_13 = bessel_r4.lo bessel_r8.lo bessel_r10.lo bessel_r16.lo
-am__objects_14 = norm2_r4.lo norm2_r8.lo norm2_r10.lo norm2_r16.lo
-am__objects_15 = parity_l1.lo parity_l2.lo parity_l4.lo parity_l8.lo \
+am__objects_14 = iall_i1.lo iall_i2.lo iall_i4.lo iall_i8.lo \
+       iall_i16.lo
+am__objects_15 = iany_i1.lo iany_i2.lo iany_i4.lo iany_i8.lo \
+       iany_i16.lo
+am__objects_16 = iparity_i1.lo iparity_i2.lo iparity_i4.lo \
+       iparity_i8.lo iparity_i16.lo
+am__objects_17 = norm2_r4.lo norm2_r8.lo norm2_r10.lo norm2_r16.lo
+am__objects_18 = parity_l1.lo parity_l2.lo parity_l4.lo parity_l8.lo \
        parity_l16.lo
-am__objects_16 = matmul_i1.lo matmul_i2.lo matmul_i4.lo matmul_i8.lo \
+am__objects_19 = matmul_i1.lo matmul_i2.lo matmul_i4.lo matmul_i8.lo \
        matmul_i16.lo matmul_r4.lo matmul_r8.lo matmul_r10.lo \
        matmul_r16.lo matmul_c4.lo matmul_c8.lo matmul_c10.lo \
        matmul_c16.lo
-am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
-am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
+am__objects_20 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
+am__objects_21 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
        transpose_r4.lo transpose_r8.lo transpose_r10.lo \
        transpose_r16.lo transpose_c4.lo transpose_c8.lo \
        transpose_c10.lo transpose_c16.lo
-am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo
-am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
-am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
-am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
-am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
+am__objects_22 = shape_i4.lo shape_i8.lo shape_i16.lo
+am__objects_23 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
+am__objects_24 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
+am__objects_25 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
+am__objects_26 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
        reshape_r4.lo reshape_r8.lo reshape_r10.lo reshape_r16.lo \
        reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo
-am__objects_24 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \
+am__objects_27 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \
        in_pack_i8.lo in_pack_i16.lo in_pack_r4.lo in_pack_r8.lo \
        in_pack_r10.lo in_pack_r16.lo in_pack_c4.lo in_pack_c8.lo \
        in_pack_c10.lo in_pack_c16.lo
-am__objects_25 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \
+am__objects_28 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \
        in_unpack_i8.lo in_unpack_i16.lo in_unpack_r4.lo \
        in_unpack_r8.lo in_unpack_r10.lo in_unpack_r16.lo \
        in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \
        in_unpack_c16.lo
-am__objects_26 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
+am__objects_29 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
        exponent_r16.lo
-am__objects_27 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
+am__objects_30 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
        fraction_r16.lo
-am__objects_28 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
+am__objects_31 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
        nearest_r16.lo
-am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo \
+am__objects_32 = set_exponent_r4.lo set_exponent_r8.lo \
        set_exponent_r10.lo set_exponent_r16.lo
-am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_c4_i4.lo \
+am__objects_33 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_c4_i4.lo \
        pow_c8_i4.lo pow_c10_i4.lo pow_c16_i4.lo pow_i4_i8.lo \
        pow_i8_i8.lo pow_i16_i8.lo pow_r4_i8.lo pow_r8_i8.lo \
        pow_r10_i8.lo pow_r16_i8.lo pow_c4_i8.lo pow_c8_i8.lo \
@@ -188,26 +194,26 @@ am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_c4_i4.lo \
        pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \
        pow_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \
        pow_c16_i16.lo
-am__objects_31 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \
+am__objects_34 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \
        rrspacing_r16.lo
-am__objects_32 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \
+am__objects_35 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \
        spacing_r16.lo
-am__objects_33 = pack_i1.lo pack_i2.lo pack_i4.lo pack_i8.lo \
+am__objects_36 = pack_i1.lo pack_i2.lo pack_i4.lo pack_i8.lo \
        pack_i16.lo pack_r4.lo pack_r8.lo pack_r10.lo pack_r16.lo \
        pack_c4.lo pack_c8.lo pack_c10.lo pack_c16.lo
-am__objects_34 = unpack_i1.lo unpack_i2.lo unpack_i4.lo unpack_i8.lo \
+am__objects_37 = unpack_i1.lo unpack_i2.lo unpack_i4.lo unpack_i8.lo \
        unpack_i16.lo unpack_r4.lo unpack_r8.lo unpack_r10.lo \
        unpack_r16.lo unpack_c4.lo unpack_c8.lo unpack_c10.lo \
        unpack_c16.lo
-am__objects_35 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \
+am__objects_38 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \
        spread_i16.lo spread_r4.lo spread_r8.lo spread_r10.lo \
        spread_r16.lo spread_c4.lo spread_c8.lo spread_c10.lo \
        spread_c16.lo
-am__objects_36 = cshift0_i1.lo cshift0_i2.lo cshift0_i4.lo \
+am__objects_39 = cshift0_i1.lo cshift0_i2.lo cshift0_i4.lo \
        cshift0_i8.lo cshift0_i16.lo cshift0_r4.lo cshift0_r8.lo \
        cshift0_r10.lo cshift0_r16.lo cshift0_c4.lo cshift0_c8.lo \
        cshift0_c10.lo cshift0_c16.lo
-am__objects_37 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
+am__objects_40 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
        $(am__objects_5) $(am__objects_6) $(am__objects_7) \
        $(am__objects_8) $(am__objects_9) $(am__objects_10) \
        $(am__objects_11) $(am__objects_12) $(am__objects_13) \
@@ -218,11 +224,12 @@ am__objects_37 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
        $(am__objects_26) $(am__objects_27) $(am__objects_28) \
        $(am__objects_29) $(am__objects_30) $(am__objects_31) \
        $(am__objects_32) $(am__objects_33) $(am__objects_34) \
-       $(am__objects_35) $(am__objects_36)
-am__objects_38 = close.lo file_pos.lo format.lo inquire.lo \
+       $(am__objects_35) $(am__objects_36) $(am__objects_37) \
+       $(am__objects_38) $(am__objects_39)
+am__objects_41 = close.lo file_pos.lo format.lo inquire.lo \
        intrinsics.lo list_read.lo lock.lo open.lo read.lo \
        size_from_kind.lo transfer.lo unit.lo unix.lo write.lo fbuf.lo
-am__objects_39 = associated.lo abort.lo access.lo args.lo \
+am__objects_42 = associated.lo abort.lo access.lo args.lo \
        bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.lo \
        cpu_time.lo cshift0.lo ctime.lo date_and_time.lo dtime.lo \
        env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo \
@@ -237,8 +244,8 @@ am__objects_39 = associated.lo abort.lo access.lo args.lo \
        system_clock.lo time.lo transpose_generic.lo umask.lo \
        unlink.lo unpack_generic.lo in_pack_generic.lo \
        in_unpack_generic.lo
-am__objects_40 =
-am__objects_41 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
+am__objects_43 =
+am__objects_44 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
        _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
        _abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
        _aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
@@ -262,18 +269,18 @@ am__objects_41 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
        _conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
        _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
        _anint_r8.lo _anint_r10.lo _anint_r16.lo
-am__objects_42 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
+am__objects_45 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
        _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
        _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
        _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
        _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
        _mod_r10.lo _mod_r16.lo
-am__objects_43 = misc_specifics.lo
-am__objects_44 = $(am__objects_41) $(am__objects_42) $(am__objects_43) \
+am__objects_46 = misc_specifics.lo
+am__objects_47 = $(am__objects_44) $(am__objects_45) $(am__objects_46) \
        dprod_r8.lo f2c_specifics.lo
-am__objects_45 = $(am__objects_1) $(am__objects_37) $(am__objects_38) \
-       $(am__objects_39) $(am__objects_40) $(am__objects_44)
-@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_45)
+am__objects_48 = $(am__objects_1) $(am__objects_40) $(am__objects_41) \
+       $(am__objects_42) $(am__objects_43) $(am__objects_47)
+@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_48)
 @onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
 libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
 libgfortranbegin_la_LIBADD =
@@ -609,6 +616,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 \
@@ -1022,11 +1050,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) \
@@ -1427,6 +1457,16 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getcwd.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getlog.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/hostnm.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ierrno.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c10.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c16.Plo@am__quote@
@@ -1458,6 +1498,11 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/inquire.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsics.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ishftc.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_binding.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_generated_procs.Plo@am__quote@
@@ -3523,6 +3568,111 @@ bessel_r16.lo: $(srcdir)/generated/bessel_r16.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bessel_r16.lo `test -f '$(srcdir)/generated/bessel_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r16.c
 
+iall_i1.lo: $(srcdir)/generated/iall_i1.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i1.lo -MD -MP -MF $(DEPDIR)/iall_i1.Tpo -c -o iall_i1.lo `test -f '$(srcdir)/generated/iall_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i1.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iall_i1.Tpo $(DEPDIR)/iall_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iall_i1.c' object='iall_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i1.lo `test -f '$(srcdir)/generated/iall_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i1.c
+
+iall_i2.lo: $(srcdir)/generated/iall_i2.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i2.lo -MD -MP -MF $(DEPDIR)/iall_i2.Tpo -c -o iall_i2.lo `test -f '$(srcdir)/generated/iall_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i2.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iall_i2.Tpo $(DEPDIR)/iall_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iall_i2.c' object='iall_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i2.lo `test -f '$(srcdir)/generated/iall_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i2.c
+
+iall_i4.lo: $(srcdir)/generated/iall_i4.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i4.lo -MD -MP -MF $(DEPDIR)/iall_i4.Tpo -c -o iall_i4.lo `test -f '$(srcdir)/generated/iall_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i4.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iall_i4.Tpo $(DEPDIR)/iall_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iall_i4.c' object='iall_i4.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i4.lo `test -f '$(srcdir)/generated/iall_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i4.c
+
+iall_i8.lo: $(srcdir)/generated/iall_i8.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i8.lo -MD -MP -MF $(DEPDIR)/iall_i8.Tpo -c -o iall_i8.lo `test -f '$(srcdir)/generated/iall_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i8.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iall_i8.Tpo $(DEPDIR)/iall_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iall_i8.c' object='iall_i8.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i8.lo `test -f '$(srcdir)/generated/iall_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i8.c
+
+iall_i16.lo: $(srcdir)/generated/iall_i16.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i16.lo -MD -MP -MF $(DEPDIR)/iall_i16.Tpo -c -o iall_i16.lo `test -f '$(srcdir)/generated/iall_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i16.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iall_i16.Tpo $(DEPDIR)/iall_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iall_i16.c' object='iall_i16.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i16.lo `test -f '$(srcdir)/generated/iall_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i16.c
+
+iany_i1.lo: $(srcdir)/generated/iany_i1.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i1.lo -MD -MP -MF $(DEPDIR)/iany_i1.Tpo -c -o iany_i1.lo `test -f '$(srcdir)/generated/iany_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i1.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iany_i1.Tpo $(DEPDIR)/iany_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iany_i1.c' object='iany_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i1.lo `test -f '$(srcdir)/generated/iany_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i1.c
+
+iany_i2.lo: $(srcdir)/generated/iany_i2.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i2.lo -MD -MP -MF $(DEPDIR)/iany_i2.Tpo -c -o iany_i2.lo `test -f '$(srcdir)/generated/iany_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i2.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iany_i2.Tpo $(DEPDIR)/iany_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iany_i2.c' object='iany_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i2.lo `test -f '$(srcdir)/generated/iany_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i2.c
+
+iany_i4.lo: $(srcdir)/generated/iany_i4.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i4.lo -MD -MP -MF $(DEPDIR)/iany_i4.Tpo -c -o iany_i4.lo `test -f '$(srcdir)/generated/iany_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i4.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iany_i4.Tpo $(DEPDIR)/iany_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iany_i4.c' object='iany_i4.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i4.lo `test -f '$(srcdir)/generated/iany_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i4.c
+
+iany_i8.lo: $(srcdir)/generated/iany_i8.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i8.lo -MD -MP -MF $(DEPDIR)/iany_i8.Tpo -c -o iany_i8.lo `test -f '$(srcdir)/generated/iany_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i8.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iany_i8.Tpo $(DEPDIR)/iany_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iany_i8.c' object='iany_i8.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i8.lo `test -f '$(srcdir)/generated/iany_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i8.c
+
+iany_i16.lo: $(srcdir)/generated/iany_i16.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i16.lo -MD -MP -MF $(DEPDIR)/iany_i16.Tpo -c -o iany_i16.lo `test -f '$(srcdir)/generated/iany_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i16.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iany_i16.Tpo $(DEPDIR)/iany_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iany_i16.c' object='iany_i16.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i16.lo `test -f '$(srcdir)/generated/iany_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i16.c
+
+iparity_i1.lo: $(srcdir)/generated/iparity_i1.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i1.lo -MD -MP -MF $(DEPDIR)/iparity_i1.Tpo -c -o iparity_i1.lo `test -f '$(srcdir)/generated/iparity_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i1.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iparity_i1.Tpo $(DEPDIR)/iparity_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iparity_i1.c' object='iparity_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i1.lo `test -f '$(srcdir)/generated/iparity_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i1.c
+
+iparity_i2.lo: $(srcdir)/generated/iparity_i2.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i2.lo -MD -MP -MF $(DEPDIR)/iparity_i2.Tpo -c -o iparity_i2.lo `test -f '$(srcdir)/generated/iparity_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i2.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iparity_i2.Tpo $(DEPDIR)/iparity_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iparity_i2.c' object='iparity_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i2.lo `test -f '$(srcdir)/generated/iparity_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i2.c
+
+iparity_i4.lo: $(srcdir)/generated/iparity_i4.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i4.lo -MD -MP -MF $(DEPDIR)/iparity_i4.Tpo -c -o iparity_i4.lo `test -f '$(srcdir)/generated/iparity_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i4.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iparity_i4.Tpo $(DEPDIR)/iparity_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iparity_i4.c' object='iparity_i4.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i4.lo `test -f '$(srcdir)/generated/iparity_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i4.c
+
+iparity_i8.lo: $(srcdir)/generated/iparity_i8.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i8.lo -MD -MP -MF $(DEPDIR)/iparity_i8.Tpo -c -o iparity_i8.lo `test -f '$(srcdir)/generated/iparity_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i8.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iparity_i8.Tpo $(DEPDIR)/iparity_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iparity_i8.c' object='iparity_i8.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i8.lo `test -f '$(srcdir)/generated/iparity_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i8.c
+
+iparity_i16.lo: $(srcdir)/generated/iparity_i16.c
+@am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i16.lo -MD -MP -MF $(DEPDIR)/iparity_i16.Tpo -c -o iparity_i16.lo `test -f '$(srcdir)/generated/iparity_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i16.c
+@am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/iparity_i16.Tpo $(DEPDIR)/iparity_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/iparity_i16.c' object='iparity_i16.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i16.lo `test -f '$(srcdir)/generated/iparity_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i16.c
+
 norm2_r4.lo: $(srcdir)/generated/norm2_r4.c
 @am__fastdepCC_TRUE@   $(LIBTOOL)  --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT norm2_r4.lo -MD -MP -MF $(DEPDIR)/norm2_r4.Tpo -c -o norm2_r4.lo `test -f '$(srcdir)/generated/norm2_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r4.c
 @am__fastdepCC_TRUE@   $(am__mv) $(DEPDIR)/norm2_r4.Tpo $(DEPDIR)/norm2_r4.Plo
@@ -5671,6 +5821,15 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
 @MAINTAINER_MODE_TRUE@$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
 
+@MAINTAINER_MODE_TRUE@$(i_iall_c): m4/iall.m4 $(I_M4_DEPS)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_iany_c): m4/iany.m4 $(I_M4_DEPS)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iany.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iparity.m4 > $@
+
 @MAINTAINER_MODE_TRUE@$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
 
diff --git a/libgfortran/generated/iall_i1.c b/libgfortran/generated/iall_i1.c
new file mode 100644 (file)
index 0000000..c6bacab
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+
+
+extern void iall_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict);
+export_proto(iall_i1);
+
+void
+iall_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_1 * restrict base;
+  GFC_INTEGER_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IALL");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_1 * restrict src;
+      GFC_INTEGER_1 result;
+      src = base;
+      {
+
+  result = (GFC_INTEGER_1) -1;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result &= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miall_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miall_i1);
+
+void
+miall_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_1 * restrict dest;
+  const GFC_INTEGER_1 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IALL");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IALL");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_1 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_1 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result &= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siall_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siall_i1);
+
+void
+siall_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iall_i1 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IALL intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i16.c b/libgfortran/generated/iall_i16.c
new file mode 100644 (file)
index 0000000..618f333
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void iall_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict);
+export_proto(iall_i16);
+
+void
+iall_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_16 * restrict base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IALL");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_16 * restrict src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = (GFC_INTEGER_16) -1;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result &= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miall_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miall_i16);
+
+void
+miall_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 * restrict dest;
+  const GFC_INTEGER_16 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IALL");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IALL");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_16 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result &= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siall_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siall_i16);
+
+void
+siall_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iall_i16 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IALL intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i2.c b/libgfortran/generated/iall_i2.c
new file mode 100644 (file)
index 0000000..c900059
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2)
+
+
+extern void iall_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict);
+export_proto(iall_i2);
+
+void
+iall_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_2 * restrict base;
+  GFC_INTEGER_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IALL");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_2 * restrict src;
+      GFC_INTEGER_2 result;
+      src = base;
+      {
+
+  result = (GFC_INTEGER_2) -1;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result &= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miall_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miall_i2);
+
+void
+miall_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_2 * restrict dest;
+  const GFC_INTEGER_2 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IALL");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IALL");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_2 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_2 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result &= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siall_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siall_i2);
+
+void
+siall_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iall_i2 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IALL intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i4.c b/libgfortran/generated/iall_i4.c
new file mode 100644 (file)
index 0000000..d5e7dfe
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void iall_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict);
+export_proto(iall_i4);
+
+void
+iall_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_4 * restrict base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IALL");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_4 * restrict src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  result = (GFC_INTEGER_4) -1;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result &= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miall_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miall_i4);
+
+void
+miall_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 * restrict dest;
+  const GFC_INTEGER_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IALL");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IALL");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result &= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siall_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siall_i4);
+
+void
+siall_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iall_i4 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IALL intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i8.c b/libgfortran/generated/iall_i8.c
new file mode 100644 (file)
index 0000000..74ae1b5
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void iall_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict);
+export_proto(iall_i8);
+
+void
+iall_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_8 * restrict base;
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IALL");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_8 * restrict src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  result = (GFC_INTEGER_8) -1;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result &= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miall_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miall_i8);
+
+void
+miall_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 * restrict dest;
+  const GFC_INTEGER_8 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IALL");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IALL");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_8 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result &= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siall_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siall_i8);
+
+void
+siall_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iall_i8 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IALL intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IALL intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i1.c b/libgfortran/generated/iany_i1.c
new file mode 100644 (file)
index 0000000..e5d7855
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+
+
+extern void iany_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict);
+export_proto(iany_i1);
+
+void
+iany_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_1 * restrict base;
+  GFC_INTEGER_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IANY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_1 * restrict src;
+      GFC_INTEGER_1 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result |= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miany_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miany_i1);
+
+void
+miany_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_1 * restrict dest;
+  const GFC_INTEGER_1 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IANY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IANY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_1 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_1 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result |= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siany_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siany_i1);
+
+void
+siany_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iany_i1 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IANY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i16.c b/libgfortran/generated/iany_i16.c
new file mode 100644 (file)
index 0000000..20d14d5
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void iany_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict);
+export_proto(iany_i16);
+
+void
+iany_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_16 * restrict base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IANY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_16 * restrict src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result |= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miany_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miany_i16);
+
+void
+miany_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 * restrict dest;
+  const GFC_INTEGER_16 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IANY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IANY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_16 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result |= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siany_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siany_i16);
+
+void
+siany_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iany_i16 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IANY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i2.c b/libgfortran/generated/iany_i2.c
new file mode 100644 (file)
index 0000000..b464c5d
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2)
+
+
+extern void iany_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict);
+export_proto(iany_i2);
+
+void
+iany_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_2 * restrict base;
+  GFC_INTEGER_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IANY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_2 * restrict src;
+      GFC_INTEGER_2 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result |= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miany_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miany_i2);
+
+void
+miany_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_2 * restrict dest;
+  const GFC_INTEGER_2 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IANY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IANY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_2 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_2 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result |= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siany_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siany_i2);
+
+void
+siany_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iany_i2 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IANY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i4.c b/libgfortran/generated/iany_i4.c
new file mode 100644 (file)
index 0000000..3e20282
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void iany_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict);
+export_proto(iany_i4);
+
+void
+iany_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_4 * restrict base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IANY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_4 * restrict src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result |= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miany_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miany_i4);
+
+void
+miany_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 * restrict dest;
+  const GFC_INTEGER_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IANY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IANY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result |= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siany_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siany_i4);
+
+void
+siany_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iany_i4 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IANY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i8.c b/libgfortran/generated/iany_i8.c
new file mode 100644 (file)
index 0000000..8c89e4d
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void iany_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict);
+export_proto(iany_i8);
+
+void
+iany_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_8 * restrict base;
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IANY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_8 * restrict src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result |= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miany_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miany_i8);
+
+void
+miany_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 * restrict dest;
+  const GFC_INTEGER_8 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IANY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IANY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_8 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result |= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siany_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siany_i8);
+
+void
+siany_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iany_i8 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IANY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IANY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i1.c b/libgfortran/generated/iparity_i1.c
new file mode 100644 (file)
index 0000000..35c51c0
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+
+
+extern void iparity_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict);
+export_proto(iparity_i1);
+
+void
+iparity_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_1 * restrict base;
+  GFC_INTEGER_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IPARITY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_1 * restrict src;
+      GFC_INTEGER_1 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result ^= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miparity_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miparity_i1);
+
+void
+miparity_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_1 * restrict dest;
+  const GFC_INTEGER_1 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IPARITY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IPARITY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_1 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_1 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result ^= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siparity_i1 (gfc_array_i1 * const restrict, 
+       gfc_array_i1 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siparity_i1);
+
+void
+siparity_i1 (gfc_array_i1 * const restrict retarray, 
+       gfc_array_i1 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iparity_i1 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IPARITY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i16.c b/libgfortran/generated/iparity_i16.c
new file mode 100644 (file)
index 0000000..608fe22
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void iparity_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict);
+export_proto(iparity_i16);
+
+void
+iparity_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_16 * restrict base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IPARITY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_16 * restrict src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result ^= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miparity_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miparity_i16);
+
+void
+miparity_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 * restrict dest;
+  const GFC_INTEGER_16 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IPARITY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IPARITY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_16 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result ^= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siparity_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siparity_i16);
+
+void
+siparity_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iparity_i16 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IPARITY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i2.c b/libgfortran/generated/iparity_i2.c
new file mode 100644 (file)
index 0000000..a1e465c
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2)
+
+
+extern void iparity_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict);
+export_proto(iparity_i2);
+
+void
+iparity_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_2 * restrict base;
+  GFC_INTEGER_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IPARITY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_2 * restrict src;
+      GFC_INTEGER_2 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result ^= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miparity_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miparity_i2);
+
+void
+miparity_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_2 * restrict dest;
+  const GFC_INTEGER_2 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IPARITY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IPARITY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_2 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_2 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result ^= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siparity_i2 (gfc_array_i2 * const restrict, 
+       gfc_array_i2 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siparity_i2);
+
+void
+siparity_i2 (gfc_array_i2 * const restrict retarray, 
+       gfc_array_i2 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iparity_i2 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IPARITY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i4.c b/libgfortran/generated/iparity_i4.c
new file mode 100644 (file)
index 0000000..e4a492c
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void iparity_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict);
+export_proto(iparity_i4);
+
+void
+iparity_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_4 * restrict base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IPARITY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_4 * restrict src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result ^= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miparity_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miparity_i4);
+
+void
+miparity_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 * restrict dest;
+  const GFC_INTEGER_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IPARITY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IPARITY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result ^= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siparity_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siparity_i4);
+
+void
+siparity_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iparity_i4 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IPARITY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i8.c b/libgfortran/generated/iparity_i8.c
new file mode 100644 (file)
index 0000000..b399751
--- /dev/null
@@ -0,0 +1,509 @@
+/* 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>
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void iparity_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict);
+export_proto(iparity_i8);
+
+void
+iparity_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  const GFC_INTEGER_8 * restrict base;
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int continue_loop;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len < 0)
+    len = 0;
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "IPARITY");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  continue_loop = 1;
+  while (continue_loop)
+    {
+      const GFC_INTEGER_8 * restrict src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result ^= *src;
+             }
+           
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             continue_loop = 0;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void miparity_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       gfc_array_l1 * const restrict);
+export_proto(miparity_i8);
+
+void
+miparity_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       gfc_array_l1 * const restrict mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 * restrict dest;
+  const GFC_INTEGER_8 * restrict base;
+  const GFC_LOGICAL_1 * restrict mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+  int mask_kind;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  len = GFC_DESCRIPTOR_EXTENT(array,dim);
+  if (len <= 0)
+    return;
+
+  mbase = mask->data;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         bounds_ifunction_return ((array_t *) retarray, extent,
+                                  "return value", "IPARITY");
+         bounds_equal_extents ((array_t *) mask, (array_t *) array,
+                               "MASK argument", "IPARITY");
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+      if (extent[n] <= 0)
+       return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+
+  while (base)
+    {
+      const GFC_INTEGER_8 * restrict src;
+      const GFC_LOGICAL_1 * restrict msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+       if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result ^= *src;
+             }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         base -= sstride[n] * extent[n];
+         mbase -= mstride[n] * extent[n];
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           {
+             /* Break out of the look.  */
+             base = NULL;
+             break;
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             mbase += mstride[n];
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+
+extern void siparity_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(siparity_i8);
+
+void
+siparity_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type dim;
+
+
+  if (*mask)
+    {
+      iparity_i8 (retarray, array, pdim);
+      return;
+    }
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  for (n = 0; n < dim; n++)
+    {
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  for (n = dim; n < rank; n++)
+    {
+      extent[n] =
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+      if (extent[n] <= 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size, str;
+
+      for (n = 0; n < rank; n++)
+       {
+         if (n == 0)
+           str = 1;
+         else
+           str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+         GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+       }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+         return;
+       }
+      else
+       retarray->data = internal_malloc_size (alloc_size);
+    }
+  else
+    {
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect in"
+                      " IPARITY intrinsic: is %ld, should be %ld",
+                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+                      (long int) rank);
+
+      if (unlikely (compile_options.bounds_check))
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " IPARITY intrinsic in dimension %ld:"
+                              " is %ld, should be %ld", (long int) n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+    }
+
+  dest = retarray->data;
+
+  while(1)
+    {
+      *dest = 0;
+      count[0]++;
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 0;
+         /* We could precalculate these products, but this is a less
+            frequently used path so probably not worth it.  */
+         dest -= dstride[n] * extent[n];
+         n++;
+         if (n == rank)
+           return;
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
+       }
+    }
+}
+
+#endif
index 72dafa6..ea6ebfa 100644 (file)
@@ -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 {
diff --git a/libgfortran/m4/iall.m4 b/libgfortran/m4/iall.m4
new file mode 100644 (file)
index 0000000..2e6667e
--- /dev/null
@@ -0,0 +1,46 @@
+`/* 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
diff --git a/libgfortran/m4/iany.m4 b/libgfortran/m4/iany.m4
new file mode 100644 (file)
index 0000000..a17d951
--- /dev/null
@@ -0,0 +1,46 @@
+`/* 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
diff --git a/libgfortran/m4/iparity.m4 b/libgfortran/m4/iparity.m4
new file mode 100644 (file)
index 0000000..78dbc3d
--- /dev/null
@@ -0,0 +1,46 @@
+`/* 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