OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Jerry DeLisle 2005-10-25 01:32:33 +00:00 committed by Jerry DeLisle
parent 8c4b4e67fb
commit 965eec1676
6 changed files with 170 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
libgfortran/ChangeLog
View File

@ -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>
PR fortran/24416

73
libgfortran/io/io.h
View File

@ -78,6 +78,26 @@ stream;
#define sread(s, buf, nbytes) ((s)->read)(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
Namelist Records
@ -93,29 +113,8 @@ stream;
These requirements are met by the following data structures.
nml_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 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
namelist_info type contains all the scalar information about the
object and arrays of descriptor_dimension and array_loop_spec types for
arrays. */
typedef struct namelist_type
@ -146,7 +145,7 @@ typedef struct namelist_type
index_type string_length;
descriptor_dimension * dim;
nml_loop_spec * ls;
array_loop_spec * ls;
struct namelist_type * next;
}
namelist_info;
@ -306,10 +305,10 @@ unit_flags;
typedef struct gfc_unit
{
int unit_number;
stream *s;
struct gfc_unit *left, *right; /* Treap links. */
/* Treap links. */
struct gfc_unit *left, *right;
int priority;
int read_bad, current_record;
@ -319,15 +318,20 @@ typedef struct gfc_unit
unit_mode mode;
unit_flags flags;
gfc_offset recl, last_record, maxrec, bytes_left;
/* recl -- Record length of the file.
last_record -- Last record number read or written
maxrec -- Maximum record number in a direct access file
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;
char file[1]; /* Filename is allocated at the end of the structure. */
char file[1];
}
gfc_unit;
@ -533,9 +537,6 @@ internal_proto(is_internal_unit);
extern int is_array_io (void);
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);
internal_proto(find_unit);
@ -583,6 +584,12 @@ internal_proto(read_block);
extern void *write_block (int);
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);
internal_proto(next_record);

6
libgfortran/io/list_read.c
View File

@ -1469,7 +1469,7 @@ calls:
static void nml_untouch_nodes (void)
static namelist_info * find_nml_node (char * var_name)
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 int nml_read_obj (namelist_info * nl, index_type offset)
calls:
@ -1500,7 +1500,7 @@ static index_type chigh;
static try
nml_parse_qualifier(descriptor_dimension * ad,
nml_loop_spec * ls, int rank)
array_loop_spec * ls, int rank)
{
int dim;
int indx;
@ -2222,7 +2222,7 @@ get_name:
if (c == '(' && nl->type == GFC_DTYPE_CHARACTER)
{
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)
{

113
libgfortran/io/transfer.c
View File

@ -258,7 +258,7 @@ read_block (int *length)
*length = current_unit->bytes_left;
}
if (current_unit->flags.form == FORM_FORMATTED &&
current_unit->flags.access == ACCESS_SEQUENTIAL)
return read_sf (length); /* Special case. */
@ -1450,6 +1450,60 @@ data_transfer_init (int read_flag)
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
seekable, we read MAX_READ chunks until we get to the right
@ -1460,8 +1514,8 @@ data_transfer_init (int read_flag)
static void
next_record_r (void)
{
int rlength, length, bytes_left;
gfc_offset new;
gfc_offset new, record;
int bytes_left, rlength, length;
char *p;
switch (current_mode ())
@ -1516,11 +1570,27 @@ next_record_r (void)
if (is_internal_unit())
{
bytes_left = (int) current_unit->bytes_left;
p = salloc_r (current_unit->s, &bytes_left);
if (p != NULL)
if (is_array_io())
{
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;
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
{
@ -1553,8 +1623,8 @@ next_record_r (void)
static void
next_record_w (void)
{
gfc_offset c, m;
int length, bytes_left;
gfc_offset c, m, record;
int bytes_left, length;
char *p;
/* Zero counters for X- and T-editing. */
@ -1633,6 +1703,18 @@ next_record_w (void)
return;
}
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;
}
else
@ -1672,7 +1754,6 @@ next_record_w (void)
}
}
/* Position to the next record, which means moving to the end of the
current record. This can happen under several different
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,
this means advancing to the next record. For internal units close the
steam associated with the unit. */
stream associated with the unit. */
static void
finalize_transfer (void)
@ -1766,7 +1847,11 @@ finalize_transfer (void)
sfree (current_unit->s);
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*)
get_mem (nml->var_rank * sizeof (descriptor_dimension));
nml->ls = (nml_loop_spec*)
get_mem (nml->var_rank * sizeof (nml_loop_spec));
nml->ls = (array_loop_spec*)
get_mem (nml->var_rank * sizeof (array_loop_spec));
}
else
{

37
libgfortran/io/unit.c
View File

@ -244,32 +244,6 @@ find_unit (int n)
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
* unit or the internal file. */
@ -279,8 +253,15 @@ get_unit (int read_flag __attribute__ ((unused)))
if (ioparm.internal_unit != NULL)
{
internal_unit.recl = ioparm.internal_unit_len;
if (is_array_io()) ioparm.internal_unit_len *=
get_array_unit_len(ioparm.internal_unit_desc);
if (is_array_io())
{
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 =
open_internal (ioparm.internal_unit, ioparm.internal_unit_len);
internal_unit.bytes_left = internal_unit.recl;

4
libgfortran/runtime/error.c
View File

@ -427,10 +427,6 @@ translate_error (int code)
p = "Numeric overflow on read";
break;
case ERROR_ARRAY_STRIDE:
p = "Array unit stride must be 1";
break;
default:
p = "Unknown error code";
break;