+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
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);
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);
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));
}
+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
--- /dev/null
+! { 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
+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
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 \
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 \
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 $@
## 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)
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 \
%.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 \
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 \
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 \
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
@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@
@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@
@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
@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
@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; \
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)
--- /dev/null
+/* 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
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
--- /dev/null
+/* 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
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
--- /dev/null
+/* 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
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
--- /dev/null
+/* 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
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
+++ /dev/null
-/* 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
#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)
}
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;
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)
{
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)
{
- 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]);
}
}
}
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;
{
#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)
}
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;
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)
{
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)
{
- 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]);
}
}
}
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;
{
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
+++ /dev/null
-/* 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
#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)
}
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;
{
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)
{
- 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]);
}
}
}
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;
{
+++ /dev/null
-/* 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
_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;
_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;
#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. */
#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;',
#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;',
-/* 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)
}
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;
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)
{
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)
{
- 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]);
}
}
}
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;
}
}
}
}
}
-}
-
-#endif
+}')dnl
+define(ARRAY_FUNCTION,
+`START_ARRAY_FUNCTION
+$2
+START_ARRAY_BLOCK($1)
+$3
+FINISH_ARRAY_FUNCTION')dnl
projects / platform / upstream / gcc.git / commitdiff