re PR libfortran/24224 (Generalized internal array IO not implemented.)
2005-10-24 Jerry DeLisle <jvdelisle@verizon.net> PR libgfortran/24224 * libgfortran.h: Remove array stride error code. * runtime/error.c: Remove array stride error. * io/io.h: Change name of 'nml_loop_spec' to 'array_loop_spec' to be generic. Add pointer to array_loop_spec and rank to gfc_unit structure. * io/list_read.c: Revise nml_loop_spec references to array_loop_spec. * io/transfer.c (init_loop_spec): New function to initialize an array_loop_spec. (next_array_record): New function to return the index to the next array record by incrementing through the array_loop_spec. (next_record_r): Use new function. (next_record_w): Use new function. (finalize_transfer): Free memory allocated for array_loop_spec. * io/unit.c (get_array_unit_len): Delete this function. Use new function init_loop_spec to initialize the array_loop_spec. From-SVN: r105878
This commit is contained in:
parent
8c4b4e67fb
commit
965eec1676
|
@ -1,3 +1,22 @@
|
||||||
|
2005-10-24 Jerry DeLisle <jvdelisle@verizon.net>
|
||||||
|
|
||||||
|
PR libgfortran/24224
|
||||||
|
* libgfortran.h: Remove array stride error code.
|
||||||
|
* runtime/error.c: Remove array stride error.
|
||||||
|
* io/io.h: Change name of 'nml_loop_spec' to 'array_loop_spec' to be
|
||||||
|
generic. Add pointer to array_loop_spec and rank to gfc_unit
|
||||||
|
structure.
|
||||||
|
* io/list_read.c: Revise nml_loop_spec references to array_loop_spec.
|
||||||
|
* io/transfer.c (init_loop_spec): New function to initialize
|
||||||
|
an array_loop_spec.
|
||||||
|
(next_array_record): New function to return the index to the next array
|
||||||
|
record by incrementing through the array_loop_spec.
|
||||||
|
(next_record_r): Use new function.
|
||||||
|
(next_record_w): Use new function.
|
||||||
|
(finalize_transfer): Free memory allocated for array_loop_spec.
|
||||||
|
* io/unit.c (get_array_unit_len): Delete this function. Use new
|
||||||
|
function init_loop_spec to initialize the array_loop_spec.
|
||||||
|
|
||||||
2005-10-24 Paul Thomas <pault@gcc.gnu.org>
|
2005-10-24 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/24416
|
PR fortran/24416
|
||||||
|
|
|
@ -78,6 +78,26 @@ stream;
|
||||||
#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
|
#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
|
||||||
#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
|
#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
|
||||||
|
|
||||||
|
/* The array_loop_spec contains the variables for the loops over index ranges
|
||||||
|
that are encountered. Since the variables can be negative, ssize_t
|
||||||
|
is used. */
|
||||||
|
|
||||||
|
typedef struct array_loop_spec
|
||||||
|
{
|
||||||
|
/* Index counter for this dimension. */
|
||||||
|
ssize_t idx;
|
||||||
|
|
||||||
|
/* Start for the index counter. */
|
||||||
|
ssize_t start;
|
||||||
|
|
||||||
|
/* End for the index counter. */
|
||||||
|
ssize_t end;
|
||||||
|
|
||||||
|
/* Step for the index counter. */
|
||||||
|
ssize_t step;
|
||||||
|
}
|
||||||
|
array_loop_spec;
|
||||||
|
|
||||||
/* Representation of a namelist object in libgfortran
|
/* Representation of a namelist object in libgfortran
|
||||||
|
|
||||||
Namelist Records
|
Namelist Records
|
||||||
|
@ -93,29 +113,8 @@ stream;
|
||||||
|
|
||||||
These requirements are met by the following data structures.
|
These requirements are met by the following data structures.
|
||||||
|
|
||||||
nml_loop_spec contains the variables for the loops over index ranges
|
namelist_info type contains all the scalar information about the
|
||||||
that are encountered. Since the variables can be negative, ssize_t
|
object and arrays of descriptor_dimension and array_loop_spec types for
|
||||||
is used. */
|
|
||||||
|
|
||||||
typedef struct nml_loop_spec
|
|
||||||
{
|
|
||||||
|
|
||||||
/* Index counter for this dimension. */
|
|
||||||
ssize_t idx;
|
|
||||||
|
|
||||||
/* Start for the index counter. */
|
|
||||||
ssize_t start;
|
|
||||||
|
|
||||||
/* End for the index counter. */
|
|
||||||
ssize_t end;
|
|
||||||
|
|
||||||
/* Step for the index counter. */
|
|
||||||
ssize_t step;
|
|
||||||
}
|
|
||||||
nml_loop_spec;
|
|
||||||
|
|
||||||
/* namelist_info type contains all the scalar information about the
|
|
||||||
object and arrays of descriptor_dimension and nml_loop_spec types for
|
|
||||||
arrays. */
|
arrays. */
|
||||||
|
|
||||||
typedef struct namelist_type
|
typedef struct namelist_type
|
||||||
|
@ -146,7 +145,7 @@ typedef struct namelist_type
|
||||||
index_type string_length;
|
index_type string_length;
|
||||||
|
|
||||||
descriptor_dimension * dim;
|
descriptor_dimension * dim;
|
||||||
nml_loop_spec * ls;
|
array_loop_spec * ls;
|
||||||
struct namelist_type * next;
|
struct namelist_type * next;
|
||||||
}
|
}
|
||||||
namelist_info;
|
namelist_info;
|
||||||
|
@ -306,10 +305,10 @@ unit_flags;
|
||||||
typedef struct gfc_unit
|
typedef struct gfc_unit
|
||||||
{
|
{
|
||||||
int unit_number;
|
int unit_number;
|
||||||
|
|
||||||
stream *s;
|
stream *s;
|
||||||
|
|
||||||
struct gfc_unit *left, *right; /* Treap links. */
|
/* Treap links. */
|
||||||
|
struct gfc_unit *left, *right;
|
||||||
int priority;
|
int priority;
|
||||||
|
|
||||||
int read_bad, current_record;
|
int read_bad, current_record;
|
||||||
|
@ -319,15 +318,20 @@ typedef struct gfc_unit
|
||||||
|
|
||||||
unit_mode mode;
|
unit_mode mode;
|
||||||
unit_flags flags;
|
unit_flags flags;
|
||||||
gfc_offset recl, last_record, maxrec, bytes_left;
|
|
||||||
|
|
||||||
/* recl -- Record length of the file.
|
/* recl -- Record length of the file.
|
||||||
last_record -- Last record number read or written
|
last_record -- Last record number read or written
|
||||||
maxrec -- Maximum record number in a direct access file
|
maxrec -- Maximum record number in a direct access file
|
||||||
bytes_left -- Bytes left in current record. */
|
bytes_left -- Bytes left in current record. */
|
||||||
|
gfc_offset recl, last_record, maxrec, bytes_left;
|
||||||
|
|
||||||
|
/* For traversing arrays */
|
||||||
|
array_loop_spec *ls;
|
||||||
|
int rank;
|
||||||
|
|
||||||
|
/* Filename is allocated at the end of the structure. */
|
||||||
int file_len;
|
int file_len;
|
||||||
char file[1]; /* Filename is allocated at the end of the structure. */
|
char file[1];
|
||||||
}
|
}
|
||||||
gfc_unit;
|
gfc_unit;
|
||||||
|
|
||||||
|
@ -533,9 +537,6 @@ internal_proto(is_internal_unit);
|
||||||
extern int is_array_io (void);
|
extern int is_array_io (void);
|
||||||
internal_proto(is_array_io);
|
internal_proto(is_array_io);
|
||||||
|
|
||||||
extern gfc_offset get_array_unit_len (gfc_array_char *);
|
|
||||||
internal_proto(get_array_unit_len);
|
|
||||||
|
|
||||||
extern gfc_unit *find_unit (int);
|
extern gfc_unit *find_unit (int);
|
||||||
internal_proto(find_unit);
|
internal_proto(find_unit);
|
||||||
|
|
||||||
|
@ -583,6 +584,12 @@ internal_proto(read_block);
|
||||||
extern void *write_block (int);
|
extern void *write_block (int);
|
||||||
internal_proto(write_block);
|
internal_proto(write_block);
|
||||||
|
|
||||||
|
extern gfc_offset next_array_record (array_loop_spec *);
|
||||||
|
internal_proto(next_array_record);
|
||||||
|
|
||||||
|
extern gfc_offset init_loop_spec (gfc_array_char *desc, array_loop_spec *ls);
|
||||||
|
internal_proto(init_loop_spec);
|
||||||
|
|
||||||
extern void next_record (int);
|
extern void next_record (int);
|
||||||
internal_proto(next_record);
|
internal_proto(next_record);
|
||||||
|
|
||||||
|
|
|
@ -1469,7 +1469,7 @@ calls:
|
||||||
static void nml_untouch_nodes (void)
|
static void nml_untouch_nodes (void)
|
||||||
static namelist_info * find_nml_node (char * var_name)
|
static namelist_info * find_nml_node (char * var_name)
|
||||||
static int nml_parse_qualifier(descriptor_dimension * ad,
|
static int nml_parse_qualifier(descriptor_dimension * ad,
|
||||||
nml_loop_spec * ls, int rank)
|
array_loop_spec * ls, int rank)
|
||||||
static void nml_touch_nodes (namelist_info * nl)
|
static void nml_touch_nodes (namelist_info * nl)
|
||||||
static int nml_read_obj (namelist_info * nl, index_type offset)
|
static int nml_read_obj (namelist_info * nl, index_type offset)
|
||||||
calls:
|
calls:
|
||||||
|
@ -1500,7 +1500,7 @@ static index_type chigh;
|
||||||
|
|
||||||
static try
|
static try
|
||||||
nml_parse_qualifier(descriptor_dimension * ad,
|
nml_parse_qualifier(descriptor_dimension * ad,
|
||||||
nml_loop_spec * ls, int rank)
|
array_loop_spec * ls, int rank)
|
||||||
{
|
{
|
||||||
int dim;
|
int dim;
|
||||||
int indx;
|
int indx;
|
||||||
|
@ -2222,7 +2222,7 @@ get_name:
|
||||||
if (c == '(' && nl->type == GFC_DTYPE_CHARACTER)
|
if (c == '(' && nl->type == GFC_DTYPE_CHARACTER)
|
||||||
{
|
{
|
||||||
descriptor_dimension chd[1] = { {1, clow, nl->string_length} };
|
descriptor_dimension chd[1] = { {1, clow, nl->string_length} };
|
||||||
nml_loop_spec ind[1] = { {1, clow, nl->string_length, 1} };
|
array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} };
|
||||||
|
|
||||||
if (nml_parse_qualifier (chd, ind, 1) == FAILURE)
|
if (nml_parse_qualifier (chd, ind, 1) == FAILURE)
|
||||||
{
|
{
|
||||||
|
|
|
@ -258,7 +258,7 @@ read_block (int *length)
|
||||||
|
|
||||||
*length = current_unit->bytes_left;
|
*length = current_unit->bytes_left;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (current_unit->flags.form == FORM_FORMATTED &&
|
if (current_unit->flags.form == FORM_FORMATTED &&
|
||||||
current_unit->flags.access == ACCESS_SEQUENTIAL)
|
current_unit->flags.access == ACCESS_SEQUENTIAL)
|
||||||
return read_sf (length); /* Special case. */
|
return read_sf (length); /* Special case. */
|
||||||
|
@ -1450,6 +1450,60 @@ data_transfer_init (int read_flag)
|
||||||
formatted_transfer (0, NULL, 0, 1);
|
formatted_transfer (0, NULL, 0, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Initialize an array_loop_spec given the array descriptor. The function
|
||||||
|
returns the index of the last element of the array. */
|
||||||
|
|
||||||
|
gfc_offset
|
||||||
|
init_loop_spec (gfc_array_char *desc, array_loop_spec *ls)
|
||||||
|
{
|
||||||
|
int rank = GFC_DESCRIPTOR_RANK(desc);
|
||||||
|
int i;
|
||||||
|
gfc_offset index;
|
||||||
|
|
||||||
|
index = 1;
|
||||||
|
for (i=0; i<rank; i++)
|
||||||
|
{
|
||||||
|
ls[i].idx = 1;
|
||||||
|
ls[i].start = desc->dim[i].lbound;
|
||||||
|
ls[i].end = desc->dim[i].ubound;
|
||||||
|
ls[i].step = desc->dim[i].stride;
|
||||||
|
|
||||||
|
index += (desc->dim[i].ubound - desc->dim[i].lbound)
|
||||||
|
* desc->dim[i].stride;
|
||||||
|
}
|
||||||
|
return index;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Determine the index to the next record in an internal unit array by
|
||||||
|
by incrementing through the array_loop_spec. TODO: Implement handling
|
||||||
|
negative strides. */
|
||||||
|
|
||||||
|
gfc_offset
|
||||||
|
next_array_record ( array_loop_spec * ls )
|
||||||
|
{
|
||||||
|
int i, carry;
|
||||||
|
gfc_offset index;
|
||||||
|
|
||||||
|
carry = 1;
|
||||||
|
index = 0;
|
||||||
|
|
||||||
|
for (i = 0; i < current_unit->rank; i++)
|
||||||
|
{
|
||||||
|
if (carry)
|
||||||
|
{
|
||||||
|
ls[i].idx++;
|
||||||
|
if (ls[i].idx > ls[i].end)
|
||||||
|
{
|
||||||
|
ls[i].idx = ls[i].start;
|
||||||
|
carry = 1;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
carry = 0;
|
||||||
|
}
|
||||||
|
index = index + (ls[i].idx - 1) * ls[i].step;
|
||||||
|
}
|
||||||
|
return index;
|
||||||
|
}
|
||||||
|
|
||||||
/* Space to the next record for read mode. If the file is not
|
/* Space to the next record for read mode. If the file is not
|
||||||
seekable, we read MAX_READ chunks until we get to the right
|
seekable, we read MAX_READ chunks until we get to the right
|
||||||
|
@ -1460,8 +1514,8 @@ data_transfer_init (int read_flag)
|
||||||
static void
|
static void
|
||||||
next_record_r (void)
|
next_record_r (void)
|
||||||
{
|
{
|
||||||
int rlength, length, bytes_left;
|
gfc_offset new, record;
|
||||||
gfc_offset new;
|
int bytes_left, rlength, length;
|
||||||
char *p;
|
char *p;
|
||||||
|
|
||||||
switch (current_mode ())
|
switch (current_mode ())
|
||||||
|
@ -1516,11 +1570,27 @@ next_record_r (void)
|
||||||
|
|
||||||
if (is_internal_unit())
|
if (is_internal_unit())
|
||||||
{
|
{
|
||||||
bytes_left = (int) current_unit->bytes_left;
|
if (is_array_io())
|
||||||
p = salloc_r (current_unit->s, &bytes_left);
|
{
|
||||||
if (p != NULL)
|
record = next_array_record (current_unit->ls);
|
||||||
|
|
||||||
|
/* Now seek to this record. */
|
||||||
|
record = record * current_unit->recl;
|
||||||
|
if (sseek (current_unit->s, record) == FAILURE)
|
||||||
|
{
|
||||||
|
generate_error (ERROR_OS, NULL);
|
||||||
|
break;
|
||||||
|
}
|
||||||
current_unit->bytes_left = current_unit->recl;
|
current_unit->bytes_left = current_unit->recl;
|
||||||
break;
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
bytes_left = (int) current_unit->bytes_left;
|
||||||
|
p = salloc_r (current_unit->s, &bytes_left);
|
||||||
|
if (p != NULL)
|
||||||
|
current_unit->bytes_left = current_unit->recl;
|
||||||
|
}
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
else do
|
else do
|
||||||
{
|
{
|
||||||
|
@ -1553,8 +1623,8 @@ next_record_r (void)
|
||||||
static void
|
static void
|
||||||
next_record_w (void)
|
next_record_w (void)
|
||||||
{
|
{
|
||||||
gfc_offset c, m;
|
gfc_offset c, m, record;
|
||||||
int length, bytes_left;
|
int bytes_left, length;
|
||||||
char *p;
|
char *p;
|
||||||
|
|
||||||
/* Zero counters for X- and T-editing. */
|
/* Zero counters for X- and T-editing. */
|
||||||
|
@ -1633,6 +1703,18 @@ next_record_w (void)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
memset(p, ' ', bytes_left);
|
memset(p, ' ', bytes_left);
|
||||||
|
|
||||||
|
/* Now that the current record has been padded out,
|
||||||
|
determine where the next record in the array is. */
|
||||||
|
|
||||||
|
record = next_array_record (current_unit->ls);
|
||||||
|
|
||||||
|
/* Now seek to this record */
|
||||||
|
record = record * current_unit->recl;
|
||||||
|
|
||||||
|
if (sseek (current_unit->s, record) == FAILURE)
|
||||||
|
goto io_error;
|
||||||
|
|
||||||
current_unit->bytes_left = current_unit->recl;
|
current_unit->bytes_left = current_unit->recl;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
@ -1672,7 +1754,6 @@ next_record_w (void)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Position to the next record, which means moving to the end of the
|
/* Position to the next record, which means moving to the end of the
|
||||||
current record. This can happen under several different
|
current record. This can happen under several different
|
||||||
conditions. If the done flag is not set, we get ready to process
|
conditions. If the done flag is not set, we get ready to process
|
||||||
|
@ -1711,7 +1792,7 @@ next_record (int done)
|
||||||
|
|
||||||
/* Finalize the current data transfer. For a nonadvancing transfer,
|
/* Finalize the current data transfer. For a nonadvancing transfer,
|
||||||
this means advancing to the next record. For internal units close the
|
this means advancing to the next record. For internal units close the
|
||||||
steam associated with the unit. */
|
stream associated with the unit. */
|
||||||
|
|
||||||
static void
|
static void
|
||||||
finalize_transfer (void)
|
finalize_transfer (void)
|
||||||
|
@ -1766,7 +1847,11 @@ finalize_transfer (void)
|
||||||
sfree (current_unit->s);
|
sfree (current_unit->s);
|
||||||
|
|
||||||
if (is_internal_unit ())
|
if (is_internal_unit ())
|
||||||
sclose (current_unit->s);
|
{
|
||||||
|
if (is_array_io() && current_unit->ls != NULL)
|
||||||
|
free_mem (current_unit->ls);
|
||||||
|
sclose (current_unit->s);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -1957,8 +2042,8 @@ st_set_nml_var (void * var_addr, char * var_name, GFC_INTEGER_4 len,
|
||||||
{
|
{
|
||||||
nml->dim = (descriptor_dimension*)
|
nml->dim = (descriptor_dimension*)
|
||||||
get_mem (nml->var_rank * sizeof (descriptor_dimension));
|
get_mem (nml->var_rank * sizeof (descriptor_dimension));
|
||||||
nml->ls = (nml_loop_spec*)
|
nml->ls = (array_loop_spec*)
|
||||||
get_mem (nml->var_rank * sizeof (nml_loop_spec));
|
get_mem (nml->var_rank * sizeof (array_loop_spec));
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
|
|
@ -244,32 +244,6 @@ find_unit (int n)
|
||||||
return p;
|
return p;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* get_array_unit_len()-- return the number of records in the array. */
|
|
||||||
|
|
||||||
gfc_offset
|
|
||||||
get_array_unit_len (gfc_array_char *desc)
|
|
||||||
{
|
|
||||||
gfc_offset record_count;
|
|
||||||
int i, rank, stride;
|
|
||||||
rank = GFC_DESCRIPTOR_RANK(desc);
|
|
||||||
record_count = stride = 1;
|
|
||||||
for (i=0;i<rank;++i)
|
|
||||||
{
|
|
||||||
/* Check that array is contiguous */
|
|
||||||
|
|
||||||
if (desc->dim[i].stride != stride)
|
|
||||||
{
|
|
||||||
generate_error (ERROR_ARRAY_STRIDE, NULL);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
stride *= desc->dim[i].ubound;
|
|
||||||
record_count *= desc->dim[i].ubound;
|
|
||||||
}
|
|
||||||
return record_count;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/* get_unit()-- Returns the unit structure associated with the integer
|
/* get_unit()-- Returns the unit structure associated with the integer
|
||||||
* unit or the internal file. */
|
* unit or the internal file. */
|
||||||
|
|
||||||
|
@ -279,8 +253,15 @@ get_unit (int read_flag __attribute__ ((unused)))
|
||||||
if (ioparm.internal_unit != NULL)
|
if (ioparm.internal_unit != NULL)
|
||||||
{
|
{
|
||||||
internal_unit.recl = ioparm.internal_unit_len;
|
internal_unit.recl = ioparm.internal_unit_len;
|
||||||
if (is_array_io()) ioparm.internal_unit_len *=
|
if (is_array_io())
|
||||||
get_array_unit_len(ioparm.internal_unit_desc);
|
{
|
||||||
|
internal_unit.rank = GFC_DESCRIPTOR_RANK(ioparm.internal_unit_desc);
|
||||||
|
internal_unit.ls = (array_loop_spec*)
|
||||||
|
get_mem (internal_unit.rank * sizeof (array_loop_spec));
|
||||||
|
ioparm.internal_unit_len *=
|
||||||
|
init_loop_spec (ioparm.internal_unit_desc, internal_unit.ls);
|
||||||
|
}
|
||||||
|
|
||||||
internal_unit.s =
|
internal_unit.s =
|
||||||
open_internal (ioparm.internal_unit, ioparm.internal_unit_len);
|
open_internal (ioparm.internal_unit, ioparm.internal_unit_len);
|
||||||
internal_unit.bytes_left = internal_unit.recl;
|
internal_unit.bytes_left = internal_unit.recl;
|
||||||
|
|
|
@ -427,10 +427,6 @@ translate_error (int code)
|
||||||
p = "Numeric overflow on read";
|
p = "Numeric overflow on read";
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case ERROR_ARRAY_STRIDE:
|
|
||||||
p = "Array unit stride must be 1";
|
|
||||||
break;
|
|
||||||
|
|
||||||
default:
|
default:
|
||||||
p = "Unknown error code";
|
p = "Unknown error code";
|
||||||
break;
|
break;
|
||||||
|
|
Loading…
Reference in New Issue