re PR libfortran/34671 (any(kind=1) and all(kind=1))

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-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

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

2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
	
	PR libfortran/34671
	* gfortran.dg/anyallcount_1.f90:  New test.

From-SVN: r131553
This commit is contained in:
Thomas Koenig 2008-01-15 21:22:07 +00:00
parent ac90ae18fb
commit 90469382c0
30 changed files with 1546 additions and 960 deletions

View File

@ -1,3 +1,11 @@
2008-01-15 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34671
* iresolve.c (gfc_resolve_all): Call resolve_mask_arg.
(gfc_resolve_any): Likewise.
(gfc_resolve_count): Likewise. Don't append kind of
argument to function name.
2008-01-13 Tobias Burnus <burnus@net-b.de>
PR fortran/34665

View File

@ -256,6 +256,8 @@ gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
}
resolve_mask_arg (mask);
f->value.function.name
= gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type),
mask->ts.kind);
@ -304,6 +306,8 @@ gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
}
resolve_mask_arg (mask);
f->value.function.name
= gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type),
mask->ts.kind);
@ -549,9 +553,11 @@ gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
}
resolve_mask_arg (mask);
f->value.function.name
= gfc_get_string (PREFIX ("count_%d_%c%d"), f->ts.kind,
gfc_type_letter (mask->ts.type), mask->ts.kind);
= gfc_get_string (PREFIX ("count_%d_%c"), f->ts.kind,
gfc_type_letter (mask->ts.type));
}

View File

@ -1,3 +1,8 @@
2008-01-15 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34671
* gfortran.dg/anyallcount_1.f90: New test.
2008-01-15 Douglas Gregor <doug.gregor@gmail.com>
PR c++/34399

View File

@ -0,0 +1,71 @@
! { dg-do run }
program main
character(len=*), parameter :: f='(3L1)'
character(len=*), parameter :: g='(3I1)'
real, dimension(3,3) :: a
logical(kind=1), dimension(3,3) :: m1
logical(kind=2), dimension(3,3) :: m2
logical(kind=4), dimension(3,3) :: m4
logical(kind=8), dimension(3,3) :: m8
character(len=3) :: res
data a /-1.0, -2.0, -3.0, 2.0, 1.0, -2.1, 1.0, 2.0, 3.0 /
m1 = a > 0
m2 = a > 0
m4 = a > 0
m8 = a > 0
write (unit=res,fmt=f) any(m1,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m2,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m4,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m8,dim=1)
if (res /= 'FTT') call abort
write (unit=res,fmt=f) any(m1,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) any(m2,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) any(m4,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) any(m8,dim=2)
if (res /= 'TTT') call abort
write (unit=res,fmt=f) all(m1,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m2,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m4,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m8,dim=1)
if (res /= 'FFT') call abort
write (unit=res,fmt=f) all(m1,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=f) all(m2,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=f) all(m4,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=f) all(m8,dim=2)
if (res /= 'FFF') call abort
write (unit=res,fmt=g) count(m1,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m2,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m4,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m8,dim=1)
if (res /= '023') call abort
write (unit=res,fmt=g) count(m1,dim=2)
if (res /= '221') call abort
write (unit=res,fmt=g) count(m2,dim=2)
if (res /= '221') call abort
write (unit=res,fmt=g) count(m4,dim=2)
if (res /= '221') call abort
write (unit=res,fmt=g) count(m8,dim=2)
if (res /= '221') call abort
end program main

View File

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

View File

