This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
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 to gfc_unit structure.
* io/list_read.c: Revise nml_loop_spec references to array_loop_spec.
* io/transfer.c (next_record_r): Add array looping code.
(next_record_w): Add array looping code.
(finalize_transfer): Free memory allocated for array_loop_spec.
* io/unit.c (get_array_unit_len) Add initialization of array_loop_spec.Index: libgfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/libgfortran.h,v
retrieving revision 1.38
diff -c -3 -p -r1.38 libgfortran.h
*** libgfortran.h 12 Oct 2005 20:21:31 -0000 1.38
--- libgfortran.h 15 Oct 2005 23:27:48 -0000
*************** typedef enum
*** 392,398 ****
ERROR_BAD_US,
ERROR_READ_VALUE,
ERROR_READ_OVERFLOW,
- ERROR_ARRAY_STRIDE,
ERROR_LAST /* Not a real error, the last error # + 1. */
}
error_codes;
--- 392,397 ----
Index: io/io.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/io.h,v
retrieving revision 1.33
diff -c -3 -p -r1.33 io.h
*** io/io.h 7 Oct 2005 20:02:28 -0000 1.33
--- io/io.h 15 Oct 2005 23:27:48 -0000
*************** stream;
*** 78,103 ****
#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
! /* Representation of a namelist object in libgfortran
!
! Namelist Records
! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
! or
! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
!
! The object can be a fully qualified, compound name for an instrinsic
! type, derived types or derived type components. So, a substring
! a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
! read. Hence full information about the structure of the object has
! to be available to list_read.c and write.
!
! 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. */
--- 78,88 ----
#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. */
*************** typedef struct nml_loop_spec
*** 112,121 ****
/* 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. */
typedef struct namelist_type
--- 97,121 ----
/* Step for the index counter. */
ssize_t step;
}
! array_loop_spec;
!
! /* Representation of a namelist object in libgfortran
!
! Namelist Records
! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
! or
! &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
!
! The object can be a fully qualified, compound name for an instrinsic
! type, derived types or derived type components. So, a substring
! a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
! read. Hence full information about the structure of the object has
! to be available to list_read.c and write.
!
! These requirements are met by the following data structures.
! 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
*************** typedef struct namelist_type
*** 146,152 ****
index_type string_length;
descriptor_dimension * dim;
! nml_loop_spec * ls;
struct namelist_type * next;
}
namelist_info;
--- 146,152 ----
index_type string_length;
descriptor_dimension * dim;
! array_loop_spec * ls;
struct namelist_type * next;
}
namelist_info;
*************** typedef struct gfc_unit
*** 326,331 ****
--- 326,332 ----
maxrec -- Maximum record number in a direct access file
bytes_left -- Bytes left in current record. */
+ array_loop_spec *ls; /* For traversing arrays */
int file_len;
char file[1]; /* Filename is allocated at the end of the structure. */
}
Index: io/list_read.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/list_read.c,v
retrieving revision 1.28
diff -c -3 -p -r1.28 list_read.c
*** io/list_read.c 26 Sep 2005 20:24:44 -0000 1.28
--- io/list_read.c 15 Oct 2005 23:27:49 -0000
*************** calls:
*** 1469,1475 ****
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)
static void nml_touch_nodes (namelist_info * nl)
static int nml_read_obj (namelist_info * nl, index_type offset)
calls:
--- 1469,1475 ----
static void nml_untouch_nodes (void)
static namelist_info * find_nml_node (char * var_name)
static int nml_parse_qualifier(descriptor_dimension * ad,
! 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:
*************** static index_type chigh;
*** 1500,1506 ****
static try
nml_parse_qualifier(descriptor_dimension * ad,
! nml_loop_spec * ls, int rank)
{
int dim;
int indx;
--- 1500,1506 ----
static try
nml_parse_qualifier(descriptor_dimension * ad,
! array_loop_spec * ls, int rank)
{
int dim;
int indx;
*************** get_name:
*** 2222,2228 ****
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} };
if (nml_parse_qualifier (chd, ind, 1) == FAILURE)
{
--- 2222,2228 ----
if (c == '(' && nl->type == GFC_DTYPE_CHARACTER)
{
descriptor_dimension chd[1] = { {1, clow, nl->string_length} };
! array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} };
if (nml_parse_qualifier (chd, ind, 1) == FAILURE)
{
Index: io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.63
diff -c -3 -p -r1.63 transfer.c
*** io/transfer.c 7 Oct 2005 20:02:28 -0000 1.63
--- io/transfer.c 15 Oct 2005 23:27:50 -0000
*************** data_transfer_init (int read_flag)
*** 1460,1467 ****
static void
next_record_r (void)
{
! int rlength, length, bytes_left;
gfc_offset new;
char *p;
switch (current_mode ())
--- 1460,1468 ----
static void
next_record_r (void)
{
! int i, bytes_left, rlength, length, record, carry, rank;
gfc_offset new;
+ array_loop_spec *ls;
char *p;
switch (current_mode ())
*************** next_record_r (void)
*** 1516,1526 ****
if (is_internal_unit())
{
! 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
{
--- 1517,1565 ----
if (is_internal_unit())
{
! if (is_array_io())
! {
! /* Determine where the next record in the array is by moving
! through the loop specification. */
!
! carry = 1;
! record = 0;
! rank = GFC_DESCRIPTOR_RANK(ioparm.internal_unit_desc);
! ls = current_unit->ls;
! for (i = 0; i < 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;
! }
! record = record + (ls[i].idx - 1) * ls[i].step;
! }
!
! /* 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;
! }
! 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
{
*************** static void
*** 1554,1560 ****
next_record_w (void)
{
gfc_offset c, m;
! int length, bytes_left;
char *p;
/* Zero counters for X- and T-editing. */
--- 1593,1601 ----
next_record_w (void)
{
gfc_offset c, m;
! int bytes_left, carry, i, length, rank;
! gfc_offset record;
! array_loop_spec *ls;
char *p;
/* Zero counters for X- and T-editing. */
*************** next_record_w (void)
*** 1633,1638 ****
--- 1674,1710 ----
return;
}
memset(p, ' ', bytes_left);
+
+ /* Now that the current record has been padded out,
+ determine where the next record in the array is by moving
+ through the loop specification. */
+
+ carry = 1;
+ record = 0;
+ rank = GFC_DESCRIPTOR_RANK(ioparm.internal_unit_desc);
+ ls = current_unit->ls;
+ for (i = 0; i < 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;
+ }
+ record = record + (ls[i].idx - 1) * ls[i].step;
+ }
+
+ /* 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
*************** finalize_transfer (void)
*** 1766,1772 ****
sfree (current_unit->s);
if (is_internal_unit ())
! sclose (current_unit->s);
}
--- 1838,1848 ----
sfree (current_unit->s);
if (is_internal_unit ())
! {
! if (current_unit->ls != NULL)
! free_mem (current_unit->ls);
! sclose (current_unit->s);
! }
}
*************** st_set_nml_var (void * var_addr, char *
*** 1957,1964 ****
{
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));
}
else
{
--- 2033,2040 ----
{
nml->dim = (descriptor_dimension*)
get_mem (nml->var_rank * sizeof (descriptor_dimension));
! nml->ls = (array_loop_spec*)
! get_mem (nml->var_rank * sizeof (array_loop_spec));
}
else
{
Index: io/unit.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/unit.c,v
retrieving revision 1.16
diff -c -3 -p -r1.16 unit.c
*** io/unit.c 1 Oct 2005 11:50:09 -0000 1.16
--- io/unit.c 15 Oct 2005 23:27:50 -0000
*************** gfc_offset
*** 251,270 ****
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;
}
--- 251,276 ----
get_array_unit_len (gfc_array_char *desc)
{
gfc_offset record_count;
! int i, rank;
rank = GFC_DESCRIPTOR_RANK(desc);
!
! record_count = 1;
! internal_unit.ls = (array_loop_spec*)
! get_mem (rank * sizeof (array_loop_spec));
!
! for (i=0; i<rank; ++i)
{
! /* Initialize the loop specification */
! internal_unit.ls[i].idx = 1;
! internal_unit.ls[i].start = desc->dim[i].lbound;
! internal_unit.ls[i].end = desc->dim[i].ubound;
! internal_unit.ls[i].step = desc->dim[i].stride;
!
! /* Determine the number of records */
!
! record_count += (desc->dim[i].ubound - desc->dim[i].lbound)
! * desc->dim[i].stride;
}
return record_count;
}
Index: runtime/error.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/runtime/error.c,v
retrieving revision 1.16
diff -c -3 -p -r1.16 error.c
*** runtime/error.c 1 Oct 2005 11:50:09 -0000 1.16
--- runtime/error.c 15 Oct 2005 23:27:50 -0000
*************** translate_error (int code)
*** 427,436 ****
p = "Numeric overflow on read";
break;
- case ERROR_ARRAY_STRIDE:
- p = "Array unit stride must be 1";
- break;
-
default:
p = "Unknown error code";
break;
--- 427,432 ----
Attachment:
arrayio_4.f90
Description: application/extension-f90
Attachment:
arrayio_6.f90
Description: application/extension-f90
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |