mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-24 11:24:05 +08:00
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
parent
ac90ae18fb
commit
90469382c0
@ -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
|
||||
|
||||
@ -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));
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
71
gcc/testsuite/gfortran.dg/anyallcount_1.f90
Normal file
71
gcc/testsuite/gfortran.dg/anyallcount_1.f90
Normal 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
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
222
libgfortran/generated/all_l1.c
Normal file
222
libgfortran/generated/all_l1.c
Normal 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
|
||||
@ -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;
|
||||
{
|
||||
|
||||
222
libgfortran/generated/all_l2.c
Normal file
222
libgfortran/generated/all_l2.c
Normal 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
|
||||
@ -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;
|
||||
{
|
||||
|
||||
@ -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;
|
||||
{
|
||||
|
||||
222
libgfortran/generated/any_l1.c
Normal file
222
libgfortran/generated/any_l1.c
Normal 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
|
||||
@ -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;
|
||||
{
|
||||
|
||||
222
libgfortran/generated/any_l2.c
Normal file
222
libgfortran/generated/any_l2.c
Normal 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
|
||||
@ -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;
|
||||
{
|
||||
|
||||
@ -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;
|
||||
{
|
||||
|
||||
@ -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;
|
||||
{
|
||||
@ -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
|
||||
@ -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;
|
||||
{
|
||||
|
||||
@ -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;
|
||||
{
|
||||
|
||||
@ -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;
|
||||
{
|
||||
@ -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
|
||||
@ -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;
|
||||
{
|
||||
@ -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
|
||||
@ -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;
|
||||
|
||||
@ -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. */
|
||||
|
||||
@ -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;',
|
||||
|
||||
@ -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;',
|
||||
|
||||
@ -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
|
||||
Loading…
Reference in New Issue
Block a user