This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran] patch for PR 15750: IOLENGTH form of the INQUIRE statement
- From: Paul Brook <paul at codesourcery dot com>
- To: fortran at gcc dot gnu dot org
- Cc: Janne Blomqvist <jblomqvi at cc dot hut dot fi>, gcc-patches at gcc dot gnu dot org
- Date: Tue, 22 Jun 2004 01:43:49 +0100
- Subject: Re: [gfortran] patch for PR 15750: IOLENGTH form of the INQUIRE statement
- Organization: CodeSourcery
- References: <20040620152133.GA9134@vipunen.hut.fi>
> 2004-06-20 Janne Blomqvist <jblomqvi@cc.hut.fi>
>
> PR fortran/15750
> * io.c (gfc_match_inquire): Bugfix for iolength related stuff.
> (gfc_resolve_inquire): Resolve the iolength tag. Return
> SUCCESS at end of function if no failure has occured.
> * resolve.c (resolve_code): Resolve if iolength is
> encountered.
> * trans-io.c: Add iolength to the ioparm
> structure. (gfc_build_io_library_fndecls ): Add
> library entry points for iolength related
> calls. (gfc_trans_iolength): Move function so it can see the
> build_dt symbol, implement function body. (gfc_trans_dt_end):
> Treat iolength as a third form of data transfer in addition to
> read and write.
>
> libgfortran Changelog:
>
> 2004-06-20 Janne Blomqvist <jblomqvi@cc.hut.fi>
>
> PR fortran/15750
> * inquire.c (st_inquire): Add comment
> * io.h: Add iolength to the ioparm (st_parameter)
> structure. Declare iolength related entry points.
> * transfer.c (iolength_transfer, iolength_transfer_init,
> st_iolength, st_iolength_done): New functions.
>
> The patch itself is attached.
I made a few minor changes and applied as attached.
- post_block in gfc_trans_iolength is redundant.
- Comments should end with "punctuation space space star slash". There already
seem to be many badly formatted comments in trans-io.c, but fixing those is a
separate issue.
- It's easier to review patches if you use diff -p
- Don't bother issuing error messages if something goes wrong in the backend,
just call abort (in gfc_trans_dt_end)
I also added the two successful testcases and added the third (failing)
testcase to the PR.
Paul
Index: gcc/fortran/io.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/io.c,v
retrieving revision 1.8
diff -u -p -r1.8 io.c
--- gcc/fortran/io.c 27 May 2004 12:35:12 -0000 1.8
+++ gcc/fortran/io.c 21 Jun 2004 23:26:31 -0000
@@ -2353,7 +2353,7 @@ gfc_match_inquire (void)
new_st.op = EXEC_IOLENGTH;
new_st.expr = inquire->iolength;
- gfc_free (inquire);
+ new_st.ext.inquire = inquire;
if (gfc_pure (NULL))
{
@@ -2439,9 +2439,10 @@ gfc_resolve_inquire (gfc_inquire * inqui
RESOLVE_TAG (&tag_readwrite, inquire->readwrite);
RESOLVE_TAG (&tag_s_delim, inquire->delim);
RESOLVE_TAG (&tag_s_pad, inquire->pad);
+ RESOLVE_TAG (&tag_iolength, inquire->iolength);
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
- return FAILURE;
+ return SUCCESS;
}
Index: gcc/fortran/resolve.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.7
diff -u -p -r1.7 resolve.c
--- gcc/fortran/resolve.c 21 Jun 2004 17:23:52 -0000 1.7
+++ gcc/fortran/resolve.c 21 Jun 2004 23:26:31 -0000
@@ -3452,7 +3452,6 @@ resolve_code (gfc_code * code, gfc_names
{
case EXEC_NOP:
case EXEC_CYCLE:
- case EXEC_IOLENGTH:
case EXEC_PAUSE:
case EXEC_STOP:
case EXEC_EXIT:
@@ -3620,6 +3619,14 @@ resolve_code (gfc_code * code, gfc_names
case EXEC_INQUIRE:
if (gfc_resolve_inquire (code->ext.inquire) == FAILURE)
+ break;
+
+ resolve_branch (code->ext.inquire->err, code);
+ break;
+
+ case EXEC_IOLENGTH:
+ assert(code->ext.inquire != NULL);
+ if (gfc_resolve_inquire (code->ext.inquire) == FAILURE)
break;
resolve_branch (code->ext.inquire->err, code);
Index: gcc/fortran/trans-io.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-io.c,v
retrieving revision 1.5
diff -u -p -r1.5 trans-io.c
--- gcc/fortran/trans-io.c 15 May 2004 17:31:32 -0000 1.5
+++ gcc/fortran/trans-io.c 22 Jun 2004 00:00:33 -0000
@@ -59,6 +59,7 @@ static GTY(()) tree ioparm_nextrec;
static GTY(()) tree ioparm_size;
static GTY(()) tree ioparm_recl_in;
static GTY(()) tree ioparm_recl_out;
+static GTY(()) tree ioparm_iolength;
static GTY(()) tree ioparm_file;
static GTY(()) tree ioparm_file_len;
static GTY(()) tree ioparm_status;
@@ -124,6 +125,8 @@ static GTY(()) tree iocall_x_complex;
static GTY(()) tree iocall_open;
static GTY(()) tree iocall_close;
static GTY(()) tree iocall_inquire;
+static GTY(()) tree iocall_iolength;
+static GTY(()) tree iocall_iolength_done;
static GTY(()) tree iocall_rewind;
static GTY(()) tree iocall_backspace;
static GTY(()) tree iocall_endfile;
@@ -136,7 +139,7 @@ static GTY(()) tree iocall_set_nml_val_l
/* Variable for keeping track of what the last data transfer statement
was. Used for deciding which subroutine to call when the data
transfer is complete. */
-static enum { READ, WRITE } last_dt;
+static enum { READ, WRITE, IOLENGTH } last_dt;
#define ADD_FIELD(name, type) \
ioparm_ ## name = gfc_add_field_to_struct \
@@ -187,6 +190,8 @@ gfc_build_io_library_fndecls (void)
ADD_FIELD (recl_in, gfc_pint4_type_node);
ADD_FIELD (recl_out, gfc_pint4_type_node);
+ ADD_FIELD (iolength, gfc_pint4_type_node);
+
ADD_STRING (file);
ADD_STRING (status);
@@ -282,6 +287,10 @@ gfc_build_io_library_fndecls (void)
gfc_build_library_function_decl (get_identifier (PREFIX("st_inquire")),
gfc_int4_type_node, 0);
+ iocall_iolength =
+ gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")),
+ void_type_node, 0);
+
iocall_rewind =
gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")),
gfc_int4_type_node, 0);
@@ -302,6 +311,11 @@ gfc_build_io_library_fndecls (void)
iocall_write_done =
gfc_build_library_function_decl (get_identifier (PREFIX("st_write_done")),
gfc_int4_type_node, 0);
+
+ iocall_iolength_done =
+ gfc_build_library_function_decl (get_identifier (PREFIX("st_iolength_done")),
+ gfc_int4_type_node, 0);
+
iocall_set_nml_val_int =
gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_int")),
void_type_node, 4,
@@ -793,16 +807,6 @@ gfc_trans_inquire (gfc_code * code)
}
-/* Translate the IOLENGTH form of an INQUIRE statement. We treat
- this as a third sort of data transfer statement, except that
- lengths are summed instead of actually transfering any data. */
-
-tree
-gfc_trans_iolength (gfc_code * c ATTRIBUTE_UNUSED)
-{
- gfc_todo_error ("IOLENGTH statement");
-}
-
static gfc_expr *
gfc_new_nml_name_expr (char * name)
{
@@ -858,6 +862,8 @@ build_dt (tree * function, gfc_code * co
set_error_locus (&block, &code->loc);
dt = code->ext.dt;
+ assert (dt != NULL);
+
if (dt->io_unit)
{
if (dt->io_unit->ts.type == BT_CHARACTER)
@@ -973,6 +979,41 @@ build_dt (tree * function, gfc_code * co
}
+/* Translate the IOLENGTH form of an INQUIRE statement. We treat
+ this as a third sort of data transfer statement, except that
+ lengths are summed instead of actually transfering any data. */
+
+tree
+gfc_trans_iolength (gfc_code * code)
+{
+ stmtblock_t block;
+ gfc_inquire *inq;
+ tree dt;
+
+ gfc_init_block (&block);
+
+ set_error_locus (&block, &code->loc);
+
+ inq = code->ext.inquire;
+
+ /* First check that preconditions are met. */
+ assert(inq != NULL);
+ assert(inq->iolength != NULL);
+
+ /* Connect to the iolength variable. */
+ if (inq->iolength)
+ set_parameter_ref (&block, ioparm_iolength, inq->iolength);
+
+ /* Actual logic. */
+ last_dt = IOLENGTH;
+ dt = build_dt(&iocall_iolength, code);
+
+ gfc_add_expr_to_block (&block, dt);
+
+ return gfc_finish_block (&block);
+}
+
+
/* Translate a READ statement. */
tree
@@ -1005,12 +1046,33 @@ gfc_trans_dt_end (gfc_code * code)
gfc_init_block (&block);
- function = (last_dt == READ) ? iocall_read_done : iocall_write_done;
+ switch (last_dt)
+ {
+ case READ:
+ function = iocall_read_done;
+ break;
+
+ case WRITE:
+ function = iocall_write_done;
+ break;
+
+ case IOLENGTH:
+ function = iocall_iolength_done;
+ break;
+
+ default:
+ abort ();
+ }
tmp = gfc_build_function_call (function, NULL);
gfc_add_expr_to_block (&block, tmp);
- io_result (&block, code->ext.dt->err, code->ext.dt->end, code->ext.dt->eor);
+ if (last_dt != IOLENGTH)
+ {
+ assert(code->ext.dt != NULL);
+ io_result (&block, code->ext.dt->err,
+ code->ext.dt->end, code->ext.dt->eor);
+ }
return gfc_finish_block (&block);
}
@@ -1087,6 +1149,7 @@ transfer_expr (gfc_se * se, gfc_typespec
tmp = gfc_build_function_call (function, args);
gfc_add_expr_to_block (&se->pre, tmp);
gfc_add_block_to_block (&se->pre, &se->post);
+
}
Index: libgfortran/io/inquire.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/libgfortran/io/inquire.c,v
retrieving revision 1.3
diff -u -p -r1.3 inquire.c
--- libgfortran/io/inquire.c 15 May 2004 20:44:38 -0000 1.3
+++ libgfortran/io/inquire.c 21 Jun 2004 23:47:13 -0000
@@ -348,6 +348,8 @@ inquire_via_filename (void)
}
+/* Library entry point for the INQUIRE statement (non-IOLENGTH
+ form). */
void
st_inquire (void)
Index: libgfortran/io/io.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/libgfortran/io/io.h,v
retrieving revision 1.5
diff -u -p -r1.5 io.h
--- libgfortran/io/io.h 18 May 2004 16:06:09 -0000 1.5
+++ libgfortran/io/io.h 21 Jun 2004 23:26:31 -0000
@@ -177,6 +177,8 @@ typedef struct
int recl_in;
int *recl_out;
+ int *iolength;
+
char *file;
int file_len;
char *status;
@@ -642,6 +644,8 @@ void list_formatted_write (bt, void *, i
#define st_open prefix(st_open)
#define st_close prefix(st_close)
#define st_inquire prefix(st_inquire)
+#define st_iolength prefix(st_iolength)
+#define st_iolength_done prefix(st_iolength_done)
#define st_rewind prefix(st_rewind)
#define st_read prefix(st_read)
#define st_read_done prefix(st_read_done)
Index: libgfortran/io/transfer.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.6
diff -u -p -r1.6 transfer.c
--- libgfortran/io/transfer.c 9 Jun 2004 01:03:01 -0000 1.6
+++ libgfortran/io/transfer.c 21 Jun 2004 23:49:21 -0000
@@ -1361,6 +1361,57 @@ finalize_transfer (void)
}
+/* Transfer function for IOLENGTH. It doesn't actually do any
+ data transfer, it just updates the length counter. */
+
+static void
+iolength_transfer (bt type, void *dest, int len)
+{
+ if (ioparm.iolength != NULL)
+ *ioparm.iolength += len;
+}
+
+
+/* Initialize the IOLENGTH data transfer. This function is in essence
+ a very much simplified version of data_transfer_init(), because it
+ doesn't have to deal with units at all. */
+
+static void
+iolength_transfer_init (void)
+{
+
+ if (ioparm.iolength != NULL)
+ *ioparm.iolength = 0;
+
+ g.item_count = 0;
+
+ /* Set up the subroutine that will handle the transfers. */
+
+ transfer = iolength_transfer;
+
+}
+
+
+/* Library entry point for the IOLENGTH form of the INQUIRE
+ statement. The IOLENGTH form requires no I/O to be performed, but
+ it must still be a runtime library call so that we can determine
+ the iolength for dynamic arrays and such. */
+
+void
+st_iolength (void)
+{
+ library_start ();
+
+ iolength_transfer_init ();
+}
+
+void
+st_iolength_done (void)
+{
+ library_end ();
+}
+
+
/* The READ statement */
void