+2007-01-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR libfortran/27107
+ * runtime/environ.c: Don't include io/io.h.
+ * runtime/string.c: Don't include io/io.h.
+ (compare0): Add cast to avoid warning.
+ * runtime/error.c: Don't include io/io.h.
+ (st_printf): Move to io/unix.c.
+ * intrinsics/flush.c: Delete, contents moved to io/intrinsics.c.
+ * intrinsics/fget.c: Likewise.
+ * intrinsics/ftell.c: Likewise.
+ * intrinsics/tty.c: Likewise.
+ * libgfortran.h (DEFAULT_RECL, notification_std,
+ get_unformatted_convert, IOPARM_*, st_parameter_common, unit_convert,
+ DEFAULT_TEMPDIR): New declarations.
+ * io/io.h (DEFAULT_RECL, notification_std, get_unformatted_convert,
+ IOPARM_*, st_parameter_common, unit_convert, DEFAULT_TEMPDIR):
+ Move to libgfortran.h.
+ * io/unix.c: Add io/unix.h content.
+ (st_printf): New function.
+ * io/intrinsics.c: New file.
+ * io/unix.h: Remove, contents moved into unix.c.
+ * libtool-version: Update library version to 3.0.0.
+ * configure.ac: Update library version to 0.3.
+ * Makefile.am (intrinsics/fget.c, intrinsics/flush.c,
+ intrinsics/ftell.c, intrinsics/tty.c, libgfortran.h): Remove targets.
+ * Makefile.in: Regenerate.
+ * configure: Regenerate.
+
2007-01-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/30435
io/file_pos.c \
io/format.c \
io/inquire.c \
+io/intrinsics.c \
io/list_read.c \
io/lock.c \
io/open.c \
intrinsics/eoshift2.c \
intrinsics/etime.c \
intrinsics/exit.c \
-intrinsics/fget.c \
-intrinsics/flush.c \
intrinsics/fnum.c \
-intrinsics/ftell.c \
intrinsics/gerror.c \
intrinsics/getcwd.c \
intrinsics/getlog.c \
intrinsics/system_clock.c \
intrinsics/time.c \
intrinsics/transpose_generic.c \
-intrinsics/tty.c \
intrinsics/umask.c \
intrinsics/unlink.c \
intrinsics/unpack_generic.c \
runtime/pause.c \
runtime/stop.c \
runtime/string.c \
-runtime/select.c \
-libgfortran.h
+runtime/select.c
i_all_c= \
generated/all_l4.c \
$(am__objects_26) $(am__objects_27) $(am__objects_28) \
$(am__objects_29)
am__objects_31 = close.lo file_pos.lo format.lo inquire.lo \
- list_read.lo lock.lo open.lo read.lo size_from_kind.lo \
- transfer.lo unit.lo unix.lo write.lo
+ intrinsics.lo list_read.lo lock.lo open.lo read.lo \
+ size_from_kind.lo transfer.lo unit.lo unix.lo write.lo
am__objects_32 = associated.lo abort.lo access.lo args.lo \
c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
cshift0.lo ctime.lo date_and_time.lo env.lo eoshift0.lo \
- eoshift2.lo etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo \
- gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo kill.lo \
- ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo move_alloc.lo \
- pack_generic.lo perror.lo signal.lo size.lo sleep.lo \
- spread_generic.lo string_intrinsics.lo system.lo rand.lo \
- random.lo rename.lo reshape_generic.lo reshape_packed.lo \
- selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \
- system_clock.lo time.lo transpose_generic.lo tty.lo umask.lo \
- unlink.lo unpack_generic.lo in_pack_generic.lo \
- in_unpack_generic.lo
+ eoshift2.lo etime.lo exit.lo fnum.lo gerror.lo getcwd.lo \
+ getlog.lo getXid.lo hostnm.lo kill.lo ierrno.lo ishftc.lo \
+ link.lo malloc.lo mvbits.lo move_alloc.lo pack_generic.lo \
+ perror.lo signal.lo size.lo sleep.lo spread_generic.lo \
+ string_intrinsics.lo system.lo rand.lo random.lo rename.lo \
+ reshape_generic.lo reshape_packed.lo selected_int_kind.lo \
+ selected_real_kind.lo stat.lo symlnk.lo system_clock.lo \
+ time.lo transpose_generic.lo umask.lo unlink.lo \
+ unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo
am__objects_33 =
am__objects_34 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
io/file_pos.c \
io/format.c \
io/inquire.c \
+io/intrinsics.c \
io/list_read.c \
io/lock.c \
io/open.c \
intrinsics/eoshift2.c \
intrinsics/etime.c \
intrinsics/exit.c \
-intrinsics/fget.c \
-intrinsics/flush.c \
intrinsics/fnum.c \
-intrinsics/ftell.c \
intrinsics/gerror.c \
intrinsics/getcwd.c \
intrinsics/getlog.c \
intrinsics/system_clock.c \
intrinsics/time.c \
intrinsics/transpose_generic.c \
-intrinsics/tty.c \
intrinsics/umask.c \
intrinsics/unlink.c \
intrinsics/unpack_generic.c \
runtime/pause.c \
runtime/stop.c \
runtime/string.c \
-runtime/select.c \
-libgfortran.h
+runtime/select.c
i_all_c = \
generated/all_l4.c \
inquire.lo: io/inquire.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o inquire.lo `test -f 'io/inquire.c' || echo '$(srcdir)/'`io/inquire.c
+intrinsics.lo: io/intrinsics.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o intrinsics.lo `test -f 'io/intrinsics.c' || echo '$(srcdir)/'`io/intrinsics.c
+
list_read.lo: io/list_read.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o list_read.lo `test -f 'io/list_read.c' || echo '$(srcdir)/'`io/list_read.c
exit.lo: intrinsics/exit.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c
-fget.lo: intrinsics/fget.c
- $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fget.lo `test -f 'intrinsics/fget.c' || echo '$(srcdir)/'`intrinsics/fget.c
-
-flush.lo: intrinsics/flush.c
- $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o flush.lo `test -f 'intrinsics/flush.c' || echo '$(srcdir)/'`intrinsics/flush.c
-
fnum.lo: intrinsics/fnum.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c
-ftell.lo: intrinsics/ftell.c
- $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ftell.lo `test -f 'intrinsics/ftell.c' || echo '$(srcdir)/'`intrinsics/ftell.c
-
gerror.lo: intrinsics/gerror.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o gerror.lo `test -f 'intrinsics/gerror.c' || echo '$(srcdir)/'`intrinsics/gerror.c
transpose_generic.lo: intrinsics/transpose_generic.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_generic.lo `test -f 'intrinsics/transpose_generic.c' || echo '$(srcdir)/'`intrinsics/transpose_generic.c
-tty.lo: intrinsics/tty.c
- $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o tty.lo `test -f 'intrinsics/tty.c' || echo '$(srcdir)/'`intrinsics/tty.c
-
umask.lo: intrinsics/umask.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o umask.lo `test -f 'intrinsics/umask.c' || echo '$(srcdir)/'`intrinsics/umask.c
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59 for GNU Fortran Runtime Library 0.2.
+# Generated by GNU Autoconf 2.59 for GNU Fortran Runtime Library 0.3.
#
# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# Identity of this package.
PACKAGE_NAME='GNU Fortran Runtime Library'
PACKAGE_TARNAME='libgfortran'
-PACKAGE_VERSION='0.2'
-PACKAGE_STRING='GNU Fortran Runtime Library 0.2'
+PACKAGE_VERSION='0.3'
+PACKAGE_STRING='GNU Fortran Runtime Library 0.3'
PACKAGE_BUGREPORT=''
# Factoring default headers for most tests.
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures GNU Fortran Runtime Library 0.2 to adapt to many kinds of systems.
+\`configure' configures GNU Fortran Runtime Library 0.3 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of GNU Fortran Runtime Library 0.2:";;
+ short | recursive ) echo "Configuration of GNU Fortran Runtime Library 0.3:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit 0
if $ac_init_version; then
cat <<\_ACEOF
-GNU Fortran Runtime Library configure 0.2
+GNU Fortran Runtime Library configure 0.3
generated by GNU Autoconf 2.59
Copyright (C) 2003 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by GNU Fortran Runtime Library $as_me 0.2, which was
+It was created by GNU Fortran Runtime Library $as_me 0.3, which was
generated by GNU Autoconf 2.59. Invocation command line was
$ $0 $@
# Define the identity of the package.
PACKAGE='libgfortran'
- VERSION='0.2'
+ VERSION='0.3'
# Some tools Automake needs.
} >&5
cat >&5 <<_CSEOF
-This file was extended by GNU Fortran Runtime Library $as_me 0.2, which was
+This file was extended by GNU Fortran Runtime Library $as_me 0.3, which was
generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
-GNU Fortran Runtime Library config.status 0.2
+GNU Fortran Runtime Library config.status 0.3
configured by $0, generated by GNU Autoconf 2.59,
with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
# aclocal && autoconf && autoheader && automake
AC_PREREQ(2.59)
-AC_INIT([GNU Fortran Runtime Library], 0.2,,[libgfortran])
+AC_INIT([GNU Fortran Runtime Library], 0.3,,[libgfortran])
AC_CONFIG_HEADER(config.h)
GCC_TOPLEV_SUBDIRS
+++ /dev/null
-/* Implementation of the FLUSH intrinsic.
- Copyright (C) 2004, 2005 Free Software Foundation, Inc.
- Contributed by Steven G. Kargl <kargls@comcast.net>.
-
-This file is part of the GNU Fortran 95 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.)
-
-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 "config.h"
-#include "libgfortran.h"
-
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
-
-#include "../io/io.h"
-
-/* SUBROUTINE FLUSH(UNIT)
- INTEGER, INTENT(IN), OPTIONAL :: UNIT */
-
-extern void flush_i4 (GFC_INTEGER_4 *);
-export_proto(flush_i4);
-
-void
-flush_i4 (GFC_INTEGER_4 *unit)
-{
- gfc_unit *us;
-
- /* flush all streams */
- if (unit == NULL)
- flush_all_units ();
- else
- {
- us = find_unit (*unit);
- if (us != NULL)
- {
- flush (us->s);
- unlock_unit (us);
- }
- }
-}
-
-
-extern void flush_i8 (GFC_INTEGER_8 *);
-export_proto(flush_i8);
-
-void
-flush_i8 (GFC_INTEGER_8 *unit)
-{
- gfc_unit *us;
-
- /* flush all streams */
- if (unit == NULL)
- flush_all_units ();
- else
- {
- us = find_unit (*unit);
- if (us != NULL)
- {
- flush (us->s);
- unlock_unit (us);
- }
- }
-}
+++ /dev/null
-/* Implementation of the FTELL intrinsic.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-
-This file is part of the GNU Fortran 95 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.)
-
-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 "config.h"
-#include "libgfortran.h"
-
-#include <string.h>
-
-#include "../io/io.h"
-
-extern size_t PREFIX(ftell) (int *);
-export_proto_np(PREFIX(ftell));
-
-size_t
-PREFIX(ftell) (int * unit)
-{
- gfc_unit * u = find_unit (*unit);
- size_t ret;
- if (u == NULL)
- return ((size_t) -1);
- ret = (size_t) stream_offset (u->s);
- unlock_unit (u);
- return ret;
-}
-
-#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) \
- { \
- gfc_unit * u = find_unit (*unit); \
- if (u == NULL) \
- *offset = -1; \
- else \
- { \
- *offset = stream_offset (u->s); \
- unlock_unit (u); \
- } \
- }
-
-FTELL_SUB(1)
-FTELL_SUB(2)
-FTELL_SUB(4)
-FTELL_SUB(8)
+++ /dev/null
-/* Implementation of the ISATTY and TTYNAM g77 intrinsics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-
-This file is part of the GNU Fortran 95 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.)
-
-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 "config.h"
-#include "libgfortran.h"
-#include "../io/io.h"
-
-#include <string.h>
-
-/* LOGICAL FUNCTION ISATTY(UNIT)
- INTEGER, INTENT(IN) :: UNIT */
-
-extern GFC_LOGICAL_4 isatty_l4 (int *);
-export_proto(isatty_l4);
-
-GFC_LOGICAL_4
-isatty_l4 (int *unit)
-{
- gfc_unit *u;
- GFC_LOGICAL_4 ret = 0;
-
- u = find_unit (*unit);
- if (u != NULL)
- {
- ret = (GFC_LOGICAL_4) stream_isatty (u->s);
- unlock_unit (u);
- }
- return ret;
-}
-
-
-extern GFC_LOGICAL_8 isatty_l8 (int *);
-export_proto(isatty_l8);
-
-GFC_LOGICAL_8
-isatty_l8 (int *unit)
-{
- gfc_unit *u;
- GFC_LOGICAL_8 ret = 0;
-
- u = find_unit (*unit);
- if (u != NULL)
- {
- ret = (GFC_LOGICAL_8) stream_isatty (u->s);
- unlock_unit (u);
- }
- return ret;
-}
-
-
-/* SUBROUTINE TTYNAM(UNIT,NAME)
- INTEGER,SCALAR,INTENT(IN) :: UNIT
- CHARACTER,SCALAR,INTENT(OUT) :: NAME */
-
-extern void ttynam_sub (int *, char *, gfc_charlen_type);
-export_proto(ttynam_sub);
-
-void
-ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
-{
- gfc_unit *u;
- char * n;
- int i;
-
- memset (name, ' ', name_len);
- u = find_unit (*unit);
- if (u != NULL)
- {
- n = stream_ttyname (u->s);
- if (n != NULL)
- {
- i = 0;
- while (*n && i < name_len)
- name[i++] = *(n++);
- }
- unlock_unit (u);
- }
-}
-
-
-extern void ttynam (char **, gfc_charlen_type *, int);
-export_proto(ttynam);
-
-void
-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_len = strlen (*name);
- *name = strdup (*name);
- unlock_unit (u);
- return;
- }
- unlock_unit (u);
- }
-
- *name_len = 0;
- *name = NULL;
-}
-/* Implementation of the FGET, FGETC, FPUT and FPUTC intrinsics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH
+ FTELL, TTYNAM and ISATTY intrinsics.
+ Copyright (C) 2005, 2007 Free Software Foundation, Inc.
This file is part of the GNU Fortran 95 runtime library (libgfortran).
#include "config.h"
#include "libgfortran.h"
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
#include <string.h>
-#include "../io/io.h"
+#include "io.h"
static const int five = 5;
static const int six = 6;
FPUT_SUB(4)
FPUT_SUB(8)
+
+/* SUBROUTINE FLUSH(UNIT)
+ INTEGER, INTENT(IN), OPTIONAL :: UNIT */
+
+extern void flush_i4 (GFC_INTEGER_4 *);
+export_proto(flush_i4);
+
+void
+flush_i4 (GFC_INTEGER_4 *unit)
+{
+ gfc_unit *us;
+
+ /* flush all streams */
+ if (unit == NULL)
+ flush_all_units ();
+ else
+ {
+ us = find_unit (*unit);
+ if (us != NULL)
+ {
+ flush (us->s);
+ unlock_unit (us);
+ }
+ }
+}
+
+
+extern void flush_i8 (GFC_INTEGER_8 *);
+export_proto(flush_i8);
+
+void
+flush_i8 (GFC_INTEGER_8 *unit)
+{
+ gfc_unit *us;
+
+ /* flush all streams */
+ if (unit == NULL)
+ flush_all_units ();
+ else
+ {
+ us = find_unit (*unit);
+ if (us != NULL)
+ {
+ flush (us->s);
+ unlock_unit (us);
+ }
+ }
+}
+
+
+/* FTELL intrinsic */
+
+extern size_t PREFIX(ftell) (int *);
+export_proto_np(PREFIX(ftell));
+
+size_t
+PREFIX(ftell) (int * unit)
+{
+ gfc_unit * u = find_unit (*unit);
+ size_t ret;
+ if (u == NULL)
+ return ((size_t) -1);
+ ret = (size_t) stream_offset (u->s);
+ unlock_unit (u);
+ return ret;
+}
+
+#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) \
+ { \
+ gfc_unit * u = find_unit (*unit); \
+ if (u == NULL) \
+ *offset = -1; \
+ else \
+ { \
+ *offset = stream_offset (u->s); \
+ unlock_unit (u); \
+ } \
+ }
+
+FTELL_SUB(1)
+FTELL_SUB(2)
+FTELL_SUB(4)
+FTELL_SUB(8)
+
+
+
+/* LOGICAL FUNCTION ISATTY(UNIT)
+ INTEGER, INTENT(IN) :: UNIT */
+
+extern GFC_LOGICAL_4 isatty_l4 (int *);
+export_proto(isatty_l4);
+
+GFC_LOGICAL_4
+isatty_l4 (int *unit)
+{
+ gfc_unit *u;
+ GFC_LOGICAL_4 ret = 0;
+
+ u = find_unit (*unit);
+ if (u != NULL)
+ {
+ ret = (GFC_LOGICAL_4) stream_isatty (u->s);
+ unlock_unit (u);
+ }
+ return ret;
+}
+
+
+extern GFC_LOGICAL_8 isatty_l8 (int *);
+export_proto(isatty_l8);
+
+GFC_LOGICAL_8
+isatty_l8 (int *unit)
+{
+ gfc_unit *u;
+ GFC_LOGICAL_8 ret = 0;
+
+ u = find_unit (*unit);
+ if (u != NULL)
+ {
+ ret = (GFC_LOGICAL_8) stream_isatty (u->s);
+ unlock_unit (u);
+ }
+ return ret;
+}
+
+
+/* SUBROUTINE TTYNAM(UNIT,NAME)
+ INTEGER,SCALAR,INTENT(IN) :: UNIT
+ CHARACTER,SCALAR,INTENT(OUT) :: NAME */
+
+extern void ttynam_sub (int *, char *, gfc_charlen_type);
+export_proto(ttynam_sub);
+
+void
+ttynam_sub (int *unit, char * name, gfc_charlen_type name_len)
+{
+ gfc_unit *u;
+ char * n;
+ int i;
+
+ memset (name, ' ', name_len);
+ u = find_unit (*unit);
+ if (u != NULL)
+ {
+ n = stream_ttyname (u->s);
+ if (n != NULL)
+ {
+ i = 0;
+ while (*n && i < name_len)
+ name[i++] = *(n++);
+ }
+ unlock_unit (u);
+ }
+}
+
+
+extern void ttynam (char **, gfc_charlen_type *, int);
+export_proto(ttynam);
+
+void
+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_len = strlen (*name);
+ *name = strdup (*name);
+ unlock_unit (u);
+ return;
+ }
+ unlock_unit (u);
+ }
+
+ *name_len = 0;
+ *name = NULL;
+}
#include <gthr.h>
-#define DEFAULT_TEMPDIR "/tmp"
-
/* Basic types used in data transfers. */
typedef enum
{READING, WRITING}
unit_mode;
-typedef enum
-{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
-unit_convert;
-
#define CHARACTER1(name) \
char * name; \
gfc_charlen_type name ## _len
gfc_charlen_type name ## _len; \
char * name
-#define IOPARM_LIBRETURN_MASK (3 << 0)
-#define IOPARM_LIBRETURN_OK (0 << 0)
-#define IOPARM_LIBRETURN_ERROR (1 << 0)
-#define IOPARM_LIBRETURN_END (2 << 0)
-#define IOPARM_LIBRETURN_EOR (3 << 0)
-#define IOPARM_ERR (1 << 2)
-#define IOPARM_END (1 << 3)
-#define IOPARM_EOR (1 << 4)
-#define IOPARM_HAS_IOSTAT (1 << 5)
-#define IOPARM_HAS_IOMSG (1 << 6)
-
-#define IOPARM_COMMON_MASK ((1 << 7) - 1)
-
-typedef struct st_parameter_common
-{
- GFC_INTEGER_4 flags;
- GFC_INTEGER_4 unit;
- const char *filename;
- GFC_INTEGER_4 line;
- CHARACTER2 (iomsg);
- GFC_INTEGER_4 *iostat;
-}
-st_parameter_common;
-
-#define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
-#define IOPARM_OPEN_HAS_FILE (1 << 8)
-#define IOPARM_OPEN_HAS_STATUS (1 << 9)
-#define IOPARM_OPEN_HAS_ACCESS (1 << 10)
-#define IOPARM_OPEN_HAS_FORM (1 << 11)
-#define IOPARM_OPEN_HAS_BLANK (1 << 12)
-#define IOPARM_OPEN_HAS_POSITION (1 << 13)
-#define IOPARM_OPEN_HAS_ACTION (1 << 14)
-#define IOPARM_OPEN_HAS_DELIM (1 << 15)
-#define IOPARM_OPEN_HAS_PAD (1 << 16)
-#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
-
typedef struct
{
st_parameter_common common;
unit_flags;
-/* The default value of record length for preconnected units is defined
- here. This value can be overriden by an environment variable.
- Default value is 1 Gb. */
-
-#define DEFAULT_RECL 1073741824
-
-
typedef struct gfc_unit
{
int unit_number;
size_t);
internal_proto(list_formatted_write);
-/* error.c */
-extern notification notification_std(int);
-internal_proto(notification_std);
-
/* size_from_kind.c */
extern size_t size_from_real_kind (int);
internal_proto(size_from_real_kind);
#endif
-/* ../runtime/environ.c This is here because we return unit_convert. */
-
-unit_convert get_unformatted_convert (int);
-internal_proto(get_unformatted_convert);
-/* Copyright (C) 2002, 2003, 2004, 2005
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
#include <unistd.h>
#include <stdio.h>
+#include <stdarg.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <assert.h>
#include "libgfortran.h"
#include "io.h"
-#include "unix.h"
#ifndef SSIZE_MAX
#define SSIZE_MAX SHRT_MAX
#define S_IWOTH 0
#endif
+
+/* Unix stream I/O module */
+
+#define BUFFER_SIZE 8192
+
+typedef struct
+{
+ stream st;
+
+ int fd;
+ gfc_offset buffer_offset; /* File offset of the start of the buffer */
+ gfc_offset physical_offset; /* Current physical file offset */
+ gfc_offset logical_offset; /* Current logical file offset */
+ gfc_offset dirty_offset; /* Start of modified bytes in buffer */
+ gfc_offset file_length; /* Length of the file, -1 if not seekable. */
+
+ char *buffer;
+ int len; /* Physical length of the current buffer */
+ int active; /* Length of valid bytes in the buffer */
+
+ int prot;
+ int ndirty; /* Dirty bytes starting at dirty_offset */
+
+ int special_file; /* =1 if the fd refers to a special file */
+
+ unsigned unbuffered:1;
+
+ char small_buffer[BUFFER_SIZE];
+
+}
+unix_stream;
+
+extern stream *init_error_stream (unix_stream *);
+internal_proto(init_error_stream);
+
+
/* This implementation of stream I/O is based on the paper:
*
* "Exploiting the advantages of mapped files for stream I/O",
return (stream *) error;
}
+/* st_printf()-- simple printf() function for streams that handles the
+ * formats %d, %s and %c. This function handles printing of error
+ * messages that originate within the library itself, not from a user
+ * program. */
+
+int
+st_printf (const char *format, ...)
+{
+ int count, total;
+ va_list arg;
+ char *p;
+ const char *q;
+ stream *s;
+ char itoa_buf[GFC_ITOA_BUF_SIZE];
+ unix_stream err_stream;
+
+ total = 0;
+ s = init_error_stream (&err_stream);
+ va_start (arg, format);
+
+ for (;;)
+ {
+ count = 0;
+
+ while (format[count] != '%' && format[count] != '\0')
+ count++;
+
+ if (count != 0)
+ {
+ p = salloc_w (s, &count);
+ memmove (p, format, count);
+ sfree (s);
+ }
+
+ total += count;
+ format += count;
+ if (*format++ == '\0')
+ break;
+
+ switch (*format)
+ {
+ case 'c':
+ count = 1;
+
+ p = salloc_w (s, &count);
+ *p = (char) va_arg (arg, int);
+
+ sfree (s);
+ break;
+
+ case 'd':
+ q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case 'x':
+ q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case 's':
+ q = va_arg (arg, char *);
+ count = strlen (q);
+
+ p = salloc_w (s, &count);
+ memmove (p, q, count);
+ sfree (s);
+ break;
+
+ case '\0':
+ return total;
+
+ default:
+ count = 2;
+ p = salloc_w (s, &count);
+ p[0] = format[-1];
+ p[1] = format[0];
+ sfree (s);
+ break;
+ }
+
+ total += count;
+ format++;
+ }
+
+ va_end (arg);
+ return total;
+}
+
/* compare_file_filename()-- Given an open stream and a fortran string
* that is a filename, figure out if the file is the same as the
+++ /dev/null
-/* Copyright (C) 2002, 2003, 2004, 2005
- Free Software Foundation, Inc.
- Contributed by Andy Vaught
-
-This file is part of the GNU Fortran 95 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, 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.)
-
-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, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
-
-/* Unix stream I/O module */
-
-#define BUFFER_SIZE 8192
-
-typedef struct
-{
- stream st;
-
- int fd;
- gfc_offset buffer_offset; /* File offset of the start of the buffer */
- gfc_offset physical_offset; /* Current physical file offset */
- gfc_offset logical_offset; /* Current logical file offset */
- gfc_offset dirty_offset; /* Start of modified bytes in buffer */
- gfc_offset file_length; /* Length of the file, -1 if not seekable. */
-
- char *buffer;
- int len; /* Physical length of the current buffer */
- int active; /* Length of valid bytes in the buffer */
-
- int prot;
- int ndirty; /* Dirty bytes starting at dirty_offset */
-
- int special_file; /* =1 if the fd refers to a special file */
-
- unsigned unbuffered:1;
-
- char small_buffer[BUFFER_SIZE];
-
-}
-unix_stream;
-
-extern stream *init_error_stream (unix_stream *);
-internal_proto(init_error_stream);
#define __attribute__(x)
#endif
+
/* For a library, a standard prefix is a requirement in order to partition
the namespace. IPREFIX is for symbols intended to be internal to the
library. */
#define gfc_alloca(x) __builtin_alloca(x)
+/* Various I/O stuff also used in other parts of the library. */
+
+#define DEFAULT_TEMPDIR "/tmp"
+
+/* The default value of record length for preconnected units is defined
+ here. This value can be overriden by an environment variable.
+ Default value is 1 Gb. */
+#define DEFAULT_RECL 1073741824
+
+typedef enum
+{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
+unit_convert;
+
+#define CHARACTER2(name) \
+ gfc_charlen_type name ## _len; \
+ char * name
+
+typedef struct st_parameter_common
+{
+ GFC_INTEGER_4 flags;
+ GFC_INTEGER_4 unit;
+ const char *filename;
+ GFC_INTEGER_4 line;
+ CHARACTER2 (iomsg);
+ GFC_INTEGER_4 *iostat;
+}
+st_parameter_common;
+
+#undef CHARACTER2
+
+#define IOPARM_LIBRETURN_MASK (3 << 0)
+#define IOPARM_LIBRETURN_OK (0 << 0)
+#define IOPARM_LIBRETURN_ERROR (1 << 0)
+#define IOPARM_LIBRETURN_END (2 << 0)
+#define IOPARM_LIBRETURN_EOR (3 << 0)
+#define IOPARM_ERR (1 << 2)
+#define IOPARM_END (1 << 3)
+#define IOPARM_EOR (1 << 4)
+#define IOPARM_HAS_IOSTAT (1 << 5)
+#define IOPARM_HAS_IOMSG (1 << 6)
+
+#define IOPARM_COMMON_MASK ((1 << 7) - 1)
+
+#define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
+#define IOPARM_OPEN_HAS_FILE (1 << 8)
+#define IOPARM_OPEN_HAS_STATUS (1 << 9)
+#define IOPARM_OPEN_HAS_ACCESS (1 << 10)
+#define IOPARM_OPEN_HAS_FORM (1 << 11)
+#define IOPARM_OPEN_HAS_BLANK (1 << 12)
+#define IOPARM_OPEN_HAS_POSITION (1 << 13)
+#define IOPARM_OPEN_HAS_ACTION (1 << 14)
+#define IOPARM_OPEN_HAS_DELIM (1 << 15)
+#define IOPARM_OPEN_HAS_PAD (1 << 16)
+#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
+
+
/* main.c */
extern void stupid_function_name_for_static_linking (void);
internal_proto(stupid_function_name_for_static_linking);
-struct st_parameter_common;
-extern void library_start (struct st_parameter_common *);
+extern void library_start (st_parameter_common *);
internal_proto(library_start);
#define library_end()
extern void os_error (const char *) __attribute__ ((noreturn));
internal_proto(os_error);
-extern void show_locus (struct st_parameter_common *);
+extern void show_locus (st_parameter_common *);
internal_proto(show_locus);
extern void runtime_error (const char *) __attribute__ ((noreturn));
iexport_proto(runtime_error);
-extern void internal_error (struct st_parameter_common *, const char *)
+extern void internal_error (st_parameter_common *, const char *)
__attribute__ ((noreturn));
internal_proto(internal_error);
extern void sys_exit (int) __attribute__ ((noreturn));
internal_proto(sys_exit);
-extern int st_printf (const char *, ...)
- __attribute__ ((format (printf, 1, 2)));
-internal_proto(st_printf);
-
extern void st_sprintf (char *, const char *, ...)
__attribute__ ((format (printf, 2, 3)));
internal_proto(st_sprintf);
extern const char *translate_error (int);
internal_proto(translate_error);
-extern void generate_error (struct st_parameter_common *, int, const char *);
+extern void generate_error (st_parameter_common *, int, const char *);
internal_proto(generate_error);
-extern try notify_std (struct st_parameter_common *, int, const char *);
+extern try notify_std (st_parameter_common *, int, const char *);
internal_proto(notify_std);
+extern notification notification_std(int);
+internal_proto(notification_std);
+
/* fpu.c */
extern void set_fpu (void);
extern void show_variables (void);
internal_proto(show_variables);
+unit_convert get_unformatted_convert (int);
+internal_proto(get_unformatted_convert);
+
/* string.c */
-extern int find_option (struct st_parameter_common *, const char *, int,
+extern int find_option (st_parameter_common *, const char *, int,
const st_option *, const char *);
internal_proto(find_option);
extern int unit_to_fd (int);
internal_proto(unit_to_fd);
+extern int st_printf (const char *, ...)
+ __attribute__ ((format (printf, 1, 2)));
+internal_proto(st_printf);
+
/* stop.c */
extern void stop_numeric (GFC_INTEGER_4);
# This is a separate file so that version updates don't involve re-running
# automake.
# CURRENT:REVISION:AGE
-2:0:0
+3:0:0
#include <ctype.h>
#include "libgfortran.h"
-#include "../io/io.h"
-
/* Environment scanner. Examine the environment for controlling minor
* aspects of the program's execution. Our philosophy here that the
#include <errno.h>
#include "libgfortran.h"
-#include "../io/io.h"
-#include "../io/unix.h"
/* Error conditions. The tricky part here is printing a message when
* it is the I/O subsystem that is severely wounded. Our goal is to
}
-/* st_printf()-- simple printf() function for streams that handles the
- * formats %d, %s and %c. This function handles printing of error
- * messages that originate within the library itself, not from a user
- * program. */
-
-int
-st_printf (const char *format, ...)
-{
- int count, total;
- va_list arg;
- char *p;
- const char *q;
- stream *s;
- char itoa_buf[GFC_ITOA_BUF_SIZE];
- unix_stream err_stream;
-
- total = 0;
- s = init_error_stream (&err_stream);
- va_start (arg, format);
-
- for (;;)
- {
- count = 0;
-
- while (format[count] != '%' && format[count] != '\0')
- count++;
-
- if (count != 0)
- {
- p = salloc_w (s, &count);
- memmove (p, format, count);
- sfree (s);
- }
-
- total += count;
- format += count;
- if (*format++ == '\0')
- break;
-
- switch (*format)
- {
- case 'c':
- count = 1;
-
- p = salloc_w (s, &count);
- *p = (char) va_arg (arg, int);
-
- sfree (s);
- break;
-
- case 'd':
- q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
- count = strlen (q);
-
- p = salloc_w (s, &count);
- memmove (p, q, count);
- sfree (s);
- break;
-
- case 'x':
- q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
- count = strlen (q);
-
- p = salloc_w (s, &count);
- memmove (p, q, count);
- sfree (s);
- break;
-
- case 's':
- q = va_arg (arg, char *);
- count = strlen (q);
-
- p = salloc_w (s, &count);
- memmove (p, q, count);
- sfree (s);
- break;
-
- case '\0':
- return total;
-
- default:
- count = 2;
- p = salloc_w (s, &count);
- p[0] = format[-1];
- p[1] = format[0];
- sfree (s);
- break;
- }
-
- total += count;
- format++;
- }
-
- va_end (arg);
- return total;
-}
-
-
/* st_sprintf()-- Simple sprintf() for formatting memory buffers. */
void
#include <string.h>
#include "libgfortran.h"
-#include "../io/io.h"
/* Compare a C-style string with a fortran style string in a case-insensitive
manner. Used for decoding string options to various statements. Returns
/* Strip trailing blanks from the Fortran string. */
len = fstrlen (s1, s1_len);
- if(len != strlen(s2)) return 0; /* don't match */
+ if (len != (int) strlen(s2)) return 0; /* don't match */
return strncasecmp (s1, s2, len) == 0;
}
projects / thirdparty / gcc.git / commitdiff
