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
parent
824a2b3d8c
commit
ddc9995b13
58 changed files with 14711 additions and 33 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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
91
gcc/testsuite/gfortran.dg/maxloc_string_1.f90
Normal 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
91
gcc/testsuite/gfortran.dg/minloc_string_1.f90
Normal 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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 > $@
|
||||
|
||||
|
|
|
|||
|
|
@ -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
327
libgfortran/generated/maxloc0_16_s1.c
Normal 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
327
libgfortran/generated/maxloc0_16_s4.c
Normal 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
327
libgfortran/generated/maxloc0_4_s1.c
Normal 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
327
libgfortran/generated/maxloc0_4_s4.c
Normal 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
327
libgfortran/generated/maxloc0_8_s1.c
Normal 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
327
libgfortran/generated/maxloc0_8_s4.c
Normal 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
552
libgfortran/generated/maxloc1_16_s1.c
Normal 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
552
libgfortran/generated/maxloc1_16_s4.c
Normal 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
552
libgfortran/generated/maxloc1_4_s1.c
Normal 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
552
libgfortran/generated/maxloc1_4_s4.c
Normal 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
552
libgfortran/generated/maxloc1_8_s1.c
Normal 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
552
libgfortran/generated/maxloc1_8_s4.c
Normal 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
156
libgfortran/generated/maxloc2_16_s1.c
Normal 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
156
libgfortran/generated/maxloc2_16_s4.c
Normal 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
156
libgfortran/generated/maxloc2_4_s1.c
Normal 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
156
libgfortran/generated/maxloc2_4_s4.c
Normal 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
156
libgfortran/generated/maxloc2_8_s1.c
Normal 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
156
libgfortran/generated/maxloc2_8_s4.c
Normal 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
327
libgfortran/generated/minloc0_16_s1.c
Normal 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
327
libgfortran/generated/minloc0_16_s4.c
Normal 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
327
libgfortran/generated/minloc0_4_s1.c
Normal 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
327
libgfortran/generated/minloc0_4_s4.c
Normal 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
327
libgfortran/generated/minloc0_8_s1.c
Normal 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
327
libgfortran/generated/minloc0_8_s4.c
Normal 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
552
libgfortran/generated/minloc1_16_s1.c
Normal 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
552
libgfortran/generated/minloc1_16_s4.c
Normal 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
552
libgfortran/generated/minloc1_4_s1.c
Normal 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
552
libgfortran/generated/minloc1_4_s4.c
Normal 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
552
libgfortran/generated/minloc1_8_s1.c
Normal 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
552
libgfortran/generated/minloc1_8_s4.c
Normal 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
155
libgfortran/generated/minloc2_16_s1.c
Normal 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
155
libgfortran/generated/minloc2_16_s4.c
Normal 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
155
libgfortran/generated/minloc2_4_s1.c
Normal 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
155
libgfortran/generated/minloc2_4_s4.c
Normal 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
155
libgfortran/generated/minloc2_8_s1.c
Normal 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
155
libgfortran/generated/minloc2_8_s4.c
Normal 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
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
288
libgfortran/m4/iforeach-s.m4
Normal 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
530
libgfortran/m4/ifunction-s.m4
Normal 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
|
||||
|
|
@ -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))
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
61
libgfortran/m4/maxloc0s.m4
Normal 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
65
libgfortran/m4/maxloc1s.m4
Normal 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
157
libgfortran/m4/maxloc2s.m4
Normal 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
61
libgfortran/m4/minloc0s.m4
Normal 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
65
libgfortran/m4/minloc1s.m4
Normal 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
156
libgfortran/m4/minloc2s.m4
Normal 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'
|
||||
Loading…
Add table
Reference in a new issue