OSDN Git Service

2008-01-15 Thomas Koenig <tkoenig@gcc.gnu.org>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 15 Jan 2008 21:22:07 +0000 (21:22 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 15 Jan 2008 21:22:07 +0000 (21:22 +0000)
PR libfortran/34671
* gfortran.am: Added _gfortran_all_l1, _gfortran_all_l2,
_gfortran_any_l1, _gfortran_any_l2, -28,15 _gfortran_count_1_l,
_gfortran_count_16_l, _gfortran_count_2_l, _gfortran_count_4_l and
_gfortran_count_8_l Removed _gfortran_count_16_l16,
_gfortran_count_16_l4, _gfortran_count_16_l8,
_gfortran_count_4_l16, _gfortran_count_4_l4, _gfortran_count_4_l8,
_gfortran_count_8_l16, _gfortran_count_8_l4 and
_gfortran_count_8_l8.
* Makefile.am: Added generated/any_l1.c and generated/any_l2.c to
i_any_c.  Added generated/all_l1. and generated/all_l2.c to
i_all_c.  Removed generated/count_4_l4.c, generated/count_8_l4.c,
generated/count_16_l4.c, generated/count_4_l8.c,
generated/count_8_l8.c, generated/count_16_l8.c,
generated/count_4_l16.c, generated/count_8_l16.c, and
generated/count_16_l16.c from i_count_c.  Added count_1_l.c,
count_2_l.c, count_4_l.c, count_8_l.c and count_16_l.c to
i_count_c.  I_M4_DEPS2 depends on ifunction_logical.m4, for
any of the files generated from all.m4, any.m4 and count.m4.
* Makefile.in:  Regenerated.
* m4/ifunction_logical.m4:  New file.  Use
GFC_LOGICAL_1 pointer for access to source arrays.
* m4/any.m4:  Include ifunction_logical.m4 instead of
ifunction.m4.  Don't check atype_name.
* m4/all.m4:  Likewise.
* m4/count.m4:  Likewise.
* generated/any_l1.c:  New file.
* generated/any_l2.c:  New file.
* generated/all_l1.c:  New file.
* generated/count_1_l.c:  New file.
* generated/count_2_l.c:  New file.
* generated/count_4_l.c:  New file.
* generated/count_8_l.c:  New file.
* generated/count_16_l.c:  New file.
* generated/any_l4.c:  Regenerated.
* generated/any_l8.c:  Regenerated.
* generated/any_l16.c:  Regenerated.
* generated/all_l4.c: Regenerated.
* generated/all_l8.c: Regenerated.
* generated/all_l16.c: Regenerated.
* generated/count_4_l4.c:  Removed.
* generated/count_4_l8.c:  Removed.
* generated/count_4_l16.c:  Removed.
* generated/count_8_l4.c:  Removed.
* generated/count_8_l8.c:  Removed.
* generated/count_8_l16.c:  Removed.
* generated/count_16_l4.c:  Removed.
* generated/count_16_l8.c:  Removed.
* generated/count_16_l16.c:  Removed.

2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR libfortran/34671
* iresolve.c (gfc_resolve_all):  Call resolve_mask_arg.
(gfc_resolve_any):  Likewise.
(gfc_resolve_count):  Likewise.  Don't append kind of
argument to function name.

2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR libfortran/34671
* gfortran.dg/anyallcount_1.f90:  New test.

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

30 files changed:
gcc/fortran/ChangeLog
gcc/fortran/iresolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/anyallcount_1.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/generated/all_l1.c [new file with mode: 0644]
libgfortran/generated/all_l16.c
libgfortran/generated/all_l2.c [new file with mode: 0644]
libgfortran/generated/all_l4.c
libgfortran/generated/all_l8.c
libgfortran/generated/any_l1.c [new file with mode: 0644]
libgfortran/generated/any_l16.c
libgfortran/generated/any_l2.c [new file with mode: 0644]
libgfortran/generated/any_l4.c
libgfortran/generated/any_l8.c
libgfortran/generated/count_16_l.c [moved from libgfortran/generated/count_16_l4.c with 82% similarity]
libgfortran/generated/count_16_l16.c [deleted file]
libgfortran/generated/count_1_l.c [moved from libgfortran/generated/count_4_l8.c with 80% similarity]
libgfortran/generated/count_2_l.c [moved from libgfortran/generated/count_8_l4.c with 80% similarity]
libgfortran/generated/count_4_l.c [moved from libgfortran/generated/count_4_l4.c with 82% similarity]
libgfortran/generated/count_4_l16.c [deleted file]
libgfortran/generated/count_8_l.c [moved from libgfortran/generated/count_8_l8.c with 82% similarity]
libgfortran/generated/count_8_l16.c [deleted file]
libgfortran/gfortran.map
libgfortran/m4/all.m4
libgfortran/m4/any.m4
libgfortran/m4/count.m4
libgfortran/m4/ifunction_logical.m4 [moved from libgfortran/generated/count_16_l8.c with 55% similarity]

index 9c2cc46..d9e28b5 100644 (file)
@@ -1,3 +1,11 @@
+2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34671
+       * iresolve.c (gfc_resolve_all):  Call resolve_mask_arg.
+       (gfc_resolve_any):  Likewise.
+       (gfc_resolve_count):  Likewise.  Don't append kind of
+       argument to function name.
+
 2008-01-13  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/34665
index 8a09efc..bdb4054 100644 (file)
@@ -256,6 +256,8 @@ gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
+  resolve_mask_arg (mask);
+
   f->value.function.name
     = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type),
                      mask->ts.kind);
@@ -304,6 +306,8 @@ gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
+  resolve_mask_arg (mask);
+
   f->value.function.name
     = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type),
                      mask->ts.kind);
@@ -549,9 +553,11 @@ gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
+  resolve_mask_arg (mask);
+
   f->value.function.name
-    = gfc_get_string (PREFIX ("count_%d_%c%d"), f->ts.kind,
-                     gfc_type_letter (mask->ts.type), mask->ts.kind);
+    = gfc_get_string (PREFIX ("count_%d_%c"), f->ts.kind,
+                     gfc_type_letter (mask->ts.type));
 }
 
 
index c9d0e6a..d0c52a2 100644 (file)
@@ -1,3 +1,8 @@
+2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
+       
+       PR libfortran/34671
+       * gfortran.dg/anyallcount_1.f90:  New test.
+
 2008-01-15  Douglas Gregor  <doug.gregor@gmail.com>
 
        PR c++/34399
diff --git a/gcc/testsuite/gfortran.dg/anyallcount_1.f90 b/gcc/testsuite/gfortran.dg/anyallcount_1.f90
new file mode 100644 (file)
index 0000000..9e8c776
--- /dev/null
@@ -0,0 +1,71 @@
+! { dg-do run }
+program main
+   character(len=*), parameter :: f='(3L1)'
+   character(len=*), parameter :: g='(3I1)'
+   real, dimension(3,3) :: a
+   logical(kind=1), dimension(3,3) :: m1
+   logical(kind=2), dimension(3,3) :: m2
+   logical(kind=4), dimension(3,3) :: m4
+   logical(kind=8), dimension(3,3) :: m8
+   character(len=3) :: res
+   data a /-1.0, -2.0, -3.0, 2.0, 1.0, -2.1, 1.0, 2.0, 3.0 /
+
+   m1 = a > 0
+   m2 = a > 0
+   m4 = a > 0
+   m8 = a > 0
+
+   write (unit=res,fmt=f) any(m1,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m2,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m4,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m8,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m1,dim=2)
+   if (res /= 'TTT') call abort
+   write (unit=res,fmt=f) any(m2,dim=2)
+   if (res /= 'TTT') call abort
+   write (unit=res,fmt=f) any(m4,dim=2)
+   if (res /= 'TTT') call abort
+   write (unit=res,fmt=f) any(m8,dim=2)
+   if (res /= 'TTT') call abort
+
+   write (unit=res,fmt=f) all(m1,dim=1)
+   if (res /= 'FFT') call abort
+   write (unit=res,fmt=f) all(m2,dim=1)
+   if (res /= 'FFT') call abort
+   write (unit=res,fmt=f) all(m4,dim=1)
+   if (res /= 'FFT') call abort
+   write (unit=res,fmt=f) all(m8,dim=1)
+   if (res /= 'FFT') call abort
+
+   write (unit=res,fmt=f) all(m1,dim=2)
+   if (res /= 'FFF') call abort
+   write (unit=res,fmt=f) all(m2,dim=2)
+   if (res /= 'FFF') call abort
+   write (unit=res,fmt=f) all(m4,dim=2)
+   if (res /= 'FFF') call abort
+   write (unit=res,fmt=f) all(m8,dim=2)
+   if (res /= 'FFF') call abort
+
+   write (unit=res,fmt=g) count(m1,dim=1)
+   if (res /= '023') call abort
+   write (unit=res,fmt=g) count(m2,dim=1)
+   if (res /= '023') call abort
+   write (unit=res,fmt=g) count(m4,dim=1)
+   if (res /= '023') call abort
+   write (unit=res,fmt=g) count(m8,dim=1)
+   if (res /= '023') call abort
+
+   write (unit=res,fmt=g) count(m1,dim=2)
+   if (res /= '221') call abort
+   write (unit=res,fmt=g) count(m2,dim=2)
+   if (res /= '221') call abort
+   write (unit=res,fmt=g) count(m4,dim=2)
+   if (res /= '221') call abort
+   write (unit=res,fmt=g) count(m8,dim=2)
+   if (res /= '221') call abort
+
+end program main
index 16ef713..389861a 100644 (file)
@@ -1,3 +1,55 @@
+2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34671
+       * gfortran.am: Added _gfortran_all_l1, _gfortran_all_l2,
+       _gfortran_any_l1, _gfortran_any_l2, -28,15 _gfortran_count_1_l,
+       _gfortran_count_16_l, _gfortran_count_2_l, _gfortran_count_4_l and
+       _gfortran_count_8_l Removed _gfortran_count_16_l16,
+       _gfortran_count_16_l4, _gfortran_count_16_l8,
+       _gfortran_count_4_l16, _gfortran_count_4_l4, _gfortran_count_4_l8,
+       _gfortran_count_8_l16, _gfortran_count_8_l4 and
+       _gfortran_count_8_l8.
+       * Makefile.am: Added generated/any_l1.c and generated/any_l2.c to
+       i_any_c.  Added generated/all_l1. and generated/all_l2.c to
+       i_all_c.  Removed generated/count_4_l4.c, generated/count_8_l4.c,
+       generated/count_16_l4.c, generated/count_4_l8.c,
+       generated/count_8_l8.c, generated/count_16_l8.c,
+       generated/count_4_l16.c, generated/count_8_l16.c, and
+       generated/count_16_l16.c from i_count_c.  Added count_1_l.c,
+       count_2_l.c, count_4_l.c, count_8_l.c and count_16_l.c to
+       i_count_c.  I_M4_DEPS2 depends on ifunction_logical.m4, for
+       any of the files generated from all.m4, any.m4 and count.m4.
+       * Makefile.in:  Regenerated.
+       * m4/ifunction_logical.m4:  New file.  Use
+       GFC_LOGICAL_1 pointer for access to source arrays.
+       * m4/any.m4:  Include ifunction_logical.m4 instead of
+       ifunction.m4.  Don't check atype_name.
+       * m4/all.m4:  Likewise.
+       * m4/count.m4:  Likewise.
+       * generated/any_l1.c:  New file.
+       * generated/any_l2.c:  New file.
+       * generated/all_l1.c:  New file.
+       * generated/count_1_l.c:  New file.
+       * generated/count_2_l.c:  New file.
+       * generated/count_4_l.c:  New file.
+       * generated/count_8_l.c:  New file.
+       * generated/count_16_l.c:  New file.
+       * generated/any_l4.c:  Regenerated.
+       * generated/any_l8.c:  Regenerated.
+       * generated/any_l16.c:  Regenerated.
+       * generated/all_l4.c: Regenerated.
+       * generated/all_l8.c: Regenerated.
+       * generated/all_l16.c: Regenerated.
+       * generated/count_4_l4.c:  Removed.
+       * generated/count_4_l8.c:  Removed.
+       * generated/count_4_l16.c:  Removed.
+       * generated/count_8_l4.c:  Removed.
+       * generated/count_8_l8.c:  Removed.
+       * generated/count_8_l16.c:  Removed.
+       * generated/count_16_l4.c:  Removed.
+       * generated/count_16_l8.c:  Removed.
+       * generated/count_16_l16.c:  Removed.
+
 2008-01-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR libfortran/34746
index 9721db2..489f9ed 100644 (file)
@@ -121,25 +121,25 @@ runtime/string.c \
 runtime/select.c
 
 i_all_c= \
+$(srcdir)/generated/all_l1.c \
+$(srcdir)/generated/all_l2.c \
 $(srcdir)/generated/all_l4.c \
 $(srcdir)/generated/all_l8.c \
 $(srcdir)/generated/all_l16.c
 
 i_any_c= \
+$(srcdir)/generated/any_l1.c \
+$(srcdir)/generated/any_l2.c \
 $(srcdir)/generated/any_l4.c \
 $(srcdir)/generated/any_l8.c \
 $(srcdir)/generated/any_l16.c
 
 i_count_c= \
-$(srcdir)/generated/count_4_l4.c \
-$(srcdir)/generated/count_8_l4.c \
-$(srcdir)/generated/count_16_l4.c \
-$(srcdir)/generated/count_4_l8.c \
-$(srcdir)/generated/count_8_l8.c \
-$(srcdir)/generated/count_16_l8.c \
-$(srcdir)/generated/count_4_l16.c \
-$(srcdir)/generated/count_8_l16.c \
-$(srcdir)/generated/count_16_l16.c
+$(srcdir)/generated/count_1_l.c \
+$(srcdir)/generated/count_2_l.c \
+$(srcdir)/generated/count_4_l.c \
+$(srcdir)/generated/count_8_l.c \
+$(srcdir)/generated/count_16_l.c
 
 i_maxloc0_c= \
 $(srcdir)/generated/maxloc0_4_i1.c \
@@ -463,7 +463,7 @@ $(srcdir)/generated/pow_c16_i16.c
 m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
     m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
-    m4/matmul.m4 m4/matmull.m4 \
+    m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \
     m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
     m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
     m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
@@ -684,6 +684,7 @@ endif
 I_M4_DEPS=m4/iparm.m4
 I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
 I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
+I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4
 
 kinds.h: $(srcdir)/mk-kinds-h.sh
        $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@@ -707,13 +708,13 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
 ## so we only include them in maintainer mode
 
 if MAINTAINER_MODE
