OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/36313 ([F03] {MIN,MAX}{LOC,VAL} should accept character arguments) 

2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36313
	* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
	i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
	* Makefile.in: Regenerated.
        * generated/maxloc0_16_s1.c: New file.
        * generated/maxloc0_16_s4.c: New file.
        * generated/maxloc0_4_s1.c: New file.
        * generated/maxloc0_4_s4.c: New file.
        * generated/maxloc0_8_s1.c: New file.
        * generated/maxloc0_8_s4.c: New file.
        * generated/maxloc1_16_s1.c: New file.
        * generated/maxloc1_16_s4.c: New file.
        * generated/maxloc1_4_s1.c: New file.
        * generated/maxloc1_4_s4.c: New file.
        * generated/maxloc1_8_s1.c: New file.
        * generated/maxloc1_8_s4.c: New file.
        * generated/maxloc2_16_s1.c: New file.
        * generated/maxloc2_16_s4.c: New file.
        * generated/maxloc2_4_s1.c: New file.
        * generated/maxloc2_4_s4.c: New file.
        * generated/maxloc2_8_s1.c: New file.
        * generated/maxloc2_8_s4.c: New file.
        * generated/minloc0_16_s1.c: New file.
        * generated/minloc0_16_s4.c: New file.
        * generated/minloc0_4_s1.c: New file.
        * generated/minloc0_4_s4.c: New file.
        * generated/minloc0_8_s1.c: New file.
        * generated/minloc0_8_s4.c: New file.
        * generated/minloc1_16_s1.c: New file.
        * generated/minloc1_16_s4.c: New file.
        * generated/minloc1_4_s1.c: New file.
        * generated/minloc1_4_s4.c: New file.
        * generated/minloc1_8_s1.c: New file.
        * generated/minloc1_8_s4.c: New file.
        * generated/minloc2_16_s1.c: New file.
        * generated/minloc2_16_s4.c: New file.
        * generated/minloc2_4_s1.c: New file.
        * generated/minloc2_4_s4.c: New file.
        * generated/minloc2_8_s1.c: New file.
        * generated/minloc2_8_s4.c: New file.
        * m4/iforeach-s.m4: New file.
        * m4/ifunction-s.m4: New file.
        * m4/maxloc0s.m4: New file.
        * m4/maxloc1s.m4: New file.
        * m4/maxloc2s.m4: New file.
        * m4/minloc0s.m4: New file.
        * m4/minloc1s.m4: New file.
        * m4/minloc2s.m4: New file.
	* gfortran.map: Add new functions.
	* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.

2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36313
	* check.c (int_or_real_or_char_check_f2003): New function.
	* iresolve.c (gfc_resolve_maxloc): Add number "2" for
	character arguments and rank-zero return value.
	(gfc_resolve_minloc): Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
	character arguments and rank-zero return value by removing
	unneeded arguments and calling the library function.

2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36313
	* gfortran.dg/maxloc_string_1.f90: New test.
	* gfortran.dg/minloc_string_1.f90: New test.

From-SVN: r255070
This commit is contained in:
Thomas Koenig 2017-11-22 18:08:07 +00:00
parent 824a2b3d8c
commit ddc9995b13
58 changed files with 14711 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2017-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* check.c (int_or_real_or_char_check_f2003): New function.
* iresolve.c (gfc_resolve_maxloc): Add number "2" for
character arguments and rank-zero return value.
(gfc_resolve_minloc): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
character arguments and rank-zero return value by removing
unneeded arguments and calling the library function.
2017-11-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/79072

33
gcc/fortran/check.c
View File

@ -117,6 +117,37 @@ int_or_real_check (gfc_expr *e, int n)
return true;
}
/* Check that an expression is integer or real; allow character for
F2003 or later. */
static bool
int_or_real_or_char_check_f2003 (gfc_expr *e, int n)
{
if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
{
if (e->ts.type == BT_CHARACTER)
return gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Character for "
"%qs argument of %qs intrinsic at %L",
gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
else
{
if (gfc_option.allow_std & GFC_STD_F2003)
gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
"or REAL or CHARACTER",
gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
else
gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
"or REAL", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
}
return false;
}
return true;
}
/* Check that an expression is real or complex. */
@ -3189,7 +3220,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
gfc_expr *a, *m, *d, *k;
a = ap->expr;
if (!int_or_real_check (a, 0) || !array_check (a, 0))
if (!int_or_real_or_char_check_f2003 (a, 0) || !array_check (a, 0))
return false;
d = ap->next->expr;

26
gcc/fortran/iresolve.c
View File

@ -1702,6 +1702,7 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
const char *name;
int i, j, idim;
int fkind;
int d_num;
f->ts.type = BT_INTEGER;
@ -1752,8 +1753,18 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
else
name = "maxloc";
if (dim)
{
if (array->ts.type != BT_CHARACTER || f->rank != 0)
d_num = 1;
else
d_num = 2;
}
else
d_num = 0;
f->value.function.name
= gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
= gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind,
gfc_type_letter (array->ts.type), array->ts.kind);
if (kind)
@ -1896,6 +1907,7 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
const char *name;
int i, j, idim;
int fkind;
int d_num;
f->ts.type = BT_INTEGER;
@ -1946,8 +1958,18 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
else
name = "minloc";
if (dim)
{
if (array->ts.type != BT_CHARACTER || f->rank != 0)
d_num = 1;
else
d_num = 2;
}
else
d_num = 0;
f->value.function.name
= gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
= gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind,
gfc_type_letter (array->ts.type), array->ts.kind);
if (fkind != f->ts.kind)

31
gcc/fortran/trans-intrinsic.c
View File

@ -4568,14 +4568,41 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
return;
}
actual = expr->value.function.actual;
arrayexpr = actual->expr;
/* Special case for character maxval. Remove unneeded actual
arguments, then call a library function. */
if (arrayexpr->ts.type == BT_CHARACTER)
{
gfc_actual_arglist *a2, *a3, *a4;
a2 = actual->next;
a3 = a2->next;
a4 = a3->next;
a4->next = NULL;
if (a3->expr == NULL)
{
actual->next = NULL;
gfc_free_actual_arglist (a2);
}
else
{
actual->next = a3; /* dim */
a3->next = NULL;
a2->next = a4;
gfc_free_actual_arglist (a4);
}
gfc_conv_intrinsic_funcall (se, expr);
return;
}
/* Initialize the result. */
pos = gfc_create_var (gfc_array_index_type, "pos");
offset = gfc_create_var (gfc_array_index_type, "offset");
type = gfc_typenode_for_spec (&expr->ts);
/* Walk the arguments. */
actual = expr->value.function.actual;
arrayexpr = actual->expr;
arrayss = gfc_walk_expr (arrayexpr);
gcc_assert (arrayss != gfc_ss_terminator);

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2017-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* gfortran.dg/maxloc_string_1.f90: New test.
* gfortran.dg/minloc_string_1.f90: New test.
2017-11-22 Marc Glisse <marc.glisse@inria.fr>
PR tree-optimization/83104

91
gcc/testsuite/gfortran.dg/maxloc_string_1.f90 Normal file
View File

@ -0,0 +1,91 @@
! { dg-do run }
! Test maxloc for strings for different code paths
program main
implicit none
integer, parameter :: n=4
character(len=4), dimension(n,n) :: c
integer, dimension(n,n) :: a
integer, dimension(2) :: res1, res2
real, dimension(n,n) :: r
logical, dimension(n,n) :: amask
logical(kind=8) :: smask
integer :: i,j
integer, dimension(n) :: q1, q2
character(len=4,kind=4), dimension(n,n) :: c4
character(len=4), dimension(n*n) :: e
integer, dimension(n*n) :: f
logical, dimension(n*n) :: cmask
call random_number (r)
a = int(r*100)
do j=1,n
do i=1,n
write (unit=c(i,j),fmt='(I4.4)') a(i,j)
write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
end do
end do
res1 = maxloc(c)
res2 = maxloc(a)
if (any(res1 /= res2)) call abort
res1 = maxloc(c4)
if (any(res1 /= res2)) call abort
amask = a < 50
res1 = maxloc(c,mask=amask)
res2 = maxloc(a,mask=amask)
if (any(res1 /= res2)) call abort
amask = .false.
res1 = maxloc(c,mask=amask)
if (any(res1 /= 0)) call abort
amask(2,3) = .true.
res1 = maxloc(c,mask=amask)
if (any(res1 /= [2,3])) call abort
res1 = maxloc(c,mask=.false.)
if (any(res1 /= 0)) call abort
res2 = maxloc(a)
res1 = maxloc(c,mask=.true.)
if (any(res1 /= res2)) call abort
q1 = maxloc(c, dim=1)
q2 = maxloc(a, dim=1)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2)
q2 = maxloc(a, dim=2)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=1, mask=amask)
q2 = maxloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2, mask=amask)
q2 = maxloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
amask = a < 50
q1 = maxloc(c, dim=1, mask=amask)
q2 = maxloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = maxloc(c, dim=2, mask=amask)
q2 = maxloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
e = reshape(c, shape(e))
f = reshape(a, shape(f))
if (maxloc(e,dim=1) /= maxloc(f,dim=1)) call abort
cmask = .false.
if (maxloc(e,dim=1,mask=cmask) /= 0) call abort
cmask = f > 50
if ( maxloc(e, dim=1, mask=cmask) /= maxloc (f, dim=1, mask=cmask)) call abort
end program main

91
gcc/testsuite/gfortran.dg/minloc_string_1.f90 Normal file
View File

@ -0,0 +1,91 @@
! { dg-do run }
! Test minloc for strings for different code paths
program main
implicit none
integer, parameter :: n=4
character(len=4), dimension(n,n) :: c
integer, dimension(n,n) :: a
integer, dimension(2) :: res1, res2
real, dimension(n,n) :: r
logical, dimension(n,n) :: amask
logical(kind=8) :: smask
integer :: i,j
integer, dimension(n) :: q1, q2
character(len=4,kind=4), dimension(n,n) :: c4
character(len=4), dimension(n*n) :: e
integer, dimension(n*n) :: f
logical, dimension(n*n) :: cmask
call random_number (r)
a = int(r*100)
do j=1,n
do i=1,n
write (unit=c(i,j),fmt='(I4.4)') a(i,j)
write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
end do
end do
res1 = minloc(c)
res2 = minloc(a)
if (any(res1 /= res2)) call abort
res1 = minloc(c4)
if (any(res1 /= res2)) call abort
amask = a < 50
res1 = minloc(c,mask=amask)
res2 = minloc(a,mask=amask)
if (any(res1 /= res2)) call abort
amask = .false.
res1 = minloc(c,mask=amask)
if (any(res1 /= 0)) call abort
amask(2,3) = .true.
res1 = minloc(c,mask=amask)
if (any(res1 /= [2,3])) call abort
res1 = minloc(c,mask=.false.)
if (any(res1 /= 0)) call abort
res2 = minloc(a)
res1 = minloc(c,mask=.true.)
if (any(res1 /= res2)) call abort
q1 = minloc(c, dim=1)
q2 = minloc(a, dim=1)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2)
q2 = minloc(a, dim=2)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=1, mask=amask)
q2 = minloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2, mask=amask)
q2 = minloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
amask = a < 50
q1 = minloc(c, dim=1, mask=amask)
q2 = minloc(a, dim=1, mask=amask)
if (any(q1 /= q2)) call abort
q1 = minloc(c, dim=2, mask=amask)
q2 = minloc(a, dim=2, mask=amask)
if (any(q1 /= q2)) call abort
e = reshape(c, shape(e))
f = reshape(a, shape(f))
if (minloc(e,dim=1) /= minloc(f,dim=1)) call abort
cmask = .false.
if (minloc(e,dim=1,mask=cmask) /= 0) call abort
cmask = f > 50
if ( minloc(e, dim=1, mask=cmask) /= minloc (f, dim=1, mask=cmask)) call abort
end program main

53
libgfortran/ChangeLog
View File

