[thirdparty/gcc.git] / libgfortran / io / file_pos.c

/* Copyright (C) 2002-2016 Free Software Foundation, Inc.
   Contributed by Andy Vaught and Janne Blomqvist

This file is part of the GNU Fortran runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "io.h"
#include "fbuf.h"
#include "unix.h"
#include <string.h>

/* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
   ENDFILE, and REWIND as well as the FLUSH statement.  */


/* formatted_backspace(fpp, u)-- Move the file back one line.  The
   current position is after the newline that terminates the previous
   record, and we have to sift backwards to find the newline before
   that or the start of the file, whichever comes first.  */

#define READ_CHUNK 4096

static void
formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
{
  gfc_offset base;
  char p[READ_CHUNK];
  ssize_t n;

  base = stell (u->s) - 1;

  do
    {
      n = (base < READ_CHUNK) ? base : READ_CHUNK;
      base -= n;
      if (sseek (u->s, base, SEEK_SET) < 0)
        goto io_error;
      if (sread (u->s, p, n) != n)
	goto io_error;

      /* We have moved backwards from the current position, it should
         not be possible to get a short read.  Because it is not
         clear what to do about such thing, we ignore the possibility.  */

      /* There is no memrchr() in the C library, so we have to do it
         ourselves.  */

      while (n > 0)
	{
          n--;
	  if (p[n] == '\n')
	    {
	      base += n + 1;
	      goto done;
	    }
	}

    }
  while (base != 0);

  /* base is the new pointer.  Seek to it exactly.  */
 done:
  if (sseek (u->s, base, SEEK_SET) < 0)
    goto io_error;
  u->last_record--;
  u->endfile = NO_ENDFILE;

  return;

 io_error:
  generate_error (&fpp->common, LIBERROR_OS, NULL);
}


/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
   sequential file.  We are guaranteed to be between records on entry and 
   we have to shift to the previous record.  Loop over subrecords.  */

static void
unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
{
  gfc_offset m, slen;
  GFC_INTEGER_4 m4;
  GFC_INTEGER_8 m8;
  ssize_t length;
  int continued;
  char p[sizeof (GFC_INTEGER_8)];

  if (compile_options.record_marker == 0)
    length = sizeof (GFC_INTEGER_4);
  else
    length = compile_options.record_marker;

  do
    {
      slen = - (gfc_offset) length;
      if (sseek (u->s, slen, SEEK_CUR) < 0)
        goto io_error;
      if (sread (u->s, p, length) != length)
        goto io_error;

      /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here.  */
      if (likely (u->flags.convert == GFC_CONVERT_NATIVE))
	{
	  switch (length)
	    {
	    case sizeof(GFC_INTEGER_4):
	      memcpy (&m4, p, sizeof (m4));
	      m = m4;
	      break;

	    case sizeof(GFC_INTEGER_8):
	      memcpy (&m8, p, sizeof (m8));
	      m = m8;
	      break;

	    default:
	      runtime_error ("Illegal value for record marker");
	      break;
	    }
	}
      else
	{
	  uint32_t u32;
	  uint64_t u64;
	  switch (length)
	    {
	    case sizeof(GFC_INTEGER_4):
	      memcpy (&u32, p, sizeof (u32));
	      u32 = __builtin_bswap32 (u32);
	      memcpy (&m4, &u32, sizeof (m4));
	      m = m4;
	      break;

	    case sizeof(GFC_INTEGER_8):
	      memcpy (&u64, p, sizeof (u64));
	      u64 = __builtin_bswap64 (u64);
	      memcpy (&m8, &u64, sizeof (m8));
	      m = m8;
	      break;

	    default:
	      runtime_error ("Illegal value for record marker");
	      break;
	    }

	}

      continued = m < 0;
      if (continued)
	m = -m;

      if (sseek (u->s, -m -2 * length, SEEK_CUR) < 0)
	goto io_error;
    } while (continued);

  u->last_record--;
  return;

 io_error:
  generate_error (&fpp->common, LIBERROR_OS, NULL);
}


extern void st_backspace (st_parameter_filepos *);
export_proto(st_backspace);

