+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
{
result = 0;
break;
- }')
+ }')`
-#endif
+#endif'
{
result = 1;
break;
- }')
+ }')`
-#endif
+#endif'
ARRAY_FUNCTION(0,
` result = 0;',
` if (*src)
- result++;')
+ result++;')`
-#endif
+#endif'
#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. */
/* 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];
index_type len;
index_type n;
int which;
- atype_name sh;
+ 'atype_name` sh;
if (pwhich)
which = *pwhich - 1;
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)
{
}
}
-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'
#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. */
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];
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. */
while (rptr)
{
-` /* Do the shift for this dimension. */'
+ /* Do the shift for this dimension. */
sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
}
}
-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'
#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. */
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;
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. */
while (rptr)
{
-` /* Do the shift for this dimension. */'
+ /* Do the shift for this dimension. */
sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
}
}
-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'
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'
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'
#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];
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;
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];
}
#endif
+'
\ No newline at end of file
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];
index_type stride0;
index_type dim;
index_type dsize;
- rtype_name *dest;
+ 'rtype_name` *dest;
int n;
dest = d->data;
if (dsize != 0)
{
- memcpy (dest, src, dsize * sizeof (rtype_name));
+ memcpy (dest, src, dsize * sizeof ('rtype_name`));
return;
}
}
#endif
+'
\ No newline at end of file
#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
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;
}
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
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)))
> 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;
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++)
{
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++)
{
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;
}
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;
{
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++)
}
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;
}
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++)
{
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;
}
}
-#endif
+#endif'
#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;
}
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;
}
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;
}
#endif
+'
\ No newline at end of file
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'
`#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;
{
if (n < 0)
{
-ifelse(rtype_letter,i,`dnl
+'ifelse(rtype_letter,i,`dnl
if (x == 1)
return 1;
if (x == -1)
u = -n;
x = pow / x;
')dnl
- }
+` }
else
{
u = n;
return pow;
}
-#endif
+#endif'
SCALAR_ARRAY_FUNCTION(1)
-#endif
+`#endif'
#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];
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];
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;
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
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;
scount[dim] = pcount[dim];
sextent[dim] = pextent[dim];
sstride[dim] = pstride[dim];
- sstride0 = sstride[0] * sizeof (rtype_name);
+ sstride0 = sstride[0] * sizeof ('rtype_name`);
}
}
}
}
-#endif
+#endif'
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'
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'
#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;
}
}
-#endif
+#endif'
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'
#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;
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;
}
}
}
-#endif
+#endif'