re PR fortran/25828 ([f2003] ACCESS='STREAM' io support)

2006-08-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/25828
	* gfortran.h: Add new pointer for stream position to st_inquire.
	Rename gfc_large_io_int_kind to gfc_intio_kind.
	* trans-types.c (gfc_init_kinds): use gfc_intio_kind.
	* io.c: Add new IO tag for file position going in and another for out.
	(match_dt_element): Match new tag_spos.
	(gfc_resolve_dt): Resolve new tag_spos.
	(gfc_free_inquire): Free inquire->strm_pos.
	(match_inquire_element): Match new tag_strm_out.
	(gfc_resolve_inquire): Resolve new tag_strm_out.
	* trans-io.c: Rename IOPARM_type_large_io_int to IOPARM_type_intio.
	(gfc_build_st_parameter): Same.
	(gfc_build_io_library_fndecls) Same. and add build pointer type pintio.
	(gfc_trans_inquire): Translate strm_pos for inquire.
	* ioparm.def: Reorder flags to accomodate addition of new inquire
	flag for strm_pos_out and add it in.

From-SVN: r116171

gcc/fortran/ChangeLog

+2006-08-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/25828
+	* gfortran.h: Add new pointer for stream position to st_inquire.
+	Rename gfc_large_io_int_kind to gfc_intio_kind.
+	* trans-types.c (gfc_init_kinds): use gfc_intio_kind.
+	* io.c: Add new IO tag for file position going in and another for out.
+	(match_dt_element): Match new tag_spos.
+	(gfc_resolve_dt): Resolve new tag_spos.
+	(gfc_free_inquire): Free inquire->strm_pos.
+	(match_inquire_element): Match new tag_strm_out.
+	(gfc_resolve_inquire): Resolve new tag_strm_out.
+	* trans-io.c: Rename IOPARM_type_large_io_int to IOPARM_type_intio.
+	(gfc_build_st_parameter): Same.
+	(gfc_build_io_library_fndecls) Same. and add build pointer type pintio.
+	(gfc_trans_inquire): Translate strm_pos for inquire.
+	* ioparm.def: Reorder flags to accomodate addition of new inquire
+	flag for strm_pos_out and add it in.
+
 2006-08-06  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/28590

gcc/fortran/gfortran.h

@@ -1465,7 +1465,7 @@ typedef struct
   gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
     *name, *access, *sequential, *direct, *form, *formatted,
     *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
-    *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert;
+    *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos;
 
   gfc_st_label *err;
 
@@ -1816,7 +1816,7 @@ extern int gfc_default_character_kind;
 extern int gfc_default_logical_kind;
 extern int gfc_default_complex_kind;
 extern int gfc_c_int_kind;
-extern int gfc_large_io_int_kind;
+extern int gfc_intio_kind;
 
 /* symbol.c */
 void gfc_clear_new_implicit (void);

gcc/fortran/io.c

@@ -52,6 +52,7 @@ static const io_tag
 	tag_unit	= {"UNIT", " unit = %e", BT_INTEGER},
 	tag_advance	= {"ADVANCE", " advance = %e", BT_CHARACTER},
 	tag_rec		= {"REC", " rec = %e", BT_INTEGER},
+	tag_spos        = {"POSITION", " pos = %e", BT_INTEGER},
 	tag_format	= {"FORMAT", NULL, BT_CHARACTER},
 	tag_iomsg	= {"IOMSG", " iomsg = %e", BT_CHARACTER},
 	tag_iostat	= {"IOSTAT", " iostat = %v", BT_INTEGER},
@@ -79,6 +80,7 @@ static const io_tag
 	tag_s_pad	= {"PAD", " pad = %v", BT_CHARACTER},
 	tag_iolength	= {"IOLENGTH", " iolength = %v", BT_INTEGER},
 	tag_convert     = {"CONVERT", " convert = %e", BT_CHARACTER},
+	tag_strm_out    = {"POS", " pos = %v", BT_INTEGER},
 	tag_err		= {"ERR", " err = %l", BT_UNKNOWN},
 	tag_end		= {"END", " end = %l", BT_UNKNOWN},
 	tag_eor		= {"EOR", " eor = %l", BT_UNKNOWN};
@@ -1784,6 +1786,9 @@ match_dt_element (io_kind k, gfc_dt * dt)
   m = match_etag (&tag_rec, &dt->rec);
   if (m != MATCH_NO)
     return m;
