mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-22 03:40:26 +08:00
re PR libfortran/30690 ([4.2, 4.1 only] Clean up m4 files)
2007-03-14 Thomas Koenig <Thomas.Koenig@online.de> PR libfortran/30690 * all.m4: Quote everything, except for m4 macros. * any.m4: Likewise. * count.m4: Likewise. * cshift1.m4: Likewise. * eoshift1.m4: Likewise. * eoshift3.m4: Likewise. * exponent.m4: Likewise. * fraction.m4: Likewise. * in_pack.m4: Likewise. * in_unpack.m4: Likewise. * matmul.m4: Likewise. * matmull.m4: Likewise. * nearest.m4: Likewise. * pow.m4: Likewise. * product.m4: Likewise. * reshape.m4: Likewise. * rrspacing.m4: Likewise. * set_exponent.m4: Likewise. * shape.m4: Likewise. * spacing.m4: Likewise. * transpose.m4: Likewise. From-SVN: r122927
This commit is contained in:
Thomas Koenig
Thomas Koenig
parent
286d12f95e
commit
adea5e16e4
@ -1,3 +1,28 @@
|
||||
2007-03-14 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR libfortran/30690
|
||||
* all.m4: Quote everything, except for m4 macros.
|
||||
* any.m4: Likewise.
|
||||
* count.m4: Likewise.
|
||||
* cshift1.m4: Likewise.
|
||||
* eoshift1.m4: Likewise.
|
||||
* eoshift3.m4: Likewise.
|
||||
* exponent.m4: Likewise.
|
||||
* fraction.m4: Likewise.
|
||||
* in_pack.m4: Likewise.
|
||||
* in_unpack.m4: Likewise.
|
||||
* matmul.m4: Likewise.
|
||||
* matmull.m4: Likewise.
|
||||
* nearest.m4: Likewise.
|
||||
* pow.m4: Likewise.
|
||||
* product.m4: Likewise.
|
||||
* reshape.m4: Likewise.
|
||||
* rrspacing.m4: Likewise.
|
||||
* set_exponent.m4: Likewise.
|
||||
* shape.m4: Likewise.
|
||||
* spacing.m4: Likewise.
|
||||
* transpose.m4: Likewise.
|
||||
|
||||
2007-03-14 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
* io/unix.c (regular_file): For ACTION_UNSPECIFIED retry with
|
||||
|
||||
@ -45,6 +45,6 @@ ARRAY_FUNCTION(1,
|
||||
{
|
||||
result = 0;
|
||||
break;
|
||||
}')
|
||||
}')`
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -45,6 +45,6 @@ ARRAY_FUNCTION(0,
|
||||
{
|
||||
result = 1;
|
||||
break;
|
||||
}')
|
||||
}')`
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -41,6 +41,6 @@ include(ifunction.m4)dnl
|
||||
ARRAY_FUNCTION(0,
|
||||
` result = 0;',
|
||||
` if (*src)
|
||||
result++;')
|
||||
result++;')`
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -35,13 +35,13 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'atype_name`)'
|
||||
`#if defined (HAVE_'atype_name`)
|
||||
|
||||
static void
|
||||
cshift1 (gfc_array_char * const restrict ret,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype` * const restrict h,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
index_type size)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
@ -59,7 +59,7 @@ cshift1 (gfc_array_char * const restrict ret,
|
||||
/* h.* indicates the shift array. */
|
||||
index_type hstride[GFC_MAX_DIMENSIONS];
|
||||
index_type hstride0;
|
||||
const atype_name *hptr;
|
||||
const 'atype_name` *hptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
@ -67,7 +67,7 @@ cshift1 (gfc_array_char * const restrict ret,
|
||||
index_type len;
|
||||
index_type n;
|
||||
int which;
|
||||
atype_name sh;
|
||||
'atype_name` sh;
|
||||
|
||||
if (pwhich)
|
||||
which = *pwhich - 1;
|
||||
@ -75,7 +75,7 @@ cshift1 (gfc_array_char * const restrict ret,
|
||||
which = 0;
|
||||
|
||||
if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
|
||||
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
|
||||
runtime_error ("Argument ''`DIM''` is out of range in call to ''`CSHIFT''`");
|
||||
|
||||
if (ret->data == NULL)
|
||||
{
|
||||
@ -198,38 +198,38 @@ cshift1 (gfc_array_char * const restrict ret,
|
||||
}
|
||||
}
|
||||
|
||||
void cshift1_`'atype_kind (gfc_array_char * const restrict,
|
||||
void cshift1_'atype_kind` (gfc_array_char * const restrict,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype * const restrict,
|
||||
const atype_name * const restrict);
|
||||
export_proto(cshift1_`'atype_kind);
|
||||
const 'atype` * const restrict,
|
||||
const 'atype_name` * const restrict);
|
||||
export_proto(cshift1_'atype_kind`);
|
||||
|
||||
void
|
||||
cshift1_`'atype_kind (gfc_array_char * const restrict ret,
|
||||
cshift1_'atype_kind` (gfc_array_char * const restrict ret,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const atype_name * const restrict pwhich)
|
||||
const 'atype` * const restrict h,
|
||||
const 'atype_name` * const restrict pwhich)
|
||||
{
|
||||
cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
|
||||
}
|
||||
|
||||
void cshift1_`'atype_kind`'_char (gfc_array_char * const restrict ret,
|
||||
void cshift1_'atype_kind`_char (gfc_array_char * const restrict ret,
|
||||
GFC_INTEGER_4,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype` * const restrict h,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
GFC_INTEGER_4);
|
||||
export_proto(cshift1_`'atype_kind`'_char);
|
||||
export_proto(cshift1_'atype_kind`_char);
|
||||
|
||||
void
|
||||
cshift1_`'atype_kind`'_char (gfc_array_char * const restrict ret,
|
||||
cshift1_'atype_kind`_char (gfc_array_char * const restrict ret,
|
||||
GFC_INTEGER_4 ret_length __attribute__((unused)),
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype` * const restrict h,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
GFC_INTEGER_4 array_length)
|
||||
{
|
||||
cshift1 (ret, array, h, pwhich, array_length);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -35,14 +35,14 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'atype_name`)'
|
||||
`#if defined (HAVE_'atype_name`)
|
||||
|
||||
static void
|
||||
eoshift1 (gfc_array_char * const restrict ret,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const 'atype` * const restrict h,
|
||||
const char * const restrict pbound,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
index_type size, char filler)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
@ -57,10 +57,10 @@ eoshift1 (gfc_array_char * const restrict ret,
|
||||
index_type soffset;
|
||||
const char *sptr;
|
||||
const char *src;
|
||||
` /* h.* indicates the shift array. */'
|
||||
/* h.* indicates the shift array. */
|
||||
index_type hstride[GFC_MAX_DIMENSIONS];
|
||||
index_type hstride0;
|
||||
const atype_name *hptr;
|
||||
const 'atype_name` *hptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
@ -68,8 +68,8 @@ eoshift1 (gfc_array_char * const restrict ret,
|
||||
index_type len;
|
||||
index_type n;
|
||||
int which;
|
||||
atype_name sh;
|
||||
atype_name delta;
|
||||
'atype_name` sh;
|
||||
'atype_name` delta;
|
||||
|
||||
/* The compiler cannot figure out that these are set, initialize
|
||||
them to avoid warnings. */
|
||||
@ -145,7 +145,7 @@ eoshift1 (gfc_array_char * const restrict ret,
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
` /* Do the shift for this dimension. */'
|
||||
/* Do the shift for this dimension. */
|
||||
sh = *hptr;
|
||||
if (( sh >= 0 ? sh : -sh ) > len)
|
||||
{
|
||||
@ -222,42 +222,42 @@ eoshift1 (gfc_array_char * const restrict ret,
|
||||
}
|
||||
}
|
||||
|
||||
void eoshift1_`'atype_kind (gfc_array_char * const restrict,
|
||||
void eoshift1_'atype_kind` (gfc_array_char * const restrict,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype * const restrict, const char * const restrict,
|
||||
const atype_name * const restrict);
|
||||
export_proto(eoshift1_`'atype_kind);
|
||||
const 'atype` * const restrict, const char * const restrict,
|
||||
const 'atype_name` * const restrict);
|
||||
export_proto(eoshift1_'atype_kind`);
|
||||
|
||||
void
|
||||
eoshift1_`'atype_kind (gfc_array_char * const restrict ret,
|
||||
eoshift1_'atype_kind` (gfc_array_char * const restrict ret,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const 'atype` * const restrict h,
|
||||
const char * const restrict pbound,
|
||||
const atype_name * const restrict pwhich)
|
||||
const 'atype_name` * const restrict pwhich)
|
||||
{
|
||||
eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
|
||||
}
|
||||
|
||||
void eoshift1_`'atype_kind`'_char (gfc_array_char * const restrict,
|
||||
void eoshift1_'atype_kind`_char (gfc_array_char * const restrict,
|
||||
GFC_INTEGER_4,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype * const restrict,
|
||||
const 'atype` * const restrict,
|
||||
const char * const restrict,
|
||||
const atype_name * const restrict,
|
||||
const 'atype_name` * const restrict,
|
||||
GFC_INTEGER_4, GFC_INTEGER_4);
|
||||
export_proto(eoshift1_`'atype_kind`'_char);
|
||||
export_proto(eoshift1_'atype_kind`_char);
|
||||
|
||||
void
|
||||
eoshift1_`'atype_kind`'_char (gfc_array_char * const restrict ret,
|
||||
eoshift1_'atype_kind`_char (gfc_array_char * const restrict ret,
|
||||
GFC_INTEGER_4 ret_length __attribute__((unused)),
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const 'atype` * const restrict h,
|
||||
const char * const restrict pbound,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
GFC_INTEGER_4 array_length,
|
||||
GFC_INTEGER_4 bound_length __attribute__((unused)))
|
||||
{
|
||||
eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
|
||||
eoshift1 (ret, array, h, pbound, pwhich, array_length, ''` ''`);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -35,14 +35,14 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'atype_name`)'
|
||||
`#if defined (HAVE_'atype_name`)
|
||||
|
||||
static void
|
||||
eoshift3 (gfc_array_char * const restrict ret,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const 'atype` * const restrict h,
|
||||
const gfc_array_char * const restrict bound,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
index_type size, char filler)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
@ -57,10 +57,10 @@ eoshift3 (gfc_array_char * const restrict ret,
|
||||
index_type soffset;
|
||||
const char *sptr;
|
||||
const char *src;
|
||||
` /* h.* indicates the shift array. */'
|
||||
/* h.* indicates the shift array. */
|
||||
index_type hstride[GFC_MAX_DIMENSIONS];
|
||||
index_type hstride0;
|
||||
const atype_name *hptr;
|
||||
const 'atype_name` *hptr;
|
||||
/* b.* indicates the bound array. */
|
||||
index_type bstride[GFC_MAX_DIMENSIONS];
|
||||
index_type bstride0;
|
||||
@ -72,8 +72,8 @@ eoshift3 (gfc_array_char * const restrict ret,
|
||||
index_type len;
|
||||
index_type n;
|
||||
int which;
|
||||
atype_name sh;
|
||||
atype_name delta;
|
||||
'atype_name` sh;
|
||||
'atype_name` delta;
|
||||
|
||||
/* The compiler cannot figure out that these are set, initialize
|
||||
them to avoid warnings. */
|
||||
@ -160,7 +160,7 @@ eoshift3 (gfc_array_char * const restrict ret,
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
` /* Do the shift for this dimension. */'
|
||||
/* Do the shift for this dimension. */
|
||||
sh = *hptr;
|
||||
if (( sh >= 0 ? sh : -sh ) > len)
|
||||
{
|
||||
@ -240,43 +240,43 @@ eoshift3 (gfc_array_char * const restrict ret,
|
||||
}
|
||||
}
|
||||
|
||||
extern void eoshift3_`'atype_kind (gfc_array_char * const restrict,
|
||||
extern void eoshift3_'atype_kind` (gfc_array_char * const restrict,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype * const restrict,
|
||||
const 'atype` * const restrict,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype_name *);
|
||||
export_proto(eoshift3_`'atype_kind);
|
||||
const 'atype_name` *);
|
||||
export_proto(eoshift3_'atype_kind`);
|
||||
|
||||
void
|
||||
eoshift3_`'atype_kind (gfc_array_char * const restrict ret,
|
||||
eoshift3_'atype_kind` (gfc_array_char * const restrict ret,
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const 'atype` * const restrict h,
|
||||
const gfc_array_char * const restrict bound,
|
||||
const atype_name * const restrict pwhich)
|
||||
const 'atype_name` * const restrict pwhich)
|
||||
{
|
||||
eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
|
||||
}
|
||||
|
||||
extern void eoshift3_`'atype_kind`'_char (gfc_array_char * const restrict,
|
||||
extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict,
|
||||
GFC_INTEGER_4,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype * const restrict,
|
||||
const 'atype` * const restrict,
|
||||
const gfc_array_char * const restrict,
|
||||
const atype_name * const restrict,
|
||||
const 'atype_name` * const restrict,
|
||||
GFC_INTEGER_4, GFC_INTEGER_4);
|
||||
export_proto(eoshift3_`'atype_kind`'_char);
|
||||
export_proto(eoshift3_'atype_kind`_char);
|
||||
|
||||
void
|
||||
eoshift3_`'atype_kind`'_char (gfc_array_char * const restrict ret,
|
||||
eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret,
|
||||
GFC_INTEGER_4 ret_length __attribute__((unused)),
|
||||
const gfc_array_char * const restrict array,
|
||||
const atype * const restrict h,
|
||||
const 'atype` * const restrict h,
|
||||
const gfc_array_char * const restrict bound,
|
||||
const atype_name * const restrict pwhich,
|
||||
const 'atype_name` * const restrict pwhich,
|
||||
GFC_INTEGER_4 array_length,
|
||||
GFC_INTEGER_4 bound_length __attribute__((unused)))
|
||||
{
|
||||
eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
|
||||
eoshift3 (ret, array, h, bound, pwhich, array_length, ''` ''`);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,17 +34,17 @@ Boston, MA 02110-1301, USA. */
|
||||
|
||||
include(`mtype.m4')dnl
|
||||
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)
|
||||
|
||||
extern GFC_INTEGER_4 exponent_r`'kind (real_type s);
|
||||
export_proto(exponent_r`'kind);
|
||||
extern GFC_INTEGER_4 exponent_r'kind` ('real_type` s);
|
||||
export_proto(exponent_r'kind`);
|
||||
|
||||
GFC_INTEGER_4
|
||||
exponent_r`'kind (real_type s)
|
||||
exponent_r'kind` ('real_type` s)
|
||||
{
|
||||
int ret;
|
||||
frexp`'q (s, &ret);
|
||||
frexp'q` (s, &ret);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,16 +34,16 @@ Boston, MA 02110-1301, USA. */
|
||||
|
||||
include(`mtype.m4')dnl
|
||||
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)
|
||||
|
||||
extern real_type fraction_r`'kind (real_type s);
|
||||
export_proto(fraction_r`'kind);
|
||||
extern 'real_type` fraction_r'kind` ('real_type` s);
|
||||
export_proto(fraction_r'kind`);
|
||||
|
||||
real_type
|
||||
fraction_r`'kind (real_type s)
|
||||
'real_type`
|
||||
fraction_r'kind` ('real_type` s)
|
||||
{
|
||||
int dummy_exp;
|
||||
return frexp`'q (s, &dummy_exp);
|
||||
return frexp'q` (s, &dummy_exp);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,15 +34,15 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)'
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
/* Allocates a block of memory with internal_malloc if the array needs
|
||||
repacking. */
|
||||
|
||||
'
|
||||
dnl The kind (ie size) is used to name the function for logicals, integers
|
||||
dnl and reals. For complex, it's c4 or c8.
|
||||
rtype_name *
|
||||
`internal_pack_'rtype_ccode (rtype * source)
|
||||
rtype_name` *
|
||||
internal_pack_'rtype_ccode` ('rtype` * source)
|
||||
{
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
@ -50,9 +50,9 @@ rtype_name *
|
||||
index_type stride0;
|
||||
index_type dim;
|
||||
index_type ssize;
|
||||
const rtype_name *src;
|
||||
rtype_name *dest;
|
||||
rtype_name *destptr;
|
||||
const 'rtype_name` *src;
|
||||
'rtype_name` *dest;
|
||||
'rtype_name` *destptr;
|
||||
int n;
|
||||
int packed;
|
||||
|
||||
@ -84,7 +84,7 @@ rtype_name *
|
||||
return source->data;
|
||||
|
||||
/* Allocate storage for the destination. */
|
||||
destptr = (rtype_name *)internal_malloc_size (ssize * sizeof (rtype_name));
|
||||
destptr = ('rtype_name` *)internal_malloc_size (ssize * sizeof ('rtype_name`));
|
||||
dest = destptr;
|
||||
src = source->data;
|
||||
stride0 = stride[0];
|
||||
@ -124,3 +124,4 @@ rtype_name *
|
||||
}
|
||||
|
||||
#endif
|
||||
'
|
||||
@ -39,8 +39,8 @@ include(iparm.m4)dnl
|
||||
|
||||
dnl Only the kind (ie size) is used to name the function for integers,
|
||||
dnl reals and logicals. For complex, it's c4 and c8.
|
||||
void
|
||||
`internal_unpack_'rtype_ccode (rtype * d, const rtype_name * src)
|
||||
`void
|
||||
internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * src)
|
||||
{
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
@ -48,7 +48,7 @@ void
|
||||
index_type stride0;
|
||||
index_type dim;
|
||||
index_type dsize;
|
||||
rtype_name *dest;
|
||||
'rtype_name` *dest;
|
||||
int n;
|
||||
|
||||
dest = d->data;
|
||||
@ -73,7 +73,7 @@ void
|
||||
|
||||
if (dsize != 0)
|
||||
{
|
||||
memcpy (dest, src, dsize * sizeof (rtype_name));
|
||||
memcpy (dest, src, dsize * sizeof ('rtype_name`));
|
||||
return;
|
||||
}
|
||||
|
||||
@ -112,3 +112,4 @@ void
|
||||
}
|
||||
|
||||
#endif
|
||||
'
|
||||
@ -35,16 +35,16 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)'
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be
|
||||
passed to us by the front-end, in which case we'll call it for large
|
||||
passed to us by the front-end, in which case we''`ll call it for large
|
||||
matrices. */
|
||||
|
||||
typedef void (*blas_call)(const char *, const char *, const int *, const int *,
|
||||
const int *, const rtype_name *, const rtype_name *,
|
||||
const int *, const rtype_name *, const int *,
|
||||
const rtype_name *, rtype_name *, const int *,
|
||||
const int *, const 'rtype_name` *, const 'rtype_name` *,
|
||||
const int *, const 'rtype_name` *, const int *,
|
||||
const 'rtype_name` *, 'rtype_name` *, const int *,
|
||||
int, int);
|
||||
|
||||
/* The order of loops is different in the case of plain matrix
|
||||
@ -76,19 +76,19 @@ typedef void (*blas_call)(const char *, const char *, const int *, const int *,
|
||||
see if there is a way to perform the matrix multiplication by a call
|
||||
to the BLAS gemm function. */
|
||||
|
||||
extern void matmul_`'rtype_code (rtype * const restrict retarray,
|
||||
rtype * const restrict a, rtype * const restrict b, int try_blas,
|
||||
extern void matmul_'rtype_code` ('rtype` * const restrict retarray,
|
||||
'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
|
||||
int blas_limit, blas_call gemm);
|
||||
export_proto(matmul_`'rtype_code);
|
||||
export_proto(matmul_'rtype_code`);
|
||||
|
||||
void
|
||||
matmul_`'rtype_code (rtype * const restrict retarray,
|
||||
rtype * const restrict a, rtype * const restrict b, int try_blas,
|
||||
matmul_'rtype_code` ('rtype` * const restrict retarray,
|
||||
'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
|
||||
int blas_limit, blas_call gemm)
|
||||
{
|
||||
const rtype_name * restrict abase;
|
||||
const rtype_name * restrict bbase;
|
||||
rtype_name * restrict dest;
|
||||
const 'rtype_name` * restrict abase;
|
||||
const 'rtype_name` * restrict bbase;
|
||||
'rtype_name` * restrict dest;
|
||||
|
||||
index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
|
||||
index_type x, y, n, count, xcount, ycount;
|
||||
@ -133,12 +133,12 @@ matmul_`'rtype_code (rtype * const restrict retarray,
|
||||
}
|
||||
|
||||
retarray->data
|
||||
= internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) retarray));
|
||||
= internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
|
||||
retarray->offset = 0;
|
||||
}
|
||||
|
||||
'
|
||||
sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
|
||||
`
|
||||
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
|
||||
{
|
||||
/* One-dimensional result may be addressed in the code below
|
||||
@ -196,7 +196,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
dest = retarray->data;
|
||||
|
||||
|
||||
/* Now that everything is set up, we're performing the multiplication
|
||||
/* Now that everything is set up, we''`re performing the multiplication
|
||||
itself. */
|
||||
|
||||
#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x)))
|
||||
@ -207,7 +207,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
> POW3(blas_limit)))
|
||||
{
|
||||
const int m = xcount, n = ycount, k = count, ldc = rystride;
|
||||
const rtype_name one = 1, zero = 0;
|
||||
const 'rtype_name` one = 1, zero = 0;
|
||||
const int lda = (axstride == 1) ? aystride : axstride,
|
||||
ldb = (bxstride == 1) ? bystride : bxstride;
|
||||
|
||||
@ -222,18 +222,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
|
||||
if (rxstride == 1 && axstride == 1 && bxstride == 1)
|
||||
{
|
||||
const rtype_name * restrict bbase_y;
|
||||
rtype_name * restrict dest_y;
|
||||
const rtype_name * restrict abase_n;
|
||||
rtype_name bbase_yn;
|
||||
const 'rtype_name` * restrict bbase_y;
|
||||
'rtype_name` * restrict dest_y;
|
||||
const 'rtype_name` * restrict abase_n;
|
||||
'rtype_name` bbase_yn;
|
||||
|
||||
if (rystride == xcount)
|
||||
memset (dest, 0, (sizeof (rtype_name) * xcount * ycount));
|
||||
memset (dest, 0, (sizeof ('rtype_name`) * xcount * ycount));
|
||||
else
|
||||
{
|
||||
for (y = 0; y < ycount; y++)
|
||||
for (x = 0; x < xcount; x++)
|
||||
dest[x + y*rystride] = (rtype_name)0;
|
||||
dest[x + y*rystride] = ('rtype_name`)0;
|
||||
}
|
||||
|
||||
for (y = 0; y < ycount; y++)
|
||||
@ -255,10 +255,10 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
{
|
||||
if (GFC_DESCRIPTOR_RANK (a) != 1)
|
||||
{
|
||||
const rtype_name *restrict abase_x;
|
||||
const rtype_name *restrict bbase_y;
|
||||
rtype_name *restrict dest_y;
|
||||
rtype_name s;
|
||||
const 'rtype_name` *restrict abase_x;
|
||||
const 'rtype_name` *restrict bbase_y;
|
||||
'rtype_name` *restrict dest_y;
|
||||
'rtype_name` s;
|
||||
|
||||
for (y = 0; y < ycount; y++)
|
||||
{
|
||||
@ -267,7 +267,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
for (x = 0; x < xcount; x++)
|
||||
{
|
||||
abase_x = &abase[x*axstride];
|
||||
s = (rtype_name) 0;
|
||||
s = ('rtype_name`) 0;
|
||||
for (n = 0; n < count; n++)
|
||||
s += abase_x[n] * bbase_y[n];
|
||||
dest_y[x] = s;
|
||||
@ -276,13 +276,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
}
|
||||
else
|
||||
{
|
||||
const rtype_name *restrict bbase_y;
|
||||
rtype_name s;
|
||||
const 'rtype_name` *restrict bbase_y;
|
||||
'rtype_name` s;
|
||||
|
||||
for (y = 0; y < ycount; y++)
|
||||
{
|
||||
bbase_y = &bbase[y*bystride];
|
||||
s = (rtype_name) 0;
|
||||
s = ('rtype_name`) 0;
|
||||
for (n = 0; n < count; n++)
|
||||
s += abase[n*axstride] * bbase_y[n];
|
||||
dest[y*rystride] = s;
|
||||
@ -293,7 +293,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
{
|
||||
for (y = 0; y < ycount; y++)
|
||||
for (x = 0; x < xcount; x++)
|
||||
dest[x*rxstride + y*rystride] = (rtype_name)0;
|
||||
dest[x*rxstride + y*rystride] = ('rtype_name`)0;
|
||||
|
||||
for (y = 0; y < ycount; y++)
|
||||
for (n = 0; n < count; n++)
|
||||
@ -303,13 +303,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
}
|
||||
else if (GFC_DESCRIPTOR_RANK (a) == 1)
|
||||
{
|
||||
const rtype_name *restrict bbase_y;
|
||||
rtype_name s;
|
||||
const 'rtype_name` *restrict bbase_y;
|
||||
'rtype_name` s;
|
||||
|
||||
for (y = 0; y < ycount; y++)
|
||||
{
|
||||
bbase_y = &bbase[y*bystride];
|
||||
s = (rtype_name) 0;
|
||||
s = ('rtype_name`) 0;
|
||||
for (n = 0; n < count; n++)
|
||||
s += abase[n*axstride] * bbase_y[n*bxstride];
|
||||
dest[y*rxstride] = s;
|
||||
@ -317,10 +317,10 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
}
|
||||
else
|
||||
{
|
||||
const rtype_name *restrict abase_x;
|
||||
const rtype_name *restrict bbase_y;
|
||||
rtype_name *restrict dest_y;
|
||||
rtype_name s;
|
||||
const 'rtype_name` *restrict abase_x;
|
||||
const 'rtype_name` *restrict bbase_y;
|
||||
'rtype_name` *restrict dest_y;
|
||||
'rtype_name` s;
|
||||
|
||||
for (y = 0; y < ycount; y++)
|
||||
{
|
||||
@ -329,7 +329,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
for (x = 0; x < xcount; x++)
|
||||
{
|
||||
abase_x = &abase[x*axstride];
|
||||
s = (rtype_name) 0;
|
||||
s = ('rtype_name`) 0;
|
||||
for (n = 0; n < count; n++)
|
||||
s += abase_x[n*aystride] * bbase_y[n*bxstride];
|
||||
dest_y[x*rxstride] = s;
|
||||
@ -338,4 +338,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,22 +34,22 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)'
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
/* Dimensions: retarray(x,y) a(x, count) b(count,y).
|
||||
Either a or b can be rank 1. In this case x or y is 1. */
|
||||
|
||||
extern void matmul_`'rtype_code (rtype * const restrict,
|
||||
extern void matmul_'rtype_code` ('rtype` * const restrict,
|
||||
gfc_array_l4 * const restrict, gfc_array_l4 * const restrict);
|
||||
export_proto(matmul_`'rtype_code);
|
||||
export_proto(matmul_'rtype_code`);
|
||||
|
||||
void
|
||||
matmul_`'rtype_code (rtype * const restrict retarray,
|
||||
matmul_'rtype_code` ('rtype` * const restrict retarray,
|
||||
gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b)
|
||||
{
|
||||
const GFC_INTEGER_4 * restrict abase;
|
||||
const GFC_INTEGER_4 * restrict bbase;
|
||||
rtype_name * restrict dest;
|
||||
'rtype_name` * restrict dest;
|
||||
index_type rxstride;
|
||||
index_type rystride;
|
||||
index_type xcount;
|
||||
@ -95,7 +95,7 @@ matmul_`'rtype_code (rtype * const restrict retarray,
|
||||
}
|
||||
|
||||
retarray->data
|
||||
= internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) retarray));
|
||||
= internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
|
||||
retarray->offset = 0;
|
||||
}
|
||||
|
||||
@ -112,9 +112,9 @@ matmul_`'rtype_code (rtype * const restrict retarray,
|
||||
bbase = GFOR_POINTER_L8_TO_L4 (bbase);
|
||||
}
|
||||
dest = retarray->data;
|
||||
|
||||
'
|
||||
sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
|
||||
`
|
||||
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
|
||||
{
|
||||
rxstride = retarray->dim[0].stride;
|
||||
@ -191,3 +191,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||
}
|
||||
|
||||
#endif
|
||||
'
|
||||
@ -35,23 +35,23 @@ Boston, MA 02110-1301, USA. */
|
||||
|
||||
include(`mtype.m4')dnl
|
||||
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_COPYSIGN'Q`) && defined (HAVE_NEXTAFTER'Q`)'
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_COPYSIGN'Q`) && defined (HAVE_NEXTAFTER'Q`)
|
||||
|
||||
extern real_type nearest_r`'kind (real_type s, real_type dir);
|
||||
export_proto(nearest_r`'kind);
|
||||
extern 'real_type` nearest_r'kind` ('real_type` s, 'real_type` dir);
|
||||
export_proto(nearest_r'kind`);
|
||||
|
||||
real_type
|
||||
nearest_r`'kind (real_type s, real_type dir)
|
||||
'real_type`
|
||||
nearest_r'kind` ('real_type` s, 'real_type` dir)
|
||||
{
|
||||
dir = copysign`'q (__builtin_inf`'q (), dir);
|
||||
dir = copysign'q` (__builtin_inf'q` (), dir);
|
||||
if (FLT_EVAL_METHOD != 0)
|
||||
{
|
||||
/* ??? Work around glibc bug on x86. */
|
||||
volatile real_type r = nextafter`'q (s, dir);
|
||||
volatile 'real_type` r = nextafter'q` (s, dir);
|
||||
return r;
|
||||
}
|
||||
else
|
||||
return nextafter`'q (s, dir);
|
||||
return nextafter'q` (s, dir);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -39,15 +39,15 @@ include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)'
|
||||
|
||||
rtype_name `pow_'rtype_code`_'atype_code (rtype_name a, atype_name b);
|
||||
export_proto(pow_`'rtype_code`_'atype_code);
|
||||
rtype_name `pow_'rtype_code`_'atype_code` ('rtype_name` a, 'atype_name` b);
|
||||
export_proto(pow_'rtype_code`_'atype_code`);
|
||||
|
||||
rtype_name
|
||||
`pow_'rtype_code`_'atype_code (rtype_name a, atype_name b)
|
||||
'rtype_name`
|
||||
pow_'rtype_code`_'atype_code` ('rtype_name` a, 'atype_name` b)
|
||||
{
|
||||
rtype_name pow, x;
|
||||
atype_name n;
|
||||
`GFC_UINTEGER_'atype_kind` u;'
|
||||
'rtype_name` pow, x;
|
||||
'atype_name` n;
|
||||
GFC_UINTEGER_'atype_kind` u;
|
||||
|
||||
n = b;
|
||||
x = a;
|
||||
@ -56,7 +56,7 @@ rtype_name
|
||||
{
|
||||
if (n < 0)
|
||||
{
|
||||
ifelse(rtype_letter,i,`dnl
|
||||
'ifelse(rtype_letter,i,`dnl
|
||||
if (x == 1)
|
||||
return 1;
|
||||
if (x == -1)
|
||||
@ -66,7 +66,7 @@ ifelse(rtype_letter,i,`dnl
|
||||
u = -n;
|
||||
x = pow / x;
|
||||
')dnl
|
||||
}
|
||||
` }
|
||||
else
|
||||
{
|
||||
u = n;
|
||||
@ -85,4 +85,4 @@ ifelse(rtype_letter,i,`dnl
|
||||
return pow;
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -49,4 +49,4 @@ MASKED_ARRAY_FUNCTION(1,
|
||||
|
||||
SCALAR_ARRAY_FUNCTION(1)
|
||||
|
||||
#endif
|
||||
`#endif'
|
||||
|
||||
@ -34,27 +34,27 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)'
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
|
||||
typedef GFC_ARRAY_DESCRIPTOR(1, 'index_type`) 'shape_type`;'
|
||||
|
||||
dnl For integer routines, only the kind (ie size) is used to name the
|
||||
dnl function. The same function will be used for integer and logical
|
||||
dnl arrays of the same kind.
|
||||
|
||||
extern void reshape_`'rtype_ccode (rtype * const restrict,
|
||||
rtype * const restrict,
|
||||
shape_type * const restrict,
|
||||
rtype * const restrict,
|
||||
shape_type * const restrict);
|
||||
export_proto(reshape_`'rtype_ccode);
|
||||
`extern void reshape_'rtype_ccode` ('rtype` * const restrict,
|
||||
'rtype` * const restrict,
|
||||
'shape_type` * const restrict,
|
||||
'rtype` * const restrict,
|
||||
'shape_type` * const restrict);
|
||||
export_proto(reshape_'rtype_ccode`);
|
||||
|
||||
void
|
||||
reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
rtype * const restrict source,
|
||||
shape_type * const restrict shape,
|
||||
rtype * const restrict pad,
|
||||
shape_type * const restrict order)
|
||||
reshape_'rtype_ccode` ('rtype` * const restrict ret,
|
||||
'rtype` * const restrict source,
|
||||
'shape_type` * const restrict shape,
|
||||
'rtype` * const restrict pad,
|
||||
'shape_type` * const restrict order)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rcount[GFC_MAX_DIMENSIONS];
|
||||
@ -65,7 +65,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
index_type rsize;
|
||||
index_type rs;
|
||||
index_type rex;
|
||||
rtype_name *rptr;
|
||||
'rtype_name` *rptr;
|
||||
/* s.* indicates the source array. */
|
||||
index_type scount[GFC_MAX_DIMENSIONS];
|
||||
index_type sextent[GFC_MAX_DIMENSIONS];
|
||||
@ -73,16 +73,16 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
index_type sstride0;
|
||||
index_type sdim;
|
||||
index_type ssize;
|
||||
const rtype_name *sptr;
|
||||
const 'rtype_name` *sptr;
|
||||
/* p.* indicates the pad array. */
|
||||
index_type pcount[GFC_MAX_DIMENSIONS];
|
||||
index_type pextent[GFC_MAX_DIMENSIONS];
|
||||
index_type pstride[GFC_MAX_DIMENSIONS];
|
||||
index_type pdim;
|
||||
index_type psize;
|
||||
const rtype_name *pptr;
|
||||
const 'rtype_name` *pptr;
|
||||
|
||||
const rtype_name *src;
|
||||
const 'rtype_name` *src;
|
||||
int n;
|
||||
int dim;
|
||||
int sempty, pempty;
|
||||
@ -100,7 +100,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
rs *= rex;
|
||||
}
|
||||
ret->offset = 0;
|
||||
ret->data = internal_malloc_size ( rs * sizeof (rtype_name));
|
||||
ret->data = internal_malloc_size ( rs * sizeof ('rtype_name`));
|
||||
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
|
||||
}
|
||||
else
|
||||
@ -184,9 +184,9 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
|
||||
if (rsize != 0 && ssize != 0 && psize != 0)
|
||||
{
|
||||
rsize *= sizeof (rtype_name);
|
||||
ssize *= sizeof (rtype_name);
|
||||
psize *= sizeof (rtype_name);
|
||||
rsize *= sizeof ('rtype_name`);
|
||||
ssize *= sizeof ('rtype_name`);
|
||||
psize *= sizeof ('rtype_name`);
|
||||
reshape_packed ((char *)ret->data, rsize, (char *)source->data,
|
||||
ssize, pad ? (char *)pad->data : NULL, psize);
|
||||
return;
|
||||
@ -210,7 +210,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
scount[dim] = pcount[dim];
|
||||
sextent[dim] = pextent[dim];
|
||||
sstride[dim] = pstride[dim];
|
||||
sstride0 = sstride[0] * sizeof (rtype_name);
|
||||
sstride0 = sstride[0] * sizeof ('rtype_name`);
|
||||
}
|
||||
}
|
||||
|
||||
@ -286,4 +286,4 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,26 +34,26 @@ Boston, MA 02110-1301, USA. */
|
||||
|
||||
include(`mtype.m4')dnl
|
||||
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FABS'Q`) && defined (HAVE_FREXP'Q`)'
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FABS'Q`) && defined (HAVE_FREXP'Q`)
|
||||
|
||||
extern real_type rrspacing_r`'kind (real_type s, int p);
|
||||
export_proto(rrspacing_r`'kind);
|
||||
extern 'real_type` rrspacing_r'kind` ('real_type` s, int p);
|
||||
export_proto(rrspacing_r'kind`);
|
||||
|
||||
real_type
|
||||
rrspacing_r`'kind (real_type s, int p)
|
||||
'real_type`
|
||||
rrspacing_r'kind` ('real_type` s, int p)
|
||||
{
|
||||
int e;
|
||||
real_type x;
|
||||
x = fabs`'q (s);
|
||||
'real_type` x;
|
||||
x = fabs'q` (s);
|
||||
if (x == 0.)
|
||||
return 0.;
|
||||
frexp`'q (s, &e);
|
||||
`#if defined (HAVE_LDEXP'Q`)'
|
||||
return ldexp`'q (x, p - e);
|
||||
frexp'q` (s, &e);
|
||||
#if defined (HAVE_LDEXP'Q`)
|
||||
return ldexp'q` (x, p - e);
|
||||
#else
|
||||
return scalbn`'q (x, p - e);
|
||||
return scalbn'q` (x, p - e);
|
||||
#endif
|
||||
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,16 +34,16 @@ Boston, MA 02110-1301, USA. */
|
||||
|
||||
include(`mtype.m4')dnl
|
||||
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)'
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)
|
||||
|
||||
extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i);
|
||||
export_proto(set_exponent_r`'kind);
|
||||
extern 'real_type` set_exponent_r'kind` ('real_type` s, GFC_INTEGER_4 i);
|
||||
export_proto(set_exponent_r'kind`);
|
||||
|
||||
real_type
|
||||
set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i)
|
||||
'real_type`
|
||||
set_exponent_r'kind` ('real_type` s, GFC_INTEGER_4 i)
|
||||
{
|
||||
int dummy_exp;
|
||||
return scalbn`'q (frexp`'q (s, &dummy_exp), i);
|
||||
return scalbn'q` (frexp'q` (s, &dummy_exp), i);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,15 +34,15 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)'
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
extern void shape_`'rtype_kind (rtype * const restrict ret,
|
||||
const rtype * const restrict array);
|
||||
export_proto(shape_`'rtype_kind);
|
||||
extern void shape_'rtype_kind` ('rtype` * const restrict ret,
|
||||
const 'rtype` * const restrict array);
|
||||
export_proto(shape_'rtype_kind`);
|
||||
|
||||
void
|
||||
shape_`'rtype_kind (rtype * const restrict ret,
|
||||
const rtype * const restrict array)
|
||||
shape_'rtype_kind` ('rtype` * const restrict ret,
|
||||
const 'rtype` * const restrict array)
|
||||
{
|
||||
int n;
|
||||
index_type stride;
|
||||
@ -56,4 +56,4 @@ shape_`'rtype_kind (rtype * const restrict ret,
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -34,25 +34,25 @@ Boston, MA 02110-1301, USA. */
|
||||
|
||||
include(`mtype.m4')dnl
|
||||
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
|
||||
`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)
|
||||
|
||||
extern real_type spacing_r`'kind (real_type s, int p, int emin, real_type tiny);
|
||||
export_proto(spacing_r`'kind);
|
||||
extern 'real_type` spacing_r'kind` ('real_type` s, int p, int emin, 'real_type` tiny);
|
||||
export_proto(spacing_r'kind`);
|
||||
|
||||
real_type
|
||||
spacing_r`'kind (real_type s, int p, int emin, real_type tiny)
|
||||
'real_type`
|
||||
spacing_r'kind` ('real_type` s, int p, int emin, 'real_type` tiny)
|
||||
{
|
||||
int e;
|
||||
if (s == 0.)
|
||||
return tiny;
|
||||
frexp`'q (s, &e);
|
||||
frexp'q` (s, &e);
|
||||
e = e - p;
|
||||
e = e > emin ? e : emin;
|
||||
`#if defined (HAVE_LDEXP'Q`)'
|
||||
return ldexp`'q (1., e);
|
||||
#if defined (HAVE_LDEXP'Q`)
|
||||
return ldexp'q` (1., e);
|
||||
#else
|
||||
return scalbn`'q (1., e);
|
||||
return scalbn'q` (1., e);
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
@ -33,22 +33,22 @@ Boston, MA 02110-1301, USA. */
|
||||
#include "libgfortran.h"'
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)'
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
extern void transpose_`'rtype_code (rtype * const restrict ret,
|
||||
rtype * const restrict source);
|
||||
export_proto(transpose_`'rtype_code);
|
||||
extern void transpose_'rtype_code` ('rtype` * const restrict ret,
|
||||
'rtype` * const restrict source);
|
||||
export_proto(transpose_'rtype_code`);
|
||||
|
||||
void
|
||||
transpose_`'rtype_code (rtype * const restrict ret,
|
||||
rtype * const restrict source)
|
||||
transpose_'rtype_code` ('rtype` * const restrict ret,
|
||||
'rtype` * const restrict source)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rxstride, rystride;
|
||||
rtype_name *rptr;
|
||||
'rtype_name` *rptr;
|
||||
/* s.* indicates the source array. */
|
||||
index_type sxstride, systride;
|
||||
const rtype_name *sptr;
|
||||
const 'rtype_name` *sptr;
|
||||
|
||||
index_type xcount, ycount;
|
||||
index_type x, y;
|
||||
@ -68,7 +68,7 @@ transpose_`'rtype_code (rtype * const restrict ret,
|
||||
ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
|
||||
ret->dim[1].stride = ret->dim[0].ubound+1;
|
||||
|
||||
ret->data = internal_malloc_size (sizeof (rtype_name) * size0 ((array_t *) ret));
|
||||
ret->data = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) ret));
|
||||
ret->offset = 0;
|
||||
}
|
||||
|
||||
@ -97,4 +97,4 @@ transpose_`'rtype_code (rtype * const restrict ret,
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif'
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user