void
st_backspace (st_parameter_filepos *fpp)
{
  gfc_unit *u;

  library_start (&fpp->common);

  u = find_unit (fpp->common.unit);
  if (u == NULL)
    {
      generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
      goto done;
    }

  /* Direct access is prohibited, and so is unformatted stream access.  */


  if (u->flags.access == ACCESS_DIRECT)
    {
      generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
		      "Cannot BACKSPACE a file opened for DIRECT access");
      goto done;
    }

  if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
    {
      generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
                      "Cannot BACKSPACE an unformatted stream file");
      goto done;
    }

  /* Make sure format buffer is flushed and reset.  */
  if (u->flags.form == FORM_FORMATTED)
    {
      int pos = fbuf_reset (u);
      if (pos != 0)
        sseek (u->s, pos, SEEK_CUR);
    }

  
  /* Check for special cases involving the ENDFILE record first.  */

  if (u->endfile == AFTER_ENDFILE)
    {
      u->endfile = AT_ENDFILE;
      u->flags.position = POSITION_APPEND;
      sflush (u->s);
    }
  else
    {
      if (stell (u->s) == 0)
	{
	  u->flags.position = POSITION_REWIND;
	  goto done;		/* Common special case */
	}

      if (u->mode == WRITING)
	{
	  /* If there are previously written bytes from a write with
	     ADVANCE="no", add a record marker before performing the
	     BACKSPACE.  */

	  if (u->previous_nonadvancing_write)
	    finish_last_advance_record (u);

	  u->previous_nonadvancing_write = 0;

	  unit_truncate (u, stell (u->s), &fpp->common);
	  u->mode = READING;
        }

      if (u->flags.form == FORM_FORMATTED)
	formatted_backspace (fpp, u);
      else
	unformatted_backspace (fpp, u);

      u->flags.position = POSITION_UNSPECIFIED;
      u->endfile = NO_ENDFILE;
      u->current_record = 0;
      u->bytes_left = 0;
    }

 done:
  if (u != NULL)
    unlock_unit (u);

  library_end ();
}


extern void st_endfile (st_parameter_filepos *);
export_proto(st_endfile);

void
st_endfile (st_parameter_filepos *fpp)
{
  gfc_unit *u;

  library_start (&fpp->common);

  u = find_unit (fpp->common.unit);
  if (u != NULL)
    {
      if (u->flags.access == ACCESS_DIRECT)
	{
	  generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
			  "Cannot perform ENDFILE on a file opened "
			  "for DIRECT access");
	  goto done;
	}

      if (u->flags.access == ACCESS_SEQUENTIAL
      	  && u->endfile == AFTER_ENDFILE)
	{
	  generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
			  "Cannot perform ENDFILE on a file already "
			  "positioned after the EOF marker");
	  goto done;
	}

      /* If there are previously written bytes from a write with ADVANCE="no",
	 add a record marker before performing the ENDFILE.  */

      if (u->previous_nonadvancing_write)
	finish_last_advance_record (u);

      u->previous_nonadvancing_write = 0;

      if (u->current_record)
	{
	  st_parameter_dt dtp;
	  dtp.common = fpp->common;
	  memset (&dtp.u.p, 0, sizeof (dtp.u.p));
	  dtp.u.p.current_unit = u;
	  next_record (&dtp, 1);
	}

      unit_truncate (u, stell (u->s), &fpp->common);
      u->endfile = AFTER_ENDFILE;
      if (0 == stell (u->s))
        u->flags.position = POSITION_REWIND;
    }
  else
    {
      if (fpp->common.unit < 0)
	{
	  generate_error (&fpp->common, LIBERROR_BAD_OPTION,
			  "Bad unit number in statement");
	  return;
	}

      u = find_or_create_unit (fpp->common.unit);
      if (u->s == NULL)
	{
	  /* Open the unit with some default flags.  */
	  st_parameter_open opp;
	  unit_flags u_flags;

	  memset (&u_flags, '\0', sizeof (u_flags));
	  u_flags.access = ACCESS_SEQUENTIAL;
	  u_flags.action = ACTION_READWRITE;

	  /* Is it unformatted?  */
	  if (!(fpp->common.flags & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT
				     | IOPARM_DT_IONML_SET)))
	    u_flags.form = FORM_UNFORMATTED;
	  else
	    u_flags.form = FORM_UNSPECIFIED;

	  u_flags.delim = DELIM_UNSPECIFIED;
	  u_flags.blank = BLANK_UNSPECIFIED;
	  u_flags.pad = PAD_UNSPECIFIED;
	  u_flags.decimal = DECIMAL_UNSPECIFIED;
	  u_flags.encoding = ENCODING_UNSPECIFIED;
	  u_flags.async = ASYNC_UNSPECIFIED;
	  u_flags.round = ROUND_UNSPECIFIED;
	  u_flags.sign = SIGN_UNSPECIFIED;
	  u_flags.status = STATUS_UNKNOWN;
	  u_flags.convert = GFC_CONVERT_NATIVE;

	  opp.common = fpp->common;
	  opp.common.flags &= IOPARM_COMMON_MASK;
	  u = new_unit (&opp, u, &u_flags);
	  if (u == NULL)
	    return;
	  u->endfile = AFTER_ENDFILE;
	}
    }

  done:
    unlock_unit (u);

  library_end ();
}


