mirror of git://gcc.gnu.org/git/gcc.git
parent
4b6903ec2f
commit
420aa7b82c
|
|
@ -92,12 +92,12 @@ matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -157,7 +157,7 @@ matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b)
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -92,12 +92,12 @@ matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -157,7 +157,7 @@ matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b)
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -92,12 +92,12 @@ matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -157,7 +157,7 @@ matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b)
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -92,12 +92,12 @@ matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -157,7 +157,7 @@ matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b)
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -83,12 +83,12 @@ matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
|
||||||
|
|
@ -83,12 +83,12 @@ matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
|
||||||
|
|
@ -92,12 +92,12 @@ matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -157,7 +157,7 @@ matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b)
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -92,12 +92,12 @@ matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
retarray->data
|
retarray->data
|
||||||
= internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) retarray));
|
= internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) retarray));
|
||||||
retarray->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -157,7 +157,7 @@ matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b)
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
|
|
@ -94,7 +94,7 @@ etime (gfc_array_r4 *t)
|
||||||
return val;
|
return val;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* LAPACK's test programs declares ETIME external, therefore we
|
/* LAPACK's test programs declares ETIME external, therefore we
|
||||||
need this. */
|
need this. */
|
||||||
|
|
||||||
extern GFC_REAL_4 etime_ (GFC_REAL_4 *t);
|
extern GFC_REAL_4 etime_ (GFC_REAL_4 *t);
|
||||||
|
|
|
||||||
|
|
@ -621,7 +621,7 @@ arandom_r8 (gfc_array_r8 *x)
|
||||||
}
|
}
|
||||||
|
|
||||||
/* random_seed is used to seed the PRNG with either a default
|
/* random_seed is used to seed the PRNG with either a default
|
||||||
set of seeds or user specified set of seeds. random_seed
|
set of seeds or user specified set of seeds. random_seed
|
||||||
must be called with no argument or exactly one argument. */
|
must be called with no argument or exactly one argument. */
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
|
||||||
|
|
@ -230,7 +230,7 @@ typedef struct
|
||||||
GFC_INTEGER_4 rec;
|
GFC_INTEGER_4 rec;
|
||||||
GFC_INTEGER_4 *nextrec, *size;
|
GFC_INTEGER_4 *nextrec, *size;
|
||||||
|
|
||||||
GFC_INTEGER_4 recl_in;
|
GFC_INTEGER_4 recl_in;
|
||||||
GFC_INTEGER_4 *recl_out;
|
GFC_INTEGER_4 *recl_out;
|
||||||
|
|
||||||
GFC_INTEGER_4 *iolength;
|
GFC_INTEGER_4 *iolength;
|
||||||
|
|
@ -343,7 +343,7 @@ typedef struct
|
||||||
unit_blank blank_status;
|
unit_blank blank_status;
|
||||||
enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
|
enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
|
||||||
int scale_factor;
|
int scale_factor;
|
||||||
jmp_buf eof_jump;
|
jmp_buf eof_jump;
|
||||||
}
|
}
|
||||||
global_t;
|
global_t;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1377,11 +1377,11 @@ list_formatted_read (bt type, void *p, int len)
|
||||||
|
|
||||||
case BT_CHARACTER:
|
case BT_CHARACTER:
|
||||||
if (saved_string)
|
if (saved_string)
|
||||||
{
|
{
|
||||||
m = (len < saved_used) ? len : saved_used;
|
m = (len < saved_used) ? len : saved_used;
|
||||||
memcpy (p, saved_string, m);
|
memcpy (p, saved_string, m);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
/* Just delimiters encountered, nothing to copy but SPACE. */
|
/* Just delimiters encountered, nothing to copy but SPACE. */
|
||||||
m = 0;
|
m = 0;
|
||||||
|
|
||||||
|
|
@ -1600,7 +1600,7 @@ nml_parse_qualifier(descriptor_dimension * ad,
|
||||||
|
|
||||||
/*Check the values of the triplet indices. */
|
/*Check the values of the triplet indices. */
|
||||||
|
|
||||||
if ( (ls[dim].start > (ssize_t)ad[dim].ubound)
|
if ( (ls[dim].start > (ssize_t)ad[dim].ubound)
|
||||||
|| (ls[dim].start < (ssize_t)ad[dim].lbound)
|
|| (ls[dim].start < (ssize_t)ad[dim].lbound)
|
||||||
|| (ls[dim].end > (ssize_t)ad[dim].ubound)
|
|| (ls[dim].end > (ssize_t)ad[dim].ubound)
|
||||||
|| (ls[dim].end < (ssize_t)ad[dim].lbound))
|
|| (ls[dim].end < (ssize_t)ad[dim].lbound))
|
||||||
|
|
@ -1646,7 +1646,7 @@ find_nml_node (char * var_name)
|
||||||
|
|
||||||
/* Visits all the components of a derived type that have
|
/* Visits all the components of a derived type that have
|
||||||
not explicitly been identified in the namelist input.
|
not explicitly been identified in the namelist input.
|
||||||
touched is set and the loop specification initialised
|
touched is set and the loop specification initialised
|
||||||
to default values */
|
to default values */
|
||||||
|
|
||||||
static void
|
static void
|
||||||
|
|
@ -1854,7 +1854,7 @@ nml_read_obj (namelist_info * nl, index_type offset)
|
||||||
pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) *
|
pdata = (void*)(pdata + (nl->ls[dim].idx - nl->dim[dim].lbound) *
|
||||||
nl->dim[dim].stride * nl->size);
|
nl->dim[dim].stride * nl->size);
|
||||||
|
|
||||||
/* Reset the error flag and try to read next value, if
|
/* Reset the error flag and try to read next value, if
|
||||||
repeat_count=0 */
|
repeat_count=0 */
|
||||||
|
|
||||||
nml_read_error = 0;
|
nml_read_error = 0;
|
||||||
|
|
@ -1873,7 +1873,7 @@ nml_read_obj (namelist_info * nl, index_type offset)
|
||||||
|
|
||||||
saved_type = GFC_DTYPE_UNKNOWN;
|
saved_type = GFC_DTYPE_UNKNOWN;
|
||||||
free_saved ();
|
free_saved ();
|
||||||
|
|
||||||
switch (nl->type)
|
switch (nl->type)
|
||||||
{
|
{
|
||||||
case GFC_DTYPE_INTEGER:
|
case GFC_DTYPE_INTEGER:
|
||||||
|
|
@ -1904,7 +1904,7 @@ nml_read_obj (namelist_info * nl, index_type offset)
|
||||||
|
|
||||||
/* Now loop over the components. Update the component pointer
|
/* Now loop over the components. Update the component pointer
|
||||||
with the return value from nml_write_obj. This loop jumps
|
with the return value from nml_write_obj. This loop jumps
|
||||||
past nested derived types by testing if the potential
|
past nested derived types by testing if the potential
|
||||||
component name contains '%'. */
|
component name contains '%'. */
|
||||||
|
|
||||||
for (cmp = nl->next;
|
for (cmp = nl->next;
|
||||||
|
|
@ -1940,7 +1940,7 @@ nml_read_obj (namelist_info * nl, index_type offset)
|
||||||
|
|
||||||
/* The standard permits array data to stop short of the number of
|
/* The standard permits array data to stop short of the number of
|
||||||
elements specified in the loop specification. In this case, we
|
elements specified in the loop specification. In this case, we
|
||||||
should be here with nml_read_error != 0. Control returns to
|
should be here with nml_read_error != 0. Control returns to
|
||||||
nml_get_obj_data and an attempt is made to read object name. */
|
nml_get_obj_data and an attempt is made to read object name. */
|
||||||
|
|
||||||
prev_nl = nl;
|
prev_nl = nl;
|
||||||
|
|
|
||||||
|
|
@ -168,7 +168,7 @@ read_sf (int *length)
|
||||||
{
|
{
|
||||||
if (is_internal_unit())
|
if (is_internal_unit())
|
||||||
{
|
{
|
||||||
/* readlen may be modified inside salloc_r if
|
/* readlen may be modified inside salloc_r if
|
||||||
is_internal_unit() is true. */
|
is_internal_unit() is true. */
|
||||||
readlen = 1;
|
readlen = 1;
|
||||||
}
|
}
|
||||||
|
|
@ -226,7 +226,7 @@ read_sf (int *length)
|
||||||
file, advancing the current position. We return a pointer to a
|
file, advancing the current position. We return a pointer to a
|
||||||
buffer containing the bytes. We return NULL on end of record or
|
buffer containing the bytes. We return NULL on end of record or
|
||||||
end of file.
|
end of file.
|
||||||
|
|
||||||
If the read is short, then it is because the current record does not
|
If the read is short, then it is because the current record does not
|
||||||
have enough data to satisfy the read request and the file was
|
have enough data to satisfy the read request and the file was
|
||||||
opened with PAD=YES. The caller must assume tailing spaces for
|
opened with PAD=YES. The caller must assume tailing spaces for
|
||||||
|
|
@ -683,7 +683,7 @@ formatted_transfer (bt type, void *p, int len)
|
||||||
else // FMT==T
|
else // FMT==T
|
||||||
{
|
{
|
||||||
consume_data_flag = 0 ;
|
consume_data_flag = 0 ;
|
||||||
pos = f->u.n - 1;
|
pos = f->u.n - 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (pos < 0 || pos >= current_unit->recl )
|
if (pos < 0 || pos >= current_unit->recl )
|
||||||
|
|
@ -1122,12 +1122,12 @@ data_transfer_init (int read_flag)
|
||||||
generate_error (ERROR_OS, NULL);
|
generate_error (ERROR_OS, NULL);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Overwriting an existing sequential file ?
|
/* Overwriting an existing sequential file ?
|
||||||
it is always safe to truncate the file on the first write */
|
it is always safe to truncate the file on the first write */
|
||||||
if (g.mode == WRITING
|
if (g.mode == WRITING
|
||||||
&& current_unit->flags.access == ACCESS_SEQUENTIAL
|
&& current_unit->flags.access == ACCESS_SEQUENTIAL
|
||||||
&& current_unit->current_record == 0)
|
&& current_unit->current_record == 0)
|
||||||
struncate(current_unit->s);
|
struncate(current_unit->s);
|
||||||
|
|
||||||
current_unit->mode = g.mode;
|
current_unit->mode = g.mode;
|
||||||
|
|
||||||
|
|
@ -1227,7 +1227,7 @@ next_record_r (int done)
|
||||||
{
|
{
|
||||||
new = file_position (current_unit->s) + current_unit->bytes_left;
|
new = file_position (current_unit->s) + current_unit->bytes_left;
|
||||||
|
|
||||||
/* Direct access files do not generate END conditions,
|
/* Direct access files do not generate END conditions,
|
||||||
only I/O errors. */
|
only I/O errors. */
|
||||||
if (sseek (current_unit->s, new) == FAILURE)
|
if (sseek (current_unit->s, new) == FAILURE)
|
||||||
generate_error (ERROR_OS, NULL);
|
generate_error (ERROR_OS, NULL);
|
||||||
|
|
@ -1255,7 +1255,7 @@ next_record_r (int done)
|
||||||
case FORMATTED_SEQUENTIAL:
|
case FORMATTED_SEQUENTIAL:
|
||||||
length = 1;
|
length = 1;
|
||||||
/* sf_read has already terminated input because of an '\n' */
|
/* sf_read has already terminated input because of an '\n' */
|
||||||
if (sf_seen_eor)
|
if (sf_seen_eor)
|
||||||
{
|
{
|
||||||
sf_seen_eor=0;
|
sf_seen_eor=0;
|
||||||
break;
|
break;
|
||||||
|
|
@ -1371,7 +1371,7 @@ next_record_w (int done)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (sfree (current_unit->s) == FAILURE)
|
if (sfree (current_unit->s) == FAILURE)
|
||||||
goto io_error;
|
goto io_error;
|
||||||
|
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
|
@ -1698,4 +1698,3 @@ export_proto(st_set_nml_var);
|
||||||
extern void st_set_nml_var_dim (GFC_INTEGER_4, GFC_INTEGER_4,
|
extern void st_set_nml_var_dim (GFC_INTEGER_4, GFC_INTEGER_4,
|
||||||
GFC_INTEGER_4 ,GFC_INTEGER_4);
|
GFC_INTEGER_4 ,GFC_INTEGER_4);
|
||||||
export_proto(st_set_nml_var_dim);
|
export_proto(st_set_nml_var_dim);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -273,7 +273,7 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
|
||||||
static void
|
static void
|
||||||
output_float (fnode *f, double value, int len)
|
output_float (fnode *f, double value, int len)
|
||||||
{
|
{
|
||||||
/* This must be large enough to accurately hold any value. */
|
/* This must be large enough to accurately hold any value. */
|
||||||
char buffer[32];
|
char buffer[32];
|
||||||
char *out;
|
char *out;
|
||||||
char *digits;
|
char *digits;
|
||||||
|
|
@ -324,7 +324,7 @@ output_float (fnode *f, double value, int len)
|
||||||
if (edigits < 2)
|
if (edigits < 2)
|
||||||
edigits = 2;
|
edigits = 2;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (ft == FMT_F || ft == FMT_EN
|
if (ft == FMT_F || ft == FMT_EN
|
||||||
|| ((ft == FMT_D || ft == FMT_E) && g.scale_factor != 0))
|
|| ((ft == FMT_D || ft == FMT_E) && g.scale_factor != 0))
|
||||||
{
|
{
|
||||||
|
|
@ -344,7 +344,7 @@ output_float (fnode *f, double value, int len)
|
||||||
}
|
}
|
||||||
|
|
||||||
sprintf (buffer, "%+-#31.*e", ndigits - 1, value);
|
sprintf (buffer, "%+-#31.*e", ndigits - 1, value);
|
||||||
|
|
||||||
/* Check the resulting string has punctuation in the correct places. */
|
/* Check the resulting string has punctuation in the correct places. */
|
||||||
if (buffer[2] != '.' || buffer[ndigits + 2] != 'e')
|
if (buffer[2] != '.' || buffer[ndigits + 2] != 'e')
|
||||||
internal_error ("printf is broken");
|
internal_error ("printf is broken");
|
||||||
|
|
@ -514,7 +514,7 @@ output_float (fnode *f, double value, int len)
|
||||||
edigits = 1;
|
edigits = 1;
|
||||||
for (i = abs (e); i >= 10; i /= 10)
|
for (i = abs (e); i >= 10; i /= 10)
|
||||||
edigits++;
|
edigits++;
|
||||||
|
|
||||||
if (f->u.real.e < 0)
|
if (f->u.real.e < 0)
|
||||||
{
|
{
|
||||||
/* Width not specified. Must be no more than 3 digits. */
|
/* Width not specified. Must be no more than 3 digits. */
|
||||||
|
|
@ -562,7 +562,7 @@ output_float (fnode *f, double value, int len)
|
||||||
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
|
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
|
||||||
if (sign != SIGN_NONE)
|
if (sign != SIGN_NONE)
|
||||||
nblanks--;
|
nblanks--;
|
||||||
|
|
||||||
/* Check the value fits in the specified field width. */
|
/* Check the value fits in the specified field width. */
|
||||||
if (nblanks < 0 || edigits == -1)
|
if (nblanks < 0 || edigits == -1)
|
||||||
{
|
{
|
||||||
|
|
@ -640,7 +640,7 @@ output_float (fnode *f, double value, int len)
|
||||||
ndigits -= i;
|
ndigits -= i;
|
||||||
out += nafter;
|
out += nafter;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Output the exponent. */
|
/* Output the exponent. */
|
||||||
if (expchar)
|
if (expchar)
|
||||||
{
|
{
|
||||||
|
|
@ -707,22 +707,22 @@ write_float (fnode *f, const char *source, int len)
|
||||||
}
|
}
|
||||||
|
|
||||||
memset(p, ' ', nb);
|
memset(p, ' ', nb);
|
||||||
res = !isnan (n);
|
res = !isnan (n);
|
||||||
if (res != 0)
|
if (res != 0)
|
||||||
{
|
{
|
||||||
if (signbit(n))
|
if (signbit(n))
|
||||||
fin = '-';
|
fin = '-';
|
||||||
else
|
else
|
||||||
fin = '+';
|
fin = '+';
|
||||||
|
|
||||||
if (nb > 7)
|
if (nb > 7)
|
||||||
memcpy(p + nb - 8, "Infinity", 8);
|
memcpy(p + nb - 8, "Infinity", 8);
|
||||||
else
|
else
|
||||||
memcpy(p + nb - 3, "Inf", 3);
|
memcpy(p + nb - 3, "Inf", 3);
|
||||||
if (nb < 8 && nb > 3)
|
if (nb < 8 && nb > 3)
|
||||||
p[nb - 4] = fin;
|
p[nb - 4] = fin;
|
||||||
else if (nb > 8)
|
else if (nb > 8)
|
||||||
p[nb - 9] = fin;
|
p[nb - 9] = fin;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
memcpy(p + nb - 3, "NaN", 3);
|
memcpy(p + nb - 3, "NaN", 3);
|
||||||
|
|
@ -1430,7 +1430,7 @@ nml_write_obj (namelist_info * obj, index_type offset,
|
||||||
}
|
}
|
||||||
num++;
|
num++;
|
||||||
|
|
||||||
/* Output the data, if an intrinsic type, or recurse into this
|
/* Output the data, if an intrinsic type, or recurse into this
|
||||||
routine to treat derived types. */
|
routine to treat derived types. */
|
||||||
|
|
||||||
switch (obj->type)
|
switch (obj->type)
|
||||||
|
|
@ -1466,10 +1466,10 @@ nml_write_obj (namelist_info * obj, index_type offset,
|
||||||
|
|
||||||
/* To treat a derived type, we need to build two strings:
|
/* To treat a derived type, we need to build two strings:
|
||||||
ext_name = the name, including qualifiers that prepends
|
ext_name = the name, including qualifiers that prepends
|
||||||
component names in the output - passed to
|
component names in the output - passed to
|
||||||
nml_write_obj.
|
nml_write_obj.
|
||||||
obj_name = the derived type name with no qualifiers but %
|
obj_name = the derived type name with no qualifiers but %
|
||||||
appended. This is used to identify the
|
appended. This is used to identify the
|
||||||
components. */
|
components. */
|
||||||
|
|
||||||
/* First ext_name => get length of all possible components */
|
/* First ext_name => get length of all possible components */
|
||||||
|
|
@ -1558,8 +1558,8 @@ obj_loop:
|
||||||
}
|
}
|
||||||
|
|
||||||
/* This is the entry function for namelist writes. It outputs the name
|
/* This is the entry function for namelist writes. It outputs the name
|
||||||
of the namelist and iterates through the namelist by calls to
|
of the namelist and iterates through the namelist by calls to
|
||||||
nml_write_obj. The call below has dummys in the arguments used in
|
nml_write_obj. The call below has dummys in the arguments used in
|
||||||
the treatment of derived types. */
|
the treatment of derived types. */
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
@ -1617,4 +1617,3 @@ namelist_write (void)
|
||||||
}
|
}
|
||||||
|
|
||||||
#undef NML_DIGITS
|
#undef NML_DIGITS
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -93,12 +93,12 @@ matmul_`'rtype_code (rtype * retarray, rtype * a, rtype * b)
|
||||||
retarray->dim[0].lbound = 0;
|
retarray->dim[0].lbound = 0;
|
||||||
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
|
||||||
retarray->dim[0].stride = 1;
|
retarray->dim[0].stride = 1;
|
||||||
|
|
||||||
retarray->dim[1].lbound = 0;
|
retarray->dim[1].lbound = 0;
|
||||||
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
|
||||||
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
retarray->dim[1].stride = retarray->dim[0].ubound+1;
|
||||||
}
|
}
|
||||||
|
|
||||||
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->base = 0;
|
retarray->base = 0;
|
||||||
|
|
@ -159,7 +159,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
|
||||||
/* bystride should never be used for 1-dimensional b.
|
/* bystride should never be used for 1-dimensional b.
|
||||||
in case it is we want it to cause a segfault, rather than
|
in case it is we want it to cause a segfault, rather than
|
||||||
an incorrect result. */
|
an incorrect result. */
|
||||||
bystride = 0xDEADBEEF;
|
bystride = 0xDEADBEEF;
|
||||||
ycount = 1;
|
ycount = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue