diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 17c960738d3..a8d0fdcee71 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,32 @@ +2007-01-17 Francois-Xavier Coudert + + 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 PR libgfortran/30435 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index b6bf05b2dc6..c1cb3ac19dc 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -25,6 +25,7 @@ io/close.c \ io/file_pos.c \ io/format.c \ io/inquire.c \ +io/intrinsics.c \ io/list_read.c \ io/lock.c \ io/open.c \ @@ -56,10 +57,7 @@ intrinsics/eoshift0.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 \ @@ -92,7 +90,6 @@ intrinsics/symlnk.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 \ @@ -109,8 +106,7 @@ runtime/memory.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 \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index c73bb0d74eb..267762c6ea4 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -167,21 +167,20 @@ am__objects_30 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ $(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 \ @@ -384,6 +383,7 @@ io/close.c \ io/file_pos.c \ io/format.c \ io/inquire.c \ +io/intrinsics.c \ io/list_read.c \ io/lock.c \ io/open.c \ @@ -415,10 +415,7 @@ intrinsics/eoshift0.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 \ @@ -451,7 +448,6 @@ intrinsics/symlnk.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 \ @@ -468,8 +464,7 @@ runtime/memory.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 \ @@ -2317,6 +2312,9 @@ format.lo: io/format.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 @@ -2395,18 +2393,9 @@ etime.lo: intrinsics/etime.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 @@ -2497,9 +2486,6 @@ time.lo: intrinsics/time.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 diff --git a/libgfortran/configure b/libgfortran/configure index d775aec3935..187df07d586 100755 --- a/libgfortran/configure +++ b/libgfortran/configure @@ -1,6 +1,6 @@ #! /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 @@ -267,8 +267,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # 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. @@ -777,7 +777,7 @@ if test "$ac_init_help" = "long"; then # 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]... @@ -844,7 +844,7 @@ fi 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 @@ -977,7 +977,7 @@ fi 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. @@ -991,7 +991,7 @@ cat >&5 <<_ACEOF 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 $@ @@ -1815,7 +1815,7 @@ fi # Define the identity of the package. PACKAGE='libgfortran' - VERSION='0.2' + VERSION='0.3' # Some tools Automake needs. @@ -24570,7 +24570,7 @@ _ASBOX } >&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 @@ -24633,7 +24633,7 @@ _ACEOF 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'`\\" diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac index 23e80fda38b..023e4d3b1e0 100644 --- a/libgfortran/configure.ac +++ b/libgfortran/configure.ac @@ -2,7 +2,7 @@ # 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 diff --git a/libgfortran/intrinsics/flush.c b/libgfortran/intrinsics/flush.c deleted file mode 100644 index 2164b47473e..00000000000 --- a/libgfortran/intrinsics/flush.c +++ /dev/null @@ -1,87 +0,0 @@ -/* Implementation of the FLUSH intrinsic. - Copyright (C) 2004, 2005 Free Software Foundation, Inc. - Contributed by Steven G. Kargl . - -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 -#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); - } - } -} diff --git a/libgfortran/intrinsics/ftell.c b/libgfortran/intrinsics/ftell.c deleted file mode 100644 index 311f070cd16..00000000000 --- a/libgfortran/intrinsics/ftell.c +++ /dev/null @@ -1,72 +0,0 @@ -/* Implementation of the FTELL intrinsic. - Copyright (C) 2005 Free Software Foundation, Inc. - Contributed by François-Xavier Coudert - -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 - -#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) diff --git a/libgfortran/intrinsics/tty.c b/libgfortran/intrinsics/tty.c deleted file mode 100644 index 93416f9983c..00000000000 --- a/libgfortran/intrinsics/tty.c +++ /dev/null @@ -1,132 +0,0 @@ -/* Implementation of the ISATTY and TTYNAM g77 intrinsics. - Copyright (C) 2005 Free Software Foundation, Inc. - Contributed by François-Xavier Coudert - -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 - -/* 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; -} diff --git a/libgfortran/intrinsics/fget.c b/libgfortran/io/intrinsics.c similarity index 57% rename from libgfortran/intrinsics/fget.c rename to libgfortran/io/intrinsics.c index 5c87ae6c3c1..ab99b25e5a5 100644 --- a/libgfortran/intrinsics/fget.c +++ b/libgfortran/io/intrinsics.c @@ -1,6 +1,6 @@ -/* Implementation of the FGET, FGETC, FPUT and FPUTC intrinsics. - Copyright (C) 2005 Free Software Foundation, Inc. - Contributed by François-Xavier Coudert +/* 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). @@ -31,9 +31,13 @@ Boston, MA 02110-1301, USA. */ #include "config.h" #include "libgfortran.h" +#ifdef HAVE_STDLIB_H +#include +#endif + #include -#include "../io/io.h" +#include "io.h" static const int five = 5; static const int six = 6; @@ -175,3 +179,189 @@ FPUT_SUB(2) 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; +} diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 314fc4cc818..8d8d592d40b 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -35,8 +35,6 @@ Boston, MA 02110-1301, USA. */ #include -#define DEFAULT_TEMPDIR "/tmp" - /* Basic types used in data transfers. */ typedef enum @@ -205,10 +203,6 @@ 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 @@ -216,42 +210,6 @@ unit_convert; 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; @@ -475,13 +433,6 @@ typedef struct 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; @@ -877,10 +828,6 @@ extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, 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); @@ -926,7 +873,3 @@ dec_waiting_unlocked (gfc_unit *u) #endif -/* ../runtime/environ.c This is here because we return unit_convert. */ - -unit_convert get_unformatted_convert (int); -internal_proto(get_unformatted_convert); diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 3419d72d75a..aa1dd1fdf59 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2002, 2003, 2004, 2005 +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA. */ #include #include +#include #include #include #include @@ -45,7 +46,6 @@ Boston, MA 02110-1301, USA. */ #include "libgfortran.h" #include "io.h" -#include "unix.h" #ifndef SSIZE_MAX #define SSIZE_MAX SHRT_MAX @@ -81,6 +81,42 @@ Boston, MA 02110-1301, USA. */ #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", @@ -1346,6 +1382,103 @@ init_error_stream (unix_stream *error) 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 diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h deleted file mode 100644 index 25508f117da..00000000000 --- a/libgfortran/io/unix.h +++ /dev/null @@ -1,63 +0,0 @@ -/* 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); diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index c6b31ed908a..dc93b2f73b1 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -67,6 +67,7 @@ typedef off_t gfc_offset; #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. */ @@ -469,13 +470,68 @@ iexport_data_proto(filename); #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() @@ -502,13 +558,13 @@ internal_proto(xtoa); 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); @@ -518,10 +574,6 @@ internal_proto(get_oserror); 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); @@ -529,12 +581,15 @@ 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); @@ -565,9 +620,12 @@ internal_proto(init_variables); 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); @@ -591,6 +649,10 @@ internal_proto(close_units); 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); diff --git a/libgfortran/libtool-version b/libgfortran/libtool-version index 64c83c4b42d..f787e378b07 100644 --- a/libgfortran/libtool-version +++ b/libgfortran/libtool-version @@ -3,4 +3,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 diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c index 555b4482c69..21c2cc9f717 100644 --- a/libgfortran/runtime/environ.c +++ b/libgfortran/runtime/environ.c @@ -34,8 +34,6 @@ Boston, MA 02110-1301, USA. */ #include #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 diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 35955644ba5..c0787dead66 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */ #include #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 @@ -122,104 +120,6 @@ xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) } -/* 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 diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c index a92082f73ee..a0c44980feb 100644 --- a/libgfortran/runtime/string.c +++ b/libgfortran/runtime/string.c @@ -31,7 +31,6 @@ Boston, MA 02110-1301, USA. */ #include #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 @@ -44,7 +43,7 @@ compare0 (const char *s1, int s1_len, const char *s2) /* 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; }