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
François-Xavier Coudert
parent
e7fd0be47b
commit
0dce3ca161
@ -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
|
||||
|
||||
@ -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 \
|
||||
|
||||
@ -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
20
libgfortran/configure
vendored
@ -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,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
|
||||
|
||||
|
||||
@ -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);
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -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)
|
||||
@ -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;
|
||||
}
|
||||
@ -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;
|
||||
}
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user