@ -121,25 +121,25 @@ runtime/string.c \
runtime/select.c
i_all_c= \
$(srcdir)/generated/all_l1.c \
$(srcdir)/generated/all_l2.c \
$(srcdir)/generated/all_l4.c \
$(srcdir)/generated/all_l8.c \
$(srcdir)/generated/all_l16.c
i_any_c= \
$(srcdir)/generated/any_l1.c \
$(srcdir)/generated/any_l2.c \
$(srcdir)/generated/any_l4.c \
$(srcdir)/generated/any_l8.c \
$(srcdir)/generated/any_l16.c
i_count_c= \
$(srcdir)/generated/count_4_l4.c \
$(srcdir)/generated/count_8_l4.c \
$(srcdir)/generated/count_16_l4.c \
$(srcdir)/generated/count_4_l8.c \
$(srcdir)/generated/count_8_l8.c \
$(srcdir)/generated/count_16_l8.c \
$(srcdir)/generated/count_4_l16.c \
$(srcdir)/generated/count_8_l16.c \
$(srcdir)/generated/count_16_l16.c
$(srcdir)/generated/count_1_l.c \
$(srcdir)/generated/count_2_l.c \
$(srcdir)/generated/count_4_l.c \
$(srcdir)/generated/count_8_l.c \
$(srcdir)/generated/count_16_l.c
i_maxloc0_c= \
$(srcdir)/generated/maxloc0_4_i1.c \
@ -463,7 +463,7 @@ $(srcdir)/generated/pow_c16_i16.c
m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
m4/matmul.m4 m4/matmull.m4 \
m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
@ -684,6 +684,7 @@ endif
I_M4_DEPS=m4/iparm.m4
I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@ -707,13 +708,13 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
## so we only include them in maintainer mode
if MAINTAINER_MODE
$(i_all_c): m4/all.m4 $(I_M4_DEPS1)
$(i_all_c): m4/all.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@
$(i_any_c): m4/any.m4 $(I_M4_DEPS1)
$(i_any_c): m4/any.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@
$(i_count_c): m4/count.m4 $(I_M4_DEPS1)
$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)

View File