extern void st_rewind (st_parameter_filepos *);
export_proto(st_rewind);

void
st_rewind (st_parameter_filepos *fpp)
{
  gfc_unit *u;

  library_start (&fpp->common);

  u = find_unit (fpp->common.unit);
  if (u != NULL)
    {
      if (u->flags.access == ACCESS_DIRECT)
	generate_error (&fpp->common, LIBERROR_BAD_OPTION,
			"Cannot REWIND a file opened for DIRECT access");
      else
	{
	  /* If there are previously written bytes from a write with ADVANCE="no",
	     add a record marker before performing the ENDFILE.  */

	  if (u->previous_nonadvancing_write)
	    finish_last_advance_record (u);

	  u->previous_nonadvancing_write = 0;

	  fbuf_reset (u);

	  u->last_record = 0;

	  if (sseek (u->s, 0, SEEK_SET) < 0)
	    {
	      generate_error (&fpp->common, LIBERROR_OS, NULL);
	      library_end ();
	      return;
	    }

	  /* Set this for compatibilty with g77 for /dev/null.  */
	  if (ssize (u->s) == 0)
	    u->endfile = AT_ENDFILE;
	  else
	    {
	      /* We are rewinding so we are not at the end.  */
	      u->endfile = NO_ENDFILE;
	    }
	  
	  u->current_record = 0;
	  u->strm_pos = 1;
	  u->read_bad = 0;
	}
      /* Update position for INQUIRE.  */
      u->flags.position = POSITION_REWIND;
      unlock_unit (u);
    }

  library_end ();
}


extern void st_flush (st_parameter_filepos *);
export_proto(st_flush);

void
st_flush (st_parameter_filepos *fpp)
{
  gfc_unit *u;

  library_start (&fpp->common);

  u = find_unit (fpp->common.unit);
  if (u != NULL)
    {
      /* Make sure format buffer is flushed.  */
      if (u->flags.form == FORM_FORMATTED)
        fbuf_flush (u, u->mode);

      sflush (u->s);
      unlock_unit (u);
    }
  else
    /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */ 
    generate_error (&fpp->common, LIBERROR_BAD_OPTION,
			"Specified UNIT in FLUSH is not connected");

  library_end ();
}
Commit	Line	Data
f1717362	1	/* Copyright (C) 2002-2016 Free Software Foundation, Inc.
a16758bb	2	Contributed by Andy Vaught and Janne Blomqvist
4ee9c684	3
a16758bb	4	This file is part of the GNU Fortran runtime library (libgfortran).
4ee9c684	5
	6	Libgfortran is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
6bc9506f	8	the Free Software Foundation; either version 3, or (at your option)
4ee9c684	9	any later version.
	10
	11	Libgfortran is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
6bc9506f	16	Under Section 7 of GPL version 3, you are granted additional
	17	permissions described in the GCC Runtime Library Exception, version
	18	3.1, as published by the Free Software Foundation.
	19
	20	You should have received a copy of the GNU General Public License and
	21	a copy of the GCC Runtime Library Exception along with this program;
	22	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	23	<http://www.gnu.org/licenses/>. */