@ -1,3 +1,56 @@
2017-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36313
* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
* Makefile.in: Regenerated.
* generated/maxloc0_16_s1.c: New file.
* generated/maxloc0_16_s4.c: New file.
* generated/maxloc0_4_s1.c: New file.
* generated/maxloc0_4_s4.c: New file.
* generated/maxloc0_8_s1.c: New file.
* generated/maxloc0_8_s4.c: New file.
* generated/maxloc1_16_s1.c: New file.
* generated/maxloc1_16_s4.c: New file.
* generated/maxloc1_4_s1.c: New file.
* generated/maxloc1_4_s4.c: New file.
* generated/maxloc1_8_s1.c: New file.
* generated/maxloc1_8_s4.c: New file.
* generated/maxloc2_16_s1.c: New file.
* generated/maxloc2_16_s4.c: New file.
* generated/maxloc2_4_s1.c: New file.
* generated/maxloc2_4_s4.c: New file.
* generated/maxloc2_8_s1.c: New file.
* generated/maxloc2_8_s4.c: New file.
* generated/minloc0_16_s1.c: New file.
* generated/minloc0_16_s4.c: New file.
* generated/minloc0_4_s1.c: New file.
* generated/minloc0_4_s4.c: New file.
* generated/minloc0_8_s1.c: New file.
* generated/minloc0_8_s4.c: New file.
* generated/minloc1_16_s1.c: New file.
* generated/minloc1_16_s4.c: New file.
* generated/minloc1_4_s1.c: New file.
* generated/minloc1_4_s4.c: New file.
* generated/minloc1_8_s1.c: New file.
* generated/minloc1_8_s4.c: New file.
* generated/minloc2_16_s1.c: New file.
* generated/minloc2_16_s4.c: New file.
* generated/minloc2_4_s1.c: New file.
* generated/minloc2_4_s4.c: New file.
* generated/minloc2_8_s1.c: New file.
* generated/minloc2_8_s4.c: New file.
* m4/iforeach-s.m4: New file.
* m4/ifunction-s.m4: New file.
* m4/maxloc0s.m4: New file.
* m4/maxloc1s.m4: New file.
* m4/maxloc2s.m4: New file.
* m4/minloc0s.m4: New file.
* m4/minloc1s.m4: New file.
* m4/minloc2s.m4: New file.
* gfortran.map: Add new functions.
* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.
2017-11-22 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/83070

73
libgfortran/Makefile.am
View File