-$(i_all_c): m4/all.m4 $(I_M4_DEPS1)
+$(i_all_c): m4/all.m4 $(I_M4_DEPS2)
        $(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@
 
-$(i_any_c): m4/any.m4 $(I_M4_DEPS1)
+$(i_any_c): m4/any.m4 $(I_M4_DEPS2)
        $(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@
 
-$(i_count_c): m4/count.m4 $(I_M4_DEPS1)
+$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
        $(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
 
 $(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
index a58916b..07feb5d 100644 (file)
@@ -80,18 +80,16 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
        runtime/compile_options.c runtime/environ.c runtime/error.c \
        runtime/fpu.c runtime/main.c runtime/memory.c runtime/pause.c \
        runtime/stop.c runtime/string.c runtime/select.c \
+       $(srcdir)/generated/all_l1.c $(srcdir)/generated/all_l2.c \
        $(srcdir)/generated/all_l4.c $(srcdir)/generated/all_l8.c \
-       $(srcdir)/generated/all_l16.c $(srcdir)/generated/any_l4.c \
+       $(srcdir)/generated/all_l16.c $(srcdir)/generated/any_l1.c \
+       $(srcdir)/generated/any_l2.c $(srcdir)/generated/any_l4.c \
        $(srcdir)/generated/any_l8.c $(srcdir)/generated/any_l16.c \
-       $(srcdir)/generated/count_4_l4.c \
-       $(srcdir)/generated/count_8_l4.c \
-       $(srcdir)/generated/count_16_l4.c \
-       $(srcdir)/generated/count_4_l8.c \
-       $(srcdir)/generated/count_8_l8.c \
-       $(srcdir)/generated/count_16_l8.c \
-       $(srcdir)/generated/count_4_l16.c \
-       $(srcdir)/generated/count_8_l16.c \
-       $(srcdir)/generated/count_16_l16.c \
+       $(srcdir)/generated/count_1_l.c \
+       $(srcdir)/generated/count_2_l.c \
+       $(srcdir)/generated/count_4_l.c \
+       $(srcdir)/generated/count_8_l.c \
+       $(srcdir)/generated/count_16_l.c \
        $(srcdir)/generated/maxloc0_4_i1.c \
        $(srcdir)/generated/maxloc0_8_i1.c \
        $(srcdir)/generated/maxloc0_16_i1.c \
@@ -523,11 +521,10 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
        %.c,$(prereq_SRC))
 am__objects_1 = backtrace.lo compile_options.lo environ.lo error.lo \
        fpu.lo main.lo memory.lo pause.lo stop.lo string.lo select.lo
-am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
-am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
-am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
-       count_4_l8.lo count_8_l8.lo count_16_l8.lo count_4_l16.lo \
-       count_8_l16.lo count_16_l16.lo
+am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo
+am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo
+am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \
+       count_16_l.lo
 am__objects_5 = maxloc0_4_i1.lo maxloc0_8_i1.lo maxloc0_16_i1.lo \
        maxloc0_4_i2.lo maxloc0_8_i2.lo maxloc0_16_i2.lo \
        maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_16_i4.lo \
@@ -960,25 +957,25 @@ runtime/string.c \
 runtime/select.c
 
 i_all_c = \
+$(srcdir)/generated/all_l1.c \
+$(srcdir)/generated/all_l2.c \
 $(srcdir)/generated/all_l4.c \
 $(srcdir)/generated/all_l8.c \
 $(srcdir)/generated/all_l16.c
 
 i_any_c = \
+$(srcdir)/generated/any_l1.c \
+$(srcdir)/generated/any_l2.c \
 $(srcdir)/generated/any_l4.c \
 $(srcdir)/generated/any_l8.c \
 $(srcdir)/generated/any_l16.c
 
 i_count_c = \
-$(srcdir)/generated/count_4_l4.c \
-$(srcdir)/generated/count_8_l4.c \
-$(srcdir)/generated/count_16_l4.c \
-$(srcdir)/generated/count_4_l8.c \
-$(srcdir)/generated/count_8_l8.c \
-$(srcdir)/generated/count_16_l8.c \
-$(srcdir)/generated/count_4_l16.c \
-$(srcdir)/generated/count_8_l16.c \
-$(srcdir)/generated/count_16_l16.c
+$(srcdir)/generated/count_1_l.c \
+$(srcdir)/generated/count_2_l.c \
+$(srcdir)/generated/count_4_l.c \
+$(srcdir)/generated/count_8_l.c \
+$(srcdir)/generated/count_16_l.c
 
 i_maxloc0_c = \
 $(srcdir)/generated/maxloc0_4_i1.c \
@@ -1302,7 +1299,7 @@ $(srcdir)/generated/pow_c16_i16.c
 m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
     m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
-    m4/matmul.m4 m4/matmull.m4 \
+    m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \
     m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
     m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
     m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
@@ -1492,6 +1489,7 @@ prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
 I_M4_DEPS = m4/iparm.m4
 I_M4_DEPS0 = $(I_M4_DEPS) m4/iforeach.m4
 I_M4_DEPS1 = $(I_M4_DEPS) m4/ifunction.m4
+I_M4_DEPS2 = $(I_M4_DEPS) m4/ifunction_logical.m4
 EXTRA_DIST = $(m4_files)
 all: $(BUILT_SOURCES) config.h
        $(MAKE) $(AM_MAKEFLAGS) all-am
@@ -1615,10 +1613,14 @@ distclean-compile:
 
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/abort.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/access.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l1.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l2.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l1.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l2.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l4.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@
@@ -1630,15 +1632,11 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/clock.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/compile_options.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l16.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l4.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l8.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l16.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l4.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l8.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l16.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l4.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_1_l.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_2_l.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cpu_time.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_16.Plo@am__quote@
@@ -2502,6 +2500,20 @@ select.lo: runtime/select.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o select.lo `test -f 'runtime/select.c' || echo '$(srcdir)/'`runtime/select.c
 
+all_l1.lo: $(srcdir)/generated/all_l1.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l1.lo -MD -MP -MF "$(DEPDIR)/all_l1.Tpo" -c -o all_l1.lo `test -f '$(srcdir)/generated/all_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l1.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/all_l1.Tpo" "$(DEPDIR)/all_l1.Plo"; else rm -f "$(DEPDIR)/all_l1.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/all_l1.c' object='all_l1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l1.lo `test -f '$(srcdir)/generated/all_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l1.c
+
+all_l2.lo: $(srcdir)/generated/all_l2.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l2.lo -MD -MP -MF "$(DEPDIR)/all_l2.Tpo" -c -o all_l2.lo `test -f '$(srcdir)/generated/all_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l2.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/all_l2.Tpo" "$(DEPDIR)/all_l2.Plo"; else rm -f "$(DEPDIR)/all_l2.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/all_l2.c' object='all_l2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l2.lo `test -f '$(srcdir)/generated/all_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l2.c
+
 all_l4.lo: $(srcdir)/generated/all_l4.c
 @am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l4.lo -MD -MP -MF "$(DEPDIR)/all_l4.Tpo" -c -o all_l4.lo `test -f '$(srcdir)/generated/all_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l4.c; \
 @am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/all_l4.Tpo" "$(DEPDIR)/all_l4.Plo"; else rm -f "$(DEPDIR)/all_l4.Tpo"; exit 1; fi
@@ -2523,6 +2535,20 @@ all_l16.lo: $(srcdir)/generated/all_l16.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l16.lo `test -f '$(srcdir)/generated/all_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l16.c
 
+any_l1.lo: $(srcdir)/generated/any_l1.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l1.lo -MD -MP -MF "$(DEPDIR)/any_l1.Tpo" -c -o any_l1.lo `test -f '$(srcdir)/generated/any_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l1.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/any_l1.Tpo" "$(DEPDIR)/any_l1.Plo"; else rm -f "$(DEPDIR)/any_l1.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/any_l1.c' object='any_l1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l1.lo `test -f '$(srcdir)/generated/any_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l1.c
+
+any_l2.lo: $(srcdir)/generated/any_l2.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l2.lo -MD -MP -MF "$(DEPDIR)/any_l2.Tpo" -c -o any_l2.lo `test -f '$(srcdir)/generated/any_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l2.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/any_l2.Tpo" "$(DEPDIR)/any_l2.Plo"; else rm -f "$(DEPDIR)/any_l2.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/any_l2.c' object='any_l2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l2.lo `test -f '$(srcdir)/generated/any_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l2.c
+
 any_l4.lo: $(srcdir)/generated/any_l4.c
 @am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l4.lo -MD -MP -MF "$(DEPDIR)/any_l4.Tpo" -c -o any_l4.lo `test -f '$(srcdir)/generated/any_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l4.c; \
 @am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/any_l4.Tpo" "$(DEPDIR)/any_l4.Plo"; else rm -f "$(DEPDIR)/any_l4.Tpo"; exit 1; fi
@@ -2544,68 +2570,40 @@ any_l16.lo: $(srcdir)/generated/any_l16.c
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l16.lo `test -f '$(srcdir)/generated/any_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l16.c
 
-count_4_l4.lo: $(srcdir)/generated/count_4_l4.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_4_l4.lo -MD -MP -MF "$(DEPDIR)/count_4_l4.Tpo" -c -o count_4_l4.lo `test -f '$(srcdir)/generated/count_4_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l4.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_4_l4.Tpo" "$(DEPDIR)/count_4_l4.Plo"; else rm -f "$(DEPDIR)/count_4_l4.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_4_l4.c' object='count_4_l4.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l4.lo `test -f '$(srcdir)/generated/count_4_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l4.c
-
-count_8_l4.lo: $(srcdir)/generated/count_8_l4.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_8_l4.lo -MD -MP -MF "$(DEPDIR)/count_8_l4.Tpo" -c -o count_8_l4.lo `test -f '$(srcdir)/generated/count_8_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l4.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_8_l4.Tpo" "$(DEPDIR)/count_8_l4.Plo"; else rm -f "$(DEPDIR)/count_8_l4.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_8_l4.c' object='count_8_l4.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l4.lo `test -f '$(srcdir)/generated/count_8_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l4.c
-
-count_16_l4.lo: $(srcdir)/generated/count_16_l4.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_16_l4.lo -MD -MP -MF "$(DEPDIR)/count_16_l4.Tpo" -c -o count_16_l4.lo `test -f '$(srcdir)/generated/count_16_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l4.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_16_l4.Tpo" "$(DEPDIR)/count_16_l4.Plo"; else rm -f "$(DEPDIR)/count_16_l4.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_16_l4.c' object='count_16_l4.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l4.lo `test -f '$(srcdir)/generated/count_16_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l4.c
-
-count_4_l8.lo: $(srcdir)/generated/count_4_l8.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_4_l8.lo -MD -MP -MF "$(DEPDIR)/count_4_l8.Tpo" -c -o count_4_l8.lo `test -f '$(srcdir)/generated/count_4_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l8.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_4_l8.Tpo" "$(DEPDIR)/count_4_l8.Plo"; else rm -f "$(DEPDIR)/count_4_l8.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_4_l8.c' object='count_4_l8.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l8.lo `test -f '$(srcdir)/generated/count_4_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l8.c
-
-count_8_l8.lo: $(srcdir)/generated/count_8_l8.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_8_l8.lo -MD -MP -MF "$(DEPDIR)/count_8_l8.Tpo" -c -o count_8_l8.lo `test -f '$(srcdir)/generated/count_8_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l8.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_8_l8.Tpo" "$(DEPDIR)/count_8_l8.Plo"; else rm -f "$(DEPDIR)/count_8_l8.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_8_l8.c' object='count_8_l8.lo' libtool=yes @AMDEPBACKSLASH@
+count_1_l.lo: $(srcdir)/generated/count_1_l.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_1_l.lo -MD -MP -MF "$(DEPDIR)/count_1_l.Tpo" -c -o count_1_l.lo `test -f '$(srcdir)/generated/count_1_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_1_l.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_1_l.Tpo" "$(DEPDIR)/count_1_l.Plo"; else rm -f "$(DEPDIR)/count_1_l.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_1_l.c' object='count_1_l.lo' libtool=yes @AMDEPBACKSLASH@
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l8.lo `test -f '$(srcdir)/generated/count_8_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l8.c
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_1_l.lo `test -f '$(srcdir)/generated/count_1_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_1_l.c
 
-count_16_l8.lo: $(srcdir)/generated/count_16_l8.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_16_l8.lo -MD -MP -MF "$(DEPDIR)/count_16_l8.Tpo" -c -o count_16_l8.lo `test -f '$(srcdir)/generated/count_16_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l8.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_16_l8.Tpo" "$(DEPDIR)/count_16_l8.Plo"; else rm -f "$(DEPDIR)/count_16_l8.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_16_l8.c' object='count_16_l8.lo' libtool=yes @AMDEPBACKSLASH@
+count_2_l.lo: $(srcdir)/generated/count_2_l.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_2_l.lo -MD -MP -MF "$(DEPDIR)/count_2_l.Tpo" -c -o count_2_l.lo `test -f '$(srcdir)/generated/count_2_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_2_l.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_2_l.Tpo" "$(DEPDIR)/count_2_l.Plo"; else rm -f "$(DEPDIR)/count_2_l.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_2_l.c' object='count_2_l.lo' libtool=yes @AMDEPBACKSLASH@
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l8.lo `test -f '$(srcdir)/generated/count_16_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l8.c
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_2_l.lo `test -f '$(srcdir)/generated/count_2_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_2_l.c
 
-count_4_l16.lo: $(srcdir)/generated/count_4_l16.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_4_l16.lo -MD -MP -MF "$(DEPDIR)/count_4_l16.Tpo" -c -o count_4_l16.lo `test -f '$(srcdir)/generated/count_4_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l16.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_4_l16.Tpo" "$(DEPDIR)/count_4_l16.Plo"; else rm -f "$(DEPDIR)/count_4_l16.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_4_l16.c' object='count_4_l16.lo' libtool=yes @AMDEPBACKSLASH@
+count_4_l.lo: $(srcdir)/generated/count_4_l.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_4_l.lo -MD -MP -MF "$(DEPDIR)/count_4_l.Tpo" -c -o count_4_l.lo `test -f '$(srcdir)/generated/count_4_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_4_l.Tpo" "$(DEPDIR)/count_4_l.Plo"; else rm -f "$(DEPDIR)/count_4_l.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_4_l.c' object='count_4_l.lo' libtool=yes @AMDEPBACKSLASH@
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l16.lo `test -f '$(srcdir)/generated/count_4_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l16.c
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l.lo `test -f '$(srcdir)/generated/count_4_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l.c
 
-count_8_l16.lo: $(srcdir)/generated/count_8_l16.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_8_l16.lo -MD -MP -MF "$(DEPDIR)/count_8_l16.Tpo" -c -o count_8_l16.lo `test -f '$(srcdir)/generated/count_8_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l16.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_8_l16.Tpo" "$(DEPDIR)/count_8_l16.Plo"; else rm -f "$(DEPDIR)/count_8_l16.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_8_l16.c' object='count_8_l16.lo' libtool=yes @AMDEPBACKSLASH@
+count_8_l.lo: $(srcdir)/generated/count_8_l.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_8_l.lo -MD -MP -MF "$(DEPDIR)/count_8_l.Tpo" -c -o count_8_l.lo `test -f '$(srcdir)/generated/count_8_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_8_l.Tpo" "$(DEPDIR)/count_8_l.Plo"; else rm -f "$(DEPDIR)/count_8_l.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_8_l.c' object='count_8_l.lo' libtool=yes @AMDEPBACKSLASH@
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l16.lo `test -f '$(srcdir)/generated/count_8_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l16.c
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l.lo `test -f '$(srcdir)/generated/count_8_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l.c
 
-count_16_l16.lo: $(srcdir)/generated/count_16_l16.c
-@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_16_l16.lo -MD -MP -MF "$(DEPDIR)/count_16_l16.Tpo" -c -o count_16_l16.lo `test -f '$(srcdir)/generated/count_16_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l16.c; \
-@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_16_l16.Tpo" "$(DEPDIR)/count_16_l16.Plo"; else rm -f "$(DEPDIR)/count_16_l16.Tpo"; exit 1; fi
-@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_16_l16.c' object='count_16_l16.lo' libtool=yes @AMDEPBACKSLASH@
+count_16_l.lo: $(srcdir)/generated/count_16_l.c
+@am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_16_l.lo -MD -MP -MF "$(DEPDIR)/count_16_l.Tpo" -c -o count_16_l.lo `test -f '$(srcdir)/generated/count_16_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l.c; \
+@am__fastdepCC_TRUE@   then mv -f "$(DEPDIR)/count_16_l.Tpo" "$(DEPDIR)/count_16_l.Plo"; else rm -f "$(DEPDIR)/count_16_l.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@      source='$(srcdir)/generated/count_16_l.c' object='count_16_l.lo' libtool=yes @AMDEPBACKSLASH@
 @AMDEP_TRUE@@am__fastdepCC_FALSE@      DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l16.lo `test -f '$(srcdir)/generated/count_16_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l16.c
+@am__fastdepCC_FALSE@  $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l.lo `test -f '$(srcdir)/generated/count_16_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l.c
 
 maxloc0_4_i1.lo: $(srcdir)/generated/maxloc0_4_i1.c
 @am__fastdepCC_TRUE@   if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i1.lo -MD -MP -MF "$(DEPDIR)/maxloc0_4_i1.Tpo" -c -o maxloc0_4_i1.lo `test -f '$(srcdir)/generated/maxloc0_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i1.c; \
@@ -5350,13 +5348,13 @@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
 fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
        cp $(srcdir)/$(FPU_HOST_HEADER) $@
 
-@MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS1)
+@MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS2)
 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@
 
-@MAINTAINER_MODE_TRUE@$(i_any_c): m4/any.m4 $(I_M4_DEPS1)
+@MAINTAINER_MODE_TRUE@$(i_any_c): m4/any.m4 $(I_M4_DEPS2)
 @MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@
 
-@MAINTAINER_MODE_TRUE@$(i_count_c): m4/count.m4 $(I_M4_DEPS1)
+@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_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
diff --git a/libgfortran/generated/all_l1.c b/libgfortran/generated/all_l1.c
new file mode 100644 (file)
index 0000000..47cf222
--- /dev/null
@@ -0,0 +1,222 @@
+/* Implementation of the ALL intrinsic
+   Copyright 2002, 2007 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_LOGICAL_1)
+
+
+extern void all_l1 (gfc_array_l1 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(all_l1);
+
+void
+all_l1 (gfc_array_l1 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_1 * restrict base;
+  GFC_LOGICAL_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int src_kind;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride * src_kind;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride * src_kind;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride * src_kind;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size;
+
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         retarray->dim[0].lbound = 0;
+         retarray->dim[0].ubound = -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"
+                      " ALL intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
+
+      if (compile_options.bounds_check)
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = retarray->dim[n].ubound + 1
+               - retarray->dim[n].lbound;
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " ALL intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ALL intrinsic");
+
+  dest = retarray->data;
+
+  while (base)
+    {
+      const GFC_LOGICAL_1 * restrict src;
+      GFC_LOGICAL_1 result;
+      src = base;
+      {
+
+  /* Return true only if all the elements are set.  */
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (! *src)
+    {
+      result = 0;
+      break;
+    }
+          }
+           *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.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 9c53707..ca147e7 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
+#if defined (HAVE_GFC_LOGICAL_16)
 
 
 extern void all_l16 (gfc_array_l16 * const restrict, 
-       gfc_array_l16 * const restrict, const index_type * const restrict);
+       gfc_array_l1 * const restrict, const index_type * const restrict);
 export_proto(all_l16);
 
 void
 all_l16 (gfc_array_l16 * const restrict retarray, 
-       gfc_array_l16 * const restrict array, 
+       gfc_array_l1 * 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_LOGICAL_16 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_LOGICAL_16 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ all_l16 (gfc_array_l16 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ all_l16 (gfc_array_l16 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " ALL intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " ALL intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ all_l16 (gfc_array_l16 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " ALL intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " ALL intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ all_l16 (gfc_array_l16 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ALL intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_16 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_LOGICAL_16 result;
       src = base;
       {
diff --git a/libgfortran/generated/all_l2.c b/libgfortran/generated/all_l2.c
new file mode 100644 (file)
index 0000000..9e4ab72
--- /dev/null
@@ -0,0 +1,222 @@
+/* Implementation of the ALL intrinsic
+   Copyright 2002, 2007 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_LOGICAL_2)
+
+
+extern void all_l2 (gfc_array_l2 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(all_l2);
+
+void
+all_l2 (gfc_array_l2 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_1 * restrict base;
+  GFC_LOGICAL_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int src_kind;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride * src_kind;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride * src_kind;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride * src_kind;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size;
+
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         retarray->dim[0].lbound = 0;
+         retarray->dim[0].ubound = -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"
+                      " ALL intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
+
+      if (compile_options.bounds_check)
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = retarray->dim[n].ubound + 1
+               - retarray->dim[n].lbound;
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " ALL intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ALL intrinsic");
+
+  dest = retarray->data;
+
+  while (base)
+    {
+      const GFC_LOGICAL_1 * restrict src;
+      GFC_LOGICAL_2 result;
+      src = base;
+      {
+
+  /* Return true only if all the elements are set.  */
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (! *src)
+    {
+      result = 0;
+      break;
+    }
+          }
+           *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.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 6eb7986..255881b 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
+#if defined (HAVE_GFC_LOGICAL_4)
 
 
 extern void all_l4 (gfc_array_l4 * const restrict, 
-       gfc_array_l4 * const restrict, const index_type * const restrict);
+       gfc_array_l1 * const restrict, const index_type * const restrict);
 export_proto(all_l4);
 
 void
 all_l4 (gfc_array_l4 * const restrict retarray, 
-       gfc_array_l4 * const restrict array, 
+       gfc_array_l1 * 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_LOGICAL_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_LOGICAL_4 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ all_l4 (gfc_array_l4 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ all_l4 (gfc_array_l4 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " ALL intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " ALL intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ all_l4 (gfc_array_l4 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " ALL intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " ALL intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ all_l4 (gfc_array_l4 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ALL intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_LOGICAL_4 result;
       src = base;
       {
index 7b98652..00ba59f 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
+#if defined (HAVE_GFC_LOGICAL_8)
 
 
 extern void all_l8 (gfc_array_l8 * const restrict, 
-       gfc_array_l8 * const restrict, const index_type * const restrict);
+       gfc_array_l1 * const restrict, const index_type * const restrict);
 export_proto(all_l8);
 
 void
 all_l8 (gfc_array_l8 * const restrict retarray, 
-       gfc_array_l8 * const restrict array, 
+       gfc_array_l1 * 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_LOGICAL_8 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_LOGICAL_8 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ all_l8 (gfc_array_l8 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ all_l8 (gfc_array_l8 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " ALL intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " ALL intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ all_l8 (gfc_array_l8 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " ALL intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " ALL intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ all_l8 (gfc_array_l8 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ALL intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_8 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_LOGICAL_8 result;
       src = base;
       {
diff --git a/libgfortran/generated/any_l1.c b/libgfortran/generated/any_l1.c
new file mode 100644 (file)
index 0000000..9781a43
--- /dev/null
@@ -0,0 +1,222 @@
+/* Implementation of the ANY intrinsic
+   Copyright 2002, 2007 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_LOGICAL_1)
+
+
+extern void any_l1 (gfc_array_l1 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(any_l1);
+
+void
+any_l1 (gfc_array_l1 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_1 * restrict base;
+  GFC_LOGICAL_1 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int src_kind;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride * src_kind;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride * src_kind;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride * src_kind;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size;
+
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         retarray->dim[0].lbound = 0;
+         retarray->dim[0].ubound = -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"
+                      " ANY intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
+
+      if (compile_options.bounds_check)
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = retarray->dim[n].ubound + 1
+               - retarray->dim[n].lbound;
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " ANY intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ANY intrinsic");
+
+  dest = retarray->data;
+
+  while (base)
+    {
+      const GFC_LOGICAL_1 * restrict src;
+      GFC_LOGICAL_1 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  /* Return true if any of the elements are set.  */
+  if (*src)
+    {
+      result = 1;
+      break;
+    }
+          }
+           *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.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index bffd620..b0e95a6 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
+#if defined (HAVE_GFC_LOGICAL_16)
 
 
 extern void any_l16 (gfc_array_l16 * const restrict, 
-       gfc_array_l16 * const restrict, const index_type * const restrict);
+       gfc_array_l1 * const restrict, const index_type * const restrict);
 export_proto(any_l16);
 
 void
 any_l16 (gfc_array_l16 * const restrict retarray, 
-       gfc_array_l16 * const restrict array, 
+       gfc_array_l1 * 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_LOGICAL_16 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_LOGICAL_16 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ any_l16 (gfc_array_l16 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ any_l16 (gfc_array_l16 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " ANY intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " ANY intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ any_l16 (gfc_array_l16 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " ANY intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " ANY intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ any_l16 (gfc_array_l16 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ANY intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_16 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_LOGICAL_16 result;
       src = base;
       {
diff --git a/libgfortran/generated/any_l2.c b/libgfortran/generated/any_l2.c
new file mode 100644 (file)
index 0000000..6a42be0
--- /dev/null
@@ -0,0 +1,222 @@
+/* Implementation of the ANY intrinsic
+   Copyright 2002, 2007 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_LOGICAL_2)
+
+
+extern void any_l2 (gfc_array_l2 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(any_l2);
+
+void
+any_l2 (gfc_array_l2 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_1 * restrict base;
+  GFC_LOGICAL_2 * restrict dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+  int src_kind;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride * src_kind;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride * src_kind;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride * src_kind;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+
+      if (extent[n] < 0)
+       extent[n] = 0;
+    }
+
+  if (retarray->data == NULL)
+    {
+      size_t alloc_size;
+
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+      alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride
+                  * extent[rank-1];
+
+      if (alloc_size == 0)
+       {
+         /* Make sure we have a zero-sized array.  */
+         retarray->dim[0].lbound = 0;
+         retarray->dim[0].ubound = -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"
+                      " ANY intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
+
+      if (compile_options.bounds_check)
+       {
+         for (n=0; n < rank; n++)
+           {
+             index_type ret_extent;
+
+             ret_extent = retarray->dim[n].ubound + 1
+               - retarray->dim[n].lbound;
+             if (extent[n] != ret_extent)
+               runtime_error ("Incorrect extent in return value of"
+                              " ANY intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
+                              (long int) ret_extent, (long int) extent[n]);
+           }
+       }
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ANY intrinsic");
+
+  dest = retarray->data;
+
+  while (base)
+    {
+      const GFC_LOGICAL_1 * restrict src;
+      GFC_LOGICAL_2 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  /* Return true if any of the elements are set.  */
+  if (*src)
+    {
+      result = 1;
+      break;
+    }
+          }
+           *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.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index f86445e..eb37296 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
+#if defined (HAVE_GFC_LOGICAL_4)
 
 
 extern void any_l4 (gfc_array_l4 * const restrict, 
-       gfc_array_l4 * const restrict, const index_type * const restrict);
+       gfc_array_l1 * const restrict, const index_type * const restrict);
 export_proto(any_l4);
 
 void
 any_l4 (gfc_array_l4 * const restrict retarray, 
-       gfc_array_l4 * const restrict array, 
+       gfc_array_l1 * 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_LOGICAL_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_LOGICAL_4 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ any_l4 (gfc_array_l4 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ any_l4 (gfc_array_l4 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " ANY intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " ANY intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ any_l4 (gfc_array_l4 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " ANY intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " ANY intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ any_l4 (gfc_array_l4 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ANY intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_LOGICAL_4 result;
       src = base;
       {
index f155abb..b5b52a0 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
+#if defined (HAVE_GFC_LOGICAL_8)
 
 
 extern void any_l8 (gfc_array_l8 * const restrict, 
-       gfc_array_l8 * const restrict, const index_type * const restrict);
+       gfc_array_l1 * const restrict, const index_type * const restrict);
 export_proto(any_l8);
 
 void
 any_l8 (gfc_array_l8 * const restrict retarray, 
-       gfc_array_l8 * const restrict array, 
+       gfc_array_l1 * 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_LOGICAL_8 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_LOGICAL_8 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ any_l8 (gfc_array_l8 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ any_l8 (gfc_array_l8 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " ANY intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " ANY intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ any_l8 (gfc_array_l8 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " ANY intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " ANY intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ any_l8 (gfc_array_l8 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in ANY intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_8 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_LOGICAL_8 result;
       src = base;
       {
similarity index 82%
rename from libgfortran/generated/count_16_l4.c
rename to libgfortran/generated/count_16_l.c
index 9b85369..d3f15d7 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_INTEGER_16)
 
 
-extern void count_16_l4 (gfc_array_i16 * const restrict, 
-       gfc_array_l4 * const restrict, const index_type * const restrict);
-export_proto(count_16_l4);
+extern void count_16_l (gfc_array_i16 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(count_16_l);
 
 void
-count_16_l4 (gfc_array_i16 * const restrict retarray, 
-       gfc_array_l4 * const restrict array, 
+count_16_l (gfc_array_i16 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_INTEGER_16 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " COUNT intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " COUNT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " COUNT intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_INTEGER_16 result;
       src = base;
       {
diff --git a/libgfortran/generated/count_16_l16.c b/libgfortran/generated/count_16_l16.c
deleted file mode 100644 (file)
index 4f3418b..0000000
+++ /dev/null
@@ -1,203 +0,0 @@
-/* Implementation of the COUNT intrinsic
-   Copyright 2002, 2007 Free Software Foundation, Inc.
-   Contributed by Paul Brook <paul@nowt.org>
-
-This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-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.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING.  If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
-
-#include "libgfortran.h"
-#include <stdlib.h>
-#include <assert.h>
-
-
-#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_16)
-
-
-extern void count_16_l16 (gfc_array_i16 * const restrict, 
-       gfc_array_l16 * const restrict, const index_type * const restrict);
-export_proto(count_16_l16);
-
-void
-count_16_l16 (gfc_array_i16 * const restrict retarray, 
-       gfc_array_l16 * 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_LOGICAL_16 * restrict base;
-  GFC_INTEGER_16 * restrict dest;
-  index_type rank;
-  index_type n;
-  index_type len;
-  index_type delta;
-  index_type dim;
-
-  /* Make dim zero based to avoid confusion.  */
-  dim = (*pdim) - 1;
-  rank = GFC_DESCRIPTOR_RANK (array) - 1;
-
-  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
-
-  for (n = 0; n < dim; n++)
-    {
-      sstride[n] = array->dim[n].stride;
-      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
-
-      if (extent[n] < 0)
-       extent[n] = 0;
-    }
-  for (n = dim; n < rank; n++)
-    {
-      sstride[n] = array->dim[n + 1].stride;
-      extent[n] =
-        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
-
-      if (extent[n] < 0)
-       extent[n] = 0;
-    }
-
-  if (retarray->data == NULL)
-    {
-      size_t alloc_size;
-
-      for (n = 0; n < rank; n++)
-        {
-          retarray->dim[n].lbound = 0;
-          retarray->dim[n].ubound = extent[n]-1;
-          if (n == 0)
-            retarray->dim[n].stride = 1;
-          else
-            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
-        }
-
-      retarray->offset = 0;
-      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
-
-      alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
-                  * extent[rank-1];
-
-      if (alloc_size == 0)
-       {
-         /* Make sure we have a zero-sized array.  */
-         retarray->dim[0].lbound = 0;
-         retarray->dim[0].ubound = -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"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
-
-      if (compile_options.bounds_check)
-       {
-         for (n=0; n < rank; n++)
-           {
-             index_type ret_extent;
-
-             ret_extent = retarray->dim[n].ubound + 1
-               - retarray->dim[n].lbound;
-             if (extent[n] != ret_extent)
-               runtime_error ("Incorrect extent in return value of"
-                              " COUNT 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] = retarray->dim[n].stride;
-      if (extent[n] <= 0)
-        len = 0;
-    }
-
-  base = array->data;
-  dest = retarray->data;
-
-  while (base)
-    {
-      const GFC_LOGICAL_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)
-             {
-
-  if (*src)
-    result++;
-          }
-           *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.  */
-              base = NULL;
-              break;
-            }
-          else
-            {
-              count[n]++;
-              base += sstride[n];
-              dest += dstride[n];
-            }
-        }
-    }
-}
-
-#endif
similarity index 80%
rename from libgfortran/generated/count_4_l8.c
rename to libgfortran/generated/count_1_l.c
index 0e2f9bb..78d82c0 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_INTEGER_1)
 
 
-extern void count_4_l8 (gfc_array_i4 * const restrict, 
-       gfc_array_l8 * const restrict, const index_type * const restrict);
-export_proto(count_4_l8);
+extern void count_1_l (gfc_array_i1 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(count_1_l);
 
 void
-count_4_l8 (gfc_array_i4 * const restrict retarray, 
-       gfc_array_l8 * const restrict array, 
+count_1_l (gfc_array_i1 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_8 * restrict base;
-  GFC_INTEGER_4 * restrict dest;
+  const GFC_LOGICAL_1 * restrict base;
+  GFC_INTEGER_1 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -99,7 +102,7 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
       retarray->offset = 0;
       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
 
-      alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
+      alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
                   * extent[rank-1];
 
       if (alloc_size == 0)
@@ -116,9 +119,8 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " COUNT intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " COUNT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " COUNT intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,12 +148,25 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_8 * restrict src;
-      GFC_INTEGER_4 result;
+      const GFC_LOGICAL_1 * restrict src;
+      GFC_INTEGER_1 result;
       src = base;
       {
 
similarity index 80%
rename from libgfortran/generated/count_8_l4.c
rename to libgfortran/generated/count_2_l.c
index e6a386e..eb03c2d 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_INTEGER_2)
 
 
-extern void count_8_l4 (gfc_array_i8 * const restrict, 
-       gfc_array_l4 * const restrict, const index_type * const restrict);
-export_proto(count_8_l4);
+extern void count_2_l (gfc_array_i2 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(count_2_l);
 
 void
-count_8_l4 (gfc_array_i8 * const restrict retarray, 
-       gfc_array_l4 * const restrict array, 
+count_2_l (gfc_array_i2 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_4 * restrict base;
-  GFC_INTEGER_8 * restrict dest;
+  const GFC_LOGICAL_1 * restrict base;
+  GFC_INTEGER_2 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -99,7 +102,7 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
       retarray->offset = 0;
       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
 
-      alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
+      alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
                   * extent[rank-1];
 
       if (alloc_size == 0)
@@ -116,9 +119,8 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " COUNT intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " COUNT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " COUNT intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,12 +148,25 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_4 * restrict src;
-      GFC_INTEGER_8 result;
+      const GFC_LOGICAL_1 * restrict src;
+      GFC_INTEGER_2 result;
       src = base;
       {
 
similarity index 82%
rename from libgfortran/generated/count_4_l4.c
rename to libgfortran/generated/count_4_l.c
index 04493b2..58dcd77 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_INTEGER_4)
 
 
-extern void count_4_l4 (gfc_array_i4 * const restrict, 
-       gfc_array_l4 * const restrict, const index_type * const restrict);
-export_proto(count_4_l4);
+extern void count_4_l (gfc_array_i4 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(count_4_l);
 
 void
-count_4_l4 (gfc_array_i4 * const restrict retarray, 
-       gfc_array_l4 * const restrict array, 
+count_4_l (gfc_array_i4 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_4 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_INTEGER_4 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " COUNT intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " COUNT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " COUNT intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_4 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_INTEGER_4 result;
       src = base;
       {
diff --git a/libgfortran/generated/count_4_l16.c b/libgfortran/generated/count_4_l16.c
deleted file mode 100644 (file)
index 5dee546..0000000
+++ /dev/null
@@ -1,203 +0,0 @@
-/* Implementation of the COUNT intrinsic
-   Copyright 2002, 2007 Free Software Foundation, Inc.
-   Contributed by Paul Brook <paul@nowt.org>
-
-This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-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.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING.  If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
-
-#include "libgfortran.h"
-#include <stdlib.h>
-#include <assert.h>
-
-
-#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_4)
-
-
-extern void count_4_l16 (gfc_array_i4 * const restrict, 
-       gfc_array_l16 * const restrict, const index_type * const restrict);
-export_proto(count_4_l16);
-
-void
-count_4_l16 (gfc_array_i4 * const restrict retarray, 
-       gfc_array_l16 * 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_LOGICAL_16 * restrict base;
-  GFC_INTEGER_4 * restrict dest;
-  index_type rank;
-  index_type n;
-  index_type len;
-  index_type delta;
-  index_type dim;
-
-  /* Make dim zero based to avoid confusion.  */
-  dim = (*pdim) - 1;
-  rank = GFC_DESCRIPTOR_RANK (array) - 1;
-
-  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
-
-  for (n = 0; n < dim; n++)
-    {
-      sstride[n] = array->dim[n].stride;
-      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
-
-      if (extent[n] < 0)
-       extent[n] = 0;
-    }
-  for (n = dim; n < rank; n++)
-    {
-      sstride[n] = array->dim[n + 1].stride;
-      extent[n] =
-        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
-
-      if (extent[n] < 0)
-       extent[n] = 0;
-    }
-
-  if (retarray->data == NULL)
-    {
-      size_t alloc_size;
-
-      for (n = 0; n < rank; n++)
-        {
-          retarray->dim[n].lbound = 0;
-          retarray->dim[n].ubound = extent[n]-1;
-          if (n == 0)
-            retarray->dim[n].stride = 1;
-          else
-            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
-        }
-
-      retarray->offset = 0;
-      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
-
-      alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
-                  * extent[rank-1];
-
-      if (alloc_size == 0)
-       {
-         /* Make sure we have a zero-sized array.  */
-         retarray->dim[0].lbound = 0;
-         retarray->dim[0].ubound = -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"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
-
-      if (compile_options.bounds_check)
-       {
-         for (n=0; n < rank; n++)
-           {
-             index_type ret_extent;
-
-             ret_extent = retarray->dim[n].ubound + 1
-               - retarray->dim[n].lbound;
-             if (extent[n] != ret_extent)
-               runtime_error ("Incorrect extent in return value of"
-                              " COUNT 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] = retarray->dim[n].stride;
-      if (extent[n] <= 0)
-        len = 0;
-    }
-
-  base = array->data;
-  dest = retarray->data;
-
-  while (base)
-    {
-      const GFC_LOGICAL_16 * restrict src;
-      GFC_INTEGER_4 result;
-      src = base;
-      {
-
-  result = 0;
-        if (len <= 0)
-         *dest = 0;
-       else
-         {
-           for (n = 0; n < len; n++, src += delta)
-             {
-
-  if (*src)
-    result++;
-          }
-           *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.  */
-              base = NULL;
-              break;
-            }
-          else
-            {
-              count[n]++;
-              base += sstride[n];
-              dest += dstride[n];
-            }
-        }
-    }
-}
-
-#endif
similarity index 82%
rename from libgfortran/generated/count_8_l8.c
rename to libgfortran/generated/count_8_l.c
index 2a1b2a5..b7db60e 100644 (file)
@@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 
 
-#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_INTEGER_8)
 
 
-extern void count_8_l8 (gfc_array_i8 * const restrict, 
-       gfc_array_l8 * const restrict, const index_type * const restrict);
-export_proto(count_8_l8);
+extern void count_8_l (gfc_array_i8 * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(count_8_l);
 
 void
-count_8_l8 (gfc_array_i8 * const restrict retarray, 
-       gfc_array_l8 * const restrict array, 
+count_8_l (gfc_array_i8 * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_8 * restrict base;
+  const GFC_LOGICAL_1 * restrict base;
   GFC_INTEGER_8 * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +77,7 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -116,9 +119,8 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " COUNT intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +132,8 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " COUNT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " COUNT intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,11 +148,24 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_8 * restrict src;
+      const GFC_LOGICAL_1 * restrict src;
       GFC_INTEGER_8 result;
       src = base;
       {
diff --git a/libgfortran/generated/count_8_l16.c b/libgfortran/generated/count_8_l16.c
deleted file mode 100644 (file)
index b0d1116..0000000
+++ /dev/null
@@ -1,203 +0,0 @@
-/* Implementation of the COUNT intrinsic
-   Copyright 2002, 2007 Free Software Foundation, Inc.
-   Contributed by Paul Brook <paul@nowt.org>
-
-This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-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.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING.  If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
-
-#include "libgfortran.h"
-#include <stdlib.h>
-#include <assert.h>
-
-
-#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_8)
-
-
-extern void count_8_l16 (gfc_array_i8 * const restrict, 
-       gfc_array_l16 * const restrict, const index_type * const restrict);
-export_proto(count_8_l16);
-
-void
-count_8_l16 (gfc_array_i8 * const restrict retarray, 
-       gfc_array_l16 * 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_LOGICAL_16 * restrict base;
-  GFC_INTEGER_8 * restrict dest;
-  index_type rank;
-  index_type n;
-  index_type len;
-  index_type delta;
-  index_type dim;
-
-  /* Make dim zero based to avoid confusion.  */
-  dim = (*pdim) - 1;
-  rank = GFC_DESCRIPTOR_RANK (array) - 1;
-
-  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
-
-  for (n = 0; n < dim; n++)
-    {
-      sstride[n] = array->dim[n].stride;
-      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
-
-      if (extent[n] < 0)
-       extent[n] = 0;
-    }
-  for (n = dim; n < rank; n++)
-    {
-      sstride[n] = array->dim[n + 1].stride;
-      extent[n] =
-        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
-
-      if (extent[n] < 0)
-       extent[n] = 0;
-    }
-
-  if (retarray->data == NULL)
-    {
-      size_t alloc_size;
-
-      for (n = 0; n < rank; n++)
-        {
-          retarray->dim[n].lbound = 0;
-          retarray->dim[n].ubound = extent[n]-1;
-          if (n == 0)
-            retarray->dim[n].stride = 1;
-          else
-            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
-        }
-
-      retarray->offset = 0;
-      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
-
-      alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
-                  * extent[rank-1];
-
-      if (alloc_size == 0)
-       {
-         /* Make sure we have a zero-sized array.  */
-         retarray->dim[0].lbound = 0;
-         retarray->dim[0].ubound = -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"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
-
-      if (compile_options.bounds_check)
-       {
-         for (n=0; n < rank; n++)
-           {
-             index_type ret_extent;
-
-             ret_extent = retarray->dim[n].ubound + 1
-               - retarray->dim[n].lbound;
-             if (extent[n] != ret_extent)
-               runtime_error ("Incorrect extent in return value of"
-                              " COUNT 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] = retarray->dim[n].stride;
-      if (extent[n] <= 0)
-        len = 0;
-    }
-
-  base = array->data;
-  dest = retarray->data;
-
-  while (base)
-    {
-      const GFC_LOGICAL_16 * restrict src;
-      GFC_INTEGER_8 result;
-      src = base;
-      {
-
-  result = 0;
-        if (len <= 0)
-         *dest = 0;
-       else
-         {
-           for (n = 0; n < len; n++, src += delta)
-             {
-
-  if (*src)
-    result++;
-          }
-           *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.  */
-              base = NULL;
-              break;
-            }
-          else
-            {
-              count[n]++;
-              base += sstride[n];
-              dest += dstride[n];
-            }
-        }
-    }
-}
-
-#endif
index 149d29b..7df4016 100644 (file)
@@ -8,10 +8,14 @@ GFORTRAN_1.0 {
     _gfortran_alarm_sub_i8;
     _gfortran_alarm_sub_int_i4;
     _gfortran_alarm_sub_int_i8;
+    _gfortran_all_l1;
     _gfortran_all_l16;
+    _gfortran_all_l2;
     _gfortran_all_l4;
     _gfortran_all_l8;
+    _gfortran_any_l1;
     _gfortran_any_l16;
+    _gfortran_any_l2;
     _gfortran_any_l4;
     _gfortran_any_l8;
     _gfortran_arandom_r10;
@@ -28,15 +32,11 @@ GFORTRAN_1.0 {
     _gfortran_chmod_i8_sub;
     _gfortran_compare_string;
     _gfortran_concat_string;
-    _gfortran_count_16_l16;
-    _gfortran_count_16_l4;
-    _gfortran_count_16_l8;
-    _gfortran_count_4_l16;
-    _gfortran_count_4_l4;
-    _gfortran_count_4_l8;
-    _gfortran_count_8_l16;
-    _gfortran_count_8_l4;
-    _gfortran_count_8_l8;
+    _gfortran_count_1_l;
+    _gfortran_count_16_l;
+    _gfortran_count_2_l;
+    _gfortran_count_4_l;
+    _gfortran_count_8_l;
     _gfortran_cpu_time_10;
     _gfortran_cpu_time_16;
     _gfortran_cpu_time_4;
index 0695078..8d4ece3 100644 (file)
@@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>'
 
 include(iparm.m4)dnl
-include(ifunction.m4)dnl
+include(ifunction_logical.m4)dnl
 
-`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+`#if defined (HAVE_'rtype_name`)'
 
 ARRAY_FUNCTION(1,
 `  /* Return true only if all the elements are set.  */
index d1893a0..156f6c5 100644 (file)
@@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>'
 
 include(iparm.m4)dnl
-include(ifunction.m4)dnl
+include(ifunction_logical.m4)dnl
 
-`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+`#if defined (HAVE_'rtype_name`)'
 
 ARRAY_FUNCTION(0,
 `  result = 0;',
index c9567ab..48ce411 100644 (file)
@@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>'
 
 include(iparm.m4)dnl
-include(ifunction.m4)dnl
+include(ifunction_logical.m4)dnl
 
-`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+`#if defined (HAVE_'rtype_name`)'
 
 ARRAY_FUNCTION(0,
 `  result = 0;',
similarity index 55%
rename from libgfortran/generated/count_16_l8.c
rename to libgfortran/m4/ifunction_logical.m4
index 7a6a31a..b2acb32 100644 (file)
@@ -1,72 +1,58 @@
-/* Implementation of the COUNT intrinsic
-   Copyright 2002, 2007 Free Software Foundation, Inc.
-   Contributed by Paul Brook <paul@nowt.org>
-
-This file is part of the GNU Fortran 95 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 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file.  (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
-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.
-
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING.  If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
-
-#include "libgfortran.h"
-#include <stdlib.h>
-#include <assert.h>
-
-
-#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_16)
-
-
-extern void count_16_l8 (gfc_array_i16 * const restrict, 
-       gfc_array_l8 * const restrict, const index_type * const restrict);
-export_proto(count_16_l8);
+dnl Support macro file for intrinsic functions.
+dnl Contains the generic sections of the array functions.
+dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
+dnl Distributed under the GNU GPL with exception.  See COPYING for details.
+dnl
+dnl Pass the implementation for a single section as the parameter to
+dnl {MASK_}ARRAY_FUNCTION.
+dnl The variables base, delta, and len describe the input section.
+dnl For masked section the mask is described by mbase and mdelta.
+dnl These should not be modified. The result should be stored in *dest.
+dnl The names count, extent, sstride, dstride, base, dest, rank, dim
+dnl retarray, array, pdim and mstride should not be used.
+dnl The variable n is declared as index_type and may be used.
+dnl Other variable declarations may be placed at the start of the code,
+dnl The types of the array parameter and the return value are
+dnl atype_name and rtype_name respectively.
+dnl Execution should be allowed to continue to the end of the block.
+dnl You should not return or break from the inner loop of the implementation.
+dnl Care should also be taken to avoid using the names defined in iparm.m4
+define(START_ARRAY_FUNCTION,
+`
+extern void name`'rtype_qual`_'atype_code (rtype * const restrict, 
+       gfc_array_l1 * const restrict, const index_type * const restrict);
+export_proto(name`'rtype_qual`_'atype_code);
 
 void
-count_16_l8 (gfc_array_i16 * const restrict retarray, 
-       gfc_array_l8 * const restrict array, 
+name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
+       gfc_array_l1 * 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_LOGICAL_8 * restrict base;
-  GFC_INTEGER_16 * restrict dest;
+  const GFC_LOGICAL_1 * restrict base;
+  rtype_name * restrict dest;
   index_type rank;
   index_type n;
   index_type len;
   index_type delta;
   index_type dim;
+  int src_kind;
 
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
+  src_kind = GFC_DESCRIPTOR_SIZE (array);
+
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
-  delta = array->dim[dim].stride;
+  delta = array->dim[dim].stride * src_kind;
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
+      sstride[n] = array->dim[n].stride * src_kind;
       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 
       if (extent[n] < 0)
@@ -74,7 +60,7 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->dim[n + 1].stride;
+      sstride[n] = array->dim[n + 1].stride * src_kind;
       extent[n] =
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 
@@ -99,7 +85,7 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
       retarray->offset = 0;
       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
 
-      alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
+      alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride
                   * extent[rank-1];
 
       if (alloc_size == 0)
@@ -116,9 +102,8 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
     {
       if (rank != GFC_DESCRIPTOR_RANK (retarray))
        runtime_error ("rank of return array incorrect in"
-                      " COUNT intrinsic: is %ld, should be %ld",
-                      (long int) (GFC_DESCRIPTOR_RANK (retarray)),
-                      (long int) rank);
+                      " u_name intrinsic: is %d, should be %d",
+                      GFC_DESCRIPTOR_RANK (retarray), rank);
 
       if (compile_options.bounds_check)
        {
@@ -130,8 +115,8 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
                - retarray->dim[n].lbound;
              if (extent[n] != ret_extent)
                runtime_error ("Incorrect extent in return value of"
-                              " COUNT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
+                              " u_name intrinsic in dimension %d:"
+                              " is %ld, should be %ld", n + 1,
                               (long int) ret_extent, (long int) extent[n]);
            }
        }
@@ -146,26 +131,38 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
     }
 
   base = array->data;
+
+  if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || src_kind == 16
+#endif
+    )
+    {
+      if (base)
+       base = GFOR_POINTER_TO_L1 (base, src_kind);
+    }
+  else
+    internal_error (NULL, "Funny sized logical array in u_name intrinsic");
+
   dest = retarray->data;
 
   while (base)
     {
-      const GFC_LOGICAL_8 * restrict src;
-      GFC_INTEGER_16 result;
+      const GFC_LOGICAL_1 * restrict src;
+      rtype_name result;
       src = base;
       {
-
-  result = 0;
-        if (len <= 0)
-         *dest = 0;
+')dnl
+define(START_ARRAY_BLOCK,
+`        if (len <= 0)
+         *dest = '$1`;
        else
          {
            for (n = 0; n < len; n++, src += delta)
              {
-
-  if (*src)
-    result++;
-          }
+')dnl
+define(FINISH_ARRAY_FUNCTION,
+    `          }
            *dest = result;
          }
       }
@@ -198,6 +195,10 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
             }
         }
     }
-}
-
-#endif
+}')dnl
+define(ARRAY_FUNCTION,
+`START_ARRAY_FUNCTION
+$2
+START_ARRAY_BLOCK($1)
+$3
+FINISH_ARRAY_FUNCTION')dnl