4ee9c684	24
4ee9c684	25	#include "io.h"
f65f6629	26	#include "fbuf.h"
f65f6629	27	#include "unix.h"
41f2d5e8	28	#include <string.h>
4ee9c684	29
a16758bb	30	/* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
	31	ENDFILE, and REWIND as well as the FLUSH statement. */
	32
4ee9c684	33
60c514ba	34	/* formatted_backspace(fpp, u)-- Move the file back one line. The
a16758bb	35	current position is after the newline that terminates the previous
	36	record, and we have to sift backwards to find the newline before
	37	that or the start of the file, whichever comes first. */
4ee9c684	38
2cb567cf	39	#define READ_CHUNK 4096
4ee9c684	40
4ee9c684	41	static void
60c514ba	42	formatted_backspace (st_parameter_filepos fpp, gfc_unit u)
4ee9c684	43	{
b093181d	44	gfc_offset base;
d875179d	45	char p[READ_CHUNK];
65f15010	46	ssize_t n;
4ee9c684	47
65f15010	48	base = stell (u->s) - 1;
4ee9c684	49
	50	do
	51	{
	52	n = (base < READ_CHUNK) ? base : READ_CHUNK;
	53	base -= n;
65f15010	54	if (sseek (u->s, base, SEEK_SET) < 0)
d875179d	55	goto io_error;
65f15010	56	if (sread (u->s, p, n) != n)
4ee9c684	57	goto io_error;
4ee9c684	58
a16758bb	59	/* We have moved backwards from the current position, it should
	60	not be possible to get a short read. Because it is not
	61	clear what to do about such thing, we ignore the possibility. */
4ee9c684	62
4ee9c684	63	/* There is no memrchr() in the C library, so we have to do it
a16758bb	64	ourselves. */
4ee9c684	65
d875179d	66	while (n > 0)
4ee9c684	67	{
d875179d	68	n--;
4ee9c684	69	if (p[n] == '\n')
	70	{
	71	base += n + 1;
	72	goto done;
	73	}
4ee9c684	74	}
	75
	76	}
	77	while (base != 0);
	78
a16758bb	79	/* base is the new pointer. Seek to it exactly. */
7145fd06	80	done:
65f15010	81	if (sseek (u->s, base, SEEK_SET) < 0)
4ee9c684	82	goto io_error;
60c514ba	83	u->last_record--;
60c514ba	84	u->endfile = NO_ENDFILE;
4ee9c684	85
	86	return;
	87
7145fd06	88	io_error:
18f0b7df	89	generate_error (&fpp->common, LIBERROR_OS, NULL);
4ee9c684	90	}
	91
	92
