From 965eec1676035e748a44bc0069f1b046c40a470c Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Tue, 25 Oct 2005 01:32:33 +0000 Subject: [PATCH] re PR libfortran/24224 (Generalized internal array IO not implemented.) 2005-10-24 Jerry DeLisle 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 --- libgfortran/ChangeLog | 19 ++++++ libgfortran/io/io.h | 73 ++++++++++++----------- libgfortran/io/list_read.c | 6 +- libgfortran/io/transfer.c | 113 +++++++++++++++++++++++++++++++----- libgfortran/io/unit.c | 37 +++--------- libgfortran/runtime/error.c | 4 -- 6 files changed, 170 insertions(+), 82 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 52ad1a91f64..e56e855614e 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,22 @@ +2005-10-24 Jerry DeLisle + + 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 PR fortran/24416 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 5e3adbc42d9..90ee36cd73f 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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); diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 2e1717ab463..95cb12659ac 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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) { diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index efd8e9dde4f..391885b5e3c 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -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; idim[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 { diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index b078d87c96a..c22d59376ee 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -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;idim[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; diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 60fc56c9d88..cdaa54255c2 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -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;