+  m = match_etag (&tag_spos, &dt->rec);
+  if (m != MATCH_NO)
+    return m;
   m = match_out_tag (&tag_iomsg, &dt->iomsg);
   if (m != MATCH_NO)
     return m;
@@ -1855,6 +1860,7 @@ gfc_resolve_dt (gfc_dt * dt)
 
   RESOLVE_TAG (&tag_format, dt->format_expr);
   RESOLVE_TAG (&tag_rec, dt->rec);
+  RESOLVE_TAG (&tag_spos, dt->rec);
   RESOLVE_TAG (&tag_advance, dt->advance);
   RESOLVE_TAG (&tag_iomsg, dt->iomsg);
   RESOLVE_TAG (&tag_iostat, dt->iostat);
@@ -2643,6 +2649,7 @@ gfc_free_inquire (gfc_inquire * inquire)
   gfc_free_expr (inquire->pad);
   gfc_free_expr (inquire->iolength);
   gfc_free_expr (inquire->convert);
+  gfc_free_expr (inquire->strm_pos);
 
   gfc_free (inquire);
 }
@@ -2685,6 +2692,7 @@ match_inquire_element (gfc_inquire * inquire)
   RETM m = match_vtag (&tag_s_pad, &inquire->pad);
   RETM m = match_vtag (&tag_iolength, &inquire->iolength);
   RETM m = match_vtag (&tag_convert, &inquire->convert);
+  RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos);
   RETM return MATCH_NO;
 }
 
@@ -2839,6 +2847,7 @@ gfc_resolve_inquire (gfc_inquire * inquire)
   RESOLVE_TAG (&tag_s_pad, inquire->pad);
   RESOLVE_TAG (&tag_iolength, inquire->iolength);
   RESOLVE_TAG (&tag_convert, inquire->convert);
+  RESOLVE_TAG (&tag_strm_out, inquire->strm_pos);
 
   if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
     return FAILURE;

gcc/fortran/ioparm.def

@@ -36,29 +36,30 @@ IOPARM (inquire, number,	1 << 9,  pint4)
 IOPARM (inquire, named,		1 << 10, pint4)
 IOPARM (inquire, nextrec,	1 << 11, pint4)
 IOPARM (inquire, recl_out,	1 << 12, pint4)
-IOPARM (inquire, file,		1 << 13, char1)
-IOPARM (inquire, access,	1 << 14, char2)
-IOPARM (inquire, form,		1 << 15, char1)
-IOPARM (inquire, blank,		1 << 16, char2)
-IOPARM (inquire, position,	1 << 17, char1)
-IOPARM (inquire, action,	1 << 18, char2)
-IOPARM (inquire, delim,		1 << 19, char1)
-IOPARM (inquire, pad,		1 << 20, char2)
-IOPARM (inquire, name,		1 << 21, char1)
-IOPARM (inquire, sequential,	1 << 22, char2)
-IOPARM (inquire, direct,	1 << 23, char1)
-IOPARM (inquire, formatted,	1 << 24, char2)
-IOPARM (inquire, unformatted,	1 << 25, char1)
-IOPARM (inquire, read,		1 << 26, char2)
-IOPARM (inquire, write,		1 << 27, char1)
-IOPARM (inquire, readwrite,	1 << 28, char2)
-IOPARM (inquire, convert,       1 << 29, char1)
+IOPARM (inquire, strm_pos_out,	1 << 13, pintio)
+IOPARM (inquire, file,		1 << 14, char1)
+IOPARM (inquire, access,	1 << 15, char2)
+IOPARM (inquire, form,		1 << 16, char1)
+IOPARM (inquire, blank,		1 << 17, char2)
+IOPARM (inquire, position,	1 << 18, char1)
+IOPARM (inquire, action,	1 << 19, char2)
+IOPARM (inquire, delim,		1 << 20, char1)
+IOPARM (inquire, pad,		1 << 21, char2)
+IOPARM (inquire, name,		1 << 22, char1)
+IOPARM (inquire, sequential,	1 << 23, char2)
+IOPARM (inquire, direct,	1 << 24, char1)
+IOPARM (inquire, formatted,	1 << 25, char2)
+IOPARM (inquire, unformatted,	1 << 26, char1)
+IOPARM (inquire, read,		1 << 27, char2)
+IOPARM (inquire, write,		1 << 28, char1)
+IOPARM (inquire, readwrite,	1 << 29, char2)
+IOPARM (inquire, convert,       1 << 30, char1)
 #ifndef IOPARM_dt_list_format
 #define IOPARM_dt_list_format		(1 << 7)
 #define IOPARM_dt_namelist_read_mode	(1 << 8)
 #endif
 IOPARM (dt,      common,	0,	 common)