60c514ba	93	/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
a16758bb	94	sequential file. We are guaranteed to be between records on entry and
bbaaa7b1	95	we have to shift to the previous record. Loop over subrecords. */
4ee9c684	96
4ee9c684	97	static void
60c514ba	98	unformatted_backspace (st_parameter_filepos fpp, gfc_unit u)
4ee9c684	99	{
65f15010	100	gfc_offset m, slen;
f23886ab	101	GFC_INTEGER_4 m4;
f23886ab	102	GFC_INTEGER_8 m8;
65f15010	103	ssize_t length;
bbaaa7b1	104	int continued;
d875179d	105	char p[sizeof (GFC_INTEGER_8)];
4ee9c684	106
f23886ab	107	if (compile_options.record_marker == 0)
bbaaa7b1	108	length = sizeof (GFC_INTEGER_4);
f23886ab	109	else
	110	length = compile_options.record_marker;
	111
bbaaa7b1	112	do
bbaaa7b1	113	{
65f15010	114	slen = - (gfc_offset) length;
65f15010	115	if (sseek (u->s, slen, SEEK_CUR) < 0)
d875179d	116	goto io_error;
65f15010	117	if (sread (u->s, p, length) != length)
d875179d	118	goto io_error;
4ee9c684	119
18f0b7df	120	/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
861d8137	121	if (likely (u->flags.convert == GFC_CONVERT_NATIVE))
f23886ab	122	{
bbaaa7b1	123	switch (length)
	124	{
	125	case sizeof(GFC_INTEGER_4):
	126	memcpy (&m4, p, sizeof (m4));
	127	m = m4;
	128	break;
	129
	130	case sizeof(GFC_INTEGER_8):
	131	memcpy (&m8, p, sizeof (m8));
	132	m = m8;
	133	break;
	134
	135	default:
	136	runtime_error ("Illegal value for record marker");
	137	break;
	138	}
f23886ab	139	}
bbaaa7b1	140	else
f23886ab	141	{
a01f9ef3	142	uint32_t u32;
a01f9ef3	143	uint64_t u64;
bbaaa7b1	144	switch (length)
	145	{
	146	case sizeof(GFC_INTEGER_4):
a01f9ef3	147	memcpy (&u32, p, sizeof (u32));
	148	u32 = __builtin_bswap32 (u32);
	149	memcpy (&m4, &u32, sizeof (m4));
bbaaa7b1	150	m = m4;
	151	break;
	152
	153	case sizeof(GFC_INTEGER_8):
a01f9ef3	154	memcpy (&u64, p, sizeof (u64));
	155	u64 = __builtin_bswap64 (u64);
	156	memcpy (&m8, &u64, sizeof (m8));
bbaaa7b1	157	m = m8;
	158	break;
	159
	160	default:
	161	runtime_error ("Illegal value for record marker");
	162	break;
	163	}
	164
f23886ab	165	}
f23886ab	166
bbaaa7b1	167	continued = m < 0;
	168	if (continued)
	169	m = -m;
9e94d29f	170
65f15010	171	if (sseek (u->s, -m -2 * length, SEEK_CUR) < 0)
bbaaa7b1	172	goto io_error;
bbaaa7b1	173	} while (continued);
4ee9c684	174
60c514ba	175	u->last_record--;
4ee9c684	176	return;
4ee9c684	177
7145fd06	178	io_error:
18f0b7df	179	generate_error (&fpp->common, LIBERROR_OS, NULL);
4ee9c684	180	}
	181
	182
60c514ba	183	extern void st_backspace (st_parameter_filepos *);
7b6cb5bd	184	export_proto(st_backspace);
7b6cb5bd	185
4ee9c684	186	void
60c514ba	187	st_backspace (st_parameter_filepos *fpp)
4ee9c684	188	{
f02dd226	189	gfc_unit *u;
4ee9c684	190
60c514ba	191	library_start (&fpp->common);
4ee9c684	192
60c514ba	193	u = find_unit (fpp->common.unit);
4ee9c684	194	if (u == NULL)
4ee9c684	195	{
18f0b7df	196	generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
4ee9c684	197	goto done;
	198	}
	199
442c1e06	200	/* Direct access is prohibited, and so is unformatted stream access. */
4ee9c684	201
442c1e06	202
	203	if (u->flags.access == ACCESS_DIRECT)
	204	{
	205	generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
	206	"Cannot BACKSPACE a file opened for DIRECT access");
	207	goto done;
	208	}
	209
65f15010	210	if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
	211	{
	212	generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
	213	"Cannot BACKSPACE an unformatted stream file");
	214	goto done;
	215	}
	216
	217	/* Make sure format buffer is flushed and reset. */
	218	if (u->flags.form == FORM_FORMATTED)
	219	{
	220	int pos = fbuf_reset (u);
	221	if (pos != 0)
	222	sseek (u->s, pos, SEEK_CUR);
	223	}
4ee9c684	224
d875179d	225
a16758bb	226	/* Check for special cases involving the ENDFILE record first. */
4ee9c684	227
4ee9c684	228	if (u->endfile == AFTER_ENDFILE)
813a04a4	229	{
813a04a4	230	u->endfile = AT_ENDFILE;
f4bfed80	231	u->flags.position = POSITION_APPEND;
65f15010	232	sflush (u->s);
813a04a4	233	}
4ee9c684	234	else
4ee9c684	235	{
65f15010	236	if (stell (u->s) == 0)
f4bfed80	237	{
	238	u->flags.position = POSITION_REWIND;
	239	goto done; /* Common special case */
	240	}
4ee9c684	241
ca865049	242	if (u->mode == WRITING)
a16758bb	243	{
442c1e06	244	/* If there are previously written bytes from a write with
	245	ADVANCE="no", add a record marker before performing the
	246	BACKSPACE. */
	247
	248	if (u->previous_nonadvancing_write)
	249	finish_last_advance_record (u);
	250
	251	u->previous_nonadvancing_write = 0;
	252
65f15010	253	unit_truncate (u, stell (u->s), &fpp->common);
a16758bb	254	u->mode = READING;
a16758bb	255	}
ca865049	256
74b0c8a0	257	if (u->flags.form == FORM_FORMATTED)
60c514ba	258	formatted_backspace (fpp, u);
4ee9c684	259	else
60c514ba	260	unformatted_backspace (fpp, u);
ca865049	261
65f15010	262	u->flags.position = POSITION_UNSPECIFIED;
ca865049	263	u->endfile = NO_ENDFILE;
ca865049	264	u->current_record = 0;
4e63a695	265	u->bytes_left = 0;
4ee9c684	266	}
4ee9c684	267
7145fd06	268	done:
60c514ba	269	if (u != NULL)
	270	unlock_unit (u);
	271