@ -80,18 +80,16 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
runtime/compile_options.c runtime/environ.c runtime/error.c \
runtime/fpu.c runtime/main.c runtime/memory.c runtime/pause.c \
runtime/stop.c runtime/string.c runtime/select.c \
$(srcdir)/generated/all_l1.c $(srcdir)/generated/all_l2.c \
$(srcdir)/generated/all_l4.c $(srcdir)/generated/all_l8.c \
$(srcdir)/generated/all_l16.c $(srcdir)/generated/any_l4.c \
$(srcdir)/generated/all_l16.c $(srcdir)/generated/any_l1.c \
$(srcdir)/generated/any_l2.c $(srcdir)/generated/any_l4.c \
$(srcdir)/generated/any_l8.c $(srcdir)/generated/any_l16.c \
$(srcdir)/generated/count_4_l4.c \
$(srcdir)/generated/count_8_l4.c \
$(srcdir)/generated/count_16_l4.c \
$(srcdir)/generated/count_4_l8.c \
$(srcdir)/generated/count_8_l8.c \
$(srcdir)/generated/count_16_l8.c \
$(srcdir)/generated/count_4_l16.c \
$(srcdir)/generated/count_8_l16.c \
$(srcdir)/generated/count_16_l16.c \
$(srcdir)/generated/count_1_l.c \
$(srcdir)/generated/count_2_l.c \
$(srcdir)/generated/count_4_l.c \
$(srcdir)/generated/count_8_l.c \
$(srcdir)/generated/count_16_l.c \
$(srcdir)/generated/maxloc0_4_i1.c \
$(srcdir)/generated/maxloc0_8_i1.c \
$(srcdir)/generated/maxloc0_16_i1.c \
@ -523,11 +521,10 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
%.c,$(prereq_SRC))
am__objects_1 = backtrace.lo compile_options.lo environ.lo error.lo \
fpu.lo main.lo memory.lo pause.lo stop.lo string.lo select.lo
am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
count_4_l8.lo count_8_l8.lo count_16_l8.lo count_4_l16.lo \
count_8_l16.lo count_16_l16.lo
am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo
am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo
am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \
count_16_l.lo
am__objects_5 = maxloc0_4_i1.lo maxloc0_8_i1.lo maxloc0_16_i1.lo \
maxloc0_4_i2.lo maxloc0_8_i2.lo maxloc0_16_i2.lo \
maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_16_i4.lo \
@ -960,25 +957,25 @@ runtime/string.c \
runtime/select.c
i_all_c = \
$(srcdir)/generated/all_l1.c \
$(srcdir)/generated/all_l2.c \
$(srcdir)/generated/all_l4.c \
$(srcdir)/generated/all_l8.c \
$(srcdir)/generated/all_l16.c
i_any_c = \
$(srcdir)/generated/any_l1.c \
$(srcdir)/generated/any_l2.c \
$(srcdir)/generated/any_l4.c \
$(srcdir)/generated/any_l8.c \
$(srcdir)/generated/any_l16.c
i_count_c = \
$(srcdir)/generated/count_4_l4.c \
$(srcdir)/generated/count_8_l4.c \
$(srcdir)/generated/count_16_l4.c \
$(srcdir)/generated/count_4_l8.c \
$(srcdir)/generated/count_8_l8.c \
$(srcdir)/generated/count_16_l8.c \
$(srcdir)/generated/count_4_l16.c \
$(srcdir)/generated/count_8_l16.c \
$(srcdir)/generated/count_16_l16.c
$(srcdir)/generated/count_1_l.c \
$(srcdir)/generated/count_2_l.c \
$(srcdir)/generated/count_4_l.c \
$(srcdir)/generated/count_8_l.c \
$(srcdir)/generated/count_16_l.c
i_maxloc0_c = \
$(srcdir)/generated/maxloc0_4_i1.c \
@ -1302,7 +1299,7 @@ $(srcdir)/generated/pow_c16_i16.c
m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
m4/matmul.m4 m4/matmull.m4 \
m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \
m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
@ -1492,6 +1489,7 @@ prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
I_M4_DEPS = m4/iparm.m4
I_M4_DEPS0 = $(I_M4_DEPS) m4/iforeach.m4
I_M4_DEPS1 = $(I_M4_DEPS) m4/ifunction.m4
I_M4_DEPS2 = $(I_M4_DEPS) m4/ifunction_logical.m4
EXTRA_DIST = $(m4_files)
all: $(BUILT_SOURCES) config.h
$(MAKE) $(AM_MAKEFLAGS) all-am
@ -1615,10 +1613,14 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/abort.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/access.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l2.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l2.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@
@ -1630,15 +1632,11 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/clock.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/compile_options.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_1_l.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_2_l.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cpu_time.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_16.Plo@am__quote@
@ -2502,6 +2500,20 @@ select.lo: runtime/select.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o select.lo `test -f 'runtime/select.c' || echo '$(srcdir)/'`runtime/select.c
all_l1.lo: $(srcdir)/generated/all_l1.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l1.lo -MD -MP -MF "$(DEPDIR)/all_l1.Tpo" -c -o all_l1.lo `test -f '$(srcdir)/generated/all_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l1.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/all_l1.Tpo" "$(DEPDIR)/all_l1.Plo"; else rm -f "$(DEPDIR)/all_l1.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l1.c' object='all_l1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l1.lo `test -f '$(srcdir)/generated/all_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l1.c
all_l2.lo: $(srcdir)/generated/all_l2.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l2.lo -MD -MP -MF "$(DEPDIR)/all_l2.Tpo" -c -o all_l2.lo `test -f '$(srcdir)/generated/all_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l2.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/all_l2.Tpo" "$(DEPDIR)/all_l2.Plo"; else rm -f "$(DEPDIR)/all_l2.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l2.c' object='all_l2.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l2.lo `test -f '$(srcdir)/generated/all_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l2.c
all_l4.lo: $(srcdir)/generated/all_l4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l4.lo -MD -MP -MF "$(DEPDIR)/all_l4.Tpo" -c -o all_l4.lo `test -f '$(srcdir)/generated/all_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/all_l4.Tpo" "$(DEPDIR)/all_l4.Plo"; else rm -f "$(DEPDIR)/all_l4.Tpo"; exit 1; fi
@ -2523,6 +2535,20 @@ all_l16.lo: $(srcdir)/generated/all_l16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l16.lo `test -f '$(srcdir)/generated/all_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l16.c
any_l1.lo: $(srcdir)/generated/any_l1.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l1.lo -MD -MP -MF "$(DEPDIR)/any_l1.Tpo" -c -o any_l1.lo `test -f '$(srcdir)/generated/any_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l1.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/any_l1.Tpo" "$(DEPDIR)/any_l1.Plo"; else rm -f "$(DEPDIR)/any_l1.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l1.c' object='any_l1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l1.lo `test -f '$(srcdir)/generated/any_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l1.c
any_l2.lo: $(srcdir)/generated/any_l2.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l2.lo -MD -MP -MF "$(DEPDIR)/any_l2.Tpo" -c -o any_l2.lo `test -f '$(srcdir)/generated/any_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l2.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/any_l2.Tpo" "$(DEPDIR)/any_l2.Plo"; else rm -f "$(DEPDIR)/any_l2.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l2.c' object='any_l2.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l2.lo `test -f '$(srcdir)/generated/any_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l2.c
any_l4.lo: $(srcdir)/generated/any_l4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l4.lo -MD -MP -MF "$(DEPDIR)/any_l4.Tpo" -c -o any_l4.lo `test -f '$(srcdir)/generated/any_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/any_l4.Tpo" "$(DEPDIR)/any_l4.Plo"; else rm -f "$(DEPDIR)/any_l4.Tpo"; exit 1; fi
@ -2544,68 +2570,40 @@ any_l16.lo: $(srcdir)/generated/any_l16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l16.lo `test -f '$(srcdir)/generated/any_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l16.c
count_4_l4.lo: $(srcdir)/generated/count_4_l4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_4_l4.lo -MD -MP -MF "$(DEPDIR)/count_4_l4.Tpo" -c -o count_4_l4.lo `test -f '$(srcdir)/generated/count_4_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/count_4_l4.Tpo" "$(DEPDIR)/count_4_l4.Plo"; else rm -f "$(DEPDIR)/count_4_l4.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/count_4_l4.c' object='count_4_l4.lo' libtool=yes @AMDEPBACKSLASH@
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_4_l4.lo `test -f '$(srcdir)/generated/count_4_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l4.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_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@
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_8_l4.lo `test -f '$(srcdir)/generated/count_8_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l4.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_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@
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_16_l4.lo `test -f '$(srcdir)/generated/count_16_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l4.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_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@
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_4_l8.lo `test -f '$(srcdir)/generated/count_4_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l8.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_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_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_8_l8.lo `test -f '$(srcdir)/generated/count_8_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l8.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@
@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
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@
@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
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@
@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
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@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l16.lo `test -f '$(srcdir)/generated/count_16_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l16.c
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l.lo `test -f '$(srcdir)/generated/count_16_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l.c
maxloc0_4_i1.lo: $(srcdir)/generated/maxloc0_4_i1.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i1.lo -MD -MP -MF "$(DEPDIR)/maxloc0_4_i1.Tpo" -c -o maxloc0_4_i1.lo `test -f '$(srcdir)/generated/maxloc0_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i1.c; \
@ -5350,13 +5348,13 @@ selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh
fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
cp $(srcdir)/$(FPU_HOST_HEADER) $@
@MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS2)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_any_c): m4/any.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@$(i_any_c): m4/any.m4 $(I_M4_DEPS2)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_count_c): m4/count.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)

View File

@ -0,0 +1,222 @@
/* Implementation of the ALL intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_1)
extern void all_l1 (gfc_array_l1 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(all_l1);
void
all_l1 (gfc_array_l1 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_1 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ALL intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ALL intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_1 result;
src = base;
{
/* Return true only if all the elements are set. */
result = 1;
if (len <= 0)
*dest = 1;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (! *src)
{
result = 0;
break;
}
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
#if defined (HAVE_GFC_LOGICAL_16)
extern void all_l16 (gfc_array_l16 * const restrict,
gfc_array_l16 * const restrict, const index_type * const restrict);
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(all_l16);
void
all_l16 (gfc_array_l16 * const restrict retarray,
gfc_array_l16 * const restrict array,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_16 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ all_l16 (gfc_array_l16 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ all_l16 (gfc_array_l16 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ALL intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" ALL intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ all_l16 (gfc_array_l16 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" ALL intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ all_l16 (gfc_array_l16 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ALL intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_16 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_16 result;
src = base;
{

View File

@ -0,0 +1,222 @@
/* Implementation of the ALL intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_2)
extern void all_l2 (gfc_array_l2 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(all_l2);
void
all_l2 (gfc_array_l2 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_2 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ALL intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ALL intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_2 result;
src = base;
{
/* Return true only if all the elements are set. */
result = 1;
if (len <= 0)
*dest = 1;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (! *src)
{
result = 0;
break;
}
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
#if defined (HAVE_GFC_LOGICAL_4)
extern void all_l4 (gfc_array_l4 * const restrict,
gfc_array_l4 * const restrict, const index_type * const restrict);
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(all_l4);
void
all_l4 (gfc_array_l4 * const restrict retarray,
gfc_array_l4 * const restrict array,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_4 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ all_l4 (gfc_array_l4 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ all_l4 (gfc_array_l4 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ALL intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" ALL intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ all_l4 (gfc_array_l4 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" ALL intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ all_l4 (gfc_array_l4 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ALL intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_4 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_4 result;
src = base;
{

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
#if defined (HAVE_GFC_LOGICAL_8)
extern void all_l8 (gfc_array_l8 * const restrict,
gfc_array_l8 * const restrict, const index_type * const restrict);
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(all_l8);
void
all_l8 (gfc_array_l8 * const restrict retarray,
gfc_array_l8 * const restrict array,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_8 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ all_l8 (gfc_array_l8 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ all_l8 (gfc_array_l8 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ALL intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" ALL intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ all_l8 (gfc_array_l8 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ALL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" ALL intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ all_l8 (gfc_array_l8 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ALL intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_8 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_8 result;
src = base;
{

View File

@ -0,0 +1,222 @@
/* Implementation of the ANY intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_1)
extern void any_l1 (gfc_array_l1 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(any_l1);
void
any_l1 (gfc_array_l1 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_1 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_LOGICAL_1) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ANY intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ANY intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_1 result;
src = base;
{
result = 0;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
/* Return true if any of the elements are set. */
if (*src)
{
result = 1;
break;
}
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
#if defined (HAVE_GFC_LOGICAL_16)
extern void any_l16 (gfc_array_l16 * const restrict,
gfc_array_l16 * const restrict, const index_type * const restrict);
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(any_l16);
void
any_l16 (gfc_array_l16 * const restrict retarray,
gfc_array_l16 * const restrict array,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_16 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ any_l16 (gfc_array_l16 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ any_l16 (gfc_array_l16 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ANY intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" ANY intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ any_l16 (gfc_array_l16 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" ANY intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ any_l16 (gfc_array_l16 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ANY intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_16 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_16 result;
src = base;
{

View File

@ -0,0 +1,222 @@
/* Implementation of the ANY intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_2)
extern void any_l2 (gfc_array_l2 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(any_l2);
void
any_l2 (gfc_array_l2 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_2 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_LOGICAL_2) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ANY intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ANY intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_2 result;
src = base;
{
result = 0;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
/* Return true if any of the elements are set. */
if (*src)
{
result = 1;
break;
}
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
#if defined (HAVE_GFC_LOGICAL_4)
extern void any_l4 (gfc_array_l4 * const restrict,
gfc_array_l4 * const restrict, const index_type * const restrict);
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(any_l4);
void
any_l4 (gfc_array_l4 * const restrict retarray,
gfc_array_l4 * const restrict array,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_4 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ any_l4 (gfc_array_l4 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ any_l4 (gfc_array_l4 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ANY intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" ANY intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ any_l4 (gfc_array_l4 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" ANY intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ any_l4 (gfc_array_l4 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ANY intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_4 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_4 result;
src = base;
{

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
#if defined (HAVE_GFC_LOGICAL_8)
extern void any_l8 (gfc_array_l8 * const restrict,
gfc_array_l8 * const restrict, const index_type * const restrict);
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(any_l8);
void
any_l8 (gfc_array_l8 * const restrict retarray,
gfc_array_l8 * const restrict array,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_8 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_LOGICAL_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ any_l8 (gfc_array_l8 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ any_l8 (gfc_array_l8 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" ANY intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" ANY intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ any_l8 (gfc_array_l8 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" ANY intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" ANY intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ any_l8 (gfc_array_l8 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in ANY intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_8 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_LOGICAL_8 result;
src = base;
{

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_16)
#if defined (HAVE_GFC_INTEGER_16)
extern void count_16_l4 (gfc_array_i16 * const restrict,
gfc_array_l4 * const restrict, const index_type * const restrict);
export_proto(count_16_l4);
extern void count_16_l (gfc_array_i16 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(count_16_l);
void
count_16_l4 (gfc_array_i16 * const restrict retarray,
gfc_array_l4 * const restrict array,
count_16_l (gfc_array_i16 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_4 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" COUNT intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" COUNT intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_4 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_INTEGER_16 result;
src = base;
{

View File

@ -1,203 +0,0 @@
/* Implementation of the COUNT intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_16)
extern void count_16_l16 (gfc_array_i16 * const restrict,
gfc_array_l16 * const restrict, const index_type * const restrict);
export_proto(count_16_l16);
void
count_16_l16 (gfc_array_i16 * const restrict retarray,
gfc_array_l16 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_16 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_16 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
result = 0;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (*src)
result++;
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_4)
#if defined (HAVE_GFC_INTEGER_1)
extern void count_4_l8 (gfc_array_i4 * const restrict,
gfc_array_l8 * const restrict, const index_type * const restrict);
export_proto(count_4_l8);
extern void count_1_l (gfc_array_i1 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(count_1_l);
void
count_4_l8 (gfc_array_i4 * const restrict retarray,
gfc_array_l8 * const restrict array,
count_1_l (gfc_array_i1 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_8 * restrict base;
GFC_INTEGER_4 * restrict dest;
const GFC_LOGICAL_1 * restrict base;
GFC_INTEGER_1 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -99,7 +102,7 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
alloc_size = sizeof (GFC_INTEGER_1) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
@ -116,9 +119,8 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" COUNT intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" COUNT intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,12 +148,25 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_8 * restrict src;
GFC_INTEGER_4 result;
const GFC_LOGICAL_1 * restrict src;
GFC_INTEGER_1 result;
src = base;
{

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_8)
#if defined (HAVE_GFC_INTEGER_2)
extern void count_8_l4 (gfc_array_i8 * const restrict,
gfc_array_l4 * const restrict, const index_type * const restrict);
export_proto(count_8_l4);
extern void count_2_l (gfc_array_i2 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(count_2_l);
void
count_8_l4 (gfc_array_i8 * const restrict retarray,
gfc_array_l4 * const restrict array,
count_2_l (gfc_array_i2 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_4 * restrict base;
GFC_INTEGER_8 * restrict dest;
const GFC_LOGICAL_1 * restrict base;
GFC_INTEGER_2 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -99,7 +102,7 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
alloc_size = sizeof (GFC_INTEGER_2) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
@ -116,9 +119,8 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" COUNT intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" COUNT intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,12 +148,25 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_4 * restrict src;
GFC_INTEGER_8 result;
const GFC_LOGICAL_1 * restrict src;
GFC_INTEGER_2 result;
src = base;
{

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_4)
#if defined (HAVE_GFC_INTEGER_4)
extern void count_4_l4 (gfc_array_i4 * const restrict,
gfc_array_l4 * const restrict, const index_type * const restrict);
export_proto(count_4_l4);
extern void count_4_l (gfc_array_i4 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(count_4_l);
void
count_4_l4 (gfc_array_i4 * const restrict retarray,
gfc_array_l4 * const restrict array,
count_4_l (gfc_array_i4 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_4 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" COUNT intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" COUNT intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_4 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_INTEGER_4 result;
src = base;
{

View File

@ -1,203 +0,0 @@
/* Implementation of the COUNT intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_4)
extern void count_4_l16 (gfc_array_i4 * const restrict,
gfc_array_l16 * const restrict, const index_type * const restrict);
export_proto(count_4_l16);
void
count_4_l16 (gfc_array_i4 * const restrict retarray,
gfc_array_l16 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_16 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_16 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
result = 0;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (*src)
result++;
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -33,40 +33,43 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_8)
#if defined (HAVE_GFC_INTEGER_8)
extern void count_8_l8 (gfc_array_i8 * const restrict,
gfc_array_l8 * const restrict, const index_type * const restrict);
export_proto(count_8_l8);
extern void count_8_l (gfc_array_i8 * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(count_8_l);
void
count_8_l8 (gfc_array_i8 * const restrict retarray,
gfc_array_l8 * const restrict array,
count_8_l (gfc_array_i8 * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_8 * restrict base;
const GFC_LOGICAL_1 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +77,7 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -116,9 +119,8 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" COUNT intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +132,8 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" COUNT intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,11 +148,24 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in COUNT intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_8 * restrict src;
const GFC_LOGICAL_1 * restrict src;
GFC_INTEGER_8 result;
src = base;
{

View File

@ -1,203 +0,0 @@
/* Implementation of the COUNT intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_8)
extern void count_8_l16 (gfc_array_i8 * const restrict,
gfc_array_l16 * const restrict, const index_type * const restrict);
export_proto(count_8_l16);
void
count_8_l16 (gfc_array_i8 * const restrict retarray,
gfc_array_l16 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_16 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->data == NULL)
{
size_t alloc_size;
for (n = 0; n < rank; n++)
{
retarray->dim[n].lbound = 0;
retarray->dim[n].ubound = extent[n]-1;
if (n == 0)
retarray->dim[n].stride = 1;
else
retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = -1;
return;
}
else
retarray->data = internal_malloc_size (alloc_size);
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (compile_options.bounds_check)
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = retarray->dim[n].ubound + 1
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = retarray->dim[n].stride;
if (extent[n] <= 0)
len = 0;
}
base = array->data;
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_16 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
result = 0;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (*src)
result++;
}
*dest = result;
}
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n == rank)
{
/* Break out of the look. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
#endif

View File

@ -8,10 +8,14 @@ GFORTRAN_1.0 {
_gfortran_alarm_sub_i8;
_gfortran_alarm_sub_int_i4;
_gfortran_alarm_sub_int_i8;
_gfortran_all_l1;
_gfortran_all_l16;
_gfortran_all_l2;
_gfortran_all_l4;
_gfortran_all_l8;
_gfortran_any_l1;
_gfortran_any_l16;
_gfortran_any_l2;
_gfortran_any_l4;
_gfortran_any_l8;
_gfortran_arandom_r10;
@ -28,15 +32,11 @@ GFORTRAN_1.0 {
_gfortran_chmod_i8_sub;
_gfortran_compare_string;
_gfortran_concat_string;
_gfortran_count_16_l16;
_gfortran_count_16_l4;
_gfortran_count_16_l8;
_gfortran_count_4_l16;
_gfortran_count_4_l4;
_gfortran_count_4_l8;
_gfortran_count_8_l16;
_gfortran_count_8_l4;
_gfortran_count_8_l8;
_gfortran_count_1_l;
_gfortran_count_16_l;
_gfortran_count_2_l;
_gfortran_count_4_l;
_gfortran_count_8_l;
_gfortran_cpu_time_10;
_gfortran_cpu_time_16;
_gfortran_cpu_time_4;

View File

@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>'
include(iparm.m4)dnl
include(ifunction.m4)dnl
include(ifunction_logical.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
`#if defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(1,
` /* Return true only if all the elements are set. */

View File

@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>'
include(iparm.m4)dnl
include(ifunction.m4)dnl
include(ifunction_logical.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
`#if defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = 0;',