@ -293,6 +293,14 @@ $(srcdir)/generated/maxloc0_4_r16.c \
$(srcdir)/generated/maxloc0_8_r16.c \
$(srcdir)/generated/maxloc0_16_r16.c
i_maxloc0s_c = \
$(srcdir)/generated/maxloc0_4_s1.c \
$(srcdir)/generated/maxloc0_4_s4.c \
$(srcdir)/generated/maxloc0_8_s1.c \
$(srcdir)/generated/maxloc0_8_s4.c \
$(srcdir)/generated/maxloc0_16_s1.c \
$(srcdir)/generated/maxloc0_16_s4.c
i_maxloc1_c= \
$(srcdir)/generated/maxloc1_4_i1.c \
$(srcdir)/generated/maxloc1_8_i1.c \
@ -322,6 +330,22 @@ $(srcdir)/generated/maxloc1_4_r16.c \
$(srcdir)/generated/maxloc1_8_r16.c \
$(srcdir)/generated/maxloc1_16_r16.c
i_maxloc1s_c= \
$(srcdir)/generated/maxloc1_4_s1.c \
$(srcdir)/generated/maxloc1_4_s4.c \
$(srcdir)/generated/maxloc1_8_s1.c \
$(srcdir)/generated/maxloc1_8_s4.c \
$(srcdir)/generated/maxloc1_16_s1.c \
$(srcdir)/generated/maxloc1_16_s4.c
i_maxloc2s_c= \
$(srcdir)/generated/maxloc2_4_s1.c \
$(srcdir)/generated/maxloc2_4_s4.c \
$(srcdir)/generated/maxloc2_8_s1.c \
$(srcdir)/generated/maxloc2_8_s4.c \
$(srcdir)/generated/maxloc2_16_s1.c \
$(srcdir)/generated/maxloc2_16_s4.c
i_maxval_c= \
$(srcdir)/generated/maxval_i1.c \
$(srcdir)/generated/maxval_i2.c \
@ -362,6 +386,14 @@ $(srcdir)/generated/minloc0_4_r16.c \
$(srcdir)/generated/minloc0_8_r16.c \
$(srcdir)/generated/minloc0_16_r16.c
i_minloc0s_c = \
$(srcdir)/generated/minloc0_4_s1.c \
$(srcdir)/generated/minloc0_4_s4.c \
$(srcdir)/generated/minloc0_8_s1.c \
$(srcdir)/generated/minloc0_8_s4.c \
$(srcdir)/generated/minloc0_16_s1.c \
$(srcdir)/generated/minloc0_16_s4.c
i_minloc1_c= \
$(srcdir)/generated/minloc1_4_i1.c \
$(srcdir)/generated/minloc1_8_i1.c \
@ -391,6 +423,22 @@ $(srcdir)/generated/minloc1_4_r16.c \
$(srcdir)/generated/minloc1_8_r16.c \
$(srcdir)/generated/minloc1_16_r16.c
i_minloc1s_c= \
$(srcdir)/generated/minloc1_4_s1.c \
$(srcdir)/generated/minloc1_4_s4.c \
$(srcdir)/generated/minloc1_8_s1.c \
$(srcdir)/generated/minloc1_8_s4.c \
$(srcdir)/generated/minloc1_16_s1.c \
$(srcdir)/generated/minloc1_16_s4.c
i_minloc2s_c= \
$(srcdir)/generated/minloc2_4_s1.c \
$(srcdir)/generated/minloc2_4_s4.c \
$(srcdir)/generated/minloc2_8_s1.c \
$(srcdir)/generated/minloc2_8_s4.c \
$(srcdir)/generated/minloc2_16_s1.c \
$(srcdir)/generated/minloc2_16_s4.c
i_minval_c= \
$(srcdir)/generated/minval_i1.c \
$(srcdir)/generated/minval_i2.c \
@ -688,7 +736,7 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/pow.m4 \
m4/misc_specifics.m4 m4/pack.m4 \
m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \
m4/iall.m4 m4/iany.m4 m4/iparity.m4
m4/iall.m4 m4/iany.m4 m4/iparity.m4 m4/iforeach-s.m4
gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
@ -699,7 +747,8 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_pow_c) $(i_pack_c) $(i_unpack_c) $(i_matmulavx128_c) \
$(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
$(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \
$(i_cshift1a_c)
$(i_cshift1a_c) $(i_maxloc0s_c) $(i_minloc0s_c) $(i_maxloc1s_c) \
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c)
# Machine generated specifics
gfor_built_specific_src= \
@ -922,6 +971,8 @@ 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
I_M4_DEPS3=$(I_M4_DEPS) m4/iforeach-s.m4
I_M4_DEPS4=$(I_M4_DEPS) m4/ifunction-s.m4
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@ -973,18 +1024,36 @@ $(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS1)
$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
$(i_maxloc0s_c) : m4/maxloc0s.m4 $(I_M4_DEPS3)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0s.m4 > $@
$(i_maxloc1_c): m4/maxloc1.m4 $(I_M4_DEPS1)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1.m4 > $@
$(i_maxloc1s_c): m4/maxloc1s.m4 $(I_M4_DEPS4)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1s.m4 > $@
$(i_maxloc2s_c): m4/maxloc2s.m4 $(I_M4_DEPS)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc2s.m4 > $@
$(i_maxval_c): m4/maxval.m4 $(I_M4_DEPS1)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxval.m4 > $@
$(i_minloc0_c): m4/minloc0.m4 $(I_M4_DEPS0)
$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0.m4 > $@
$(i_minloc0s_c) : m4/minloc0s.m4 $(I_M4_DEPS3)
$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0s.m4 > $@
$(i_minloc1_c): m4/minloc1.m4 $(I_M4_DEPS1)
$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1.m4 > $@
$(i_minloc1s_c): m4/minloc1s.m4 $(I_M4_DEPS4)
$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1s.m4 > $@
$(i_minloc2s_c): m4/minloc2s.m4 $(I_M4_DEPS)
$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc2s.m4 > $@
$(i_minval_c): m4/minval.m4 $(I_M4_DEPS1)
$(M4) -Dfile=$@ -I$(srcdir)/m4 minval.m4 > $@

411
libgfortran/Makefile.in
View File

@ -317,7 +317,19 @@ am__objects_36 = cshift1_4_i1.lo cshift1_4_i2.lo cshift1_4_i4.lo \
cshift1_16_i16.lo cshift1_16_r4.lo cshift1_16_r8.lo \
cshift1_16_r10.lo cshift1_16_r16.lo cshift1_16_c4.lo \
cshift1_16_c8.lo cshift1_16_c10.lo cshift1_16_c16.lo
am__objects_37 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
am__objects_37 = maxloc0_4_s1.lo maxloc0_4_s4.lo maxloc0_8_s1.lo \
maxloc0_8_s4.lo maxloc0_16_s1.lo maxloc0_16_s4.lo
am__objects_38 = minloc0_4_s1.lo minloc0_4_s4.lo minloc0_8_s1.lo \
minloc0_8_s4.lo minloc0_16_s1.lo minloc0_16_s4.lo
am__objects_39 = maxloc1_4_s1.lo maxloc1_4_s4.lo maxloc1_8_s1.lo \
maxloc1_8_s4.lo maxloc1_16_s1.lo maxloc1_16_s4.lo
am__objects_40 = minloc1_4_s1.lo minloc1_4_s4.lo minloc1_8_s1.lo \
minloc1_8_s4.lo minloc1_16_s1.lo minloc1_16_s4.lo
am__objects_41 = maxloc2_4_s1.lo maxloc2_4_s4.lo maxloc2_8_s1.lo \
maxloc2_8_s4.lo maxloc2_16_s1.lo maxloc2_16_s4.lo
am__objects_42 = minloc2_4_s1.lo minloc2_4_s4.lo minloc2_8_s1.lo \
minloc2_8_s4.lo minloc2_16_s1.lo minloc2_16_s4.lo
am__objects_43 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
$(am__objects_7) $(am__objects_8) $(am__objects_9) \
$(am__objects_10) $(am__objects_11) $(am__objects_12) \
$(am__objects_13) $(am__objects_14) $(am__objects_15) \
@ -327,14 +339,16 @@ am__objects_37 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
$(am__objects_25) $(am__objects_26) $(am__objects_27) \
$(am__objects_28) $(am__objects_29) $(am__objects_30) \
$(am__objects_31) $(am__objects_32) $(am__objects_33) \
$(am__objects_34) $(am__objects_35) $(am__objects_36)
@LIBGFOR_MINIMAL_FALSE@am__objects_38 = close.lo file_pos.lo format.lo \
$(am__objects_34) $(am__objects_35) $(am__objects_36) \
$(am__objects_37) $(am__objects_38) $(am__objects_39) \
$(am__objects_40) $(am__objects_41) $(am__objects_42)
@LIBGFOR_MINIMAL_FALSE@am__objects_44 = close.lo file_pos.lo format.lo \
@LIBGFOR_MINIMAL_FALSE@ inquire.lo intrinsics.lo list_read.lo \
@LIBGFOR_MINIMAL_FALSE@ lock.lo open.lo read.lo transfer.lo \
@LIBGFOR_MINIMAL_FALSE@ transfer128.lo unit.lo unix.lo write.lo \
@LIBGFOR_MINIMAL_FALSE@ fbuf.lo
am__objects_39 = size_from_kind.lo $(am__objects_38)
@LIBGFOR_MINIMAL_FALSE@am__objects_40 = access.lo c99_functions.lo \
am__objects_45 = size_from_kind.lo $(am__objects_44)
@LIBGFOR_MINIMAL_FALSE@am__objects_46 = access.lo c99_functions.lo \
@LIBGFOR_MINIMAL_FALSE@ chdir.lo chmod.lo clock.lo cpu_time.lo \
@LIBGFOR_MINIMAL_FALSE@ ctime.lo date_and_time.lo dtime.lo \
@LIBGFOR_MINIMAL_FALSE@ env.lo etime.lo execute_command_line.lo \
@ -344,19 +358,19 @@ am__objects_39 = size_from_kind.lo $(am__objects_38)
@LIBGFOR_MINIMAL_FALSE@ rename.lo stat.lo symlnk.lo \
@LIBGFOR_MINIMAL_FALSE@ system_clock.lo time.lo umask.lo \
@LIBGFOR_MINIMAL_FALSE@ unlink.lo
@IEEE_SUPPORT_TRUE@am__objects_41 = ieee_helper.lo
am__objects_42 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
@IEEE_SUPPORT_TRUE@am__objects_47 = ieee_helper.lo
am__objects_48 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
eoshift2.lo erfc_scaled.lo extends_type_of.lo fnum.lo \
ierrno.lo ishftc.lo mvbits.lo move_alloc.lo pack_generic.lo \
selected_char_kind.lo size.lo spread_generic.lo \
string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
$(am__objects_40) $(am__objects_41)
@IEEE_SUPPORT_TRUE@am__objects_43 = ieee_arithmetic.lo \
$(am__objects_46) $(am__objects_47)
@IEEE_SUPPORT_TRUE@am__objects_49 = ieee_arithmetic.lo \
@IEEE_SUPPORT_TRUE@ ieee_exceptions.lo ieee_features.lo
am__objects_44 =
am__objects_45 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
am__objects_50 =
am__objects_51 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
_abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
_aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
@ -380,19 +394,19 @@ am__objects_45 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
_aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
_anint_r8.lo _anint_r10.lo _anint_r16.lo
am__objects_46 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
am__objects_52 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
_sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
_dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
_atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
_mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
_mod_r10.lo _mod_r16.lo
am__objects_47 = misc_specifics.lo
am__objects_48 = $(am__objects_45) $(am__objects_46) $(am__objects_47) \
am__objects_53 = misc_specifics.lo
am__objects_54 = $(am__objects_51) $(am__objects_52) $(am__objects_53) \
dprod_r8.lo f2c_specifics.lo
am__objects_49 = $(am__objects_3) $(am__objects_37) $(am__objects_39) \
$(am__objects_42) $(am__objects_43) $(am__objects_44) \
$(am__objects_48)
@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_49)
am__objects_55 = $(am__objects_3) $(am__objects_43) $(am__objects_45) \
$(am__objects_48) $(am__objects_49) $(am__objects_50) \
$(am__objects_54)
@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_55)
@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
DEFAULT_INCLUDES = -I.@am__isrc@
@ -732,6 +746,14 @@ $(srcdir)/generated/maxloc0_4_r16.c \
$(srcdir)/generated/maxloc0_8_r16.c \
$(srcdir)/generated/maxloc0_16_r16.c
i_maxloc0s_c = \
$(srcdir)/generated/maxloc0_4_s1.c \
$(srcdir)/generated/maxloc0_4_s4.c \
$(srcdir)/generated/maxloc0_8_s1.c \
$(srcdir)/generated/maxloc0_8_s4.c \
$(srcdir)/generated/maxloc0_16_s1.c \
$(srcdir)/generated/maxloc0_16_s4.c
i_maxloc1_c = \
$(srcdir)/generated/maxloc1_4_i1.c \
$(srcdir)/generated/maxloc1_8_i1.c \
@ -761,6 +783,22 @@ $(srcdir)/generated/maxloc1_4_r16.c \
$(srcdir)/generated/maxloc1_8_r16.c \
$(srcdir)/generated/maxloc1_16_r16.c
i_maxloc1s_c = \
$(srcdir)/generated/maxloc1_4_s1.c \
$(srcdir)/generated/maxloc1_4_s4.c \
$(srcdir)/generated/maxloc1_8_s1.c \
$(srcdir)/generated/maxloc1_8_s4.c \
$(srcdir)/generated/maxloc1_16_s1.c \
$(srcdir)/generated/maxloc1_16_s4.c
i_maxloc2s_c = \
$(srcdir)/generated/maxloc2_4_s1.c \
$(srcdir)/generated/maxloc2_4_s4.c \
$(srcdir)/generated/maxloc2_8_s1.c \
$(srcdir)/generated/maxloc2_8_s4.c \
$(srcdir)/generated/maxloc2_16_s1.c \
$(srcdir)/generated/maxloc2_16_s4.c
i_maxval_c = \
$(srcdir)/generated/maxval_i1.c \
$(srcdir)/generated/maxval_i2.c \
@ -801,6 +839,14 @@ $(srcdir)/generated/minloc0_4_r16.c \
$(srcdir)/generated/minloc0_8_r16.c \
$(srcdir)/generated/minloc0_16_r16.c
i_minloc0s_c = \
$(srcdir)/generated/minloc0_4_s1.c \
$(srcdir)/generated/minloc0_4_s4.c \
$(srcdir)/generated/minloc0_8_s1.c \
$(srcdir)/generated/minloc0_8_s4.c \
$(srcdir)/generated/minloc0_16_s1.c \
$(srcdir)/generated/minloc0_16_s4.c
i_minloc1_c = \
$(srcdir)/generated/minloc1_4_i1.c \
$(srcdir)/generated/minloc1_8_i1.c \
@ -830,6 +876,22 @@ $(srcdir)/generated/minloc1_4_r16.c \
$(srcdir)/generated/minloc1_8_r16.c \
$(srcdir)/generated/minloc1_16_r16.c
i_minloc1s_c = \
$(srcdir)/generated/minloc1_4_s1.c \
$(srcdir)/generated/minloc1_4_s4.c \
$(srcdir)/generated/minloc1_8_s1.c \
$(srcdir)/generated/minloc1_8_s4.c \
$(srcdir)/generated/minloc1_16_s1.c \
$(srcdir)/generated/minloc1_16_s4.c
i_minloc2s_c = \
$(srcdir)/generated/minloc2_4_s1.c \
$(srcdir)/generated/minloc2_4_s4.c \
$(srcdir)/generated/minloc2_8_s1.c \
$(srcdir)/generated/minloc2_8_s4.c \
$(srcdir)/generated/minloc2_16_s1.c \
$(srcdir)/generated/minloc2_16_s4.c
i_minval_c = \
$(srcdir)/generated/minval_i1.c \
$(srcdir)/generated/minval_i2.c \
@ -1127,7 +1189,7 @@ m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/pow.m4 \
m4/misc_specifics.m4 m4/pack.m4 \
m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \
m4/iall.m4 m4/iany.m4 m4/iparity.m4
m4/iall.m4 m4/iany.m4 m4/iparity.m4 m4/iforeach-s.m4
gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
@ -1138,7 +1200,8 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_pow_c) $(i_pack_c) $(i_unpack_c) $(i_matmulavx128_c) \
$(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
$(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \
$(i_cshift1a_c)
$(i_cshift1a_c) $(i_maxloc0s_c) $(i_minloc0s_c) $(i_maxloc1s_c) \
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c)
# Machine generated specifics
@ -1314,6 +1377,8 @@ 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
I_M4_DEPS3 = $(I_M4_DEPS) m4/iforeach-s.m4
I_M4_DEPS4 = $(I_M4_DEPS) m4/ifunction-s.m4
EXTRA_DIST = $(m4_files)
all: $(BUILT_SOURCES) config.h
$(MAKE) $(AM_MAKEFLAGS) all-am
@ -1656,6 +1721,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i2.Plo@am__quote@
@ -1665,6 +1732,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i2.Plo@am__quote@
@ -1674,6 +1743,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i2.Plo@am__quote@
@ -1683,6 +1754,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i2.Plo@am__quote@
@ -1692,6 +1765,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i2.Plo@am__quote@
@ -1701,6 +1776,14 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc2_16_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc2_16_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc2_4_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc2_4_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc2_8_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc2_8_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i2.Plo@am__quote@
@ -1721,6 +1804,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i2.Plo@am__quote@
@ -1730,6 +1815,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i2.Plo@am__quote@
@ -1739,6 +1826,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i2.Plo@am__quote@
@ -1748,6 +1837,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i2.Plo@am__quote@
@ -1757,6 +1848,8 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i2.Plo@am__quote@
@ -1766,6 +1859,14 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc2_16_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc2_16_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc2_4_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc2_4_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc2_8_s1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc2_8_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i2.Plo@am__quote@
@ -5259,6 +5360,258 @@ cshift1_16_c16.lo: $(srcdir)/generated/cshift1_16_c16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_16_c16.lo `test -f '$(srcdir)/generated/cshift1_16_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_16_c16.c
maxloc0_4_s1.lo: $(srcdir)/generated/maxloc0_4_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_s1.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_s1.Tpo -c -o maxloc0_4_s1.lo `test -f '$(srcdir)/generated/maxloc0_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_s1.Tpo $(DEPDIR)/maxloc0_4_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_s1.c' object='maxloc0_4_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_s1.lo `test -f '$(srcdir)/generated/maxloc0_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_s1.c
maxloc0_4_s4.lo: $(srcdir)/generated/maxloc0_4_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_s4.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_s4.Tpo -c -o maxloc0_4_s4.lo `test -f '$(srcdir)/generated/maxloc0_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_s4.Tpo $(DEPDIR)/maxloc0_4_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_s4.c' object='maxloc0_4_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_s4.lo `test -f '$(srcdir)/generated/maxloc0_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_s4.c
maxloc0_8_s1.lo: $(srcdir)/generated/maxloc0_8_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_s1.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_s1.Tpo -c -o maxloc0_8_s1.lo `test -f '$(srcdir)/generated/maxloc0_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_s1.Tpo $(DEPDIR)/maxloc0_8_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_s1.c' object='maxloc0_8_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_s1.lo `test -f '$(srcdir)/generated/maxloc0_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_s1.c
maxloc0_8_s4.lo: $(srcdir)/generated/maxloc0_8_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_s4.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_s4.Tpo -c -o maxloc0_8_s4.lo `test -f '$(srcdir)/generated/maxloc0_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_s4.Tpo $(DEPDIR)/maxloc0_8_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_s4.c' object='maxloc0_8_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_s4.lo `test -f '$(srcdir)/generated/maxloc0_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_s4.c
maxloc0_16_s1.lo: $(srcdir)/generated/maxloc0_16_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_s1.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_s1.Tpo -c -o maxloc0_16_s1.lo `test -f '$(srcdir)/generated/maxloc0_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_s1.Tpo $(DEPDIR)/maxloc0_16_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_s1.c' object='maxloc0_16_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_s1.lo `test -f '$(srcdir)/generated/maxloc0_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_s1.c
maxloc0_16_s4.lo: $(srcdir)/generated/maxloc0_16_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_s4.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_s4.Tpo -c -o maxloc0_16_s4.lo `test -f '$(srcdir)/generated/maxloc0_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_s4.Tpo $(DEPDIR)/maxloc0_16_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_s4.c' object='maxloc0_16_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_s4.lo `test -f '$(srcdir)/generated/maxloc0_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_s4.c
minloc0_4_s1.lo: $(srcdir)/generated/minloc0_4_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_s1.lo -MD -MP -MF $(DEPDIR)/minloc0_4_s1.Tpo -c -o minloc0_4_s1.lo `test -f '$(srcdir)/generated/minloc0_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_s1.Tpo $(DEPDIR)/minloc0_4_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_s1.c' object='minloc0_4_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_s1.lo `test -f '$(srcdir)/generated/minloc0_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_s1.c
minloc0_4_s4.lo: $(srcdir)/generated/minloc0_4_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_s4.lo -MD -MP -MF $(DEPDIR)/minloc0_4_s4.Tpo -c -o minloc0_4_s4.lo `test -f '$(srcdir)/generated/minloc0_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_s4.Tpo $(DEPDIR)/minloc0_4_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_s4.c' object='minloc0_4_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_s4.lo `test -f '$(srcdir)/generated/minloc0_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_s4.c
minloc0_8_s1.lo: $(srcdir)/generated/minloc0_8_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_s1.lo -MD -MP -MF $(DEPDIR)/minloc0_8_s1.Tpo -c -o minloc0_8_s1.lo `test -f '$(srcdir)/generated/minloc0_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_s1.Tpo $(DEPDIR)/minloc0_8_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_s1.c' object='minloc0_8_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_s1.lo `test -f '$(srcdir)/generated/minloc0_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_s1.c
minloc0_8_s4.lo: $(srcdir)/generated/minloc0_8_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_s4.lo -MD -MP -MF $(DEPDIR)/minloc0_8_s4.Tpo -c -o minloc0_8_s4.lo `test -f '$(srcdir)/generated/minloc0_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_s4.Tpo $(DEPDIR)/minloc0_8_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_s4.c' object='minloc0_8_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_s4.lo `test -f '$(srcdir)/generated/minloc0_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_s4.c
minloc0_16_s1.lo: $(srcdir)/generated/minloc0_16_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_s1.lo -MD -MP -MF $(DEPDIR)/minloc0_16_s1.Tpo -c -o minloc0_16_s1.lo `test -f '$(srcdir)/generated/minloc0_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_s1.Tpo $(DEPDIR)/minloc0_16_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_s1.c' object='minloc0_16_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_s1.lo `test -f '$(srcdir)/generated/minloc0_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_s1.c
minloc0_16_s4.lo: $(srcdir)/generated/minloc0_16_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_s4.lo -MD -MP -MF $(DEPDIR)/minloc0_16_s4.Tpo -c -o minloc0_16_s4.lo `test -f '$(srcdir)/generated/minloc0_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_s4.Tpo $(DEPDIR)/minloc0_16_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_s4.c' object='minloc0_16_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_s4.lo `test -f '$(srcdir)/generated/minloc0_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_s4.c
maxloc1_4_s1.lo: $(srcdir)/generated/maxloc1_4_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_s1.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_s1.Tpo -c -o maxloc1_4_s1.lo `test -f '$(srcdir)/generated/maxloc1_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_s1.Tpo $(DEPDIR)/maxloc1_4_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_s1.c' object='maxloc1_4_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_s1.lo `test -f '$(srcdir)/generated/maxloc1_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_s1.c
maxloc1_4_s4.lo: $(srcdir)/generated/maxloc1_4_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_s4.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_s4.Tpo -c -o maxloc1_4_s4.lo `test -f '$(srcdir)/generated/maxloc1_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_s4.Tpo $(DEPDIR)/maxloc1_4_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_s4.c' object='maxloc1_4_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_s4.lo `test -f '$(srcdir)/generated/maxloc1_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_s4.c
maxloc1_8_s1.lo: $(srcdir)/generated/maxloc1_8_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_s1.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_s1.Tpo -c -o maxloc1_8_s1.lo `test -f '$(srcdir)/generated/maxloc1_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_s1.Tpo $(DEPDIR)/maxloc1_8_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_s1.c' object='maxloc1_8_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_s1.lo `test -f '$(srcdir)/generated/maxloc1_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_s1.c
maxloc1_8_s4.lo: $(srcdir)/generated/maxloc1_8_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_s4.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_s4.Tpo -c -o maxloc1_8_s4.lo `test -f '$(srcdir)/generated/maxloc1_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_s4.Tpo $(DEPDIR)/maxloc1_8_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_s4.c' object='maxloc1_8_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_s4.lo `test -f '$(srcdir)/generated/maxloc1_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_s4.c
maxloc1_16_s1.lo: $(srcdir)/generated/maxloc1_16_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_s1.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_s1.Tpo -c -o maxloc1_16_s1.lo `test -f '$(srcdir)/generated/maxloc1_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_s1.Tpo $(DEPDIR)/maxloc1_16_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_s1.c' object='maxloc1_16_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_s1.lo `test -f '$(srcdir)/generated/maxloc1_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_s1.c
maxloc1_16_s4.lo: $(srcdir)/generated/maxloc1_16_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_s4.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_s4.Tpo -c -o maxloc1_16_s4.lo `test -f '$(srcdir)/generated/maxloc1_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_s4.Tpo $(DEPDIR)/maxloc1_16_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_s4.c' object='maxloc1_16_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_s4.lo `test -f '$(srcdir)/generated/maxloc1_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_s4.c
minloc1_4_s1.lo: $(srcdir)/generated/minloc1_4_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_s1.lo -MD -MP -MF $(DEPDIR)/minloc1_4_s1.Tpo -c -o minloc1_4_s1.lo `test -f '$(srcdir)/generated/minloc1_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_s1.Tpo $(DEPDIR)/minloc1_4_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_s1.c' object='minloc1_4_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_s1.lo `test -f '$(srcdir)/generated/minloc1_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_s1.c
minloc1_4_s4.lo: $(srcdir)/generated/minloc1_4_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_s4.lo -MD -MP -MF $(DEPDIR)/minloc1_4_s4.Tpo -c -o minloc1_4_s4.lo `test -f '$(srcdir)/generated/minloc1_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_s4.Tpo $(DEPDIR)/minloc1_4_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_s4.c' object='minloc1_4_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_s4.lo `test -f '$(srcdir)/generated/minloc1_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_s4.c
minloc1_8_s1.lo: $(srcdir)/generated/minloc1_8_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_s1.lo -MD -MP -MF $(DEPDIR)/minloc1_8_s1.Tpo -c -o minloc1_8_s1.lo `test -f '$(srcdir)/generated/minloc1_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_s1.Tpo $(DEPDIR)/minloc1_8_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_s1.c' object='minloc1_8_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_s1.lo `test -f '$(srcdir)/generated/minloc1_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_s1.c
minloc1_8_s4.lo: $(srcdir)/generated/minloc1_8_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_s4.lo -MD -MP -MF $(DEPDIR)/minloc1_8_s4.Tpo -c -o minloc1_8_s4.lo `test -f '$(srcdir)/generated/minloc1_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_s4.Tpo $(DEPDIR)/minloc1_8_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_s4.c' object='minloc1_8_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_s4.lo `test -f '$(srcdir)/generated/minloc1_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_s4.c
minloc1_16_s1.lo: $(srcdir)/generated/minloc1_16_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_s1.lo -MD -MP -MF $(DEPDIR)/minloc1_16_s1.Tpo -c -o minloc1_16_s1.lo `test -f '$(srcdir)/generated/minloc1_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_s1.Tpo $(DEPDIR)/minloc1_16_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_s1.c' object='minloc1_16_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_s1.lo `test -f '$(srcdir)/generated/minloc1_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_s1.c
minloc1_16_s4.lo: $(srcdir)/generated/minloc1_16_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_s4.lo -MD -MP -MF $(DEPDIR)/minloc1_16_s4.Tpo -c -o minloc1_16_s4.lo `test -f '$(srcdir)/generated/minloc1_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_s4.Tpo $(DEPDIR)/minloc1_16_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_s4.c' object='minloc1_16_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_s4.lo `test -f '$(srcdir)/generated/minloc1_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_s4.c
maxloc2_4_s1.lo: $(srcdir)/generated/maxloc2_4_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc2_4_s1.lo -MD -MP -MF $(DEPDIR)/maxloc2_4_s1.Tpo -c -o maxloc2_4_s1.lo `test -f '$(srcdir)/generated/maxloc2_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_4_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc2_4_s1.Tpo $(DEPDIR)/maxloc2_4_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc2_4_s1.c' object='maxloc2_4_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc2_4_s1.lo `test -f '$(srcdir)/generated/maxloc2_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_4_s1.c
maxloc2_4_s4.lo: $(srcdir)/generated/maxloc2_4_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc2_4_s4.lo -MD -MP -MF $(DEPDIR)/maxloc2_4_s4.Tpo -c -o maxloc2_4_s4.lo `test -f '$(srcdir)/generated/maxloc2_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_4_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc2_4_s4.Tpo $(DEPDIR)/maxloc2_4_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc2_4_s4.c' object='maxloc2_4_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc2_4_s4.lo `test -f '$(srcdir)/generated/maxloc2_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_4_s4.c
maxloc2_8_s1.lo: $(srcdir)/generated/maxloc2_8_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc2_8_s1.lo -MD -MP -MF $(DEPDIR)/maxloc2_8_s1.Tpo -c -o maxloc2_8_s1.lo `test -f '$(srcdir)/generated/maxloc2_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_8_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc2_8_s1.Tpo $(DEPDIR)/maxloc2_8_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc2_8_s1.c' object='maxloc2_8_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc2_8_s1.lo `test -f '$(srcdir)/generated/maxloc2_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_8_s1.c
maxloc2_8_s4.lo: $(srcdir)/generated/maxloc2_8_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc2_8_s4.lo -MD -MP -MF $(DEPDIR)/maxloc2_8_s4.Tpo -c -o maxloc2_8_s4.lo `test -f '$(srcdir)/generated/maxloc2_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_8_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc2_8_s4.Tpo $(DEPDIR)/maxloc2_8_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc2_8_s4.c' object='maxloc2_8_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc2_8_s4.lo `test -f '$(srcdir)/generated/maxloc2_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_8_s4.c
maxloc2_16_s1.lo: $(srcdir)/generated/maxloc2_16_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc2_16_s1.lo -MD -MP -MF $(DEPDIR)/maxloc2_16_s1.Tpo -c -o maxloc2_16_s1.lo `test -f '$(srcdir)/generated/maxloc2_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_16_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc2_16_s1.Tpo $(DEPDIR)/maxloc2_16_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc2_16_s1.c' object='maxloc2_16_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc2_16_s1.lo `test -f '$(srcdir)/generated/maxloc2_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_16_s1.c
maxloc2_16_s4.lo: $(srcdir)/generated/maxloc2_16_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc2_16_s4.lo -MD -MP -MF $(DEPDIR)/maxloc2_16_s4.Tpo -c -o maxloc2_16_s4.lo `test -f '$(srcdir)/generated/maxloc2_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_16_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc2_16_s4.Tpo $(DEPDIR)/maxloc2_16_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc2_16_s4.c' object='maxloc2_16_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc2_16_s4.lo `test -f '$(srcdir)/generated/maxloc2_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc2_16_s4.c
minloc2_4_s1.lo: $(srcdir)/generated/minloc2_4_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc2_4_s1.lo -MD -MP -MF $(DEPDIR)/minloc2_4_s1.Tpo -c -o minloc2_4_s1.lo `test -f '$(srcdir)/generated/minloc2_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_4_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc2_4_s1.Tpo $(DEPDIR)/minloc2_4_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc2_4_s1.c' object='minloc2_4_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc2_4_s1.lo `test -f '$(srcdir)/generated/minloc2_4_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_4_s1.c
minloc2_4_s4.lo: $(srcdir)/generated/minloc2_4_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc2_4_s4.lo -MD -MP -MF $(DEPDIR)/minloc2_4_s4.Tpo -c -o minloc2_4_s4.lo `test -f '$(srcdir)/generated/minloc2_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_4_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc2_4_s4.Tpo $(DEPDIR)/minloc2_4_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc2_4_s4.c' object='minloc2_4_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc2_4_s4.lo `test -f '$(srcdir)/generated/minloc2_4_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_4_s4.c
minloc2_8_s1.lo: $(srcdir)/generated/minloc2_8_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc2_8_s1.lo -MD -MP -MF $(DEPDIR)/minloc2_8_s1.Tpo -c -o minloc2_8_s1.lo `test -f '$(srcdir)/generated/minloc2_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_8_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc2_8_s1.Tpo $(DEPDIR)/minloc2_8_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc2_8_s1.c' object='minloc2_8_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc2_8_s1.lo `test -f '$(srcdir)/generated/minloc2_8_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_8_s1.c
minloc2_8_s4.lo: $(srcdir)/generated/minloc2_8_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc2_8_s4.lo -MD -MP -MF $(DEPDIR)/minloc2_8_s4.Tpo -c -o minloc2_8_s4.lo `test -f '$(srcdir)/generated/minloc2_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_8_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc2_8_s4.Tpo $(DEPDIR)/minloc2_8_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc2_8_s4.c' object='minloc2_8_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc2_8_s4.lo `test -f '$(srcdir)/generated/minloc2_8_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_8_s4.c
minloc2_16_s1.lo: $(srcdir)/generated/minloc2_16_s1.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc2_16_s1.lo -MD -MP -MF $(DEPDIR)/minloc2_16_s1.Tpo -c -o minloc2_16_s1.lo `test -f '$(srcdir)/generated/minloc2_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_16_s1.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc2_16_s1.Tpo $(DEPDIR)/minloc2_16_s1.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc2_16_s1.c' object='minloc2_16_s1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc2_16_s1.lo `test -f '$(srcdir)/generated/minloc2_16_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_16_s1.c
minloc2_16_s4.lo: $(srcdir)/generated/minloc2_16_s4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc2_16_s4.lo -MD -MP -MF $(DEPDIR)/minloc2_16_s4.Tpo -c -o minloc2_16_s4.lo `test -f '$(srcdir)/generated/minloc2_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_16_s4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc2_16_s4.Tpo $(DEPDIR)/minloc2_16_s4.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc2_16_s4.c' object='minloc2_16_s4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc2_16_s4.lo `test -f '$(srcdir)/generated/minloc2_16_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc2_16_s4.c
size_from_kind.lo: io/size_from_kind.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT size_from_kind.lo -MD -MP -MF $(DEPDIR)/size_from_kind.Tpo -c -o size_from_kind.lo `test -f 'io/size_from_kind.c' || echo '$(srcdir)/'`io/size_from_kind.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/size_from_kind.Tpo $(DEPDIR)/size_from_kind.Plo
@ -6139,18 +6492,36 @@ fpu-target.inc: fpu-target.h $(srcdir)/libgfortran.h
@MAINTAINER_MODE_TRUE@$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_maxloc0s_c) : m4/maxloc0s.m4 $(I_M4_DEPS3)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0s.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_maxloc1_c): m4/maxloc1.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_maxloc1s_c): m4/maxloc1s.m4 $(I_M4_DEPS4)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1s.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_maxloc2s_c): m4/maxloc2s.m4 $(I_M4_DEPS)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc2s.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_maxval_c): m4/maxval.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxval.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_minloc0_c): m4/minloc0.m4 $(I_M4_DEPS0)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_minloc0s_c) : m4/minloc0s.m4 $(I_M4_DEPS3)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0s.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_minloc1_c): m4/minloc1.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_minloc1s_c): m4/minloc1s.m4 $(I_M4_DEPS4)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1s.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_minloc2s_c): m4/minloc2s.m4 $(I_M4_DEPS)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc2s.m4 > $@
@MAINTAINER_MODE_TRUE@$(i_minval_c): m4/minval.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minval.m4 > $@

