/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH
FTELL, TTYNAM and ISATTY intrinsics.
- Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
+ Copyright (C) 2005-2018 Free Software Foundation, Inc.
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+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 2 of the License, or (at your option) any later version.
-
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
+version 3 of the License, 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.
-You should have received a copy of the GNU General Public
-License along with libgfortran; see the file COPYING. If not,
-write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-#include "io.h"
+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.
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
+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>
+
static const int five = 5;
static const int six = 6;
export_proto_np(PREFIX(fgetc));
int
-PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
+PREFIX(fgetc) (const int *unit, char *c, gfc_charlen_type c_len)
{
int ret;
- gfc_unit * u = find_unit (*unit);
+ gfc_unit *u = find_unit (*unit);
if (u == NULL)
return -1;
+ fbuf_reset (u);
+ if (u->mode == WRITING)
+ {
+ sflush (u->s);
+ u->mode = READING;
+ }
+
memset (c, ' ', c_len);
ret = sread (u->s, c, 1);
unlock_unit (u);
(const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fgetc_i ## kind ## _sub); \
void fgetc_i ## kind ## _sub \
- (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+ (const int *unit, char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fgetc) (unit, c, c_len); \
else \
export_proto_np(PREFIX(fget));
int
-PREFIX(fget) (char * c, gfc_charlen_type c_len)
+PREFIX(fget) (char *c, gfc_charlen_type c_len)
{
return PREFIX(fgetc) (&five, c, c_len);
}
(char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fget_i ## kind ## _sub); \
void fget_i ## kind ## _sub \
- (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+ (char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fgetc) (&five, c, c_len); \
else \
export_proto_np(PREFIX(fputc));
int
-PREFIX(fputc) (const int * unit, char * c,
+PREFIX(fputc) (const int *unit, char *c,
gfc_charlen_type c_len __attribute__((unused)))
{
ssize_t s;
- gfc_unit * u = find_unit (*unit);
+ gfc_unit *u = find_unit (*unit);
if (u == NULL)
return -1;
+ fbuf_reset (u);
+ if (u->mode == READING)
+ {
+ sflush (u->s);
+ u->mode = WRITING;
+ }
+
s = swrite (u->s, c, 1);
unlock_unit (u);
if (s < 0)
(const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fputc_i ## kind ## _sub); \
void fputc_i ## kind ## _sub \
- (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+ (const int *unit, char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fputc) (unit, c, c_len); \
else \
export_proto_np(PREFIX(fput));
int
-PREFIX(fput) (char * c, gfc_charlen_type c_len)
+PREFIX(fput) (char *c, gfc_charlen_type c_len)
{
return PREFIX(fputc) (&six, c, c_len);
}
(char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fput_i ## kind ## _sub); \
void fput_i ## kind ## _sub \
- (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+ (char *c, GFC_INTEGER_ ## kind *st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fputc) (&six, c, c_len); \
else \
export_proto(fseek_sub);
void
-fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status)
+fseek_sub (int *unit, GFC_IO_INT *offset, int *whence, int *status)
{
- gfc_unit * u = find_unit (*unit);
+ gfc_unit *u = find_unit (*unit);
ssize_t result = -1;
- if (u != NULL && is_seekable(u->s))
+ if (u != NULL)
{
result = sseek(u->s, *offset, *whence);
/* FTELL intrinsic */
-extern size_t PREFIX(ftell) (int *);
-export_proto_np(PREFIX(ftell));
-
-size_t
-PREFIX(ftell) (int * unit)
+static gfc_offset
+gf_ftell (int unit)
{
- gfc_unit * u = find_unit (*unit);
- size_t ret;
+ gfc_unit *u = find_unit (unit);
if (u == NULL)
- return ((size_t) -1);
- ret = (size_t) stell (u->s);
+ return -1;
+ int pos = fbuf_reset (u);
+ if (pos != 0)
+ sseek (u->s, pos, SEEK_CUR);
+ gfc_offset ret = stell (u->s);
unlock_unit (u);
return ret;
}
+
+extern GFC_IO_INT PREFIX(ftell) (int *);
+export_proto_np(PREFIX(ftell));
+
+GFC_IO_INT
+PREFIX(ftell) (int *unit)
+{
+ return gf_ftell (*unit);
+}
+
+
#define FTELL_SUB(kind) \
extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
export_proto(ftell_i ## kind ## _sub); \
void \
- ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
+ ftell_i ## kind ## _sub (int *unit, GFC_INTEGER_ ## kind *offset) \
{ \
- gfc_unit * u = find_unit (*unit); \
- if (u == NULL) \
- *offset = -1; \
- else \
- { \
- *offset = stell (u->s); \
- unlock_unit (u); \
- } \
+ *offset = gf_ftell (*unit); \
}
FTELL_SUB(1)
export_proto(ttynam_sub);
void
-ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
+ttynam_sub (int *unit, char *name, gfc_charlen_type name_len)
{
gfc_unit *u;
- char * n;
- int i;
+ int nlen;
+ int err = 1;
- memset (name, ' ', name_len);
u = find_unit (*unit);
if (u != NULL)
{
- n = stream_ttyname (u->s);
- if (n != NULL)
+ err = stream_ttyname (u->s, name, name_len);
+ if (err == 0)
{
- i = 0;
- while (*n && i < name_len)
- name[i++] = *(n++);
+ nlen = strlen (name);
+ memset (&name[nlen], ' ', name_len - nlen);
}
+
unlock_unit (u);
}
+ if (err != 0)
+ memset (name, ' ', name_len);
}
export_proto(ttynam);
void
-ttynam (char ** name, gfc_charlen_type * name_len, int unit)
+ttynam (char **name, gfc_charlen_type *name_len, int unit)
{
gfc_unit *u;
u = find_unit (unit);
if (u != NULL)
{
- *name = stream_ttyname (u->s);
- if (*name != NULL)
+ *name = xmalloc (TTY_NAME_MAX);
+ int err = stream_ttyname (u->s, *name, TTY_NAME_MAX);
+ if (err == 0)
{
*name_len = strlen (*name);
- *name = strdup (*name);
unlock_unit (u);
return;
}
+ free (*name);
unlock_unit (u);
}
projects / gcc.git / blobdiff