4ee9c684	272	library_end ();
4ee9c684	273	}
a16758bb	274
a16758bb	275
60c514ba	276	extern void st_endfile (st_parameter_filepos *);
a16758bb	277	export_proto(st_endfile);
	278
	279	void
60c514ba	280	st_endfile (st_parameter_filepos *fpp)
a16758bb	281	{
	282	gfc_unit *u;
	283
60c514ba	284	library_start (&fpp->common);
a16758bb	285
60c514ba	286	u = find_unit (fpp->common.unit);
a16758bb	287	if (u != NULL)
a16758bb	288	{
442c1e06	289	if (u->flags.access == ACCESS_DIRECT)
	290	{
	291	generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
7fb4c5ad	292	"Cannot perform ENDFILE on a file opened "
	293	"for DIRECT access");
	294	goto done;
	295	}
	296
	297	if (u->flags.access == ACCESS_SEQUENTIAL
	298	&& u->endfile == AFTER_ENDFILE)
	299	{
	300	generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
	301	"Cannot perform ENDFILE on a file already "
	302	"positioned after the EOF marker");
442c1e06	303	goto done;
	304	}
	305
	306	/* If there are previously written bytes from a write with ADVANCE="no",
	307	add a record marker before performing the ENDFILE. */
	308
	309	if (u->previous_nonadvancing_write)
	310	finish_last_advance_record (u);
	311
	312	u->previous_nonadvancing_write = 0;
	313
a16758bb	314	if (u->current_record)
60c514ba	315	{
	316	st_parameter_dt dtp;
	317	dtp.common = fpp->common;
b5d015e3	318	memset (&dtp.u.p, 0, sizeof (dtp.u.p));
60c514ba	319	dtp.u.p.current_unit = u;
	320	next_record (&dtp, 1);
	321	}
a16758bb	322
65f15010	323	unit_truncate (u, stell (u->s), &fpp->common);
a16758bb	324	u->endfile = AFTER_ENDFILE;
65f15010	325	if (0 == stell (u->s))
65f15010	326	u->flags.position = POSITION_REWIND;
a16758bb	327	}
7fb4c5ad	328	else
	329	{
	330	if (fpp->common.unit < 0)
	331	{
	332	generate_error (&fpp->common, LIBERROR_BAD_OPTION,
	333	"Bad unit number in statement");
	334	return;
	335	}
	336
	337	u = find_or_create_unit (fpp->common.unit);
	338	if (u->s == NULL)
	339	{
	340	/* Open the unit with some default flags. */
	341	st_parameter_open opp;
	342	unit_flags u_flags;
	343
	344	memset (&u_flags, '\0', sizeof (u_flags));
	345	u_flags.access = ACCESS_SEQUENTIAL;
	346	u_flags.action = ACTION_READWRITE;
26ba582e	347
	348	/* Is it unformatted? */
	349	if (!(fpp->common.flags & (IOPARM_DT_HAS_FORMAT \| IOPARM_DT_LIST_FORMAT
	350	\| IOPARM_DT_IONML_SET)))
	351	u_flags.form = FORM_UNFORMATTED;
	352	else
	353	u_flags.form = FORM_UNSPECIFIED;
	354
7fb4c5ad	355	u_flags.delim = DELIM_UNSPECIFIED;
	356	u_flags.blank = BLANK_UNSPECIFIED;
	357	u_flags.pad = PAD_UNSPECIFIED;
	358	u_flags.decimal = DECIMAL_UNSPECIFIED;
	359	u_flags.encoding = ENCODING_UNSPECIFIED;
	360	u_flags.async = ASYNC_UNSPECIFIED;
	361	u_flags.round = ROUND_UNSPECIFIED;
	362	u_flags.sign = SIGN_UNSPECIFIED;
	363	u_flags.status = STATUS_UNKNOWN;
	364	u_flags.convert = GFC_CONVERT_NATIVE;
	365
	366	opp.common = fpp->common;
	367	opp.common.flags &= IOPARM_COMMON_MASK;
	368	u = new_unit (&opp, u, &u_flags);
	369	if (u == NULL)
	370	return;
	371	u->endfile = AFTER_ENDFILE;
	372	}
	373	}
	374
	375	done:
	376	unlock_unit (u);