-IOPARM (dt,      rec,		1 << 9,  large_io_int)
+IOPARM (dt,      rec,		1 << 9,  intio)
 IOPARM (dt,      size,		1 << 10, pint4)
 IOPARM (dt,      iolength,	1 << 11, pint4)
 IOPARM (dt,      internal_unit_desc, 0,  parray)

gcc/fortran/trans-io.c

@@ -35,7 +35,6 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "trans-types.h"
 #include "trans-const.h"
 
-
 /* Members of the ioparm structure.  */
 
 enum ioparam_type
@@ -52,8 +51,9 @@ enum ioparam_type
 enum iofield_type
 {
   IOPARM_type_int4,
-  IOPARM_type_large_io_int,
+  IOPARM_type_intio,
   IOPARM_type_pint4,
+  IOPARM_type_pintio,
   IOPARM_type_pchar,
   IOPARM_type_parray,
   IOPARM_type_pad,
@@ -169,8 +169,9 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
       switch (p->type)
 	{
 	case IOPARM_type_int4:
-	case IOPARM_type_large_io_int:
+	case IOPARM_type_intio:
 	case IOPARM_type_pint4:
+	case IOPARM_type_pintio:
 	case IOPARM_type_parray:
 	case IOPARM_type_pchar:
 	case IOPARM_type_pad:
@@ -216,16 +217,18 @@ void
 gfc_build_io_library_fndecls (void)
 {
   tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node;
-  tree gfc_large_io_int_type_node;
+  tree gfc_intio_type_node;
   tree parm_type, dt_parm_type;
   tree gfc_c_int_type_node;
   HOST_WIDE_INT pad_size;
   enum ioparam_type ptype;
 
   types[IOPARM_type_int4] = gfc_int4_type_node = gfc_get_int_type (4);
-  types[IOPARM_type_large_io_int] = gfc_large_io_int_type_node
-			    = gfc_get_int_type (gfc_large_io_int_kind);
+  types[IOPARM_type_intio] = gfc_intio_type_node
+			    = gfc_get_int_type (gfc_intio_kind);
   types[IOPARM_type_pint4] = build_pointer_type (gfc_int4_type_node);
+  types[IOPARM_type_pintio]
+			    = build_pointer_type (gfc_intio_type_node);
   types[IOPARM_type_parray] = pchar_type_node;
   types[IOPARM_type_pchar] = pchar_type_node;
   pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
@@ -1098,6 +1101,10 @@ gfc_trans_inquire (gfc_code * code)
     mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
 			p->convert);
 
+  if (p->strm_pos)
+    mask |= set_parameter_ref (&block, &post_block, var,
+			       IOPARM_inquire_strm_pos_out, p->strm_pos);
+
   set_parameter_const (&block, var, IOPARM_common_flags, mask);
 
   tmp = build_fold_addr_expr (var);

gcc/fortran/trans-types.c

@@ -95,7 +95,7 @@ int gfc_c_int_kind;
 
 /* The kind size used for record offsets. If the target system supports
    kind=8, this will be set to 8, otherwise it is set to 4.  */
-int gfc_large_io_int_kind; 
+int gfc_intio_kind; 
 
 /* Query the target to determine which machine modes are available for
    computation.  Choose KIND numbers for them.  */
@@ -144,13 +144,13 @@ gfc_init_kinds (void)
       i_index += 1;
     }
 
-  /* Set the kind used to match GFC_LARGE_IO_INT in libgfortran.  This is 
+  /* Set the kind used to match GFC_INT_IO in libgfortran.  This is 
      used for large file access.  */
 
   if (saw_i8)
-    gfc_large_io_int_kind = 8;
+    gfc_intio_kind = 8;
   else
-    gfc_large_io_int_kind = 4;
+    gfc_intio_kind = 4;
 
   /* If we do not at least have kind = 4, everything is pointless.  */  
   gcc_assert(saw_i4);