diff options
author | jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-11-22 08:10:41 +0000 |
---|---|---|
committer | jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-11-22 08:10:41 +0000 |
commit | b5d015e3eb036000e3aeb3c510b76a7b06cc7b4a (patch) | |
tree | fd3f39fc5493d036706217573269adc0cd79d272 | |
parent | b07ff86b61d685482f617bd89d6bb672aa745962 (diff) | |
download | gcc-b5d015e3eb036000e3aeb3c510b76a7b06cc7b4a.tar.gz |
PR libfortran/37839
* trans-io.c (gfc_build_io_library_fndecls): Decrease pad size back
to 16 pointers plus 32 integers. Don't use max integer kind
alignment, only gfc_intio_kind's alignment.
(gfc_trans_inquire): Only set flags2 if mask2 is non-zero.
* ioparm.def: Fix order, bitmasks and types of inquire round, sign
and pending fields. Move u in dt before id.
* io.c (gfc_free_inquire): Free decimal and size exprs.
(match_inquire_element): Match size instead of matching blank twice.
(gfc_resolve_inquire): Resolve size.
* gfortran.dg/f2003_inquire_1.f03: New test.
* gfortran.dg/f2003_io_1.f03: Remove xfail.
* gfortran.dg/f2003_io_4.f03: Likewise.
* gfortran.dg/f2003_io_5.f03: Likewise.
* gfortran.dg/f2003_io_6.f03: Likewise.
* gfortran.dg/f2003_io_7.f03: Likewise.
* io/io.h (IOPARM_INQUIRE_HAS_ROUND, IOPARM_INQUIRE_HAS_SIGN,
IOPARM_INQUIRE_HAS_PENDING): Adjust values.
(st_parameter_inquire): Reorder and fix types of round, sign and
pending fields.
(st_parameter_43, st_parameter_44): Removed.
(st_parameter_dt): Put back struct definition directly to u.p
declaration. Change type of u.p.size_used from gfc_offset to
GFC_IO_INT. Decrease back size of u.pad to 16 pointers and
32 ints. Put id, pos, asynchronous, blank, decimal, delim,
pad, round and sign fields after the union.
* io/inquire.c (inquire_via_unit, inquire_via_filename): Only read
flags2 if it is defined.
* io/transfer.c (read_sf, read_block_form, write_block): Cast
additions to size_used to GFC_IO_INT instead of gfc_offset.
(data_transfer_init): Clear whole u.p struct. Adjust
for moving id, pos, asynchronous, blank, decimal, delim, pad,
round and sign fields from u.p directly into st_parameter_dt.
(finalize_transfer): Don't cast size_used to GFC_IO_INT.
* io/file_pos.c (st_endfile): Clear whole u.p struct.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@142111 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 13 | ||||
-rw-r--r-- | gcc/fortran/io.c | 5 | ||||
-rw-r--r-- | gcc/fortran/ioparm.def | 8 | ||||
-rw-r--r-- | gcc/fortran/trans-io.c | 10 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 | 21 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/f2003_io_1.f03 | 1 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/f2003_io_4.f03 | 1 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/f2003_io_5.f03 | 1 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/f2003_io_6.f03 | 1 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/f2003_io_7.f03 | 1 | ||||
-rw-r--r-- | libgfortran/ChangeLog | 23 | ||||
-rw-r--r-- | libgfortran/io/file_pos.c | 2 | ||||
-rw-r--r-- | libgfortran/io/inquire.c | 6 | ||||
-rw-r--r-- | libgfortran/io/io.h | 268 | ||||
-rw-r--r-- | libgfortran/io/transfer.c | 24 |
16 files changed, 187 insertions, 208 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 941186fcbd5..f1ac3ed5588 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2008-11-22 Jakub Jelinek <jakub@redhat.com> + + PR libfortran/37839 + * trans-io.c (gfc_build_io_library_fndecls): Decrease pad size back + to 16 pointers plus 32 integers. Don't use max integer kind + alignment, only gfc_intio_kind's alignment. + (gfc_trans_inquire): Only set flags2 if mask2 is non-zero. + * ioparm.def: Fix order, bitmasks and types of inquire round, sign + and pending fields. Move u in dt before id. + * io.c (gfc_free_inquire): Free decimal and size exprs. + (match_inquire_element): Match size instead of matching blank twice. + (gfc_resolve_inquire): Resolve size. + 2008-11-20 Jakub Jelinek <jakub@redhat.com> PR middle-end/29215 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 1c42a96d714..85b712f5977 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -3540,9 +3540,11 @@ gfc_free_inquire (gfc_inquire *inquire) gfc_free_expr (inquire->convert); gfc_free_expr (inquire->strm_pos); gfc_free_expr (inquire->asynchronous); + gfc_free_expr (inquire->decimal); gfc_free_expr (inquire->pending); gfc_free_expr (inquire->id); gfc_free_expr (inquire->sign); + gfc_free_expr (inquire->size); gfc_free_expr (inquire->round); gfc_free (inquire); } @@ -3584,7 +3586,7 @@ match_inquire_element (gfc_inquire *inquire) RETM m = match_vtag (&tag_s_async, &inquire->asynchronous); RETM m = match_vtag (&tag_s_delim, &inquire->delim); RETM m = match_vtag (&tag_s_decimal, &inquire->decimal); - RETM m = match_vtag (&tag_s_blank, &inquire->blank); + RETM m = match_vtag (&tag_size, &inquire->size); RETM m = match_vtag (&tag_s_encoding, &inquire->encoding); RETM m = match_vtag (&tag_s_round, &inquire->round); RETM m = match_vtag (&tag_s_sign, &inquire->sign); @@ -3761,6 +3763,7 @@ gfc_resolve_inquire (gfc_inquire *inquire) RESOLVE_TAG (&tag_s_sign, inquire->sign); RESOLVE_TAG (&tag_s_round, inquire->round); RESOLVE_TAG (&tag_pending, inquire->pending); + RESOLVE_TAG (&tag_size, inquire->size); RESOLVE_TAG (&tag_id, inquire->id); if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def index deb1b98389c..eba719f0a91 100644 --- a/gcc/fortran/ioparm.def +++ b/gcc/fortran/ioparm.def @@ -63,9 +63,9 @@ IOPARM (inquire, flags2, 1 << 31, int4) IOPARM (inquire, asynchronous, 1 << 0, char1) IOPARM (inquire, decimal, 1 << 1, char2) IOPARM (inquire, encoding, 1 << 2, char1) -IOPARM (inquire, pending, 1 << 3, pint4) -IOPARM (inquire, round, 1 << 4, char1) -IOPARM (inquire, sign, 1 << 5, char2) +IOPARM (inquire, round, 1 << 3, char2) +IOPARM (inquire, sign, 1 << 4, char1) +IOPARM (inquire, pending, 1 << 5, pint4) IOPARM (inquire, size, 1 << 6, pint4) IOPARM (inquire, id, 1 << 7, pint4) IOPARM (wait, common, 0, common) @@ -83,6 +83,7 @@ IOPARM (dt, format, 1 << 12, char1) IOPARM (dt, advance, 1 << 13, char2) IOPARM (dt, internal_unit, 1 << 14, char1) IOPARM (dt, namelist_name, 1 << 15, char2) +IOPARM (dt, u, 0, pad) IOPARM (dt, id, 1 << 16, pint4) IOPARM (dt, pos, 1 << 17, intio) IOPARM (dt, asynchronous, 1 << 18, char1) @@ -92,4 +93,3 @@ IOPARM (dt, delim, 1 << 21, char2) IOPARM (dt, pad, 1 << 22, char1) IOPARM (dt, round, 1 << 23, char2) IOPARM (dt, sign, 1 << 24, char1) -IOPARM (dt, u, 0, pad) diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index af46ea2d65a..b5749ec89ac 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -291,9 +291,9 @@ gfc_build_io_library_fndecls (void) = build_pointer_type (gfc_intio_type_node); types[IOPARM_type_parray] = pchar_type_node; types[IOPARM_type_pchar] = pchar_type_node; - pad_size = 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node)); + pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node)); pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node)); - pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size)); + pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size - 1)); types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx); /* pad actually contains pointers and integers so it needs to have an @@ -301,7 +301,7 @@ gfc_build_io_library_fndecls (void) types. See the st_parameter_dt structure in libgfortran/io/io.h for what really goes into this space. */ TYPE_ALIGN (types[IOPARM_type_pad]) = MAX (TYPE_ALIGN (pchar_type_node), - TYPE_ALIGN (gfc_get_int_type (gfc_max_integer_kind))); + TYPE_ALIGN (gfc_get_int_type (gfc_intio_kind))); for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++) gfc_build_st_parameter (ptype, types); @@ -1315,10 +1315,8 @@ gfc_trans_inquire (gfc_code * code) mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id, p->id); - set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2); - if (mask2) - mask |= IOPARM_inquire_flags2; + mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2); set_parameter_const (&block, var, IOPARM_common_flags, mask); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c9e449fee1f..ef7faccef17 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2008-11-22 Jakub Jelinek <jakub@redhat.com> + + PR libfortran/37839 + * gfortran.dg/f2003_inquire_1.f03: New test. + * gfortran.dg/f2003_io_1.f03: Remove xfail. + * gfortran.dg/f2003_io_4.f03: Likewise. + * gfortran.dg/f2003_io_5.f03: Likewise. + * gfortran.dg/f2003_io_6.f03: Likewise. + * gfortran.dg/f2003_io_7.f03: Likewise. + 2008-11-21 Jakub Jelinek <jakub@redhat.com> PR middle-end/38200 diff --git a/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 b/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 new file mode 100644 index 00000000000..5f3a9612a3b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 @@ -0,0 +1,21 @@ +! { dg-do run { target fd_truncate } } +! { dg-options "-std=gnu" } +character(25) :: sround, ssign, sasynchronous, sdecimal, sencoding +integer :: vsize, vid +logical :: vpending + +open(10, file='mydata', asynchronous="yes", blank="null", & +& decimal="comma", encoding="utf-8", sign="plus") + +inquire(unit=10, round=sround, sign=ssign, size=vsize, id=vid, & +& pending=vpending, asynchronous=sasynchronous, decimal=sdecimal, & +& encoding=sencoding) + +if (ssign.ne."PLUS") call abort +if (sasynchronous.ne."YES") call abort +if (sdecimal.ne."COMMA") call abort +if (sencoding.ne."UTF-8") call abort +if (vpending) call abort + +close(10, status="delete") +end diff --git a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 b/gcc/testsuite/gfortran.dg/f2003_io_1.f03 index d5861d9cab3..f1d67c5aaae 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_1.f03 @@ -1,6 +1,5 @@ ! { dg-do run { target fd_truncate } } ! { dg-options "-std=gnu" } -! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } } ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> real :: a(4), b(4) real :: c diff --git a/gcc/testsuite/gfortran.dg/f2003_io_4.f03 b/gcc/testsuite/gfortran.dg/f2003_io_4.f03 index 5c45f9619ef..92c708c2921 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_4.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_4.f03 @@ -1,5 +1,4 @@ ! { dg-do run { target fd_truncate } } -! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } } ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test of decimal= feature diff --git a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 b/gcc/testsuite/gfortran.dg/f2003_io_5.f03 index c59e500ab07..3949b1a372f 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_5.f03 @@ -1,5 +1,4 @@ ! { dg-do run { target fd_truncate } } -! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } } ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test of decimal="comma" in namelist and complex integer :: i diff --git a/gcc/testsuite/gfortran.dg/f2003_io_6.f03 b/gcc/testsuite/gfortran.dg/f2003_io_6.f03 index ad16cf6b74c..40758e2232d 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_6.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_6.f03 @@ -1,5 +1,4 @@ ! { dg-do run } -! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } } ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test of decimal="comma" in namelist, checks separators implicit none diff --git a/gcc/testsuite/gfortran.dg/f2003_io_7.f03 b/gcc/testsuite/gfortran.dg/f2003_io_7.f03 index 488377d5c43..f45741718dc 100644 --- a/gcc/testsuite/gfortran.dg/f2003_io_7.f03 +++ b/gcc/testsuite/gfortran.dg/f2003_io_7.f03 @@ -1,5 +1,4 @@ ! { dg-do run { target fd_truncate } } -! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } } ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> ! Test of sign=, decimal=, and blank= . program iotests diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 56fff3fcf80..f2d279db20c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,26 @@ +2008-11-22 Jakub Jelinek <jakub@redhat.com> + + PR libfortran/37839 + * io/io.h (IOPARM_INQUIRE_HAS_ROUND, IOPARM_INQUIRE_HAS_SIGN, + IOPARM_INQUIRE_HAS_PENDING): Adjust values. + (st_parameter_inquire): Reorder and fix types of round, sign and + pending fields. + (st_parameter_43, st_parameter_44): Removed. + (st_parameter_dt): Put back struct definition directly to u.p + declaration. Change type of u.p.size_used from gfc_offset to + GFC_IO_INT. Decrease back size of u.pad to 16 pointers and + 32 ints. Put id, pos, asynchronous, blank, decimal, delim, + pad, round and sign fields after the union. + * io/inquire.c (inquire_via_unit, inquire_via_filename): Only read + flags2 if it is defined. + * io/transfer.c (read_sf, read_block_form, write_block): Cast + additions to size_used to GFC_IO_INT instead of gfc_offset. + (data_transfer_init): Clear whole u.p struct. Adjust + for moving id, pos, asynchronous, blank, decimal, delim, pad, + round and sign fields from u.p directly into st_parameter_dt. + (finalize_transfer): Don't cast size_used to GFC_IO_INT. + * io/file_pos.c (st_endfile): Clear whole u.p struct. + 2008-11-20 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libfortran/37472 diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 25b0108eef4..4054b3a5bb1 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -300,7 +300,7 @@ st_endfile (st_parameter_filepos *fpp) { st_parameter_dt dtp; dtp.common = fpp->common; - memset (&dtp.u.p.transfer, 0, sizeof (dtp.u.q)); + memset (&dtp.u.p, 0, sizeof (dtp.u.p)); dtp.u.p.current_unit = u; next_record (&dtp, 1); } diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 3b5f3f74473..4134f166202 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -43,7 +43,6 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) { const char *p; GFC_INTEGER_4 cf = iqp->common.flags; - GFC_INTEGER_4 cf2 = iqp->flags2; if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) { @@ -254,6 +253,8 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) if (cf & IOPARM_INQUIRE_HAS_FLAGS2) { + GFC_INTEGER_4 cf2 = iqp->flags2; + if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) *iqp->pending = 0; @@ -525,7 +526,6 @@ inquire_via_filename (st_parameter_inquire *iqp) { const char *p; GFC_INTEGER_4 cf = iqp->common.flags; - GFC_INTEGER_4 cf2 = iqp->flags2; if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) *iqp->exist = file_exists (iqp->file, iqp->file_len); @@ -586,6 +586,8 @@ inquire_via_filename (st_parameter_inquire *iqp) if (cf & IOPARM_INQUIRE_HAS_FLAGS2) { + GFC_INTEGER_4 cf2 = iqp->flags2; + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index ec37be37a81..1f363914866 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -310,9 +310,9 @@ st_parameter_filepos; #define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0) #define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1) #define IOPARM_INQUIRE_HAS_ENCODING (1 << 2) -#define IOPARM_INQUIRE_HAS_PENDING (1 << 3) -#define IOPARM_INQUIRE_HAS_ROUND (1 << 4) -#define IOPARM_INQUIRE_HAS_SIGN (1 << 5) +#define IOPARM_INQUIRE_HAS_ROUND (1 << 3) +#define IOPARM_INQUIRE_HAS_SIGN (1 << 4) +#define IOPARM_INQUIRE_HAS_PENDING (1 << 5) #define IOPARM_INQUIRE_HAS_SIZE (1 << 6) #define IOPARM_INQUIRE_HAS_ID (1 << 7) @@ -343,9 +343,9 @@ typedef struct CHARACTER1 (asynchronous); CHARACTER2 (decimal); CHARACTER1 (encoding); - CHARACTER2 (pending); - CHARACTER1 (round); - CHARACTER2 (sign); + CHARACTER2 (round); + CHARACTER1 (sign); + GFC_INTEGER_4 *pending; GFC_INTEGER_4 *size; GFC_INTEGER_4 *id; } @@ -377,172 +377,6 @@ struct format_data; #define IOPARM_DT_IONML_SET (1 << 31) -typedef struct st_parameter_43 -{ - void (*transfer) (struct st_parameter_dt *, bt, void *, int, - size_t, size_t); - struct gfc_unit *current_unit; - /* Item number in a formatted data transfer. Also used in namelist - read_logical as an index into line_buffer. */ - int item_count; - unit_mode mode; - unit_blank blank_status; - unit_sign sign_status; - int scale_factor; - int max_pos; /* Maximum righthand column written to. */ - /* Number of skips + spaces to be done for T and X-editing. */ - int skips; - /* Number of spaces to be done for T and X-editing. */ - int pending_spaces; - /* Whether an EOR condition was encountered. Value is: - 0 if no EOR was encountered - 1 if an EOR was encountered due to a 1-byte marker (LF) - 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ - int sf_seen_eor; - unit_advance advance_status; - unsigned reversion_flag : 1; /* Format reversion has occurred. */ - unsigned first_item : 1; - unsigned seen_dollar : 1; - unsigned eor_condition : 1; - unsigned no_leading_blank : 1; - unsigned char_flag : 1; - unsigned input_complete : 1; - unsigned at_eol : 1; - unsigned comma_flag : 1; - /* A namelist specific flag used in the list directed library - to flag that calls are being made from namelist read (eg. to - ignore comments or to treat '/' as a terminator) */ - unsigned namelist_mode : 1; - /* A namelist specific flag used in the list directed library - to flag read errors and return, so that an attempt can be - made to read a new object name. */ - unsigned nml_read_error : 1; - /* A sequential formatted read specific flag used to signal that a - character string is being read so don't use commas to shorten a - formatted field width. */ - unsigned sf_read_comma : 1; - /* A namelist specific flag used to enable reading input from - line_buffer for logical reads. */ - unsigned line_buffer_enabled : 1; - /* An internal unit specific flag used to identify that the associated - unit is internal. */ - unsigned unit_is_internal : 1; - /* An internal unit specific flag to signify an EOF condition for list - directed read. */ - unsigned at_eof : 1; - /* 16 unused bits. */ - - char last_char; - char nml_delim; - - int repeat_count; - int saved_length; - int saved_used; - bt saved_type; - char *saved_string; - char *scratch; - char *line_buffer; - struct format_data *fmt; - jmp_buf *eof_jump; - namelist_info *ionml; - /* A flag used to identify when a non-standard expanded namelist read - has occurred. */ - int expanded_read; - /* Storage area for values except for strings. Must be large - enough to hold a complex value (two reals) of the largest - kind. */ - char value[32]; - gfc_offset size_used; -} st_parameter_43; - - -typedef struct st_parameter_44 -{ - GFC_INTEGER_4 *id; - GFC_IO_INT pos; - CHARACTER1 (asynchronous); - CHARACTER2 (blank); - CHARACTER1 (decimal); - CHARACTER2 (delim); - CHARACTER1 (pad); - CHARACTER2 (round); - CHARACTER1 (sign); - void (*transfer) (struct st_parameter_dt *, bt, void *, int, - size_t, size_t); - struct gfc_unit *current_unit; - /* Item number in a formatted data transfer. Also used in namelist - read_logical as an index into line_buffer. */ - int item_count; - unit_mode mode; - unit_blank blank_status; - unit_sign sign_status; - int scale_factor; - int max_pos; /* Maximum righthand column written to. */ - /* Number of skips + spaces to be done for T and X-editing. */ - int skips; - /* Number of spaces to be done for T and X-editing. */ - int pending_spaces; - /* Whether an EOR condition was encountered. Value is: - 0 if no EOR was encountered - 1 if an EOR was encountered due to a 1-byte marker (LF) - 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ - int sf_seen_eor; - unit_advance advance_status; - unsigned reversion_flag : 1; /* Format reversion has occurred. */ - unsigned first_item : 1; - unsigned seen_dollar : 1; - unsigned eor_condition : 1; - unsigned no_leading_blank : 1; - unsigned char_flag : 1; - unsigned input_complete : 1; - unsigned at_eol : 1; - unsigned comma_flag : 1; - /* A namelist specific flag used in the list directed library - to flag that calls are being made from namelist read (eg. to - ignore comments or to treat '/' as a terminator) */ - unsigned namelist_mode : 1; - /* A namelist specific flag used in the list directed library - to flag read errors and return, so that an attempt can be - made to read a new object name. */ - unsigned nml_read_error : 1; - /* A sequential formatted read specific flag used to signal that a - character string is being read so don't use commas to shorten a - formatted field width. */ - unsigned sf_read_comma : 1; - /* A namelist specific flag used to enable reading input from - line_buffer for logical reads. */ - unsigned line_buffer_enabled : 1; - /* An internal unit specific flag used to identify that the associated - unit is internal. */ - unsigned unit_is_internal : 1; - /* An internal unit specific flag to signify an EOF condition for list - directed read. */ - unsigned at_eof : 1; - /* 16 unused bits. */ - - char last_char; - char nml_delim; - - int repeat_count; - int saved_length; - int saved_used; - bt saved_type; - char *saved_string; - char *scratch; - char *line_buffer; - struct format_data *fmt; - jmp_buf *eof_jump; - namelist_info *ionml; - /* A flag used to identify when a non-standard expanded namelist read - has occurred. */ - int expanded_read; - /* Storage area for values except for strings. Must be large - enough to hold a complex value (two reals) of the largest - kind. */ - char value[32]; - gfc_offset size_used; -} st_parameter_44; - typedef struct st_parameter_dt { st_parameter_common common; @@ -557,13 +391,97 @@ typedef struct st_parameter_dt to reserve enough space. */ union { - st_parameter_43 q; - st_parameter_44 p; + struct + { + void (*transfer) (struct st_parameter_dt *, bt, void *, int, + size_t, size_t); + struct gfc_unit *current_unit; + /* Item number in a formatted data transfer. Also used in namelist + read_logical as an index into line_buffer. */ + int item_count; + unit_mode mode; + unit_blank blank_status; + unit_sign sign_status; + int scale_factor; + int max_pos; /* Maximum righthand column written to. */ + /* Number of skips + spaces to be done for T and X-editing. */ + int skips; + /* Number of spaces to be done for T and X-editing. */ + int pending_spaces; + /* Whether an EOR condition was encountered. Value is: + 0 if no EOR was encountered + 1 if an EOR was encountered due to a 1-byte marker (LF) + 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ + int sf_seen_eor; + unit_advance advance_status; + unsigned reversion_flag : 1; /* Format reversion has occurred. */ + unsigned first_item : 1; + unsigned seen_dollar : 1; + unsigned eor_condition : 1; + unsigned no_leading_blank : 1; + unsigned char_flag : 1; + unsigned input_complete : 1; + unsigned at_eol : 1; + unsigned comma_flag : 1; + /* A namelist specific flag used in the list directed library + to flag that calls are being made from namelist read (eg. to + ignore comments or to treat '/' as a terminator) */ + unsigned namelist_mode : 1; + /* A namelist specific flag used in the list directed library + to flag read errors and return, so that an attempt can be + made to read a new object name. */ + unsigned nml_read_error : 1; + /* A sequential formatted read specific flag used to signal that a + character string is being read so don't use commas to shorten a + formatted field width. */ + unsigned sf_read_comma : 1; + /* A namelist specific flag used to enable reading input from + line_buffer for logical reads. */ + unsigned line_buffer_enabled : 1; + /* An internal unit specific flag used to identify that the associated + unit is internal. */ + unsigned unit_is_internal : 1; + /* An internal unit specific flag to signify an EOF condition for list + directed read. */ + unsigned at_eof : 1; + /* 16 unused bits. */ + + char last_char; + char nml_delim; + + int repeat_count; + int saved_length; + int saved_used; + bt saved_type; + char *saved_string; + char *scratch; + char *line_buffer; + struct format_data *fmt; + jmp_buf *eof_jump; + namelist_info *ionml; + /* A flag used to identify when a non-standard expanded namelist read + has occurred. */ + int expanded_read; + /* Storage area for values except for strings. Must be large + enough to hold a complex value (two reals) of the largest + kind. */ + char value[32]; + GFC_IO_INT size_used; + } p; /* This pad size must be equal to the pad_size declared in trans-io.c (gfc_build_io_library_fndecls). The above structure must be smaller or equal to this array. */ - char pad[32 * sizeof (char *) + 32 * sizeof (int)]; + char pad[16 * sizeof (char *) + 32 * sizeof (int)]; } u; + GFC_INTEGER_4 *id; + GFC_IO_INT pos; + CHARACTER1 (asynchronous); + CHARACTER2 (blank); + CHARACTER1 (decimal); + CHARACTER2 (delim); + CHARACTER1 (pad); + CHARACTER2 (round); + CHARACTER1 (sign); } st_parameter_dt; diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 500cce95e40..c4fae32bead 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -300,7 +300,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error) dtp->u.p.current_unit->bytes_left -= *length; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) *length; + dtp->u.p.size_used += (GFC_IO_INT) *length; return base; } @@ -377,7 +377,7 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes) } if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) nread; + dtp->u.p.size_used += (GFC_IO_INT) nread; if (nread != *nbytes) { /* Short read, this shouldn't happen. */ @@ -625,7 +625,7 @@ write_block (st_parameter_dt *dtp, int length) } if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (gfc_offset) length; + dtp->u.p.size_used += (GFC_IO_INT) length; dtp->u.p.current_unit->strm_pos += (gfc_offset) length; @@ -1829,11 +1829,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL; - /* To maintain ABI, &transfer is the start of the private memory area in - in st_parameter_dt. Memory from the beginning of the structure to this - point is set by the front end and must not be touched. The number of - bytes to clear must stay within the sizeof q to avoid over-writing. */ - memset (&dtp->u.p.transfer, 0, sizeof (dtp->u.q)); + memset (&dtp->u.p, 0, sizeof (dtp->u.p)); dtp->u.p.ionml = ionml; dtp->u.p.mode = read_flag ? READING : WRITING; @@ -2077,7 +2073,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check the decimal mode. */ dtp->u.p.current_unit->decimal_status = !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED : - find_option (&dtp->common, dtp->u.p.decimal, dtp->u.p.decimal_len, + find_option (&dtp->common, dtp->decimal, dtp->decimal_len, decimal_opt, "Bad DECIMAL parameter in data transfer " "statement"); @@ -2087,7 +2083,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check the sign mode. */ dtp->u.p.sign_status = !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED : - find_option (&dtp->common, dtp->u.p.sign, dtp->u.p.sign_len, sign_opt, + find_option (&dtp->common, dtp->sign, dtp->sign_len, sign_opt, "Bad SIGN parameter in data transfer statement"); if (dtp->u.p.sign_status == SIGN_UNSPECIFIED) @@ -2096,7 +2092,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check the blank mode. */ dtp->u.p.blank_status = !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED : - find_option (&dtp->common, dtp->u.p.blank, dtp->u.p.blank_len, + find_option (&dtp->common, dtp->blank, dtp->blank_len, blank_opt, "Bad BLANK parameter in data transfer statement"); @@ -2106,7 +2102,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check the delim mode. */ dtp->u.p.current_unit->delim_status = !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED : - find_option (&dtp->common, dtp->u.p.delim, dtp->u.p.delim_len, + find_option (&dtp->common, dtp->delim, dtp->delim_len, delim_opt, "Bad DELIM parameter in data transfer statement"); if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED) @@ -2115,7 +2111,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check the pad mode. */ dtp->u.p.current_unit->pad_status = !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED : - find_option (&dtp->common, dtp->u.p.pad, dtp->u.p.pad_len, pad_opt, + find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt, "Bad PAD parameter in data transfer statement"); if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED) @@ -2858,7 +2854,7 @@ finalize_transfer (st_parameter_dt *dtp) GFC_INTEGER_4 cf = dtp->common.flags; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - *dtp->size = (GFC_IO_INT) dtp->u.p.size_used; + *dtp->size = dtp->u.p.size_used; if (dtp->u.p.eor_condition) { |