327
libgfortran/generated/maxloc0_16_s1.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len);
export_proto(maxloc0_16_s1);
void
maxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_1 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mmaxloc0_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mmaxloc0_16_s1);
void
mmaxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
const GFC_INTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_1 *maxval;
maxval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void smaxloc0_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(smaxloc0_16_s1);
void
smaxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_16 *dest;
if (*mask)
{
maxloc0_16_s1 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/maxloc0_16_s4.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len);
export_proto(maxloc0_16_s4);
void
maxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_4 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mmaxloc0_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mmaxloc0_16_s4);
void
mmaxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
const GFC_INTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_4 *maxval;
maxval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void smaxloc0_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(smaxloc0_16_s4);
void
smaxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_16 *dest;
if (*mask)
{
maxloc0_16_s4 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/maxloc0_4_s1.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len);
export_proto(maxloc0_4_s1);
void
maxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_1 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mmaxloc0_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mmaxloc0_4_s1);
void
mmaxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
const GFC_INTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_1 *maxval;
maxval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void smaxloc0_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(smaxloc0_4_s1);
void
smaxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_4 *dest;
if (*mask)
{
maxloc0_4_s1 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/maxloc0_4_s4.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len);
export_proto(maxloc0_4_s4);
void
maxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_4 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mmaxloc0_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mmaxloc0_4_s4);
void
mmaxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
const GFC_INTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_4 *maxval;
maxval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void smaxloc0_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(smaxloc0_4_s4);
void
smaxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_4 *dest;
if (*mask)
{
maxloc0_4_s4 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/maxloc0_8_s1.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len);
export_proto(maxloc0_8_s1);
void
maxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_1 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mmaxloc0_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mmaxloc0_8_s1);
void
mmaxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
const GFC_INTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_1 *maxval;
maxval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void smaxloc0_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(smaxloc0_8_s1);
void
smaxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_8 *dest;
if (*mask)
{
maxloc0_8_s1 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/maxloc0_8_s4.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len);
export_proto(maxloc0_8_s4);
void
maxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_4 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mmaxloc0_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mmaxloc0_8_s4);
void
mmaxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
const GFC_INTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_4 *maxval;
maxval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void smaxloc0_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(smaxloc0_8_s4);
void
smaxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_8 *dest;
if (*mask)
{
maxloc0_8_s4 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

552
libgfortran/generated/maxloc1_16_s1.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc1_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(maxloc1_16_s1);
void
maxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_1 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_1 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mmaxloc1_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mmaxloc1_16_s1);
void
mmaxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
maxval = src;
result = (GFC_INTEGER_16)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void smaxloc1_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxloc1_16_s1);
void
smaxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
maxloc1_16_s1 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/maxloc1_16_s4.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc1_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(maxloc1_16_s4);
void
maxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_4 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_4 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mmaxloc1_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mmaxloc1_16_s4);
void
mmaxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
maxval = src;
result = (GFC_INTEGER_16)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void smaxloc1_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxloc1_16_s4);
void
smaxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
maxloc1_16_s4 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/maxloc1_4_s1.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc1_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(maxloc1_4_s1);
void
maxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_1 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_1 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mmaxloc1_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mmaxloc1_4_s1);
void
mmaxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
maxval = src;
result = (GFC_INTEGER_4)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void smaxloc1_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxloc1_4_s1);
void
smaxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
maxloc1_4_s1 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/maxloc1_4_s4.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc1_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(maxloc1_4_s4);
void
maxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_4 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_4 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mmaxloc1_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mmaxloc1_4_s4);
void
mmaxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
maxval = src;
result = (GFC_INTEGER_4)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void smaxloc1_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxloc1_4_s4);
void
smaxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
maxloc1_4_s4 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/maxloc1_8_s1.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc1_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(maxloc1_8_s1);
void
maxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_1 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_1 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mmaxloc1_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mmaxloc1_8_s1);
void
mmaxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_1 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
maxval = src;
result = (GFC_INTEGER_8)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void smaxloc1_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxloc1_8_s1);
void
smaxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
maxloc1_8_s1 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/maxloc1_8_s4.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void maxloc1_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(maxloc1_8_s4);
void
maxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_4 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_4 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mmaxloc1_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mmaxloc1_8_s4);
void
mmaxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_4 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
maxval = src;
result = (GFC_INTEGER_8)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void smaxloc1_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxloc1_8_s4);
void
smaxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
maxloc1_8_s4 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MAXLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MAXLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

156
libgfortran/generated/maxloc2_16_s1.c Normal file
View File

@ -0,0 +1,156 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_16 maxloc2_16_s1 (gfc_array_s1 * const restrict, int);
export_proto(maxloc2_16_s1);
GFC_INTEGER_16
maxloc2_16_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_16 mmaxloc2_16_s1 (gfc_array_s1 * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(mmaxloc2_16_s1);
GFC_INTEGER_16
mmaxloc2_16_s1 (gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_16 smaxloc2_16_s1 (gfc_array_s1 * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(smaxloc2_16_s1);
GFC_INTEGER_16
smaxloc2_16_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return maxloc2_16_s1 (array, len);
else
return 0;
}
#endif

156
libgfortran/generated/maxloc2_16_s4.c Normal file
View File

@ -0,0 +1,156 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_16 maxloc2_16_s4 (gfc_array_s4 * const restrict, int);
export_proto(maxloc2_16_s4);
GFC_INTEGER_16
maxloc2_16_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_16 mmaxloc2_16_s4 (gfc_array_s4 * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(mmaxloc2_16_s4);
GFC_INTEGER_16
mmaxloc2_16_s4 (gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_16 smaxloc2_16_s4 (gfc_array_s4 * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(smaxloc2_16_s4);
GFC_INTEGER_16
smaxloc2_16_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return maxloc2_16_s4 (array, len);
else
return 0;
}
#endif

156
libgfortran/generated/maxloc2_4_s1.c Normal file
View File

@ -0,0 +1,156 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_4 maxloc2_4_s1 (gfc_array_s1 * const restrict, int);
export_proto(maxloc2_4_s1);
GFC_INTEGER_4
maxloc2_4_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_4 mmaxloc2_4_s1 (gfc_array_s1 * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(mmaxloc2_4_s1);
GFC_INTEGER_4
mmaxloc2_4_s1 (gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_4 smaxloc2_4_s1 (gfc_array_s1 * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(smaxloc2_4_s1);
GFC_INTEGER_4
smaxloc2_4_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return maxloc2_4_s1 (array, len);
else
return 0;
}
#endif

156
libgfortran/generated/maxloc2_4_s4.c Normal file
View File

@ -0,0 +1,156 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_4 maxloc2_4_s4 (gfc_array_s4 * const restrict, int);
export_proto(maxloc2_4_s4);
GFC_INTEGER_4
maxloc2_4_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_4 mmaxloc2_4_s4 (gfc_array_s4 * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(mmaxloc2_4_s4);
GFC_INTEGER_4
mmaxloc2_4_s4 (gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_4 smaxloc2_4_s4 (gfc_array_s4 * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(smaxloc2_4_s4);
GFC_INTEGER_4
smaxloc2_4_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return maxloc2_4_s4 (array, len);
else
return 0;
}
#endif

156
libgfortran/generated/maxloc2_8_s1.c Normal file
View File

@ -0,0 +1,156 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_8 maxloc2_8_s1 (gfc_array_s1 * const restrict, int);
export_proto(maxloc2_8_s1);
GFC_INTEGER_8
maxloc2_8_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_8 mmaxloc2_8_s1 (gfc_array_s1 * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(mmaxloc2_8_s1);
GFC_INTEGER_8
mmaxloc2_8_s1 (gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_8 smaxloc2_8_s1 (gfc_array_s1 * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(smaxloc2_8_s1);
GFC_INTEGER_8
smaxloc2_8_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return maxloc2_8_s1 (array, len);
else
return 0;
}
#endif

156
libgfortran/generated/maxloc2_8_s4.c Normal file
View File

@ -0,0 +1,156 @@
/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_8 maxloc2_8_s4 (gfc_array_s4 * const restrict, int);
export_proto(maxloc2_8_s4);
GFC_INTEGER_8
maxloc2_8_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_8 mmaxloc2_8_s4 (gfc_array_s4 * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(mmaxloc2_8_s4);
GFC_INTEGER_8
mmaxloc2_8_s4 (gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_8 smaxloc2_8_s4 (gfc_array_s4 * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(smaxloc2_8_s4);
GFC_INTEGER_8
smaxloc2_8_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return maxloc2_8_s4 (array, len);
else
return 0;
}
#endif

327
libgfortran/generated/minloc0_16_s1.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len);
export_proto(minloc0_16_s1);
void
minloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_1 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_1 *minval;
minval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mminloc0_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mminloc0_16_s1);
void
mminloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
const GFC_INTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_1 *minval;
minval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void sminloc0_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(sminloc0_16_s1);
void
sminloc0_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_16 *dest;
if (*mask)
{
minloc0_16_s1 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/minloc0_16_s4.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len);
export_proto(minloc0_16_s4);
void
minloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_4 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_4 *minval;
minval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mminloc0_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mminloc0_16_s4);
void
mminloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
const GFC_INTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_4 *minval;
minval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void sminloc0_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(sminloc0_16_s4);
void
sminloc0_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_16 *dest;
if (*mask)
{
minloc0_16_s4 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/minloc0_4_s1.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len);
export_proto(minloc0_4_s1);
void
minloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_1 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_1 *minval;
minval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mminloc0_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mminloc0_4_s1);
void
mminloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
const GFC_INTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_1 *minval;
minval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void sminloc0_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(sminloc0_4_s1);
void
sminloc0_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_4 *dest;
if (*mask)
{
minloc0_4_s1 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/minloc0_4_s4.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len);
export_proto(minloc0_4_s4);
void
minloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_4 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_4 *minval;
minval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mminloc0_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mminloc0_4_s4);
void
mminloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
const GFC_INTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_4 *minval;
minval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void sminloc0_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(sminloc0_4_s4);
void
sminloc0_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_4 *dest;
if (*mask)
{
minloc0_4_s4 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/minloc0_8_s1.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len);
export_proto(minloc0_8_s1);
void
minloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_1 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_1 *minval;
minval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mminloc0_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mminloc0_8_s1);
void
mminloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
const GFC_INTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_1 *minval;
minval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void sminloc0_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(sminloc0_8_s1);
void
sminloc0_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_8 *dest;
if (*mask)
{
minloc0_8_s1 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

327
libgfortran/generated/minloc0_8_s4.c Normal file
View File

@ -0,0 +1,327 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len);
export_proto(minloc0_8_s4);
void
minloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const GFC_INTEGER_4 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
const GFC_INTEGER_4 *minval;
minval = base;
while (base)
{
do
{
/* Implementation start. */
if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void mminloc0_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(mminloc0_8_s4);
void
mminloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
const GFC_INTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
const GFC_INTEGER_4 *minval;
minval = NULL;
while (base)
{
do
{
/* Implementation start. */
if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}
/* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}
extern void sminloc0_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(sminloc0_8_s4);
void
sminloc0_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
GFC_INTEGER_8 *dest;
if (*mask)
{
minloc0_8_s4 (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = 0 ;
}
#endif

552
libgfortran/generated/minloc1_16_s1.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc1_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(minloc1_16_s1);
void
minloc1_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_1 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_1 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
const GFC_INTEGER_1 *minval;
minval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mminloc1_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mminloc1_16_s1);
void
mminloc1_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MINLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_1 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
minval = src;
result = (GFC_INTEGER_16)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void sminloc1_16_s1 (gfc_array_i16 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminloc1_16_s1);
void
sminloc1_16_s1 (gfc_array_i16 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
minloc1_16_s1 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/minloc1_16_s4.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc1_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(minloc1_16_s4);
void
minloc1_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_4 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_4 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
const GFC_INTEGER_4 *minval;
minval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mminloc1_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mminloc1_16_s4);
void
mminloc1_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MINLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_4 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
minval = src;
result = (GFC_INTEGER_16)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_16)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void sminloc1_16_s4 (gfc_array_i16 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminloc1_16_s4);
void
sminloc1_16_s4 (gfc_array_i16 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
minloc1_16_s4 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/minloc1_4_s1.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc1_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(minloc1_4_s1);
void
minloc1_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_1 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_1 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
const GFC_INTEGER_1 *minval;
minval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mminloc1_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mminloc1_4_s1);
void
mminloc1_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MINLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_1 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
minval = src;
result = (GFC_INTEGER_4)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void sminloc1_4_s1 (gfc_array_i4 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminloc1_4_s1);
void
sminloc1_4_s1 (gfc_array_i4 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
minloc1_4_s1 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/minloc1_4_s4.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc1_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(minloc1_4_s4);
void
minloc1_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_4 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_4 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
const GFC_INTEGER_4 *minval;
minval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mminloc1_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mminloc1_4_s4);
void
mminloc1_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MINLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_4 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
minval = src;
result = (GFC_INTEGER_4)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_4)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void sminloc1_4_s4 (gfc_array_i4 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminloc1_4_s4);
void
sminloc1_4_s4 (gfc_array_i4 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
minloc1_4_s4 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/minloc1_8_s1.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc1_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(minloc1_8_s1);
void
minloc1_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_1 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_1 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
const GFC_INTEGER_1 *minval;
minval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mminloc1_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mminloc1_8_s1);
void
mminloc1_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MINLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_1 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
minval = src;
result = (GFC_INTEGER_8)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void sminloc1_8_s1 (gfc_array_i8 * const restrict,
gfc_array_s1 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminloc1_8_s1);
void
sminloc1_8_s1 (gfc_array_i8 * const restrict retarray,
gfc_array_s1 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
minloc1_8_s1 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

552
libgfortran/generated/minloc1_8_s4.c Normal file
View File

@ -0,0 +1,552 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
#include <string.h>
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void minloc1_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(minloc1_8_s4);
void
minloc1_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
const GFC_INTEGER_4 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const GFC_INTEGER_4 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
const GFC_INTEGER_4 *minval;
minval = base;
result = 1;
if (len <= 0)
*dest = 0;
else
{
for (n = 0; n < len; n++, src += delta)
{
if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}
extern void mminloc1_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(mminloc1_8_s4);
void
mminloc1_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in MINLOC intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
const GFC_INTEGER_4 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc)
{
minval = src;
result = (GFC_INTEGER_8)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (GFC_INTEGER_8)n + 1;
}
}
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}
extern void sminloc1_8_s4 (gfc_array_i8 * const restrict,
gfc_array_s4 * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminloc1_8_s4);
void
sminloc1_8_s4 (gfc_array_i8 * const restrict retarray,
gfc_array_s4 * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
minloc1_8_s4 (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" MINLOC intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}
#endif

155
libgfortran/generated/minloc2_16_s1.c Normal file
View File

@ -0,0 +1,155 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_16 minloc2_16_s1 (gfc_array_s1 * const restrict, int);
export_proto(minloc2_16_s1);
GFC_INTEGER_16
minloc2_16_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_16 mminloc2_16_s1 (gfc_array_s1 * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(mminloc2_16_s1);
GFC_INTEGER_16
mminloc2_16_s1 (gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_16 sminloc2_16_s1 (gfc_array_s1 * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(sminloc2_16_s1);
GFC_INTEGER_16
sminloc2_16_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return minloc2_16_s1 (array, len);
else
return 0;
}
#endif

155
libgfortran/generated/minloc2_16_s4.c Normal file
View File

@ -0,0 +1,155 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_16 minloc2_16_s4 (gfc_array_s4 * const restrict, int);
export_proto(minloc2_16_s4);
GFC_INTEGER_16
minloc2_16_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_16 mminloc2_16_s4 (gfc_array_s4 * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(mminloc2_16_s4);
GFC_INTEGER_16
mminloc2_16_s4 (gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_16 sminloc2_16_s4 (gfc_array_s4 * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(sminloc2_16_s4);
GFC_INTEGER_16
sminloc2_16_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return minloc2_16_s4 (array, len);
else
return 0;
}
#endif

155
libgfortran/generated/minloc2_4_s1.c Normal file
View File

@ -0,0 +1,155 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_4 minloc2_4_s1 (gfc_array_s1 * const restrict, int);
export_proto(minloc2_4_s1);
GFC_INTEGER_4
minloc2_4_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_4 mminloc2_4_s1 (gfc_array_s1 * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(mminloc2_4_s1);
GFC_INTEGER_4
mminloc2_4_s1 (gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_4 sminloc2_4_s1 (gfc_array_s1 * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(sminloc2_4_s1);
GFC_INTEGER_4
sminloc2_4_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return minloc2_4_s1 (array, len);
else
return 0;
}
#endif

155
libgfortran/generated/minloc2_4_s4.c Normal file
View File

@ -0,0 +1,155 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_4 minloc2_4_s4 (gfc_array_s4 * const restrict, int);
export_proto(minloc2_4_s4);
GFC_INTEGER_4
minloc2_4_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_4 mminloc2_4_s4 (gfc_array_s4 * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(mminloc2_4_s4);
GFC_INTEGER_4
mminloc2_4_s4 (gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_4 sminloc2_4_s4 (gfc_array_s4 * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(sminloc2_4_s4);
GFC_INTEGER_4
sminloc2_4_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return minloc2_4_s4 (array, len);
else
return 0;
}
#endif

155
libgfortran/generated/minloc2_8_s1.c Normal file
View File

@ -0,0 +1,155 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
{
if (sizeof (GFC_INTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_8 minloc2_8_s1 (gfc_array_s1 * const restrict, int);
export_proto(minloc2_8_s1);
GFC_INTEGER_8
minloc2_8_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_8 mminloc2_8_s1 (gfc_array_s1 * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(mminloc2_8_s1);
GFC_INTEGER_8
mminloc2_8_s1 (gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_1 *src;
const GFC_INTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_8 sminloc2_8_s1 (gfc_array_s1 * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(sminloc2_8_s1);
GFC_INTEGER_8
sminloc2_8_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return minloc2_8_s1 (array, len);
else
return 0;
}
#endif

155
libgfortran/generated/minloc2_8_s4.c Normal file
View File

@ -0,0 +1,155 @@
/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
static inline int
compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
{
if (sizeof (GFC_INTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern GFC_INTEGER_8 minloc2_8_s4 (gfc_array_s4 * const restrict, int);
export_proto(minloc2_8_s4);
GFC_INTEGER_8
minloc2_8_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern GFC_INTEGER_8 mminloc2_8_s4 (gfc_array_s4 * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(mminloc2_8_s4);
GFC_INTEGER_8
mminloc2_8_s4 (gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const GFC_INTEGER_4 *src;
const GFC_INTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern GFC_INTEGER_8 sminloc2_8_s4 (gfc_array_s4 * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(sminloc2_8_s4);
GFC_INTEGER_8
sminloc2_8_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return minloc2_8_s4 (array, len);
else
return 0;
}
#endif

114
libgfortran/gfortran.map
View File

@ -1,4 +1,4 @@
GFORTRAN_7 {
GFORTRAN_8 {
global:
__ieee_arithmetic_MOD_ieee_class_10;
__ieee_arithmetic_MOD_ieee_class_16;
@ -357,6 +357,8 @@ GFORTRAN_7 {
_gfortran_maxloc0_16_r16;
_gfortran_maxloc0_16_r4;
_gfortran_maxloc0_16_r8;
_gfortran_maxloc0_16_s1;
_gfortran_maxloc0_16_s4;
_gfortran_maxloc0_4_i16;
_gfortran_maxloc0_4_i1;
_gfortran_maxloc0_4_i2;
@ -366,6 +368,8 @@ GFORTRAN_7 {
_gfortran_maxloc0_4_r16;
_gfortran_maxloc0_4_r4;
_gfortran_maxloc0_4_r8;
_gfortran_maxloc0_4_s1;
_gfortran_maxloc0_4_s4;
_gfortran_maxloc0_8_i16;
_gfortran_maxloc0_8_i1;
_gfortran_maxloc0_8_i2;
@ -375,6 +379,8 @@ GFORTRAN_7 {
_gfortran_maxloc0_8_r16;
_gfortran_maxloc0_8_r4;
_gfortran_maxloc0_8_r8;
_gfortran_maxloc0_8_s1;
_gfortran_maxloc0_8_s4;
_gfortran_maxloc1_16_i16;
_gfortran_maxloc1_16_i1;
_gfortran_maxloc1_16_i2;
@ -384,6 +390,8 @@ GFORTRAN_7 {
_gfortran_maxloc1_16_r16;
_gfortran_maxloc1_16_r4;
_gfortran_maxloc1_16_r8;
_gfortran_maxloc1_16_s1;
_gfortran_maxloc1_16_s4;
_gfortran_maxloc1_4_i16;
_gfortran_maxloc1_4_i1;
_gfortran_maxloc1_4_i2;
@ -393,6 +401,8 @@ GFORTRAN_7 {
_gfortran_maxloc1_4_r16;
_gfortran_maxloc1_4_r4;
_gfortran_maxloc1_4_r8;
_gfortran_maxloc1_4_s1;
_gfortran_maxloc1_4_s4;
_gfortran_maxloc1_8_i16;
_gfortran_maxloc1_8_i1;
_gfortran_maxloc1_8_i2;
@ -402,6 +412,14 @@ GFORTRAN_7 {
_gfortran_maxloc1_8_r16;
_gfortran_maxloc1_8_r4;
_gfortran_maxloc1_8_r8;
_gfortran_maxloc1_8_s1;
_gfortran_maxloc1_8_s4;
_gfortran_maxloc2_16_s1;
_gfortran_maxloc2_16_s4;
_gfortran_maxloc2_4_s1;
_gfortran_maxloc2_4_s4;
_gfortran_maxloc2_8_s1;
_gfortran_maxloc2_8_s4;
_gfortran_maxval_i16;
_gfortran_maxval_i1;
_gfortran_maxval_i2;
@ -432,6 +450,8 @@ GFORTRAN_7 {
_gfortran_minloc0_16_r16;
_gfortran_minloc0_16_r4;
_gfortran_minloc0_16_r8;
_gfortran_minloc0_16_s1;
_gfortran_minloc0_16_s4;
_gfortran_minloc0_4_i16;
_gfortran_minloc0_4_i1;
_gfortran_minloc0_4_i2;
@ -441,6 +461,8 @@ GFORTRAN_7 {
_gfortran_minloc0_4_r16;
_gfortran_minloc0_4_r4;
_gfortran_minloc0_4_r8;
_gfortran_minloc0_4_s1;
_gfortran_minloc0_4_s4;
_gfortran_minloc0_8_i16;
_gfortran_minloc0_8_i1;
_gfortran_minloc0_8_i2;
@ -450,6 +472,8 @@ GFORTRAN_7 {
_gfortran_minloc0_8_r16;
_gfortran_minloc0_8_r4;
_gfortran_minloc0_8_r8;
_gfortran_minloc0_8_s1;
_gfortran_minloc0_8_s4;
_gfortran_minloc1_16_i16;
_gfortran_minloc1_16_i1;
_gfortran_minloc1_16_i2;
@ -459,6 +483,8 @@ GFORTRAN_7 {
_gfortran_minloc1_16_r16;
_gfortran_minloc1_16_r4;
_gfortran_minloc1_16_r8;
_gfortran_minloc1_16_s1;
_gfortran_minloc1_16_s4;
_gfortran_minloc1_4_i16;
_gfortran_minloc1_4_i1;
_gfortran_minloc1_4_i2;
@ -468,6 +494,8 @@ GFORTRAN_7 {
_gfortran_minloc1_4_r16;
_gfortran_minloc1_4_r4;
_gfortran_minloc1_4_r8;
_gfortran_minloc1_4_s1;
_gfortran_minloc1_4_s4;
_gfortran_minloc1_8_i16;
_gfortran_minloc1_8_i1;
_gfortran_minloc1_8_i2;
@ -477,6 +505,14 @@ GFORTRAN_7 {
_gfortran_minloc1_8_r16;
_gfortran_minloc1_8_r4;
_gfortran_minloc1_8_r8;
_gfortran_minloc1_8_s1;
_gfortran_minloc1_8_s4;
_gfortran_minloc2_16_s1;
_gfortran_minloc2_16_s4;
_gfortran_minloc2_4_s1;
_gfortran_minloc2_4_s4;
_gfortran_minloc2_8_s1;
_gfortran_minloc2_8_s4;
_gfortran_minval_i16;
_gfortran_minval_i1;
_gfortran_minval_i2;
@ -500,6 +536,8 @@ GFORTRAN_7 {
_gfortran_mmaxloc0_16_r16;
_gfortran_mmaxloc0_16_r4;
_gfortran_mmaxloc0_16_r8;
_gfortran_mmaxloc0_16_s1;
_gfortran_mmaxloc0_16_s4;
_gfortran_mmaxloc0_4_i16;
_gfortran_mmaxloc0_4_i1;
_gfortran_mmaxloc0_4_i2;
@ -509,6 +547,8 @@ GFORTRAN_7 {
_gfortran_mmaxloc0_4_r16;
_gfortran_mmaxloc0_4_r4;
_gfortran_mmaxloc0_4_r8;
_gfortran_mmaxloc0_4_s1;
_gfortran_mmaxloc0_4_s4;
_gfortran_mmaxloc0_8_i16;
_gfortran_mmaxloc0_8_i1;
_gfortran_mmaxloc0_8_i2;
@ -518,6 +558,8 @@ GFORTRAN_7 {
_gfortran_mmaxloc0_8_r16;
_gfortran_mmaxloc0_8_r4;
_gfortran_mmaxloc0_8_r8;
_gfortran_mmaxloc0_8_s1;
_gfortran_mmaxloc0_8_s4;
_gfortran_mmaxloc1_16_i16;
_gfortran_mmaxloc1_16_i1;
_gfortran_mmaxloc1_16_i2;
@ -527,6 +569,8 @@ GFORTRAN_7 {
_gfortran_mmaxloc1_16_r16;
_gfortran_mmaxloc1_16_r4;
_gfortran_mmaxloc1_16_r8;
_gfortran_mmaxloc1_16_s1;
_gfortran_mmaxloc1_16_s4;
_gfortran_mmaxloc1_4_i16;
_gfortran_mmaxloc1_4_i1;
_gfortran_mmaxloc1_4_i2;
@ -536,6 +580,8 @@ GFORTRAN_7 {
_gfortran_mmaxloc1_4_r16;
_gfortran_mmaxloc1_4_r4;
_gfortran_mmaxloc1_4_r8;
_gfortran_mmaxloc1_4_s1;
_gfortran_mmaxloc1_4_s4;
_gfortran_mmaxloc1_8_i16;
_gfortran_mmaxloc1_8_i1;
_gfortran_mmaxloc1_8_i2;
@ -545,6 +591,14 @@ GFORTRAN_7 {
_gfortran_mmaxloc1_8_r16;
_gfortran_mmaxloc1_8_r4;
_gfortran_mmaxloc1_8_r8;
_gfortran_mmaxloc1_8_s1;
_gfortran_mmaxloc1_8_s4;
_gfortran_mmaxloc2_16_s1;
_gfortran_mmaxloc2_16_s4;
_gfortran_mmaxloc2_4_s1;
_gfortran_mmaxloc2_4_s4;
_gfortran_mmaxloc2_8_s1;
_gfortran_mmaxloc2_8_s4;
_gfortran_mmaxval_i16;
_gfortran_mmaxval_i1;
_gfortran_mmaxval_i2;
@ -563,6 +617,8 @@ GFORTRAN_7 {
_gfortran_mminloc0_16_r16;
_gfortran_mminloc0_16_r4;
_gfortran_mminloc0_16_r8;
_gfortran_mminloc0_16_s1;
_gfortran_mminloc0_16_s4;
_gfortran_mminloc0_4_i16;
_gfortran_mminloc0_4_i1;
_gfortran_mminloc0_4_i2;
@ -572,6 +628,8 @@ GFORTRAN_7 {
_gfortran_mminloc0_4_r16;
_gfortran_mminloc0_4_r4;
_gfortran_mminloc0_4_r8;
_gfortran_mminloc0_4_s1;
_gfortran_mminloc0_4_s4;
_gfortran_mminloc0_8_i16;
_gfortran_mminloc0_8_i1;
_gfortran_mminloc0_8_i2;
@ -581,6 +639,8 @@ GFORTRAN_7 {
_gfortran_mminloc0_8_r16;
_gfortran_mminloc0_8_r4;
_gfortran_mminloc0_8_r8;
_gfortran_mminloc0_8_s1;
_gfortran_mminloc0_8_s4;
_gfortran_mminloc1_16_i16;
_gfortran_mminloc1_16_i1;
_gfortran_mminloc1_16_i2;
@ -590,6 +650,8 @@ GFORTRAN_7 {
_gfortran_mminloc1_16_r16;
_gfortran_mminloc1_16_r4;
_gfortran_mminloc1_16_r8;
_gfortran_mminloc1_16_s1;
_gfortran_mminloc1_16_s4;
_gfortran_mminloc1_4_i16;
_gfortran_mminloc1_4_i1;
_gfortran_mminloc1_4_i2;
@ -599,6 +661,8 @@ GFORTRAN_7 {
_gfortran_mminloc1_4_r16;
_gfortran_mminloc1_4_r4;
_gfortran_mminloc1_4_r8;
_gfortran_mminloc1_4_s1;
_gfortran_mminloc1_4_s4;
_gfortran_mminloc1_8_i16;
_gfortran_mminloc1_8_i1;
_gfortran_mminloc1_8_i2;
@ -608,6 +672,14 @@ GFORTRAN_7 {
_gfortran_mminloc1_8_r16;
_gfortran_mminloc1_8_r4;
_gfortran_mminloc1_8_r8;
_gfortran_mminloc1_8_s1;
_gfortran_mminloc1_8_s4;
_gfortran_mminloc2_16_s1;
_gfortran_mminloc2_16_s4;
_gfortran_mminloc2_4_s1;
_gfortran_mminloc2_4_s4;
_gfortran_mminloc2_8_s1;
_gfortran_mminloc2_8_s4;
_gfortran_mminval_i16;
_gfortran_mminval_i1;
_gfortran_mminval_i2;
@ -792,6 +864,8 @@ GFORTRAN_7 {
_gfortran_smaxloc0_16_r16;
_gfortran_smaxloc0_16_r4;
_gfortran_smaxloc0_16_r8;
_gfortran_smaxloc0_16_s1;
_gfortran_smaxloc0_16_s4;
_gfortran_smaxloc0_4_i16;
_gfortran_smaxloc0_4_i1;
_gfortran_smaxloc0_4_i2;
@ -801,6 +875,8 @@ GFORTRAN_7 {
_gfortran_smaxloc0_4_r16;
_gfortran_smaxloc0_4_r4;
_gfortran_smaxloc0_4_r8;
_gfortran_smaxloc0_4_s1;
_gfortran_smaxloc0_4_s4;
_gfortran_smaxloc0_8_i16;
_gfortran_smaxloc0_8_i1;
_gfortran_smaxloc0_8_i2;
@ -810,6 +886,8 @@ GFORTRAN_7 {
_gfortran_smaxloc0_8_r16;
_gfortran_smaxloc0_8_r4;
_gfortran_smaxloc0_8_r8;
_gfortran_smaxloc0_8_s1;
_gfortran_smaxloc0_8_s4;
_gfortran_smaxloc1_16_i16;
_gfortran_smaxloc1_16_i1;
_gfortran_smaxloc1_16_i2;
@ -819,6 +897,8 @@ GFORTRAN_7 {
_gfortran_smaxloc1_16_r16;
_gfortran_smaxloc1_16_r4;
_gfortran_smaxloc1_16_r8;
_gfortran_smaxloc1_16_s1;
_gfortran_smaxloc1_16_s4;
_gfortran_smaxloc1_4_i16;
_gfortran_smaxloc1_4_i1;
_gfortran_smaxloc1_4_i2;
@ -828,6 +908,8 @@ GFORTRAN_7 {
_gfortran_smaxloc1_4_r16;
_gfortran_smaxloc1_4_r4;
_gfortran_smaxloc1_4_r8;
_gfortran_smaxloc1_4_s1;
_gfortran_smaxloc1_4_s4;
_gfortran_smaxloc1_8_i16;
_gfortran_smaxloc1_8_i1;
_gfortran_smaxloc1_8_i2;
@ -837,6 +919,14 @@ GFORTRAN_7 {
_gfortran_smaxloc1_8_r16;
_gfortran_smaxloc1_8_r4;
_gfortran_smaxloc1_8_r8;
_gfortran_smaxloc1_8_s1;
_gfortran_smaxloc1_8_s4;
_gfortran_smaxloc2_16_s1;
_gfortran_smaxloc2_16_s4;
_gfortran_smaxloc2_4_s1;
_gfortran_smaxloc2_4_s4;
_gfortran_smaxloc2_8_s1;
_gfortran_smaxloc2_8_s4;
_gfortran_smaxval_i16;
_gfortran_smaxval_i1;
_gfortran_smaxval_i2;
@ -855,6 +945,8 @@ GFORTRAN_7 {
_gfortran_sminloc0_16_r16;
_gfortran_sminloc0_16_r4;
_gfortran_sminloc0_16_r8;
_gfortran_sminloc0_16_s1;
_gfortran_sminloc0_16_s4;
_gfortran_sminloc0_4_i16;
_gfortran_sminloc0_4_i1;
_gfortran_sminloc0_4_i2;
@ -864,6 +956,8 @@ GFORTRAN_7 {
_gfortran_sminloc0_4_r16;
_gfortran_sminloc0_4_r4;
_gfortran_sminloc0_4_r8;
_gfortran_sminloc0_4_s1;
_gfortran_sminloc0_4_s4;
_gfortran_sminloc0_8_i16;
_gfortran_sminloc0_8_i1;
_gfortran_sminloc0_8_i2;
@ -873,6 +967,8 @@ GFORTRAN_7 {
_gfortran_sminloc0_8_r16;
_gfortran_sminloc0_8_r4;
_gfortran_sminloc0_8_r8;
_gfortran_sminloc0_8_s1;
_gfortran_sminloc0_8_s4;
_gfortran_sminloc1_16_i16;
_gfortran_sminloc1_16_i1;
_gfortran_sminloc1_16_i2;
@ -882,6 +978,8 @@ GFORTRAN_7 {
_gfortran_sminloc1_16_r16;
_gfortran_sminloc1_16_r4;
_gfortran_sminloc1_16_r8;
_gfortran_sminloc1_16_s1;
_gfortran_sminloc1_16_s4;
_gfortran_sminloc1_4_i16;
_gfortran_sminloc1_4_i1;
_gfortran_sminloc1_4_i2;
@ -891,6 +989,8 @@ GFORTRAN_7 {
_gfortran_sminloc1_4_r16;
_gfortran_sminloc1_4_r4;
_gfortran_sminloc1_4_r8;
_gfortran_sminloc1_4_s1;
_gfortran_sminloc1_4_s4;
_gfortran_sminloc1_8_i16;
_gfortran_sminloc1_8_i1;
_gfortran_sminloc1_8_i2;
@ -900,6 +1000,14 @@ GFORTRAN_7 {
_gfortran_sminloc1_8_r16;
_gfortran_sminloc1_8_r4;
_gfortran_sminloc1_8_r8;
_gfortran_sminloc1_8_s1;
_gfortran_sminloc1_8_s4;
_gfortran_sminloc2_16_s1;
_gfortran_sminloc2_16_s4;
_gfortran_sminloc2_4_s1;
_gfortran_sminloc2_4_s4;
_gfortran_sminloc2_8_s1;
_gfortran_sminloc2_8_s4;
_gfortran_sminval_i16;
_gfortran_sminval_i1;
_gfortran_sminval_i2;
@ -1196,7 +1304,7 @@ GFORTRAN_7 {
*;
};
GFORTRAN_F2C_7 {
GFORTRAN_F2C_8 {
global:
_gfortran_f2c_specific__abs_c4;
_gfortran_f2c_specific__abs_r4;
@ -1238,7 +1346,7 @@ GFORTRAN_F2C_7 {
_gfortran_f2c_specific__tan_r4;
};
GFORTRAN_C99_7 {
GFORTRAN_C99_8 {
global:
acosf;
acoshf;

3
libgfortran/libgfortran.h
View File

@ -376,7 +376,8 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
#ifdef HAVE_GFC_LOGICAL_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
#endif
typedef gfc_array_i1 gfc_array_s1;
typedef gfc_array_i4 gfc_array_s4;
#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \

288
libgfortran/m4/iforeach-s.m4 Normal file
View File

@ -0,0 +1,288 @@
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 Runtime Library (libgfortran)
dnl Distributed under the GNU GPL with exception. See COPYING for details.
define(START_FOREACH_FUNCTION,
`static inline int
compare_fcn (const atype_name *a, const atype_name *b, gfc_charlen_type n)
{
if (sizeof ('atype_name`) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array, gfc_charlen_type len);
export_proto(name`'rtype_qual`_'atype_code);
void
name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
const atype_name *base;
rtype_name * restrict dest;
index_type rank;
index_type n;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (rtype_name));
}
else
{
if (unlikely (compile_options.bounds_check))
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 1;
{
')dnl
define(START_FOREACH_BLOCK,
` while (base)
{
do
{
/* Implementation start. */
')dnl
define(FINISH_FOREACH_FUNCTION,
` /* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* 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];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
}
}
while (count[n] == extent[n]);
}
}
}')dnl
define(START_MASKED_FOREACH_FUNCTION,
`
extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict,
atype * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
export_proto(`m'name`'rtype_qual`_'atype_code);
void
`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
rtype_name *dest;
const atype_name *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (rtype_name));
}
else
{
if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"u_name");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "u_name");
}
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
count[n] = 0;
if (extent[n] <= 0)
{
/* Set the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
return;
}
}
base = array->base_addr;
/* Initialize the return value. */
for (n = 0; n < rank; n++)
dest[n * dstride] = 0;
{
')dnl
define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl
define(FINISH_MASKED_FOREACH_FUNCTION,
` /* Implementation end. */
/* Advance to the next element. */
base += sstride[0];
mbase += mstride[0];
}
while (++count[0] != extent[0]);
n = 0;
do
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
}
}
while (count[n] == extent[n]);
}
}
}')dnl
define(FOREACH_FUNCTION,
`START_FOREACH_FUNCTION
$1
START_FOREACH_BLOCK
$2
FINISH_FOREACH_FUNCTION')dnl
define(MASKED_FOREACH_FUNCTION,
`START_MASKED_FOREACH_FUNCTION
$1
START_MASKED_FOREACH_BLOCK
$2
FINISH_MASKED_FOREACH_FUNCTION')dnl
define(SCALAR_FOREACH_FUNCTION,
`
extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict,
atype * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
export_proto(`s'name`'rtype_qual`_'atype_code);
void
`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
GFC_LOGICAL_4 * mask, gfc_charlen_type len)
{
index_type rank;
index_type dstride;
index_type n;
rtype_name *dest;
if (*mask)
{
name`'rtype_qual`_'atype_code (retarray, array, len);
return;
}
rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0)
runtime_error ("Rank of array needs to be > 0");
if (retarray->base_addr == NULL)
{
GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
retarray->offset = 0;
retarray->base_addr = xmallocarray (rank, sizeof (rtype_name));
}
else if (unlikely (compile_options.bounds_check))
{
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
dest = retarray->base_addr;
for (n = 0; n<rank; n++)
dest[n * dstride] = $1 ;
}')dnl

530
libgfortran/m4/ifunction-s.m4 Normal file
View File

@ -0,0 +1,530 @@
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 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,
`#include <string.h>
static inline int
compare_fcn (const atype_name *a, const atype_name *b, gfc_charlen_type n)
{
if (sizeof ('atype_name`) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern void name`'rtype_qual`_'atype_code (rtype * const restrict,
atype * const restrict, const index_type * const restrict,
gfc_charlen_type);
export_proto(name`'rtype_qual`_'atype_code);
void
name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
const index_type * const restrict pdim, gfc_charlen_type string_len)
{
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 atype_name * restrict base;
rtype_name * restrict dest;
index_type rank;
index_type n;
index_type len;
index_type delta;
index_type dim;
int continue_loop;
/* Make dim zero based to avoid confusion. */
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in u_name intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len < 0)
len = 0;
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1) * string_len;
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" u_name intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "u_name");
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
base = array->base_addr;
dest = retarray->base_addr;
continue_loop = 1;
while (continue_loop)
{
const atype_name * restrict src;
rtype_name result;
src = base;
{
')dnl
define(START_ARRAY_BLOCK,
` if (len <= 0)
*dest = '$1`;
else
{
for (n = 0; n < len; n++, src += delta)
{
')dnl
define(FINISH_ARRAY_FUNCTION,
` }
'$1`
*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 loop. */
continue_loop = 0;
break;
}
else
{
count[n]++;
base += sstride[n];
dest += dstride[n];
}
}
}
}')dnl
define(START_MASKED_ARRAY_FUNCTION,
`
extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict,
atype * const restrict, const index_type * const restrict,
gfc_array_l1 * const restrict, gfc_charlen_type);
export_proto(`m'name`'rtype_qual`_'atype_code);
void
`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
const index_type * const restrict pdim,
gfc_array_l1 * const restrict mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
rtype_name * restrict dest;
const atype_name * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
index_type n;
index_type len;
index_type delta;
index_type mdelta;
int mask_kind;
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in u_name intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
len = GFC_DESCRIPTOR_EXTENT(array,dim);
if (len <= 0)
return;
mbase = mask->base_addr;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = GFC_DESCRIPTOR_STRIDE(array,dim) * string_len;
mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
for (n = 0; n < dim; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] < 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1) * string_len;
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
if (extent[n] < 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in u_name intrinsic");
if (unlikely (compile_options.bounds_check))
{
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "u_name");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "u_name");
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
if (extent[n] <= 0)
return;
}
dest = retarray->base_addr;
base = array->base_addr;
while (base)
{
const atype_name * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
rtype_name result;
src = base;
msrc = mbase;
{
')dnl
define(START_MASKED_ARRAY_BLOCK,
` for (n = 0; n < len; n++, src += delta, msrc += mdelta)
{
')dnl
define(FINISH_MASKED_ARRAY_FUNCTION,
` }
*dest = result;
}
/* Advance to the next element. */
count[0]++;
base += sstride[0];
mbase += mstride[0];
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
base -= sstride[n] * extent[n];
mbase -= mstride[n] * extent[n];
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
{
/* Break out of the loop. */
base = NULL;
break;
}
else
{
count[n]++;
base += sstride[n];
mbase += mstride[n];
dest += dstride[n];
}
}
}
}')dnl
define(SCALAR_ARRAY_FUNCTION,
`
extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict,
atype * const restrict, const index_type * const restrict,
GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(`s'name`'rtype_qual`_'atype_code);
void
`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
atype * const restrict array,
const index_type * const restrict pdim,
GFC_LOGICAL_4 * mask, gfc_charlen_type string_len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
rtype_name * restrict dest;
index_type rank;
index_type n;
index_type dim;
if (*mask)
{
name`'rtype_qual`_'atype_code (retarray, array, pdim, string_len);
return;
}
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
if (unlikely (dim < 0 || dim > rank))
{
runtime_error ("Dim argument incorrect in u_name intrinsic: "
"is %ld, should be between 1 and %ld",
(long int) dim + 1, (long int) rank + 1);
}
for (n = 0; n < dim; n++)
{
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
for (n = dim; n < rank; n++)
{
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
if (extent[n] <= 0)
extent[n] = 0;
}
if (retarray->base_addr == NULL)
{
size_t alloc_size, str;
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
retarray->offset = 0;
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
return;
}
else
retarray->base_addr = xmallocarray (alloc_size, sizeof (rtype_name));
}
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
runtime_error ("rank of return array incorrect in"
" u_name intrinsic: is %ld, should be %ld",
(long int) (GFC_DESCRIPTOR_RANK (retarray)),
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" u_name intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
}
for (n = 0; n < rank; n++)
{
count[n] = 0;
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
}
dest = retarray->base_addr;
while(1)
{
*dest = '$1`;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
n++;
if (n >= rank)
return;
else
{
count[n]++;
dest += dstride[n];
}
}
}
}')dnl
define(ARRAY_FUNCTION,
`START_ARRAY_FUNCTION
$2
START_ARRAY_BLOCK($1)
$3
FINISH_ARRAY_FUNCTION($4)')dnl
define(MASKED_ARRAY_FUNCTION,
`START_MASKED_ARRAY_FUNCTION
$2
START_MASKED_ARRAY_BLOCK
$3
FINISH_MASKED_ARRAY_FUNCTION')dnl

2
libgfortran/m4/ifunction.m4
View File

@ -42,8 +42,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
int continue_loop;
/* Make dim zero based to avoid confusion. */
dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1;
dim = (*pdim) - 1;
if (unlikely (dim < 0 || dim > rank))
{

2
libgfortran/m4/iparm.m4
View File

@ -4,7 +4,7 @@ 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 M4 macro file to get type names from filenames
define(get_typename2, `GFC_$1_$2')dnl
define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,unknown)))),`$2')')dnl
define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,s,INTEGER,unknown))))),`$2')')dnl
define(get_arraytype, `gfc_array_$1$2')dnl
define(define_type, `dnl
ifelse(regexp($2,`^[0-9]'),-1,`dnl

61
libgfortran/m4/maxloc0s.m4 Normal file
View File

@ -0,0 +1,61 @@
`/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>'
include(iparm.m4)dnl
include(iforeach-s.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
FOREACH_FUNCTION(
` const atype_name *maxval;
maxval = base;'
,
` if (compare_fcn (base, maxval, len) > 0)
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
` const atype_name *maxval;
maxval = NULL;'
,
` if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
{
maxval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
#endif

65
libgfortran/m4/maxloc1s.m4 Normal file
View File

@ -0,0 +1,65 @@
`/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"'
include(iparm.m4)dnl
include(ifunction-s.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` const atype_name *maxval;
maxval = base;
result = 1;',
` if (compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (rtype_name)n + 1;
}', `')
MASKED_ARRAY_FUNCTION(0,
` const atype_name *maxval;
maxval = base;
result = 0;',
` if (*msrc)
{
maxval = src;
result = (rtype_name)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, maxval, string_len) > 0)
{
maxval = src;
result = (rtype_name)n + 1;
}
')
SCALAR_ARRAY_FUNCTION(0)
#endif

157
libgfortran/m4/maxloc2s.m4 Normal file
View File

@ -0,0 +1,157 @@
`/* Implementation of the MAXLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>'
include(iparm.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)
static inline int
compare_fcn (const 'atype_name` *a, const 'atype_name` *b, int n)
{
if (sizeof ('atype_name`) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern 'rtype_name` 'name`'rtype_qual`_'atype_code` ('atype` * const restrict, int);
export_proto('name`'rtype_qual`_'atype_code`);
'rtype_name`
'name`'rtype_qual`_'atype_code` ('atype` * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const 'atype_name` *src;
const 'atype_name` *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern 'rtype_name` m'name`'rtype_qual`_'atype_code` ('atype` * const restrict,
gfc_array_l1 *const restrict mask, gfc_charlen_type);
export_proto(m'name`'rtype_qual`_'atype_code`);
'rtype_name`
m'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
gfc_array_l1 * const restrict mask,
gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const 'atype_name` *src;
const 'atype_name` *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) > 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern 'rtype_name` s'name`'rtype_qual`_'atype_code` ('atype` * const restrict,
GFC_LOGICAL_4 *mask, int);
export_proto(s'name`'rtype_qual`_'atype_code`);
'rtype_name`
s'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return 'name`'rtype_qual`_'atype_code` (array, len);
else
return 0;
}
#endif'

61
libgfortran/m4/minloc0s.m4 Normal file
View File

@ -0,0 +1,61 @@
`/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <limits.h>'
include(iparm.m4)dnl
include(iforeach-s.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
FOREACH_FUNCTION(
` const atype_name *minval;
minval = base;'
,
` if (compare_fcn (base, minval, len) < 0)
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
MASKED_FOREACH_FUNCTION(
` const atype_name *minval;
minval = NULL;'
,
` if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
{
minval = base;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
SCALAR_FOREACH_FUNCTION(`0')
#endif

65
libgfortran/m4/minloc1s.m4 Normal file
View File

@ -0,0 +1,65 @@
`/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"'
include(iparm.m4)dnl
include(ifunction-s.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
ARRAY_FUNCTION(0,
` const atype_name *minval;
minval = base;
result = 1;',
` if (compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (rtype_name)n + 1;
}', `')
MASKED_ARRAY_FUNCTION(0,
` const atype_name *minval;
minval = base;
result = 0;',
` if (*msrc)
{
minval = src;
result = (rtype_name)n + 1;
break;
}
}
for (; n < len; n++, src += delta, msrc += mdelta)
{
if (*msrc && compare_fcn (src, minval, string_len) < 0)
{
minval = src;
result = (rtype_name)n + 1;
}
')
SCALAR_ARRAY_FUNCTION(0)
#endif

156
libgfortran/m4/minloc2s.m4 Normal file
View File

@ -0,0 +1,156 @@
`/* Implementation of the MINLOC intrinsic
Copyright 2017 Free Software Foundation, Inc.
Contributed by Thomas Koenig
This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.
You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
#include <stdlib.h>
#include <string.h>'
include(iparm.m4)dnl
`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)
static inline int
compare_fcn (const 'atype_name` *a, const 'atype_name` *b, int n)
{
if (sizeof ('atype_name`) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
}
extern 'rtype_name` 'name`'rtype_qual`_'atype_code` ('atype` * const restrict, int);
export_proto('name`'rtype_qual`_'atype_code`);
'rtype_name`
'name`'rtype_qual`_'atype_code` ('atype` * const restrict array, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const 'atype_name` *src;
const 'atype_name` *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
ret = 1;
src = array->base_addr;
maxval = src;
for (i=2; i<=extent; i++)
{
src += sstride;
if (compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
}
return ret;
}
extern 'rtype_name` m'name`'rtype_qual`_'atype_code` ('atype` * const restrict,
gfc_array_l1 *const restrict mask, int);
export_proto(m'name`'rtype_qual`_'atype_code`);
'rtype_name`
m'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
index_type ret;
index_type sstride;
index_type extent;
const 'atype_name` *src;
const 'atype_name` *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
index_type mstride;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
if (extent <= 0)
return 0;
sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->base_addr;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
internal_error (NULL, "Funny sized logical array");
mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
/* Search for the first occurrence of a true element in mask. */
for (j=0; j<extent; j++)
{
if (*mbase)
break;
mbase += mstride;
}
if (j == extent)
return 0;
ret = j + 1;
src = array->base_addr + j * sstride;
maxval = src;
for (i=j+1; i<=extent; i++)
{
if (*mbase && compare_fcn (src, maxval, len) < 0)
{
ret = i;
maxval = src;
}
src += sstride;
mbase += mstride;
}
return ret;
}
extern 'rtype_name` s'name`'rtype_qual`_'atype_code` ('atype` * const restrict,
GFC_LOGICAL_4 *mask, gfc_charlen_type);
export_proto(s'name`'rtype_qual`_'atype_code`);
'rtype_name`
s'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
{
if (mask)
return 'name`'rtype_qual`_'atype_code` (array, len);
else
return 0;
}
#endif'