a16758bb	377
	378	library_end ();
	379	}
	380
	381
60c514ba	382	extern void st_rewind (st_parameter_filepos *);
a16758bb	383	export_proto(st_rewind);
	384
	385	void
60c514ba	386	st_rewind (st_parameter_filepos *fpp)
a16758bb	387	{
	388	gfc_unit *u;
	389
60c514ba	390	library_start (&fpp->common);
a16758bb	391
60c514ba	392	u = find_unit (fpp->common.unit);
a16758bb	393	if (u != NULL)
a16758bb	394	{
4d8ee55b	395	if (u->flags.access == ACCESS_DIRECT)
18f0b7df	396	generate_error (&fpp->common, LIBERROR_BAD_OPTION,
a16758bb	397	"Cannot REWIND a file opened for DIRECT access");
	398	else
	399	{
442c1e06	400	/* If there are previously written bytes from a write with ADVANCE="no",
	401	add a record marker before performing the ENDFILE. */
	402
	403	if (u->previous_nonadvancing_write)
	404	finish_last_advance_record (u);
	405
	406	u->previous_nonadvancing_write = 0;
	407
7ee4f67a	408	fbuf_reset (u);
1c201879	409
a16758bb	410	u->last_record = 0;
6e34b5c4	411
65f15010	412	if (sseek (u->s, 0, SEEK_SET) < 0)
83fb22d2	413	{
	414	generate_error (&fpp->common, LIBERROR_OS, NULL);
	415	library_end ();
	416	return;
	417	}
a16758bb	418
cc65b133	419	/* Set this for compatibilty with g77 for /dev/null. */
41178014	420	if (ssize (u->s) == 0)
cc65b133	421	u->endfile = AT_ENDFILE;
cc65b133	422	else
6e34b5c4	423	{
	424	/* We are rewinding so we are not at the end. */
	425	u->endfile = NO_ENDFILE;
	426	}
cc65b133	427
a16758bb	428	u->current_record = 0;
3c43c91f	429	u->strm_pos = 1;
8f0b0abf	430	u->read_bad = 0;
a16758bb	431	}
	432	/* Update position for INQUIRE. */
	433	u->flags.position = POSITION_REWIND;
60c514ba	434	unlock_unit (u);
a16758bb	435	}
	436
	437	library_end ();
	438	}
	439
	440
60c514ba	441	extern void st_flush (st_parameter_filepos *);
a16758bb	442	export_proto(st_flush);
	443
	444	void
60c514ba	445	st_flush (st_parameter_filepos *fpp)
a16758bb	446	{
	447	gfc_unit *u;
	448
60c514ba	449	library_start (&fpp->common);
a16758bb	450
60c514ba	451	u = find_unit (fpp->common.unit);
a16758bb	452	if (u != NULL)
a16758bb	453	{
65f15010	454	/* Make sure format buffer is flushed. */
	455	if (u->flags.form == FORM_FORMATTED)
	456	fbuf_flush (u, u->mode);
	457
	458	sflush (u->s);
60c514ba	459	unlock_unit (u);
a16758bb	460	}
9bc7d5e2	461	else
9bc7d5e2	462	/* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */
18f0b7df	463	generate_error (&fpp->common, LIBERROR_BAD_OPTION,
9bc7d5e2	464	"Specified UNIT in FLUSH is not connected");
a16758bb	465
	466	library_end ();
	467	}