View File

@ -33,9 +33,9 @@ Boston, MA 02110-1301, USA. */
#include <assert.h>'
include(iparm.m4)dnl
include(ifunction.m4)dnl
include(ifunction_logical.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
`#if defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` result = 0;',

View File

@ -1,72 +1,58 @@
/* Implementation of the COUNT intrinsic
Copyright 2002, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_16)
extern void count_16_l8 (gfc_array_i16 * const restrict,
gfc_array_l8 * const restrict, const index_type * const restrict);
export_proto(count_16_l8);
dnl Support macro file for intrinsic functions.
dnl Contains the generic sections of the array functions.
dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
dnl Distributed under the GNU GPL with exception. See COPYING for details.
dnl
dnl Pass the implementation for a single section as the parameter to
dnl {MASK_}ARRAY_FUNCTION.
dnl The variables base, delta, and len describe the input section.
dnl For masked section the mask is described by mbase and mdelta.
dnl These should not be modified. The result should be stored in *dest.
dnl The names count, extent, sstride, dstride, base, dest, rank, dim
dnl retarray, array, pdim and mstride should not be used.
dnl The variable n is declared as index_type and may be used.
dnl Other variable declarations may be placed at the start of the code,
dnl The types of the array parameter and the return value are
dnl atype_name and rtype_name respectively.
dnl Execution should be allowed to continue to the end of the block.
dnl You should not return or break from the inner loop of the implementation.
dnl Care should also be taken to avoid using the names defined in iparm.m4
define(START_ARRAY_FUNCTION,
`
extern void name`'rtype_qual`_'atype_code (rtype * const restrict,
gfc_array_l1 * const restrict, const index_type * const restrict);
export_proto(name`'rtype_qual`_'atype_code);
void
count_16_l8 (gfc_array_i16 * const restrict retarray,
gfc_array_l8 * const restrict array,
name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
gfc_array_l1 * const restrict array,
const index_type * const restrict pdim)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_LOGICAL_8 * restrict base;
GFC_INTEGER_16 * restrict dest;
const GFC_LOGICAL_1 * restrict base;
rtype_name * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int src_kind;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
src_kind = GFC_DESCRIPTOR_SIZE (array);
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
delta = array->dim[dim].stride;
delta = array->dim[dim].stride * src_kind;
for (n = 0; n < dim; n++)
{
sstride[n] = array->dim[n].stride;
sstride[n] = array->dim[n].stride * src_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0)
@ -74,7 +60,7 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
}
for (n = dim; n < rank; n++)
{
sstride[n] = array->dim[n + 1].stride;
sstride[n] = array->dim[n + 1].stride * src_kind;
extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -99,7 +85,7 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = sizeof (GFC_INTEGER_16) * retarray->dim[rank-1].stride
alloc_size = sizeof (rtype_name) * retarray->dim[rank-1].stride
* extent[rank-1];
if (alloc_size == 0)
@ -116,9 +102,8 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" COUNT intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
" u_name intrinsic: is %d, should be %d",
GFC_DESCRIPTOR_RANK (retarray), rank);
if (compile_options.bounds_check)
{
@ -130,8 +115,8 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
- retarray->dim[n].lbound;
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" COUNT intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
" u_name intrinsic in dimension %d:"
" is %ld, should be %ld", n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
@ -146,26 +131,38 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
}
base = array->data;
if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| src_kind == 16
#endif
)
{
if (base)
base = GFOR_POINTER_TO_L1 (base, src_kind);
}
else
internal_error (NULL, "Funny sized logical array in u_name intrinsic");
dest = retarray->data;
while (base)
{
const GFC_LOGICAL_8 * restrict src;
GFC_INTEGER_16 result;
const GFC_LOGICAL_1 * restrict src;
rtype_name result;
src = base;
{
result = 0;
if (len <= 0)
*dest = 0;
')dnl
define(START_ARRAY_BLOCK,
` if (len <= 0)
*dest = '$1`;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (*src)
result++;
}
')dnl
define(FINISH_ARRAY_FUNCTION,
` }
*dest = result;
}
}
@ -198,6 +195,10 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
}
}
}
}
#endif
}')dnl
define(ARRAY_FUNCTION,
`START_ARRAY_FUNCTION
$2
START_ARRAY_BLOCK($1)
$3
FINISH_ARRAY_FUNCTION')dnl