OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/27107 (Make dependency on io/io.h broken) 

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.

From-SVN: r120869
This commit is contained in:
Francois-Xavier Coudert 2007-01-17 20:44:00 +01:00 committed by François-Xavier Coudert
parent e7fd0be47b
commit 0dce3ca161
17 changed files with 462 additions and 580 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
libgfortran/ChangeLog
View File

@ -1,3 +1,32 @@
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

8
libgfortran/Makefile.am
View File

@ -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 \

46
libgfortran/Makefile.in
View File

@ -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

20
libgfortran/configure vendored
View File

@ -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'`\\"

2
libgfortran/configure.ac
View File

@ -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

87
libgfortran/intrinsics/flush.c
View File

@ -1,87 +0,0 @@
/* 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);
}
}
}

72
libgfortran/intrinsics/ftell.c
View File

@ -1,72 +0,0 @@
/* 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)

132
libgfortran/intrinsics/tty.c
View File

@ -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 <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;
}

198
libgfortran/intrinsics/fget.c → libgfortran/io/intrinsics.c
View File

@ -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 <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).
@ -31,9 +31,13 @@ Boston, MA 02110-1301, USA. */
#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;
@ -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;
}

57
libgfortran/io/io.h
View File

@ -35,8 +35,6 @@ Boston, MA 02110-1301, USA. */
#include <gthr.h>
#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);

137
libgfortran/io/unix.c
View File

@ -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 <unistd.h>
#include <stdio.h>
#include <stdarg.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <assert.h>
@ -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

63
libgfortran/io/unix.h
View File

@ -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);

84
libgfortran/libgfortran.h
View File

@ -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);

2
libgfortran/libtool-version
View File

@ -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

2
libgfortran/runtime/environ.c
View File

@ -34,8 +34,6 @@ Boston, MA 02110-1301, USA. */
#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

100
libgfortran/runtime/error.c
View File

@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
#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
@ -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

3
libgfortran/runtime/string.c
View File

@ -31,7 +31,6 @@ Boston, MA 02110-1301, USA. */
#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
@ -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;
}