Commit adea5e16 by Thomas Koenig Committed by Thomas Koenig

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
parent 286d12f9
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> 2007-03-14 Jakub Jelinek <jakub@redhat.com>
* io/unix.c (regular_file): For ACTION_UNSPECIFIED retry with * io/unix.c (regular_file): For ACTION_UNSPECIFIED retry with
......
...@@ -45,6 +45,6 @@ ARRAY_FUNCTION(1, ...@@ -45,6 +45,6 @@ ARRAY_FUNCTION(1,
{ {
result = 0; result = 0;
break; break;
}') }')`
#endif #endif'
...@@ -45,6 +45,6 @@ ARRAY_FUNCTION(0, ...@@ -45,6 +45,6 @@ ARRAY_FUNCTION(0,
{ {
result = 1; result = 1;
break; break;
}') }')`
#endif #endif'
...@@ -41,6 +41,6 @@ include(ifunction.m4)dnl ...@@ -41,6 +41,6 @@ include(ifunction.m4)dnl
ARRAY_FUNCTION(0, ARRAY_FUNCTION(0,
` result = 0;', ` result = 0;',
` if (*src) ` if (*src)
result++;') result++;')`
#endif #endif'
...@@ -35,13 +35,13 @@ Boston, MA 02110-1301, USA. */ ...@@ -35,13 +35,13 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl include(iparm.m4)dnl
`#if defined (HAVE_'atype_name`)' `#if defined (HAVE_'atype_name`)
static void static void
cshift1 (gfc_array_char * const restrict ret, cshift1 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array, const gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const atype_name * const restrict pwhich, const 'atype_name` * const restrict pwhich,
index_type size) index_type size)
{ {
/* r.* indicates the return array. */ /* r.* indicates the return array. */
...@@ -59,7 +59,7 @@ cshift1 (gfc_array_char * const restrict ret, ...@@ -59,7 +59,7 @@ cshift1 (gfc_array_char * const restrict ret,
/* h.* indicates the shift array. */ /* h.* indicates the shift array. */
index_type hstride[GFC_MAX_DIMENSIONS]; index_type hstride[GFC_MAX_DIMENSIONS];
index_type hstride0; index_type hstride0;
const atype_name *hptr; const 'atype_name` *hptr;
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
...@@ -67,7 +67,7 @@ cshift1 (gfc_array_char * const restrict ret, ...@@ -67,7 +67,7 @@ cshift1 (gfc_array_char * const restrict ret,
index_type len; index_type len;
index_type n; index_type n;
int which; int which;
atype_name sh; 'atype_name` sh;
if (pwhich) if (pwhich)
which = *pwhich - 1; which = *pwhich - 1;
...@@ -75,7 +75,7 @@ cshift1 (gfc_array_char * const restrict ret, ...@@ -75,7 +75,7 @@ cshift1 (gfc_array_char * const restrict ret,
which = 0; which = 0;
if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) 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) if (ret->data == NULL)
{ {
...@@ -198,38 +198,38 @@ cshift1 (gfc_array_char * const restrict ret, ...@@ -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 gfc_array_char * const restrict,
const atype * const restrict, const 'atype` * const restrict,
const atype_name * const restrict); const 'atype_name` * const restrict);
export_proto(cshift1_`'atype_kind); export_proto(cshift1_'atype_kind`);
void 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 gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const atype_name * const restrict pwhich) const 'atype_name` * const restrict pwhich)
{ {
cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); 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, GFC_INTEGER_4,
const gfc_array_char * const restrict array, const gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const atype_name * const restrict pwhich, const 'atype_name` * const restrict pwhich,
GFC_INTEGER_4); GFC_INTEGER_4);
export_proto(cshift1_`'atype_kind`'_char); export_proto(cshift1_'atype_kind`_char);
void 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)), GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char * const restrict array, const gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const atype_name * const restrict pwhich, const 'atype_name` * const restrict pwhich,
GFC_INTEGER_4 array_length) GFC_INTEGER_4 array_length)
{ {
cshift1 (ret, array, h, pwhich, array_length); cshift1 (ret, array, h, pwhich, array_length);
} }
#endif #endif'
...@@ -35,14 +35,14 @@ Boston, MA 02110-1301, USA. */ ...@@ -35,14 +35,14 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl include(iparm.m4)dnl
`#if defined (HAVE_'atype_name`)' `#if defined (HAVE_'atype_name`)
static void static void
eoshift1 (gfc_array_char * const restrict ret, eoshift1 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array, const gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const char * const restrict pbound, const char * const restrict pbound,
const atype_name * const restrict pwhich, const 'atype_name` * const restrict pwhich,
index_type size, char filler) index_type size, char filler)
{ {
/* r.* indicates the return array. */ /* r.* indicates the return array. */
...@@ -57,10 +57,10 @@ eoshift1 (gfc_array_char * const restrict ret, ...@@ -57,10 +57,10 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type soffset; index_type soffset;
const char *sptr; const char *sptr;
const char *src; const char *src;
` /* h.* indicates the shift array. */' /* h.* indicates the shift array. */
index_type hstride[GFC_MAX_DIMENSIONS]; index_type hstride[GFC_MAX_DIMENSIONS];
index_type hstride0; index_type hstride0;
const atype_name *hptr; const 'atype_name` *hptr;
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
...@@ -68,8 +68,8 @@ eoshift1 (gfc_array_char * const restrict ret, ...@@ -68,8 +68,8 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type len; index_type len;
index_type n; index_type n;
int which; int which;
atype_name sh; 'atype_name` sh;
atype_name delta; 'atype_name` delta;
/* The compiler cannot figure out that these are set, initialize /* The compiler cannot figure out that these are set, initialize
them to avoid warnings. */ them to avoid warnings. */
...@@ -145,7 +145,7 @@ eoshift1 (gfc_array_char * const restrict ret, ...@@ -145,7 +145,7 @@ eoshift1 (gfc_array_char * const restrict ret,
while (rptr) while (rptr)
{ {
` /* Do the shift for this dimension. */' /* Do the shift for this dimension. */
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len) if (( sh >= 0 ? sh : -sh ) > len)
{ {
...@@ -222,42 +222,42 @@ eoshift1 (gfc_array_char * const restrict ret, ...@@ -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 gfc_array_char * const restrict,
const atype * const restrict, const char * const restrict, const 'atype` * const restrict, const char * const restrict,
const atype_name * const restrict); const 'atype_name` * const restrict);
export_proto(eoshift1_`'atype_kind); export_proto(eoshift1_'atype_kind`);
void 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 gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const char * const restrict pbound, 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); 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, GFC_INTEGER_4,
const gfc_array_char * const restrict, const gfc_array_char * const restrict,
const atype * const restrict, const 'atype` * const restrict,
const char * const restrict, const char * const restrict,
const atype_name * const restrict, const 'atype_name` * const restrict,
GFC_INTEGER_4, GFC_INTEGER_4); GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(eoshift1_`'atype_kind`'_char); export_proto(eoshift1_'atype_kind`_char);
void 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)), GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char * const restrict array, const gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const char * const restrict pbound, 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 array_length,
GFC_INTEGER_4 bound_length __attribute__((unused))) 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. */ ...@@ -35,14 +35,14 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl include(iparm.m4)dnl
`#if defined (HAVE_'atype_name`)' `#if defined (HAVE_'atype_name`)
static void static void
eoshift3 (gfc_array_char * const restrict ret, eoshift3 (gfc_array_char * const restrict ret,
const gfc_array_char * const restrict array, 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 gfc_array_char * const restrict bound,
const atype_name * const restrict pwhich, const 'atype_name` * const restrict pwhich,
index_type size, char filler) index_type size, char filler)
{ {
/* r.* indicates the return array. */ /* r.* indicates the return array. */
...@@ -57,10 +57,10 @@ eoshift3 (gfc_array_char * const restrict ret, ...@@ -57,10 +57,10 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type soffset; index_type soffset;
const char *sptr; const char *sptr;
const char *src; const char *src;
` /* h.* indicates the shift array. */' /* h.* indicates the shift array. */
index_type hstride[GFC_MAX_DIMENSIONS]; index_type hstride[GFC_MAX_DIMENSIONS];
index_type hstride0; index_type hstride0;
const atype_name *hptr; const 'atype_name` *hptr;
/* b.* indicates the bound array. */ /* b.* indicates the bound array. */
index_type bstride[GFC_MAX_DIMENSIONS]; index_type bstride[GFC_MAX_DIMENSIONS];
index_type bstride0; index_type bstride0;
...@@ -72,8 +72,8 @@ eoshift3 (gfc_array_char * const restrict ret, ...@@ -72,8 +72,8 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type len; index_type len;
index_type n; index_type n;
int which; int which;
atype_name sh; 'atype_name` sh;
atype_name delta; 'atype_name` delta;
/* The compiler cannot figure out that these are set, initialize /* The compiler cannot figure out that these are set, initialize
them to avoid warnings. */ them to avoid warnings. */
...@@ -160,7 +160,7 @@ eoshift3 (gfc_array_char * const restrict ret, ...@@ -160,7 +160,7 @@ eoshift3 (gfc_array_char * const restrict ret,
while (rptr) while (rptr)
{ {
` /* Do the shift for this dimension. */' /* Do the shift for this dimension. */
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len) if (( sh >= 0 ? sh : -sh ) > len)
{ {
...@@ -240,43 +240,43 @@ eoshift3 (gfc_array_char * const restrict ret, ...@@ -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 gfc_array_char * const restrict,
const atype * const restrict, const 'atype` * const restrict,
const gfc_array_char * const restrict, const gfc_array_char * const restrict,
const atype_name *); const 'atype_name` *);
export_proto(eoshift3_`'atype_kind); export_proto(eoshift3_'atype_kind`);
void 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 gfc_array_char * const restrict array,
const atype * const restrict h, const 'atype` * const restrict h,
const gfc_array_char * const restrict bound, 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); 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, GFC_INTEGER_4,
const 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 gfc_array_char * const restrict,
const atype_name * const restrict, const 'atype_name` * const restrict,
GFC_INTEGER_4, GFC_INTEGER_4); GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(eoshift3_`'atype_kind`'_char); export_proto(eoshift3_'atype_kind`_char);
void 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)), GFC_INTEGER_4 ret_length __attribute__((unused)),
const gfc_array_char * const restrict array, 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 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 array_length,
GFC_INTEGER_4 bound_length __attribute__((unused))) 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. */ ...@@ -34,17 +34,17 @@ Boston, MA 02110-1301, USA. */
include(`mtype.m4')dnl 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); extern GFC_INTEGER_4 exponent_r'kind` ('real_type` s);
export_proto(exponent_r`'kind); export_proto(exponent_r'kind`);
GFC_INTEGER_4 GFC_INTEGER_4
exponent_r`'kind (real_type s) exponent_r'kind` ('real_type` s)
{ {
int ret; int ret;
frexp`'q (s, &ret); frexp'q` (s, &ret);
return ret; return ret;
} }
#endif #endif'
...@@ -34,16 +34,16 @@ Boston, MA 02110-1301, USA. */ ...@@ -34,16 +34,16 @@ Boston, MA 02110-1301, USA. */
include(`mtype.m4')dnl 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); extern 'real_type` fraction_r'kind` ('real_type` s);
export_proto(fraction_r`'kind); export_proto(fraction_r'kind`);
real_type 'real_type`
fraction_r`'kind (real_type s) fraction_r'kind` ('real_type` s)
{ {
int dummy_exp; 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. */ ...@@ -34,15 +34,15 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl 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 /* Allocates a block of memory with internal_malloc if the array needs
repacking. */ repacking. */
'
dnl The kind (ie size) is used to name the function for logicals, integers dnl The kind (ie size) is used to name the function for logicals, integers
dnl and reals. For complex, it's c4 or c8. dnl and reals. For complex, it's c4 or c8.
rtype_name * rtype_name` *
`internal_pack_'rtype_ccode (rtype * source) internal_pack_'rtype_ccode` ('rtype` * source)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
...@@ -50,9 +50,9 @@ rtype_name * ...@@ -50,9 +50,9 @@ rtype_name *
index_type stride0; index_type stride0;
index_type dim; index_type dim;
index_type ssize; index_type ssize;
const rtype_name *src; const 'rtype_name` *src;
rtype_name *dest; 'rtype_name` *dest;
rtype_name *destptr; 'rtype_name` *destptr;
int n; int n;
int packed; int packed;
...@@ -84,7 +84,7 @@ rtype_name * ...@@ -84,7 +84,7 @@ rtype_name *
return source->data; return source->data;
/* Allocate storage for the destination. */ /* 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; dest = destptr;
src = source->data; src = source->data;
stride0 = stride[0]; stride0 = stride[0];
...@@ -124,3 +124,4 @@ rtype_name * ...@@ -124,3 +124,4 @@ rtype_name *
} }
#endif #endif
'
\ No newline at end of file
...@@ -39,8 +39,8 @@ include(iparm.m4)dnl ...@@ -39,8 +39,8 @@ include(iparm.m4)dnl
dnl Only the kind (ie size) is used to name the function for integers, 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. dnl reals and logicals. For complex, it's c4 and c8.
void `void
`internal_unpack_'rtype_ccode (rtype * d, const rtype_name * src) internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * src)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
...@@ -48,7 +48,7 @@ void ...@@ -48,7 +48,7 @@ void
index_type stride0; index_type stride0;
index_type dim; index_type dim;
index_type dsize; index_type dsize;
rtype_name *dest; 'rtype_name` *dest;
int n; int n;
dest = d->data; dest = d->data;
...@@ -73,7 +73,7 @@ void ...@@ -73,7 +73,7 @@ void
if (dsize != 0) if (dsize != 0)
{ {
memcpy (dest, src, dsize * sizeof (rtype_name)); memcpy (dest, src, dsize * sizeof ('rtype_name`));
return; return;
} }
...@@ -112,3 +112,4 @@ void ...@@ -112,3 +112,4 @@ void
} }
#endif #endif
'
\ No newline at end of file
...@@ -35,16 +35,16 @@ Boston, MA 02110-1301, USA. */ ...@@ -35,16 +35,16 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl 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 /* 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. */ matrices. */
typedef void (*blas_call)(const char *, const char *, const int *, const int *, 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 'rtype_name` *,
const int *, const rtype_name *, const int *, const int *, const 'rtype_name` *, const int *,
const rtype_name *, rtype_name *, const int *, const 'rtype_name` *, 'rtype_name` *, const int *,
int, int); int, int);
/* The order of loops is different in the case of plain matrix /* 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 *, ...@@ -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 see if there is a way to perform the matrix multiplication by a call
to the BLAS gemm function. */ to the BLAS gemm function. */
extern void matmul_`'rtype_code (rtype * const restrict retarray, extern void matmul_'rtype_code` ('rtype` * const restrict retarray,
rtype * const restrict a, rtype * const restrict b, int try_blas, 'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
int blas_limit, blas_call gemm); int blas_limit, blas_call gemm);
export_proto(matmul_`'rtype_code); export_proto(matmul_'rtype_code`);
void void
matmul_`'rtype_code (rtype * const restrict retarray, matmul_'rtype_code` ('rtype` * const restrict retarray,
rtype * const restrict a, rtype * const restrict b, int try_blas, 'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas,
int blas_limit, blas_call gemm) int blas_limit, blas_call gemm)
{ {
const rtype_name * restrict abase; const 'rtype_name` * restrict abase;
const rtype_name * restrict bbase; const 'rtype_name` * restrict bbase;
rtype_name * restrict dest; 'rtype_name` * restrict dest;
index_type rxstride, rystride, axstride, aystride, bxstride, bystride; index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
index_type x, y, n, count, xcount, ycount; index_type x, y, n, count, xcount, ycount;
...@@ -133,12 +133,12 @@ matmul_`'rtype_code (rtype * const restrict retarray, ...@@ -133,12 +133,12 @@ matmul_`'rtype_code (rtype * const restrict retarray,
} }
retarray->data 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; retarray->offset = 0;
} }
'
sinclude(`matmul_asm_'rtype_code`.m4')dnl sinclude(`matmul_asm_'rtype_code`.m4')dnl
`
if (GFC_DESCRIPTOR_RANK (retarray) == 1) if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{ {
/* One-dimensional result may be addressed in the code below /* One-dimensional result may be addressed in the code below
...@@ -196,7 +196,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -196,7 +196,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
dest = retarray->data; 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. */ itself. */
#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) #define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x)))
...@@ -207,7 +207,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -207,7 +207,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
> POW3(blas_limit))) > POW3(blas_limit)))
{ {
const int m = xcount, n = ycount, k = count, ldc = rystride; 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, const int lda = (axstride == 1) ? aystride : axstride,
ldb = (bxstride == 1) ? bystride : bxstride; ldb = (bxstride == 1) ? bystride : bxstride;
...@@ -222,18 +222,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -222,18 +222,18 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
if (rxstride == 1 && axstride == 1 && bxstride == 1) if (rxstride == 1 && axstride == 1 && bxstride == 1)
{ {
const rtype_name * restrict bbase_y; const 'rtype_name` * restrict bbase_y;
rtype_name * restrict dest_y; 'rtype_name` * restrict dest_y;
const rtype_name * restrict abase_n; const 'rtype_name` * restrict abase_n;
rtype_name bbase_yn; 'rtype_name` bbase_yn;
if (rystride == xcount) if (rystride == xcount)
memset (dest, 0, (sizeof (rtype_name) * xcount * ycount)); memset (dest, 0, (sizeof ('rtype_name`) * xcount * ycount));
else else
{ {
for (y = 0; y < ycount; y++) for (y = 0; y < ycount; y++)
for (x = 0; x < xcount; x++) 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++) for (y = 0; y < ycount; y++)
...@@ -255,10 +255,10 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -255,10 +255,10 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
{ {
if (GFC_DESCRIPTOR_RANK (a) != 1) if (GFC_DESCRIPTOR_RANK (a) != 1)
{ {
const rtype_name *restrict abase_x; const 'rtype_name` *restrict abase_x;
const rtype_name *restrict bbase_y; const 'rtype_name` *restrict bbase_y;
rtype_name *restrict dest_y; 'rtype_name` *restrict dest_y;
rtype_name s; 'rtype_name` s;
for (y = 0; y < ycount; y++) for (y = 0; y < ycount; y++)
{ {
...@@ -267,7 +267,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -267,7 +267,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (x = 0; x < xcount; x++) for (x = 0; x < xcount; x++)
{ {
abase_x = &abase[x*axstride]; abase_x = &abase[x*axstride];
s = (rtype_name) 0; s = ('rtype_name`) 0;
for (n = 0; n < count; n++) for (n = 0; n < count; n++)
s += abase_x[n] * bbase_y[n]; s += abase_x[n] * bbase_y[n];
dest_y[x] = s; dest_y[x] = s;
...@@ -276,13 +276,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -276,13 +276,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
} }
else else
{ {
const rtype_name *restrict bbase_y; const 'rtype_name` *restrict bbase_y;
rtype_name s; 'rtype_name` s;
for (y = 0; y < ycount; y++) for (y = 0; y < ycount; y++)
{ {
bbase_y = &bbase[y*bystride]; bbase_y = &bbase[y*bystride];
s = (rtype_name) 0; s = ('rtype_name`) 0;
for (n = 0; n < count; n++) for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n]; s += abase[n*axstride] * bbase_y[n];
dest[y*rystride] = s; dest[y*rystride] = s;
...@@ -293,7 +293,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -293,7 +293,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
{ {
for (y = 0; y < ycount; y++) for (y = 0; y < ycount; y++)
for (x = 0; x < xcount; x++) 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 (y = 0; y < ycount; y++)
for (n = 0; n < count; n++) for (n = 0; n < count; n++)
...@@ -303,13 +303,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -303,13 +303,13 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
} }
else if (GFC_DESCRIPTOR_RANK (a) == 1) else if (GFC_DESCRIPTOR_RANK (a) == 1)
{ {
const rtype_name *restrict bbase_y; const 'rtype_name` *restrict bbase_y;
rtype_name s; 'rtype_name` s;
for (y = 0; y < ycount; y++) for (y = 0; y < ycount; y++)
{ {
bbase_y = &bbase[y*bystride]; bbase_y = &bbase[y*bystride];
s = (rtype_name) 0; s = ('rtype_name`) 0;
for (n = 0; n < count; n++) for (n = 0; n < count; n++)
s += abase[n*axstride] * bbase_y[n*bxstride]; s += abase[n*axstride] * bbase_y[n*bxstride];
dest[y*rxstride] = s; dest[y*rxstride] = s;
...@@ -317,10 +317,10 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -317,10 +317,10 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
} }
else else
{ {
const rtype_name *restrict abase_x; const 'rtype_name` *restrict abase_x;
const rtype_name *restrict bbase_y; const 'rtype_name` *restrict bbase_y;
rtype_name *restrict dest_y; 'rtype_name` *restrict dest_y;
rtype_name s; 'rtype_name` s;
for (y = 0; y < ycount; y++) for (y = 0; y < ycount; y++)
{ {
...@@ -329,7 +329,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -329,7 +329,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
for (x = 0; x < xcount; x++) for (x = 0; x < xcount; x++)
{ {
abase_x = &abase[x*axstride]; abase_x = &abase[x*axstride];
s = (rtype_name) 0; s = ('rtype_name`) 0;
for (n = 0; n < count; n++) for (n = 0; n < count; n++)
s += abase_x[n*aystride] * bbase_y[n*bxstride]; s += abase_x[n*aystride] * bbase_y[n*bxstride];
dest_y[x*rxstride] = s; dest_y[x*rxstride] = s;
...@@ -338,4 +338,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -338,4 +338,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
} }
} }
#endif #endif'
...@@ -34,22 +34,22 @@ Boston, MA 02110-1301, USA. */ ...@@ -34,22 +34,22 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl include(iparm.m4)dnl
`#if defined (HAVE_'rtype_name`)' `#if defined (HAVE_'rtype_name`)
/* Dimensions: retarray(x,y) a(x, count) b(count,y). /* 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. */ 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); gfc_array_l4 * const restrict, gfc_array_l4 * const restrict);
export_proto(matmul_`'rtype_code); export_proto(matmul_'rtype_code`);
void 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) gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b)
{ {
const GFC_INTEGER_4 * restrict abase; const GFC_INTEGER_4 * restrict abase;
const GFC_INTEGER_4 * restrict bbase; const GFC_INTEGER_4 * restrict bbase;
rtype_name * restrict dest; 'rtype_name` * restrict dest;
index_type rxstride; index_type rxstride;
index_type rystride; index_type rystride;
index_type xcount; index_type xcount;
...@@ -95,7 +95,7 @@ matmul_`'rtype_code (rtype * const restrict retarray, ...@@ -95,7 +95,7 @@ matmul_`'rtype_code (rtype * const restrict retarray,
} }
retarray->data 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; retarray->offset = 0;
} }
...@@ -112,9 +112,9 @@ matmul_`'rtype_code (rtype * const restrict retarray, ...@@ -112,9 +112,9 @@ matmul_`'rtype_code (rtype * const restrict retarray,
bbase = GFOR_POINTER_L8_TO_L4 (bbase); bbase = GFOR_POINTER_L8_TO_L4 (bbase);
} }
dest = retarray->data; dest = retarray->data;
'
sinclude(`matmul_asm_'rtype_code`.m4')dnl sinclude(`matmul_asm_'rtype_code`.m4')dnl
`
if (GFC_DESCRIPTOR_RANK (retarray) == 1) if (GFC_DESCRIPTOR_RANK (retarray) == 1)
{ {
rxstride = retarray->dim[0].stride; rxstride = retarray->dim[0].stride;
...@@ -191,3 +191,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl ...@@ -191,3 +191,4 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
} }
#endif #endif
'
\ No newline at end of file
...@@ -35,23 +35,23 @@ Boston, MA 02110-1301, USA. */ ...@@ -35,23 +35,23 @@ Boston, MA 02110-1301, USA. */
include(`mtype.m4')dnl 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); extern 'real_type` nearest_r'kind` ('real_type` s, 'real_type` dir);
export_proto(nearest_r`'kind); export_proto(nearest_r'kind`);
real_type 'real_type`
nearest_r`'kind (real_type s, real_type dir) 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) if (FLT_EVAL_METHOD != 0)
{ {
/* ??? Work around glibc bug on x86. */ /* ??? Work around glibc bug on x86. */
volatile real_type r = nextafter`'q (s, dir); volatile 'real_type` r = nextafter'q` (s, dir);
return r; return r;
} }
else else
return nextafter`'q (s, dir); return nextafter'q` (s, dir);
} }
#endif #endif'
...@@ -39,15 +39,15 @@ include(iparm.m4)dnl ...@@ -39,15 +39,15 @@ include(iparm.m4)dnl
`#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)' `#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)'
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);
export_proto(pow_`'rtype_code`_'atype_code); export_proto(pow_'rtype_code`_'atype_code`);
rtype_name 'rtype_name`
`pow_'rtype_code`_'atype_code (rtype_name a, atype_name b) pow_'rtype_code`_'atype_code` ('rtype_name` a, 'atype_name` b)
{ {
rtype_name pow, x; 'rtype_name` pow, x;
atype_name n; 'atype_name` n;
`GFC_UINTEGER_'atype_kind` u;' GFC_UINTEGER_'atype_kind` u;
n = b; n = b;
x = a; x = a;
...@@ -56,7 +56,7 @@ rtype_name ...@@ -56,7 +56,7 @@ rtype_name
{ {
if (n < 0) if (n < 0)
{ {
ifelse(rtype_letter,i,`dnl 'ifelse(rtype_letter,i,`dnl
if (x == 1) if (x == 1)
return 1; return 1;
if (x == -1) if (x == -1)
...@@ -66,7 +66,7 @@ ifelse(rtype_letter,i,`dnl ...@@ -66,7 +66,7 @@ ifelse(rtype_letter,i,`dnl
u = -n; u = -n;
x = pow / x; x = pow / x;
')dnl ')dnl
} ` }
else else
{ {
u = n; u = n;
...@@ -85,4 +85,4 @@ ifelse(rtype_letter,i,`dnl ...@@ -85,4 +85,4 @@ ifelse(rtype_letter,i,`dnl
return pow; return pow;
} }
#endif #endif'
...@@ -49,4 +49,4 @@ MASKED_ARRAY_FUNCTION(1, ...@@ -49,4 +49,4 @@ MASKED_ARRAY_FUNCTION(1,
SCALAR_ARRAY_FUNCTION(1) SCALAR_ARRAY_FUNCTION(1)
#endif `#endif'
...@@ -34,27 +34,27 @@ Boston, MA 02110-1301, USA. */ ...@@ -34,27 +34,27 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl 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 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 function. The same function will be used for integer and logical
dnl arrays of the same kind. dnl arrays of the same kind.
extern void reshape_`'rtype_ccode (rtype * const restrict, `extern void reshape_'rtype_ccode` ('rtype` * const restrict,
rtype * const restrict, 'rtype` * const restrict,
shape_type * const restrict, 'shape_type` * const restrict,
rtype * const restrict, 'rtype` * const restrict,
shape_type * const restrict); 'shape_type` * const restrict);
export_proto(reshape_`'rtype_ccode); export_proto(reshape_'rtype_ccode`);
void void
reshape_`'rtype_ccode (rtype * const restrict ret, reshape_'rtype_ccode` ('rtype` * const restrict ret,
rtype * const restrict source, 'rtype` * const restrict source,
shape_type * const restrict shape, 'shape_type` * const restrict shape,
rtype * const restrict pad, 'rtype` * const restrict pad,
shape_type * const restrict order) 'shape_type` * const restrict order)
{ {
/* r.* indicates the return array. */ /* r.* indicates the return array. */
index_type rcount[GFC_MAX_DIMENSIONS]; index_type rcount[GFC_MAX_DIMENSIONS];
...@@ -65,7 +65,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret, ...@@ -65,7 +65,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
index_type rsize; index_type rsize;
index_type rs; index_type rs;
index_type rex; index_type rex;
rtype_name *rptr; 'rtype_name` *rptr;
/* s.* indicates the source array. */ /* s.* indicates the source array. */
index_type scount[GFC_MAX_DIMENSIONS]; index_type scount[GFC_MAX_DIMENSIONS];
index_type sextent[GFC_MAX_DIMENSIONS]; index_type sextent[GFC_MAX_DIMENSIONS];
...@@ -73,16 +73,16 @@ reshape_`'rtype_ccode (rtype * const restrict ret, ...@@ -73,16 +73,16 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
index_type sstride0; index_type sstride0;
index_type sdim; index_type sdim;
index_type ssize; index_type ssize;
const rtype_name *sptr; const 'rtype_name` *sptr;
/* p.* indicates the pad array. */ /* p.* indicates the pad array. */
index_type pcount[GFC_MAX_DIMENSIONS]; index_type pcount[GFC_MAX_DIMENSIONS];
index_type pextent[GFC_MAX_DIMENSIONS]; index_type pextent[GFC_MAX_DIMENSIONS];
index_type pstride[GFC_MAX_DIMENSIONS]; index_type pstride[GFC_MAX_DIMENSIONS];
index_type pdim; index_type pdim;
index_type psize; index_type psize;
const rtype_name *pptr; const 'rtype_name` *pptr;
const rtype_name *src; const 'rtype_name` *src;
int n; int n;
int dim; int dim;
int sempty, pempty; int sempty, pempty;
...@@ -100,7 +100,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret, ...@@ -100,7 +100,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
rs *= rex; rs *= rex;
} }
ret->offset = 0; 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; ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
} }
else else
...@@ -184,9 +184,9 @@ reshape_`'rtype_ccode (rtype * const restrict ret, ...@@ -184,9 +184,9 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
if (rsize != 0 && ssize != 0 && psize != 0) if (rsize != 0 && ssize != 0 && psize != 0)
{ {
rsize *= sizeof (rtype_name); rsize *= sizeof ('rtype_name`);
ssize *= sizeof (rtype_name); ssize *= sizeof ('rtype_name`);
psize *= sizeof (rtype_name); psize *= sizeof ('rtype_name`);
reshape_packed ((char *)ret->data, rsize, (char *)source->data, reshape_packed ((char *)ret->data, rsize, (char *)source->data,
ssize, pad ? (char *)pad->data : NULL, psize); ssize, pad ? (char *)pad->data : NULL, psize);
return; return;
...@@ -210,7 +210,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret, ...@@ -210,7 +210,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
scount[dim] = pcount[dim]; scount[dim] = pcount[dim];
sextent[dim] = pextent[dim]; sextent[dim] = pextent[dim];
sstride[dim] = pstride[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, ...@@ -286,4 +286,4 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
} }
} }
#endif #endif'
...@@ -34,26 +34,26 @@ Boston, MA 02110-1301, USA. */ ...@@ -34,26 +34,26 @@ Boston, MA 02110-1301, USA. */
include(`mtype.m4')dnl 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); extern 'real_type` rrspacing_r'kind` ('real_type` s, int p);
export_proto(rrspacing_r`'kind); export_proto(rrspacing_r'kind`);
real_type 'real_type`
rrspacing_r`'kind (real_type s, int p) rrspacing_r'kind` ('real_type` s, int p)
{ {
int e; int e;
real_type x; 'real_type` x;
x = fabs`'q (s); x = fabs'q` (s);
if (x == 0.) if (x == 0.)
return 0.; return 0.;
frexp`'q (s, &e); frexp'q` (s, &e);
`#if defined (HAVE_LDEXP'Q`)' #if defined (HAVE_LDEXP'Q`)
return ldexp`'q (x, p - e); return ldexp'q` (x, p - e);
#else #else
return scalbn`'q (x, p - e); return scalbn'q` (x, p - e);
#endif #endif
} }
#endif #endif'
...@@ -34,16 +34,16 @@ Boston, MA 02110-1301, USA. */ ...@@ -34,16 +34,16 @@ Boston, MA 02110-1301, USA. */
include(`mtype.m4')dnl 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); extern 'real_type` set_exponent_r'kind` ('real_type` s, GFC_INTEGER_4 i);
export_proto(set_exponent_r`'kind); export_proto(set_exponent_r'kind`);
real_type 'real_type`
set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i) set_exponent_r'kind` ('real_type` s, GFC_INTEGER_4 i)
{ {
int dummy_exp; 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. */ ...@@ -34,15 +34,15 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl include(iparm.m4)dnl
`#if defined (HAVE_'rtype_name`)' `#if defined (HAVE_'rtype_name`)
extern void shape_`'rtype_kind (rtype * const restrict ret, extern void shape_'rtype_kind` ('rtype` * const restrict ret,
const rtype * const restrict array); const 'rtype` * const restrict array);
export_proto(shape_`'rtype_kind); export_proto(shape_'rtype_kind`);
void void
shape_`'rtype_kind (rtype * const restrict ret, shape_'rtype_kind` ('rtype` * const restrict ret,
const rtype * const restrict array) const 'rtype` * const restrict array)
{ {
int n; int n;
index_type stride; index_type stride;
...@@ -56,4 +56,4 @@ shape_`'rtype_kind (rtype * const restrict ret, ...@@ -56,4 +56,4 @@ shape_`'rtype_kind (rtype * const restrict ret,
} }
} }
#endif #endif'
...@@ -34,25 +34,25 @@ Boston, MA 02110-1301, USA. */ ...@@ -34,25 +34,25 @@ Boston, MA 02110-1301, USA. */
include(`mtype.m4')dnl 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); extern 'real_type` spacing_r'kind` ('real_type` s, int p, int emin, 'real_type` tiny);
export_proto(spacing_r`'kind); export_proto(spacing_r'kind`);
real_type 'real_type`
spacing_r`'kind (real_type s, int p, int emin, real_type tiny) spacing_r'kind` ('real_type` s, int p, int emin, 'real_type` tiny)
{ {
int e; int e;
if (s == 0.) if (s == 0.)
return tiny; return tiny;
frexp`'q (s, &e); frexp'q` (s, &e);
e = e - p; e = e - p;
e = e > emin ? e : emin; e = e > emin ? e : emin;
`#if defined (HAVE_LDEXP'Q`)' #if defined (HAVE_LDEXP'Q`)
return ldexp`'q (1., e); return ldexp'q` (1., e);
#else #else
return scalbn`'q (1., e); return scalbn'q` (1., e);
#endif #endif
} }
#endif #endif'
...@@ -33,22 +33,22 @@ Boston, MA 02110-1301, USA. */ ...@@ -33,22 +33,22 @@ Boston, MA 02110-1301, USA. */
#include "libgfortran.h"' #include "libgfortran.h"'
include(iparm.m4)dnl include(iparm.m4)dnl
`#if defined (HAVE_'rtype_name`)' `#if defined (HAVE_'rtype_name`)
extern void transpose_`'rtype_code (rtype * const restrict ret, extern void transpose_'rtype_code` ('rtype` * const restrict ret,
rtype * const restrict source); 'rtype` * const restrict source);
export_proto(transpose_`'rtype_code); export_proto(transpose_'rtype_code`);
void void
transpose_`'rtype_code (rtype * const restrict ret, transpose_'rtype_code` ('rtype` * const restrict ret,
rtype * const restrict source) 'rtype` * const restrict source)
{ {
/* r.* indicates the return array. */ /* r.* indicates the return array. */
index_type rxstride, rystride; index_type rxstride, rystride;
rtype_name *rptr; 'rtype_name` *rptr;
/* s.* indicates the source array. */ /* s.* indicates the source array. */
index_type sxstride, systride; index_type sxstride, systride;
const rtype_name *sptr; const 'rtype_name` *sptr;
index_type xcount, ycount; index_type xcount, ycount;
index_type x, y; index_type x, y;
...@@ -68,7 +68,7 @@ transpose_`'rtype_code (rtype * const restrict ret, ...@@ -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].ubound = source->dim[0].ubound - source->dim[0].lbound;
ret->dim[1].stride = ret->dim[0].ubound+1; 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; ret->offset = 0;
} }
...@@ -97,4 +97,4 @@ transpose_`'rtype_code (rtype * const restrict ret, ...@@ -97,4 +97,4 @@ transpose_`'rtype_code (rtype * const restrict ret,
} }
} }
#endif #endif'
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment